siteinit.l

; 雀の往来

(require "isearch")
(require "ni/setup")
(require "wandbox")
(ni-autoload)

(setq-default backup-by-copying t)
(setf
 (symbol-function 'backward-delete-char-untabify-or-selection) #'delete-backward-char-or-selection
 backup-by-copying t
 *lisp-indent-tabs-mode* nil
 *next-buffer-in-tab-order* t
 *default-buffer-mode* 'text-mode
 ed::*default-fileio-encoding* *encoding-utf8n*
 ed::*default-eol-code* 0)

(set-extended-key-translate-table exkey-M-return #\M-RET)

(global-set-key '(#\C-x #\3) 'split-window-vertically)
(global-set-key #\C-F6 'next-buffer)
(global-set-key #\C-S-F6 'previous-buffer)
(global-set-key #\M-i 'tab-to-tab-stop)
(global-set-key #\C-h 'delete-backward-char-or-selection)
(global-set-key #\C-_ 'undo)
(global-set-key '(#\C-x #\u) 'undo)
(global-set-key #\C-z 'undo)
(global-set-key #\M-z 'redo)
(global-set-key #\M-g 'goto-line)
(global-set-key #\C-\\ 'toggle-ime)
(global-set-key '(#\C-x #\C-w) 'emacs-write-file)
(global-set-key '(#\C-x #\h) 'selection-whole-buffer)
(global-set-key #\C-\| 'redo)
(global-set-key #\Home 'beginning-of-buffer)
(global-set-key #\End 'end-of-buffer)
(global-set-key #\C-Left 'previous-buffer)
(global-set-key #\C-Right 'next-buffer)
(global-set-key #\C-\M-o 'previous-buffer)
(global-set-key #\C-\M-p 'next-buffer)
(global-set-key #\M-: 'eval-expression)
(global-set-key '(#\C-c #\e) 'launch-explorer)
(global-set-key #\C-F3 'next-buffer-fold-type)
(global-set-key '(#\C-x #\C-k #\C-f) 'change-fileio-encoding-reload)
(global-set-key '(#\C-x #\C-k #\r) 'revert-buffer-toggle)
(global-set-key '(#\C-x #\C-k #\m) 'change-eol-code-reload)
(global-set-key '(#\C-c #\w) 'wandbox:post-wandbox)
(global-set-key '(#\C-c #\W) 'wandbox:post-wandbox-region)

(defun new-xyzzy ()
  (interactive)
  (launch-application (get-short-path-name (merge-pathnames "xyzzy.exe" (si:system-root)))))

(defun rename-buffer-with-directory (&optional BUFFER)
  (interactive)
  (unless BUFFER
    (setf BUFFER (selected-buffer)))
  (let ((tbn (get-buffer-file-name BUFFER))
        (bn (buffer-name BUFFER))
        (idmax 2))
    (while
        (string-match "<[0-9]+>" bn)
      (setf bn (substring bn 0 (string-match "<[0-9]+>" bn)))
      (let ((fl (split-string tbn "/"))
            (fln (length fl))
            (id idmax))
        (while (not (rename-buffer (abbreviate-display-string (setf bn (concat (nth (- fln id) fl) "/" bn)) 35) BUFFER))
          (decf id))
        (setq bn (buffer-name BUFFER))
        (incf idmax)))))

(defun launch-explorer ()
  (interactive)
  (launch-application "cmd /c start ."))

(defun change-eol-code-reload (&optional eol-code)
  (interactive "p")
  (let ((eol-list '(0 1 2)) eol key)
    (unless eol-code
      (setf eol 0))
    (loop
      (let ((*expected-eol-code* eol))
        (declare (special *expected-eol-code*))
        (revert-buffer (char-encoding-name (buffer-fileio-encoding))))
      (refresh-screen)
      (message "eol code : ~A" (case eol
                                 (0 "LF")
                                 (1 "CRLF")
                                 (2 "CR")))
      (setf eol-list (append (cdr eol-list) (list eol))
            key (read-char *keyboard*))
      (setf eol (car eol-list))
      (when (not (eq key #\m))
        (unread-char key)
        (return-from change-eol-code-reload)))))

(defun change-fileio-encoding-reload (encoding)
  (interactive "zEncoding: ")
  (let ((*expected-eol-code* (buffer-eol-code)))
    (declare (special *expected-eol-code*))
    (revert-buffer encoding)))

(defun revert-buffer-toggle (&optional encodinglist)
  (interactive)
  (let ((encode (list *encoding-utf8n* *encoding-euc-jp* *encoding-sjis*)) key)
    (if (and encodinglist
             (dolist (item encodinglist t)
               (when (not (char-encoding-p item))
                 (return-from revert-buffer-toggle))))
        (setf encode encodinglist))
    (loop
      (let ((*expected-eol-code* (buffer-eol-code)))
        (declare (special *expected-eol-code*))
        (revert-buffer (car encode)))
      (refresh-screen)
      (message "char set : ~A" (char-encoding-name (car encode)))
      (setf encode (append (cdr encode)(list (car encode)))
            key (read-char *keyboard*))
      (when (not (eq key #\r))
        (unread-char key)
        (return-from revert-buffer-toggle)))))

(defun shell-execute-current-file ()
  (interactive)
  (save-buffer)
  (launch-application (format nil "cmd /c start \"\" \"~A\"" (get-buffer-file-name))))

(defun next-buffer-fold-type ()
  (interactive)
  (case
      (cond
       ((set-buffer-fold-type-none-update) 0)
       ((set-buffer-fold-type-column-update) 1)
       ((set-buffer-fold-type-window-update) 2))
    (0 (set-buffer-fold-type-window)(message "fold-window"))
    (1 (set-buffer-fold-type-none)(message "fold-none"))
    (2 (set-buffer-fold-type-column)(message "fold-column"))))

(add-hook
 'ed::*csharp-mode-hook*
 #'(lambda ()
     (setf
      csharp-indent-level 4
      csharp-continued-statement-offset 4
      csharp-argdecl-indent 4
      csharp-brace-offset 0
      csharp-brace-imaginary-offset 0
      csharp-label-offset -4
      csharp-preprocessor-offset nil
      csharp-comment-indent 4
      indent-tabs-mode t)))
(add-hook
 'ed::*c-mode-hook*
 #'(lambda ()
     (setf
      c-indent-level 4
      c-continued-statement-offset 4
      c-argdecl-indent 4
      c-brace-offset 0
      c-brace-imaginary-offset 0
      c-label-offset -4
      c-preprocessor-offset nil
      c-comment-indent 4
      indent-tabs-mode t)))
(add-hook
 'ed::*c++-mode-hook*
 #'(lambda ()
     (setf
      c++-indent-level 4
      c++-continued-statement-offset 4
      c++-argdecl-indent 4
      c++-brace-offset 0
      c++-brace-imaginary-offset 0
      c++-label-offset -4
      c++-preprocessor-offset nil
      c++-comment-indent 4
      indent-tabs-mode t)))

(add-hook '*find-file-hooks* #'rename-buffer-with-directory)

(defun periodize ()
  (interactive)
  (save-excursion
    (progn
      (goto-char 0)
      (replace-string "。" ". ")
      (replace-string "、" ", "))))

(defun resolve-placeholder (bound actual)
  (let ((ns (let ((x (list (- (length actual) 1))))
              (while (<= 0 (car x))
                (setf x (cons (- (car x) 1) x)))
              x)))
    (cond
     ((and (consp bound)
           (symbolp (car bound))
           (string= (symbol-name (car bound)) "bind"))
      (let ((g (map 'list #'(lambda (b) (resolve-placeholder b actual)) (eval (second bound)))))
        (apply (car g) (cdr g))))
     ((symbolp bound)
      (let* ((y (symbol-name bound))
             (n (find-if #'(lambda (n) (string= y (format nil "_~A" (+ n 1)))) ns)))
        (if n (nth n actual) bound)))
     (t
      bound))))

(defun bind (bounds)
  #'(lambda (&rest args)
      (let ((a (map 'list #'(lambda (b) (resolve-placeholder b args)) bounds)))
        (apply (car a) (cdr a)))))

(defun compose (f g)
  #'(lambda (&rest args)
      (funcall f (apply g args))))

(pushnew '("\\.xyzzy$" . lisp-mode) *auto-mode-alist* :test 'equal)
(pushnew (cons "\\.sty$" (cdr (find "tex.tex" *auto-mode-alist* :test (bind '(string-matchp (bind '(car _2)) _1))))) *auto-mode-alist* :test 'equal)