Skip to content

Instantly share code, notes, and snippets.

@DeaR DeaR/siteinit.lisp
Created Apr 25, 2012

Embed
What would you like to do?
私のsiteinit.l #xyzzy
;; -*- mode: lisp; package: user; encoding: shift_jis -*-
;; @name siteinit.l
;; @description xyzzy 設定ファイル
;; @namespace http://kuonn.mydns.jp/
;; @author DeaR
;; @timestamp <2012-06-29 22:49:56 DeaR>
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; load-first
;;--------------------------------------------------------------------------------
;; ansify
(eval-when (:execute :compile-toplevel :load-toplevel)
(require "ansify"))
(ansify::install)
; ;;--------------------------------------------------------------------------------
; ;; ansi-loop
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "ansi-loop"))
; (use-package :ansi-loop)
; ;;--------------------------------------------------------------------------------
; ;; json
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "json"))
; (use-package :json)
; ;;--------------------------------------------------------------------------------
; ;; junk-library
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "junk/defs")
; (require "junk/macro")
; (require "junk/lib")
; (require "junk/http")
; (require "junk/imap4")
; (require "junk/log")
; (require "junk/mail-address")
; (require "junk/mail-edit")
; (require "junk/mail-signature")
; (require "junk/mail-view")
; (require "junk/mail")
; (require "junk/mime-encode")
; (require "junk/pop3")
; (require "junk/rfc2045")
; (require "junk/rfc822")
; (require "junk/smtp")
; (require "junk/wsse"))
; (use-package :junk)
; ;;--------------------------------------------------------------------------------
; ;; lisp-unit
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "lisp-unit"))
;;--------------------------------------------------------------------------------
;; setf-values
(eval-when (:execute :compile-toplevel :load-toplevel)
(require "setf-values"))
; ;;--------------------------------------------------------------------------------
; ;; xl-alexandria
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "xl-alexandria"))
; (use-package :alexandria)
; ;;--------------------------------------------------------------------------------
; ;; xl-interpol
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "xl-interpol"))
; (use-package :interpol)
; ;;--------------------------------------------------------------------------------
; ;; xl-ppcre
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "xl-ppcre"))
; (use-package :ppcre)
; ;;--------------------------------------------------------------------------------
; ;; xml-http-request
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (require "xml-http-request"))
; (use-package :xhr)
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; define
;;--------------------------------------------------------------------------------
;; browser-pathname
(defvar *browser-pathname* "C:/Program Files (x86)/Firefox Community Edition/firefox.exe"
"ブラウザーのパス")
;;--------------------------------------------------------------------------------
;; export-from
(defmacro export-from (symbol package)
"他のパッケージのsymbolをエクスポートする"
`(export (if (consp ,symbol)
(mapcar #'(lambda (s)
(intern (symbol-name s) ,package))
,symbol)
(intern (symbol-name ,symbol) ,package))
,package))
;;--------------------------------------------------------------------------------
;; push-load-path / remove-load-path
(defmacro push-load-path (suffix path)
"*load-path*に追加"
`(progn
(defun ,(intern (concat "push-load-path-" suffix)) ()
,(concat (eval path) " を*load-path*に追加")
(pushnew ,path *load-path* :test #'string-equal))
(add-hook '*pre-startup-hook* ',(intern (concat "push-load-path-" suffix)))
(pushnew ,path *load-path* :test #'string-equal)))
(defmacro remove-load-path (suffix path)
"*load-path*から削除"
`(progn
(delete-hook '*pre-startup-hook* ',(intern (concat "push-load-path-" suffix)))
(unintern ,(intern (concat "push-load-path-" suffix)))
(remove ,path *load-path* :test #'string-equal)))
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; xyzzy
; ;;--------------------------------------------------------------------------------
; ;; .xyzzy.d
; (push-load-path "siteinit-d" (merge-pathnames "xyzzy.d" (user-homedir-pathname)))
; (defun load-xyzzy-d ()
; "xyzzy.dから読み込み"
; (directory (merge-pathnames "xyzzy.d" (user-homedir-pathname)) :recursive t :wild "*.l" :callback #'load-library))
; (add-hook '*post-startup-hook* 'load-xyzzy-d)
;;--------------------------------------------------------------------------------
;; auto-encoding-alist
(setf *auto-encoding-alist* '())
;;--------------------------------------------------------------------------------
;; auto-mode-alist
(setf *auto-mode-alist* '())
;;--------------------------------------------------------------------------------
;; chdir
(when (fboundp 'ed::chdir)
(defun chdir-to-system-root ()
"作業ディレクトリをインストールディレクトリに設定"
(funcall 'ed::chdir (si:system-root)))
(add-hook '*pre-startup-hook* 'chdir-to-system-root))
;;--------------------------------------------------------------------------------
;; clipboard-char-encoding
(setf *clipboard-char-encoding* *encoding-auto*)
;;--------------------------------------------------------------------------------
;; default-buffer-mode
(setf *default-buffer-mode* 'text-mode)
;;--------------------------------------------------------------------------------
;; emacs-interactive-buffer-name
(pushnew '(#\B . emacs-interactive-buffer-name)
*interactive-specifier-alist* :test #'equal)
(pushnew '(#\b . emacs-interactive-exist-buffer-name)
*interactive-specifier-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; etc-path
(setf *etc-path* (merge-pathnames "etc" (si:system-root)))
;;--------------------------------------------------------------------------------
;; find-other-file
(setf *find-other-file-requires-file-name* t)
;;--------------------------------------------------------------------------------
;; indent
(setf *indent-tabs-mode* t)
;;--------------------------------------------------------------------------------
;; init-home-directory
(defun init-home-directory ()
"(user-homedir-pathname)をデフォルトディレクトリに設定"
(dolist (scratch (find-name-buffer "*scratch*"))
(set-default-directory (user-homedir-pathname) scratch)))
(add-hook '*pre-startup-hook* 'init-home-directory)
;;--------------------------------------------------------------------------------
;; keyword-load-path
(pushnew (merge-pathnames "keywords" (si:system-root)) *keyword-load-path* :test #'string-equal)
;;--------------------------------------------------------------------------------
;; mode-line
(defvar ed::*mode-line* nil
"モードライン")
;;--------------------------------------------------------------------------------
;; mode-line-format
(setq-default mode-line-format "[%i]%k(%l)/%* %b (%M) %f")
;;--------------------------------------------------------------------------------
;; move-forward-after-undo-delection
(setf *move-forward-after-undo-delection* t)
; ;;--------------------------------------------------------------------------------
; ;; siteinit.d
; (push-load-path "siteinit-d" (merge-pathnames "site-lisp/siteinit.d" (si:system-root)))
; (eval-when (:execute :compile-toplevel :load-toplevel)
; (directory (merge-pathnames "site-lisp/siteinit.d" (si:system-root)) :recursive t :wild "*.l" :callback #'load-library))
;;--------------------------------------------------------------------------------
;; status-bar-format
(setf *status-bar-format* "pcu")
;;--------------------------------------------------------------------------------
;; title-bar-format
(setq-default title-bar-format "%b - %p %v%#h")
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; function
;;--------------------------------------------------------------------------------
;; backup-file
(pushnew '("~$" . backup-file-mode) *auto-mode-alist* :test #'equal)
(pushnew '("#[^#/]+#$" . backup-file-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.bak$" . backup-file-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.new$" . backup-file-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.ori?g$" . backup-file-mode) *auto-mode-alist* :test #'equal)
(defun backup-file-mode ()
"元のファイル名でmodeを再帰検索"
(let* ((fn (get-buffer-file-name))
(filename (if (string-matchp "#[^#/]+#$" fn)
(substitute-string fn "#\\([^#/]+\\)#$" "\\1" :case-fold t)
(substitute-string fn "\\(~\\|\\.bak\\|\\.new\\|\\.ori?g\\)$" "" :case-fold t)))
(func (assoc filename *auto-mode-alist*
:test #'(lambda (x y)
(string-matchp y x)))))
(when func
(funcall (rest func)))))
(pushnew '("#[^#/]+#$" . backup-file-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.bak$" . backup-file-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.new$" . backup-file-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.ori?g$" . backup-file-encoding) *auto-encoding-alist* :test #'equal)
(defun backup-file-encoding ()
"元のファイル名でencodingを再帰検索"
(let* ((fn (get-buffer-file-name))
(filename (if (string-matchp "#[^#/]+#$" fn)
(substitute-string fn "#\\([^#/]+\\)#$" "\\1" :case-fold t)
(substitute-string fn "\\.\\(bak\\|new\\|ori?g\\)$" "" :case-fold t)))
(func (assoc filename *auto-encoding-alist*
:test #'(lambda (x y)
(string-matchp y x)))))
(when func
(funcall (rest func)))))
;;--------------------------------------------------------------------------------
;; buffer-substring-at-point
(defun buffer-substring-at-point (&optional prompt)
"カーソル下の単語を取得する"
(save-excursion
(cond ((and prompt
*prefix-args*)
(read-string prompt))
((pre-selection-p)
(selection-start-end (s e)
(buffer-substring s e)))
((and (mark t)
(modulep "rv-region")
(find (intern "rv-region") *post-command-hook*))
(buffer-substring (region-beginning) (region-end)))
(t
(buffer-substring (progn
(or (skip-syntax-spec-forward "w_")
(skip-syntax-spec-backward "^w_"))
(point))
(progn
(skip-syntax-spec-backward "w_")
(point)))))))
;;--------------------------------------------------------------------------------
;; delete-dump-image
(defun delete-dump-image ()
"dump-image を削除"
(interactive)
(and (file-exist-p (si:dump-image-path))
(delete-file (si:dump-image-path))))
;;--------------------------------------------------------------------------------
;; if-load-session-on-find-file
(defun if-load-session-on-find-file (x)
"session-fileならsessionを開く"
(when (string-matchp "\\.ssn$" x)
(load-session x)
(selected-buffer)))
(add-hook '*before-find-file-hook* 'if-load-session-on-find-file)
;;--------------------------------------------------------------------------------
;; if-save-empty-then-delete
(defvar *if-save-empty-then-delete-auto-save* t
"if-save-empty-then-delete 時 auto-save も削除する")
(defun if-save-empty-then-delete ()
"保存時ファイルが空なら削除"
(if (and (= (point-max) (point-min))
(y-or-n-p (format nil "~A は空のファイルです。削除しますか?" (buffer-name (selected-buffer)))))
(progn
(let* ((filename (get-buffer-file-name))
(auto-save-filename (merge-pathnames (directory-namestring filename)
(concat "#" (file-namestring filename) "#"))))
(when (file-exist-p filename)
(delete-file filename))
(when (and *if-save-empty-then-delete-auto-save*
(file-exist-p auto-save-filename))
(delete-file auto-save-filename)))
(delete-buffer (selected-buffer)))
nil))
(add-hook '*before-save-buffer-hook* 'if-save-empty-then-delete)
;;--------------------------------------------------------------------------------
;; indent-whole-buffer
(defun indent-whole-buffer ()
"バッファ全体をインデント"
(interactive "*")
(when mode-specific-indent-command
(save-excursion
(goto-char (point-min))
(funcall mode-specific-indent-command)
(indent-region (point-min) (point-max)))))
;;--------------------------------------------------------------------------------
;; iswitchb
(defun iswitchb (&optional (input ""))
"iswitchb: バッファの切り替え"
(interactive)
(let ((buffer-list (iswitchb-buffer-list-init-rotate (iswitchb-buffer-list-init)
(buffer-name (other-buffer))))
(pre-buffer (selected-buffer))
(top-buffer (buffer-name (selected-buffer)))
(buffer-list-grepd)
(c))
(loop ; iswitchb-mode ...
(setf buffer-list-grepd (iswitchb-list-grep buffer-list input))
(message "~S" buffer-list-grepd)
(when (< 0 (length buffer-list-grepd))
(when (string/= top-buffer (first buffer-list-grepd))
(setf top-buffer (first buffer-list-grepd))
(switch-to-buffer top-buffer)
(when (modulep "outline-tree/outline-tree")
(funcall (intern "outline-tree-select-node-by-window-for-hook" :outline-tree2)))))
(ed:minibuffer-prompt "iswitchb: ~A" input)
(setf c (read-char ed:*keyboard*))
(case c
((#\C-g #\ESC)
(switch-to-buffer pre-buffer) (quit))
((#\Left #\Up #\C-r #\Home #\PageDown) ; 'iswitchb-prev-match
(when (< 1 (length buffer-list-grepd))
(while (string= top-buffer (first (iswitchb-list-grep buffer-list input)))
(setf buffer-list (append (last buffer-list) (butlast buffer-list))))))
((#\Right #\Down #\C-s #\End #\PageUp) ; 'iswitchb-next-match
(when (< 1 (length buffer-list-grepd))
(while (string= top-buffer (first (iswitchb-list-grep buffer-list input)))
(setf buffer-list (append (rest buffer-list) (list (first buffer-list)))))))
((#\C-m #\RET) ; 'iswitchb-exit-minibuffer
(return (switch-to-buffer top-buffer)))
((#\C-j)
(switch-to-buffer top-buffer))
((#\C-a)
(setf input ""))
((#\C-h)
(ignore-errors (setf input (substring input 0 -1))))
((#\TAB)
(ignore-errors
(multiple-value-bind (result list prefix)
(*do-completion input :buffer-name)
(cond ((eq result :solo-match)
(return (switch-to-buffer top-buffer)))
((stringp result)
(setf input result))))))
(t
(setf input (format nil "~A~A" input c)))))))
(defun iswitchb-list-grep (list input)
"iswitchb: listをinput によって絞り込み" ; 空白区切りは & とみなす
(remove-if #'(lambda (x)
(dolist (s (split-string input " "))
(when (not (string-matchp (regexp-quote s) x))
(return t))))
list))
(defun iswitchb-buffer-list-init ()
"iswitchb: iswitchbで選択するバッファ名リストの取り出し(初期値)"
(remove-if #'(lambda (x)
(string-match "^ " x)) ; ミニバッファ以外
(mapcar #'buffer-name
(buffer-list :buffer-bar-order *next-buffer-in-tab-order*))))
(defun iswitchb-buffer-list-init-rotate (list name)
"iswitchb: listをnameが先頭に来るまで回転"
(when (position name list :test 'string=)
(while (< 0 (position name list :test 'string=))
(setf list (append (rest list) (list (first list))))))
list)
;;--------------------------------------------------------------------------------
;; non-byte-compile-files
(defun non-byte-compile-files()
"*load-path* 内でバイトコンパイルされてないファイルを出力"
(delete-duplicates (mapcan #'(lambda (dir)
(mapcan #'(lambda (l)
(let ((lc (substitute-string l "\\.l\\(isp\\)?" ".lc")))
(when (or (not (file-exist-p lc))
(file-newer-than-file-p l lc))
(list l))))
(directory dir :absolute t :recursive t :wild '("*.l" "*.lisp"))))
*load-path*)
:test #'string-equal))
;;--------------------------------------------------------------------------------
;; make-directory-unless-directory-exists
(defun make-directory-unless-directory-exists (filename)
"find-file時にディレクトリが作れるように"
(unless (or (and (modulep "cygwin-mount")
(funcall (intern "cygwin-mount-active-p" :cygmount))
(or (file-exist-p (funcall (intern "cygmount-cygpath->winpath" :cygmount) filename))
(file-exist-p (funcall (intern "cygmount-cygpath->winpath" :cygmount) (substitute-string filename "^[A-Za-z]:" "")))))
(valid-path-p filename))
(let ((d (directory-namestring filename)))
(when (yes-or-no-p "~A~%ディレクトリがないけど作る?" d)
(create-directory d)))))
(add-hook '*before-find-file-hook* 'make-directory-unless-directory-exists)
;;--------------------------------------------------------------------------------
;; microsoft-help-viewer
(defun microsoft-help-viewer ()
"microsoft-help-viewerで検索"
(interactive)
(shell-execute (concat "ms-xhelp:///?product=VS&productVersion=100&locale=ja-JP&embedded=false&method=search&query=" (si:www-url-encode (buffer-substring-at-point "Reference: "))) t))
(defun microsoft-help-viewer-set-local-variable ()
"microsoft-help-viewerのlocal-variable設定"
(make-local-variable 'ed::local-help-variable)
(setf ed::local-help-variable 'microsoft-help-viewer))
;;--------------------------------------------------------------------------------
;; modified-line-mark
(defun set-modified-line-mark (pos line)
"modified-line-mark: 色を設定する"
(let ((prefix (code-char (+ (rem line 10) (char-code #\0)))))
(set-text-attribute pos pos 'modified-line
:foreground 0
:prefix prefix :extend t)))
(defun modified-lines-mark-again ()
"modified-line-mark: 色を再設定する"
(dolist (attr (list-text-attributes))
(when (eq (third attr) 'modified-line)
(save-excursion
(goto-char (first attr))
(if (if (buffer-line-number-mode)
(virtual-bolp)
(bolp))
(set-modified-line-mark (point)
(if (buffer-line-number-mode)
(current-virtual-line-number)
(current-line-number)))
(delete-text-attribute-point (point))))))
(refresh-screen))
(defun buffer-modified-hook (buffer operation from to undo-p)
"modified-line-mark: 編集された行に色を設定する"
(save-excursion
(goto-char from)
(while (<= from to)
(progn
(if (buffer-line-number-mode)
(goto-virtual-bol)
(goto-bol))
(set-modified-line-mark (point)
(if (buffer-line-number-mode)
(current-virtual-line-number)
(current-line-number)))
(unless (if (buffer-line-number-mode)
(next-virtual-line)
(next-line))
(return))
(setf from (point))))
(stop-timer 'modified-lines-mark-again)
(start-timer 0.1 'modified-lines-mark-again t)))
(add-hook 'post-buffer-modified-hook 'buffer-modified-hook)
(defun search-modified-line-forward ()
"modified-line-mark: 次の編集された行に移動する"
(interactive)
(goto-char (or (find-text-attribute
'modified-line
:start (+ 1 (save-excursion (goto-eol) (point))))
(plain-error "編集された行はありません"))))
(defun search-modified-line-backward ()
"modified-line-mark: 前の編集された行に移動する"
(interactive)
(goto-char (or (find-text-attribute
'modified-line
:end (- (save-excursion (goto-bol) (point)) 1)
:from-end t)
(plain-error "編集された行はありません"))))
(defun enable-post-buffer-modified-hook-t ()
"modified-line-mark: 編集した際にフックを実行するようにする"
(enable-post-buffer-modified-hook t))
(add-hook '*find-file-hooks* 'enable-post-buffer-modified-hook-t)
(add-hook '*lisp-interaction-mode-hook* 'enable-post-buffer-modified-hook-t)
(defun delete-modified-line-mark ()
"modified-line-mark: 色を消去する"
(interactive)
(delete-text-attributes 'modified-line))
(add-hook '*after-save-buffer-hook* 'delete-modified-line-mark)
;;--------------------------------------------------------------------------------
;; selection-at-point
(defun selection-at-point ()
"カーソル下の単語をセレクションにする"
(unless (pre-selection-p)
(if (and (mark t)
(modulep "rv-region")
(find (intern "rv-region") *post-command-hook*))
(progn
(ed::begin-selection)
(goto-char (mark)))
(progn
(or (skip-syntax-spec-forward "w_")
(skip-syntax-spec-backward "^w_"))
(ed::begin-selection)
(skip-syntax-spec-backward "w_")))))
;;--------------------------------------------------------------------------------
;; yank-pupup-list
(defun yank-popup-list ()
"kill-ring のデータを popup-list から選択して貼り付け"
(interactive)
(when *kill-ring*
(let ((lst))
(dolist (item *kill-ring*)
(pushnew (first item) lst :test #'equal))
(popup-list (reverse lst)
#'(lambda (x)
(insert x)
(refresh-screen))))))
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; multiple-frames-xyzzy
;;--------------------------------------------------------------------------------
;; multiple-frames-fix
#+multiple-frames
(eval-when (:execute :compile-toplevel :load-toplevel)
(require "multiple-frames-fix")
(require "outline-tree-multiple-frames"))
;;--------------------------------------------------------------------------------
;; keymap
#-multiple-frames
(setf (symbol-function 'ctl-x-5-prefix) ctl-x-6-map)
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; load-ahead
;;--------------------------------------------------------------------------------
;; Emacslisp移植キット
(require "elisp")
(use-package :el)
;;--------------------------------------------------------------------------------
;; info
(require "info")
(setf *info-node-forecolor* 1)
(setf *info-node-backcolor* nil)
(setf *info-ref-forecolor* 6)
(setf *info-ref-backcolor* nil)
(setf *info-menu-forecolor* 6)
(setf *info-menu-backcolor* nil)
(setf ed::*info-fontify-maximum-menu-size* 45000)
(setf ed::*info-suffix-list*
'((".info.tar.bz2" . "tar32.dll")
(".info.tar.gz" . "tar32.dll")
(".info.tar.Z" . "tar32.dll")
(".info.tbz2" . "tar32.dll")
(".info.tbz" . "tar32.dll")
(".info.tgz" . "tar32.dll")
(".info.taz" . "tar32.dll")
(".info.tar" . "tar32.dll")
(".info.bz2" . "tar32.dll")
(".info.gz" . "tar32.dll")
(".info.tz" . "tar32.dll")
(".info.Z" . "tar32.dll")
(".info" . nil)
(".tar.bz2" . "tar32.dll")
(".tar.gz" . "tar32.dll")
(".tar.Z" . "tar32.dll")
(".tbz2" . "tar32.dll")
(".tbz" . "tar32.dll")
(".tgz" . "tar32.dll")
(".taz" . "tar32.dll")
(".tar" . "tar32.dll")
(".bz2" . "tar32.dll")
(".gz" . "tar32.dll")
(".tz" . "tar32.dll")
(".Z" . "tar32.dll")
("" . nil)))
(defun info-mode-set-local-variable ()
"info-modeのlocal-variable設定"
(set-tab-columns 8 (selected-buffer)))
(add-hook '*info-mode-hook* 'info-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; meadow-func
(require "meadow-func")
(setf *list-directory-sort-method* 1)
;;--------------------------------------------------------------------------------
;; multi-major-mode
(require "multi-major-mode")
(setf ed::*multi-major-mode-name* "MMM")
;;--------------------------------------------------------------------------------
;; NetInstaller
(require "ni/setup")
; (ni-autoload)
;; NetInstallerサイト残り
; http://rohinomiya.cocolog-nifty.com/xyzzy/packages.l
(defun ni::add-site-from-wiki ()
"ネットインストーラのsiteを無理やり最新に"
(interactive)
; (let ((s (ni::http-get-url "http://xyzzy.s53.xrea.com/wiki/index.php?cmd=source&page=NetInstaller%2F%C7%DB%C9%DB%A5%D1%A5%C3%A5%B1%A1%BC%A5%B8%B0%EC%CD%F7"))
(let ((s (ni::http-get-url "http://xyzzy.s53.xrea.com/wiki/index.php?cmd=source&page=NetInstaller%2F%C7%DB%C9%DB%A5%D1%A5%C3%A5%B1%A1%BC%A5%B8%B0%EC%CD%F72"))
(regexp (compile-regexp "^:[^|]+|\\(http:.*\\)$")))
(ni::load-site-data)
(mapcar #'(lambda (x)
(ignore-errors (ni::site-add x)))
(set-difference
(remove-if 'null
(mapcar #'(lambda (i)
(and (string-match regexp i)
(apply #'concat
(mapcar #'(lambda (x)
(let ((tmp (split-string x #\;)))
(if (string-equal (first tmp) "amp")
(apply #'concat "&" (rest tmp))
(first tmp))))
(split-string (match-string 1) #\&)))))
(let ((out))
(while
(handler-case
(progn
(push (read-line s) out)
t)
(quit (c)
(return-from ni::add-site-from-wiki))
(error (c)
nil)))
(nreverse out))))
(mapcar #'(lambda (x)
(rest (assoc "src" x :test #'equal)))
ni::*site-data*)
:test #'equal)))
(message "done.")
t)
(define-key ni::*site-map* #\N 'ni::add-site-from-wiki)
;;--------------------------------------------------------------------------------
;; outline-tree2
(require "outline-tree/outline-tree")
(require "outline-tree-ctags")
(setf outline-tree2::*outline-tree-text-highlight-attribute* '(:foreground 3 :extend t))
(pushnew '("^ *\\(\\*tterm\\)" . " tterm") outline-tree2::*outline-tree-buffer-category-regexp-list* :test #'equal)
(define-key outline-tree2::*outline-tree-map* #\RET 'tv::treeview-focus-editor)
(define-key outline-tree2::*outline-tree-map* #\F13 'outline-tree2::outline-tree-node-action)
(outline-tree2::outline-tree-autoload)
(outline-tree2::outline-tree-config-load)
;;--------------------------------------------------------------------------------
;; treeview
(require "treeview/setup")
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; lisp
;;--------------------------------------------------------------------------------
;; abbrev
(require "abbrev")
(setf *abbrev-file-name* (merge-pathnames ".xyzzy.d/.abbrev_defs" (user-homedir-pathname)))
(pushnew '("\\.abbrev_defs$" . lisp-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; app-menu
(require "app-menu")
(require "app-menu2")
;;--------------------------------------------------------------------------------
;; backup
(require "backup")
(setf *backup-directory* (merge-pathnames ".bak/" (user-homedir-pathname)))
(setf *hierarchic-backup-directory* t)
(defvar *backup-exclude-regexp*
(compile-regexp
(concat "\\~xyz[a-z0-9]+\\.tmp$\\|"
"~$\\|#[^#/]+#$\\|\\.bak$\\|\\.new$\\|\\.ori?g$\\|"
"\\.lc$\\|\\.katexrc$\\|"
"COMMIT_EDITMSG$\\|TAG_EDITMSG$\\|git-rebase-todo$") t)
"バックアップを作らないファイル")
(defun backup-exclude ()
"バックアップを作るかチェック"
(when (and make-backup-files
(string-matchp *backup-exclude-regexp* (get-buffer-file-name (selected-buffer))))
(make-local-variable 'make-backup-files)
(setf make-backup-files nil))
nil)
(add-hook '*find-file-hooks* 'backup-exclude)
(add-hook '*before-save-buffer-hook* 'backup-exclude)
;;--------------------------------------------------------------------------------
;; basic-mode
(require "basic-mode")
(setf *basic-indent-level* 4)
(setf *basic-continued-line-offset* 4)
(setf *basic-label-offset* -4)
(setf *basic-tab-always-indent* t)
(setf ed::*basic-block-begin-regexp*
(compile-regexp
(concat "\\(SyncLock\\|Namespace\\|[GS]et\\|Try\\|Using\\|Begin\\|Do\\|For\\|If\\|Select\\|While\\|With\\|BeginProperty\\|"
"\\(Public[ \t]+\\|Private[ \t]+\\)?\\(Type\\|Enum\\)\\|"
"\\(Protected[ \t]+\\|Public[ \t]+\\|Private[ \t]+\\|Friend[ \t]+\\)?\\(Overrides[ \t]+\\|Static[ \t]+\\)?\\(Class\\|Function\\|Sub\\|Property\\)\\)"
"\\([^A-Za-z0-9_]\\|$\\)") t))
(setf ed::*basic-block-end-regexp*
(compile-regexp "\\(Loop\\|End\\|Next\\|Wend\\|EndProperty\\)\\([^A-Za-z0-9_\n]\\|$\\)" t))
(setf ed::*basic-block-mid-regexp*
(compile-regexp "\\(Catch\\|Finally\\|ElseIf\\|Else\\|Case\\)\\([^A-Za-z0-9_\n]\\|$\\)" t))
(setf ed::*basic-lambda-regexp*
(compile-regexp "[^\n]*\\(Function\\|Sub\\)[ \t]*([^)]*)[ \t]*\\('.*\\)?$" t))
(pushnew '("\\.bas$" . basic-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.b[ib]$" . basic-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.pb$" . basic-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.vbs?$" . basic-mode) *auto-mode-alist* :test #'equal)
(define-key *basic-mode-map* #\SPC 'nil)
(defun basic-mode-set-local-variable ()
"basic-modeのlocal-variable設定"
(make-local-variable 'regexp-keyword-list)
(setf regexp-keyword-list
(compile-regexp-keyword-list
'(("<[^>\n]+>"
nil (:color 15) :comment))))
(microsoft-help-viewer-set-local-variable))
(add-hook '*basic-mode-hook* 'basic-mode-set-local-variable)
(defun ed::calc-basic-indent ()
"basic-modeの現在行をインデントする"
(save-excursion
(goto-bol)
(when (looking-at "[ \t]*#")
(return-from ed::calc-basic-indent 0))
(let* ((single-line-if-p nil)
(column (save-excursion
(loop
(or (forward-line -1)
(return 0))
(unless (ed::basic-continuation-line-p)
(skip-chars-forward " \t")
(cond ((eolp))
((looking-at ed::*basic-comment-regexp*))
((looking-at ed::*basic-label-regexp*))
((looking-at ed::*basic-block-begin-regexp* t)
(if (and (looking-for "If" t)
(ed::basic-single-line-if-p))
(progn
(setf single-line-if-p t)
(return (current-column)))
(return (+ (current-column) ed::*basic-indent-level*))))
((looking-at ed::*basic-block-end-regexp* t)
(return (current-column)))
((looking-at ed::*basic-block-mid-regexp* t)
(return (+ (current-column) ed::*basic-indent-level*)))
((looking-at ed::*basic-lambda-regexp*)
(return (+ (current-column) ed::*basic-indent-level*)))
(t
(return (current-column)))))))))
(goto-bol)
(if (ed::basic-continuation-line-p)
(progn
(when single-line-if-p
(incf column ed::*basic-indent-level*))
(incf column ed::*basic-continued-line-offset*))
(progn
(skip-chars-forward " \t")
(cond ((looking-at ed::*basic-block-end-regexp* t)
(unless (and (looking-for "End" t)
(ed::basic-end-stmt-p))
(decf column ed::*basic-indent-level*)))
((looking-at ed::*basic-block-mid-regexp* t)
(decf column ed::*basic-indent-level*))
((looking-at ed::*basic-label-regexp*)
(incf column ed::*basic-label-offset*)))))
(max column 0))))
;;--------------------------------------------------------------------------------
;; c++-mode
(require "cc-mode")
(setf *c++-indent-tabs-mode* t)
(setf c++-indent-level 4)
(setf c++-continued-statement-offset 4)
(setf c++-argdecl-indent 4)
(setf c++-brace-offset -4)
(setf c++-brace-imaginary-offset 0)
(setf c++-label-offset -4)
(setf c++-comment-indent 0)
(setf ed:c++-preprocessor-offset 0)
(pushnew '("\\.cc?$" . c++-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.hh?$" . c++-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.[ch]++$" . c++-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.[ch]pp?$" . c++-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.[ch]xx$" . c++-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.rc?$" . c++-mode) *auto-mode-alist* :test #'equal)
(defun c++-mode-set-local-variable ()
"c++-modeのlocal-variable設定"
(make-local-variable 'regexp-keyword-list)
(setf regexp-keyword-list
(compile-regexp-keyword-list
'(("<[^>\n]+>"
nil (:color 15) :comment))))
(make-local-variable 'grep-ext-variable)
(setf grep-ext-variable "*.c;*.h;*.cc;*.hh;*.c++;*.h++;*.cp;*.hp;*.cpp;*.hpp;*.cxx;*.hxx;*.r;*.rc")
(microsoft-help-viewer-set-local-variable))
(add-hook '*c++-mode-hook* 'c++-mode-set-local-variable)
(defun c++-mode-set-multi-major-mode ()
"c++-modeのmulti-major-mode設定"
(multi-major-mode-start t "c++-mode"
'("asm[ \t\n]*{" "}" "asm-mode" t)))
(add-hook '*c++-mode-hook* 'c++-mode-set-multi-major-mode)
;;--------------------------------------------------------------------------------
;; c-mode
(require "c-mode")
(setf *c-indent-tabs-mode* t)
(setf c-indent-level 4)
(setf c-continued-statement-offset 4)
(setf c-argdecl-indent 4)
(setf c-brace-offset -4)
(setf c-brace-imaginary-offset 0)
(setf c-label-offset -4)
(setf c-comment-indent 0)
;;--------------------------------------------------------------------------------
;; calc
(require "calc")
;;--------------------------------------------------------------------------------
;; calendar
(require "calendar")
(defun calendar-mode-set-local-variable ()
"calendar-modeのlocal-variable設定"
(set-local-window-flags (selected-buffer) *window-flag-line-number* nil))
(add-hook 'ed::*calendar-mode-hook* 'calendar-mode-set-local-variable)
(defvar *calendar-winconf* nil
"前のカレンダーウィンドウの状態")
(defvar *original-calendar* #'ed::calendar
"ed::calendar の退避")
(defun ed::calendar (&optional year)
"カレンダーを表示"
(interactive "p")
(unwind-protect
(setf *calendar-winconf* (current-window-configuration))
(funcall *original-calendar*)))
(defun kill-calendar ()
"カレンダーを閉じる"
(interactive)
(delete-buffer "*Calendar*")
(set-window-configuration *calendar-winconf*)
(set-window (minibuffer-window)))
(define-key *calendar-mode-map* #\q 'kill-calendar)
;;--------------------------------------------------------------------------------
;; compile
(require "compile")
(defun byte-compile-current-file ()
"現在のバッファをバイトコンパイル"
(interactive)
(when (buffer-modified-p)
(save-buffer))
(long-operation
(unwind-protect
(progn
(eval-buffer (selected-buffer))
(byte-compile-file (get-buffer-file-name))))))
(defun compiler::compile-call (form)
(let ((f (assoc (first form) compiler::*macro-environment* :test #'eq)))
(cond ((null f)
(when (and (consp (first form))
(eq (first (first form)) 'lambda))
(push 'funcall form))
(dolist (f (rest form))
(compiler::compile-form f))
(compiler::output-insn 'compiler::insn-call (first form) (1- (length form))))
((symbolp (rest f))
(compiler::compile-form (rest f))
(dolist (f (rest form))
(compiler::compile-form f))
(compiler::output-insn 'compiler::insn-call 'funcall (length form)))
(t
(compiler::compile-error "不正な関数コールです: ~S" form)))))
;;--------------------------------------------------------------------------------
;; csharp-mode
(require "c#-mode")
(setf *csharp-indent-tabs-mode* t)
(setf csharp-indent-level 4)
(setf csharp-continued-statement-offset 4)
(setf csharp-argdecl-indent 4)
(setf csharp-brace-offset -4)
(setf csharp-brace-imaginary-offset 0)
(setf csharp-label-offset -4)
(setf csharp-comment-indent 0)
(setf ed:csharp-preprocessor-offset 0)
(pushnew '("\\.cs$" . csharp-mode) *auto-mode-alist* :test #'equal)
(defun csharp-mode-encoding ()
"csharp-modeのエンコーディング判定"
*encoding-utf8*)
(pushnew '("\\.cs$" . csharp-mode-encoding) *auto-encoding-alist* :test #'equal)
(defun csharp-mode-set-local-variable ()
"csharp-modeのlocal-variable設定"
(make-local-variable 'regexp-keyword-list)
(setf regexp-keyword-list
(compile-regexp-keyword-list
'(("<[^>\n]+>"
nil (:color 15) :comment))))
(microsoft-help-viewer-set-local-variable))
(add-hook '*csharp-mode-hook* 'csharp-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; css-mode
(require "css-mode")
;;--------------------------------------------------------------------------------
;; dabbrev
(require "dabbrev")
(setf *popup-completion-list-default* :always)
(setf *minibuffer-popup-completion-list* :never)
;;--------------------------------------------------------------------------------
;; dexplorer
(require "dexplorer")
;;--------------------------------------------------------------------------------
;; dialogs
(require "dialogs")
(defun search-dialog-at-point ()
"カーソル下の単語でsearch-dialog"
(interactive)
(unless (get-buffer-file-name)
(return-from search-dialog-at-point nil))
(selection-at-point)
(search-dialog))
(defun replace-dialog-at-point ()
"カーソル下の単語でreplace-dialog"
(interactive)
(unless (get-buffer-file-name)
(return-from replace-dialog-at-point nil))
(selection-at-point)
(replace-dialog))
;;--------------------------------------------------------------------------------
;; diff
(require "diff")
(setf *diff-command-name* (merge-pathnames "bin/diff" (si:system-root)))
(defun diff-mode-set-multi-major-mode ()
"diff-modeのmulti-major-mode設定"
(multi-major-mode-start nil))
(add-hook '*diff-mode-hook* 'diff-mode-set-multi-major-mode)
;;--------------------------------------------------------------------------------
;; edict
(require "edict")
(defmacro def-lookup-dictionary-popup (suffix name)
"多いので纏めて生成マクロ"
`(progn
(defun ,(intern (concat (symbol-name (eval suffix)) "-popup")) ()
,(concat name "をポップアップ")
(interactive)
(let ((msg (save-window-excursion
(cond ((pre-selection-p)s
(call-interactively ',(intern (concat (symbol-name (eval suffix)) "-selection"))))
((and (modulep "rv-region")
(find (intern "rv-region") *post-command-hook*))
(call-interactively ',(intern (symbol-name (eval suffix)))))
(t
(call-interactively ',(intern (concat (symbol-name (eval suffix)) "-word")))))
(prog2
(set-buffer "*dictionary*")
(buffer-substring (point-min) (point-max))
(delete-buffer "*dictionary*")))))
(popup-string (string-trim (string #\LFD) msg) (point))))))
(def-lookup-dictionary-popup 'lookup-j2e-dictionary "和英辞書")
(def-lookup-dictionary-popup 'lookup-reading-dictionary "読み辞書")
(def-lookup-dictionary-popup 'lookup-e2j-dictionary "英和辞書")
(def-lookup-dictionary-popup 'lookup-idiom-dictionary "熟語辞書")
;;--------------------------------------------------------------------------------
;; filer
(require "filer")
(setf *filer-guide-text* nil)
(setf *filer-use-recycle-bin* t)
(defun filer-forward-line-or-goto-bof (&optional (arg 1))
"次の行、もしくはウィンドウの先頭に移動"
(let ((old-file (filer-get-current-file)))
(filer-forward-line arg)
(when (string= old-file (filer-get-current-file))
(filer-goto-bof))))
(defun filer-backward-line-or-goto-eof (&optional (arg 1))
"前の行、もしくはウィンドウの最後に移動"
(let ((old-file (filer-get-current-file)))
(filer-forward-line (- arg))
(when (string= old-file (filer-get-current-file))
(filer-goto-eof))))
(defun filer-up-directory-or-drive (&optional)
"1段上のディレクトリ、もしくはドライブ選択へ移動"
(let ((old-directory (filer-get-directory)))
(filer-up-directory)
(when (string= old-directory (filer-get-directory))
(filer-change-drive))))
(defun filer-scroll-or-left-window-or-up-or-drive ()
"左方向にスクロール、もしくはドライブ選択へ移動"
(if (filer-dual-window-p)
(if (filer-left-window-p)
(filer-up-directory-or-drive)
(filer-left-window))
(unless (filer-scroll-left)
(filer-up-directory-or-drive))))
(defun filer-scroll-or-right-window-or-up-or-drive ()
"右方向にスクロール、もしくはドライブ選択へ移動"
(if (filer-dual-window-p)
(if (not (filer-left-window-p))
(filer-up-directory-or-drive)
(filer-right-window))
(filer-scroll-right)))
(defun filer-popup-guide-text ()
"ファイラーのガイドテキストをポップアップ"
(message-box
(concat "A:属性 B:バイトコンパイル C:コピー D:削除 E:解凍\n"
"F:検索 G:ファイル名検索 J:DIR移動 K:mkdir L:ドライブ\n"
"M:移動 N:ファイル名 O:圧縮 P:DIR?? Q:終了\n"
"R:名前変更 S:DIR?? T:ショートカット U:DIRサイズ V:リスト\n"
"W:閲覧 X:実行 Y:ショートカット Z:プロパティ\n"
"\n"
"*:load .:マスク /:マーク <:先頭 >:末尾\n"
"@:別名コピー \:ルート =:比較 ^:イジェクト ]:送る\n"
"\n"
"C-h:上ディレクトリ C-r:後isearch C-s:前isearch C-u:ディレクトリサイズ\n"
"C-1:ファイル広 C-2:サイズ広 C-3:日時広 C-4:属性広\n"
"C-M-1:ファイル狭 C-M-2:サイズ狭 C-M-3:日時狭 C-M-4:属性狭\n"
"\n"
"M-g:grep M-r:gresreg M-v:リードオンリー\n"
"\n"
"F3:実行 F5:マークトグル F6:ソート S-F10:ポップアップメニュー\n"
"\n"
"TAB:移動 SPC:マーク End:リロード\n"
"Home:トグル(ファイル) S-Home:クリア\n"
"C-Home:トグル(含Dir) S-C-Home:全ファイルマーク")))
(define-key filer-keymap #\C-b 'filer-scroll-or-left-window-or-up-or-drive)
(define-key filer-keymap #\C-f 'filer-scroll-or-right-window-or-up-or-drive)
(define-key filer-keymap #\C-h 'filer-up-directory-or-drive)
(define-key filer-keymap #\C-n 'filer-forward-line-or-goto-bof)
(define-key filer-keymap #\C-p 'filer-backward-line-or-goto-eof)
(define-key filer-keymap #\Left 'filer-scroll-or-left-window-or-up-or-drive)
(define-key filer-keymap #\Up 'filer-backward-line-or-goto-eof)
(define-key filer-keymap #\Down 'filer-forward-line-or-goto-bof)
(define-key filer-keymap #\Right 'filer-scroll-or-right-window-or-up-or-drive)
(define-key filer-keymap #\F1 'filer-popup-guide-text)
;;--------------------------------------------------------------------------------
;; files
(require "files")
(defun find-file-buffer-encoding (arg)
"エンコーディングの自動判定"
(let ((encoding (gethash (substitute-string arg "-\\(dos\\|mac\\|unix\\)$" "" :case-fold t)
*mime-charset-name-hash-table*))
(eol (cond ((string-matchp "-dos$" arg)
*eol-crlf*)
((string-matchp "-mac$" arg)
*eol-cr*)
((string-matchp "-unix$" arg)
*eol-lf*))))
(when encoding
(revert-buffer (if (and *find-file-auto-encoding-use-utf8n*
(eq encoding *encoding-utf8*))
*encoding-utf8n*
encoding)))
(when eol
(set-buffer-eol-code eol))))
(pushnew '("coding" . find-file-buffer-encoding) *auto-mode-parameter-alist* :test #'equal)
(pushnew '("encoding" . find-file-buffer-encoding) *auto-mode-parameter-alist* :test #'equal)
(defun find-file-buffer-eol (arg)
"改行コードの自動判定"
(let ((eol (cond ((or (string-equal "dos" arg)
(string-equal "crlf" arg))
*eol-crlf*)
((or (string-equal "mac" arg)
(string-equal "cr" arg))
*eol-cr*)
((or (string-equal "unix" arg)
(string-equal "lf" arg))
*eol-lf*))))
(when eol
(set-buffer-eol-code eol))))
(pushnew '("eol" . find-file-buffer-eol) *auto-mode-parameter-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; grep
(require "grep")
(defvar-local grep-ext-variable nil
"grepの拡張子指定ローカル変数")
(defun grep-at-point ()
"カーソル下の単語でgrep"
(interactive)
(unless (get-buffer-file-name)
(return-from grep-at-point nil))
(let* ((word (buffer-substring-at-point "grep: "))
(bufname (get-buffer-file-name))
(ext (or grep-ext-variable
(if (and bufname
(string-match "\\.[^.]+$" bufname))
(concat "*" (match-string 0))
"*")))
(dir (directory-namestring (get-buffer-file-name))))
(ed::scan-files word (split-string ext #\; t " ") dir)))
;;--------------------------------------------------------------------------------
;; grep-dialog
(require "grepd")
(defun grep-dialog-at-point ()
"カーソル下の単語でgrep-dialog"
(interactive)
(selection-at-point)
(let* ((bufname (get-buffer-file-name))
(ext (or grep-ext-variable
(if (and bufname
(string-match "\\.[^.]+$" bufname))
(concat "*" (match-string 0))
"*"))))
(when bufname
(message "~A" bufname)
(add-history (directory-namestring bufname) 'ed::*grep-directory-history*)
(add-history ext 'ed::*grep-file-history*)))
(labels ((uniq (%list)
(if (null %list)
nil
(cons (first %list)
(uniq (remove (first %list) %list :test #'equal))))))
(setf ed::*grep-directory-history* (uniq ed::*grep-directory-history*))
(setf ed::*grep-file-history* (uniq ed::*grep-file-history*)))
(grep-dialog))
;;--------------------------------------------------------------------------------
;; gresreg
(require "gresreg")
;;--------------------------------------------------------------------------------
;; gresreg-dialog
(require "gresregd")
(defun gresreg-dialog-at-point ()
"カーソル下の単語でgresreg-dialog"
(interactive)
(selection-at-point)
(let* ((bufname (get-buffer-file-name))
(ext (or grep-ext-variable
(if (and bufname
(string-match "\\.[^.]+$" bufname))
(concat "*" (match-string 0))
"*"))))
(when bufname
(message "~A" bufname)
(add-history (directory-namestring bufname) 'ed::*gresreg-directory-history*)
(add-history ext 'ed::*gresreg-file-history*)))
(labels ((uniq (%list)
(if (null %list)
nil
(cons (first %list)
(uniq (remove (first %list) %list :test #'equal))))))
(setf ed::*gresreg-directory-history* (uniq ed::*gresreg-directory-history*))
(setf ed::*gresreg-file-history* (uniq ed::*gresreg-file-history*)))
(gresreg-dialog))
;;--------------------------------------------------------------------------------
;; hideif
(require "hideif")
(require "hideif2")
(setf *hide-ifdef-cpp* "C:/MinGW/bin/gcc -E")
;;--------------------------------------------------------------------------------
;; idl-mode
(require "idl-mode")
(pushnew '("\\.idl$" . idl-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; java-mode
(require "java")
(setf *java-indent-tabs-mode* t)
(setf java-indent-level 4)
(setf java-continued-statement-offset 4)
(setf java-argdecl-indent 4)
(setf java-brace-offset -4)
(setf java-brace-imaginary-offset 0)
(setf java-label-offset -4)
(setf java-comment-indent 0)
(pushnew '("\\.java$" . java-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; kbd-macro
(require "kbdmacro")
(defvar *original-start-kbd-macro* #'ed::start-kbd-macro
"ed::start-kbd-macro の退避")
(defun start-kbd-macro (&optional arg)
"キーボードマクロ記録開始"
(interactive "p")
(funcall *original-start-kbd-macro* arg)
(message "Defining kbd macro..."))
(defvar *original-end-kbd-macro* #'ed::end-kbd-macro
"ed::end-kbd-macro の退避")
(defun end-kbd-macro (&optional arg)
"キーボードマクロ記録終了"
(interactive "p")
(funcall *original-end-kbd-macro* arg)
(message "Keyboard macro defined"))
;;--------------------------------------------------------------------------------
;; LaTeX-mode
(require "LaTeX")
; (pushnew '("\\.tex$" . LaTeX-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; list-function
(require "listfn")
;;--------------------------------------------------------------------------------
;; pascal-mode
(require "pascal")
(setf *pascal-indent-tabs-mode* t)
(pushnew '("\\.p$" . pascal-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.pas$" . pascal-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; perl-mode
(require "perl")
(pushnew '("\\.plx?$" . perl-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.pm" . perl-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.perl" . perl-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.cgi" . perl-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; sql-mode
(require "sql-mode")
(pushnew '("\\.sql$" . sql-mode) *auto-mode-alist* :test #'equal)
(defun sql-mode-set-local-variable ()
"sql-modeのlocal-variable設定"
(set-syntax-start-c++-comment ed::*sql-mode-syntax-table* #\-)
(set-syntax-end-c++-comment ed::*sql-mode-syntax-table* #\LFD))
(add-hook '*sql-mode-hook* 'sql-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; tail-f
(require "tail-f")
(defun tail-f-mode-set-multi-major-mode ()
"tail-f-modeのmulti-major-mode設定"
(multi-major-mode-start nil))
(add-hook '*tail-f-mode-hook* 'tail-f-mode-set-multi-major-mode)
;;--------------------------------------------------------------------------------
;; text-mode
(require "textmode")
(pushnew '("\\.txt$" . text-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.log$" . text-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; winhelp
(require "winhelp")
;;■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□
;; site-lisp
;;--------------------------------------------------------------------------------
;; ac-mode
(require "ac-mode")
(add-hook '*find-file-hooks* 'ac-mode-on)
(add-hook '*multi-major-mode-hook* 'ac-mode-on)
(define-key ed::*ac-mode-internal-map* #\Down 'ed::ac-mode-select-next)
(define-key ed::*ac-mode-internal-map* #\Up 'ed::ac-mode-select-prev)
;;--------------------------------------------------------------------------------
;; ac-mode-css
(require "ac-mode-css")
(require "css+-mode")
(add-hook '*css+-mode-hook* 'ac-mode-css-init)
;;--------------------------------------------------------------------------------
;; ac-mode-html+
(require "ac-mode-html+")
(setq-default ac-mode-html+-xhtml t)
;;--------------------------------------------------------------------------------
;; ac-mode-lisp
(require "ac-mode-lisp")
(add-hook '*lisp-interaction-mode-hook* 'ac-mode-on)
;;--------------------------------------------------------------------------------
;; addref
(require "addref")
(setf *addref-file* (merge-pathnames "reference/addref.xml" (si:system-root)))
(defun addref-add (tpc)
"addref: 出来上がった空のトピックをバッファに追加"
(save-excursion
(set-buffer (ed::find-file-internal *addref-file*))
(widen)
(goto-char (point-min))
(scan-buffer "<book>\n?" :tail t :regexp t)
(unless (bolp)
(insert "\n"))
(with-output-to-selected-buffer
(addref-output-topic-format tpc))))
;;--------------------------------------------------------------------------------
;; ahk-mode
(require "ahk-mode")
(setf *ahk-exe-dir* (si:system-root))
(setf *ahk-html-help-file* (merge-pathnames "AutoHotkey.chm" (etc-path)))
(setf *ahk-syntax-dirname* (merge-pathnames "AutoHotKey-Syntax" (etc-path)))
(pushnew '("\\.ahk$" . ahk-mode) *auto-mode-alist* :test #'equal)
(pushnew '("autohotkey\\.ini$" . ahk-mode) *auto-mode-alist* :test #'equal)
(define-key ed::*ahk-mode-map* #\{ nil)
(define-key ed::*ahk-mode-map* #\} nil)
(define-key ed::*ahk-mode-map* #\F1 'help-prefix)
(defun ahk-mode-set-local-variable ()
"ahk-modeのlocal-variable設定"
(make-local-variable 'ed::local-help-variable)
(setf ed::local-help-variable *ahk-html-help-file*))
(add-hook '*ahk-mode-hook* 'ahk-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; apache-mode
(require "apache-mode")
(pushnew '("\\.htaccess$" . apache-mode) *auto-mode-alist* :test #'equal)
(pushnew '("httpd\\.conf$" . apache-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; approx-search
(require "approx-search")
;;--------------------------------------------------------------------------------
;; asm-mode
(require "asm-mode")
(setf *asm-indent-tabs-mode* t)
(setf asm-indent-level 4)
(pushnew '("\\.app$" . asm-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.asm$" . asm-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.inc$" . asm-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.mac$" . asm-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.s$" . asm-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.src$" . asm-mode) *auto-mode-alist* :test #'equal)
(defvar *asm-keyword-file-list*
'(("Asm" . "Asm")
("ESR-H" . "Asm-ESR-H")
("ESR-L" . "Asm-ESR-L")
("MIPS" . "Asm-MIPS")
("MIPS16" . "Asm-MIPS16")
("SH" . "Asm-SH")
("SH1" . "Asm-SH1")
("SH2" . "Asm-SH2")
("SH3" . "Asm-SH3")
("SH3-DSP" . "Asm-SH3-DSP")
("SH3E" . "Asm-SH3E")
("SH4" . "Asm-SH4")
("SH64" . "Asm-SH64")
("SH-DSP" . "Asm-SH-DSP")
("Z80" . "Asm-Z80"))
"asm-modeのキーワードファイルのリスト")
(register-history-variable 'ed::*asm-keyword-file*)
(defun asm-message-keyword-file ()
"asm-modeのキーワードファイルの表示"
(interactive)
(message "Keyword file: ~A" ed::*asm-keyword-file*))
(defun asm-change-keyword-file (keyword-file)
"asm-modeのキーワードファイルを変更"
(interactive
(list (rest (assoc (completing-read "Keyword file: "
(mapcar #'first *asm-keyword-file-list*)
:must-match t :case-fold t)
*asm-keyword-file-list*
:test #'string-equal))))
(setf ed::*asm-keyword-file* keyword-file)
(setf ed::*asm-keyword-hash-table* (load-keyword-file ed::*asm-keyword-file* t))
(when ed::*asm-keyword-hash-table*
(make-local-variable 'keyword-hash-table)
(setf keyword-hash-table ed::*asm-keyword-hash-table*))
(asm-message-keyword-file))
(define-key *asm-mode-map* '(#\C-c #\k) 'asm-change-keyword-file)
(defun asm-auto-keyword-file ()
"asm-modeのキーワードファイルを自動判定"
(unwind-protect
(let* ((param (ed::find-file-scan-params))
(ret (or (rest (assoc "keyword" param :test #'string-equal))
(rest (assoc "cpu" param :test #'string-equal))))
(keyword-file (and ret
(rest (assoc ret *asm-keyword-file-list* :test #'string-equal)))))
(when keyword-file
(asm-change-keyword-file keyword-file)))
(asm-message-keyword-file)))
(add-hook '*asm-mode-hook* 'asm-auto-keyword-file)
;;--------------------------------------------------------------------------------
;; autolookup
(require "autolookup")
(setf *autolookup-dictionary-path* (merge-pathnames "dict" (si:system-root)))
(defun autolookup-mode-on ()
"autolookup-modeをON"
(interactive)
(autolookup-mode t))
(defun autolookup-mode-off ()
"autolookup-modeをOFF"
(interactive)
(autolookup-mode nil))
; (add-hook '*find-file-hooks* 'autolookup-mode-on)
; (add-hook '*lisp-interaction-mode-hook* 'autolookup-mode-on)
;;--------------------------------------------------------------------------------
;; auto-time-stamp
(require "auto-time-stamp")
;;--------------------------------------------------------------------------------
;; auto-time-stamp-bottom
(require "auto-time-stamp-bottom")
;;--------------------------------------------------------------------------------
;; bash-mode
(require "bash-mode")
(pushnew '("\\.[bkz]?sh$" . bash-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.bash$" . bash-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.zcompdump$" . bash-mode) *auto-mode-alist* :test #'equal)
(defun bash-mode-encoding ()
"bash-modeのエンコーディング判定"
*encoding-utf8n*)
(pushnew '("\\.[bkz]?sh$" . bash-mode-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.bash$" . bash-mode-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.zcompdump$" . bash-mode-encoding) *auto-encoding-alist* :test #'equal)
(defun bash-mode-set-local-variable ()
"bash-modeのlocal-variable設定"
(set-buffer-eol-code *eol-lf*))
(add-hook '*bash-mode-hook* 'bash-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; bat-mode
(require "bat-mode")
(setf ed::*bat-comment-color* :comment)
(setf ed::*bat-lavel-color* '(:color 5 0 :underline))
(setf ed::*bat-command-color* 0)
(setf ed::*bat-goto-label-color* 1)
(setf ed::*bat-echo-stop-color* 1)
(setf ed::*bat-string-color* :string)
(setf ed::*bat-if-syntax-color* 2)
(setf ed::*bat-for-syntax-color* 2)
(setf ed::*bat-loop-variable-color* 2)
(setf ed::*bat-argument-color* 2)
(setf ed::*bat-variable-color* '(:color 4 0))
(setf ed::*bat-variable-reference-color* 2)
(setf ed::*bat-regexp-keyword-list*
(compile-regexp-keyword-list
`(("^[ \t]*:.+"
t ,ed::*bat-lavel-color*)
("^[ \t]*\\(@\\)"
t ,ed::*bat-echo-stop-color* nil 1)
(,(concat "\\<\\(REM\\)\\>"
"\\(?:[ \t]\\(.*\\)\\)?")
t ,ed::*bat-comment-color*)
("\\<\\(IF\\|ELSE\\)\\>"
t ,ed::*bat-command-color*)
("\\<\\(?:NOT\\|ERRORLEVEL\\|EXIST\\)\\>"
t ,ed::*bat-if-syntax-color*)
("\\<FOR\\>"
t ,ed::*bat-command-color*)
("\\<\\(?:IN\\|DO\\)\\>"
t ,ed::*bat-for-syntax-color*)
(,(concat "\\<\\(GOTO\\)\\>"
"\\(?:[ \t]\\(.*\\)\\)?")
t ((1 . ,ed::*bat-command-color*)
(2 . ,ed::*bat-goto-label-color*)))
("\\<\\(ECHO\\)[ \t]+\\(ON\\|OFF\\)[ \t]*$"
t ,ed::*bat-command-color*)
(,(concat "\\<\\(ECHO\\.?\\)\\>"
"\\(?:[ \t]\\(.*\\)\\)?")
t ((1 . ,ed::*bat-command-color*)
(2 . ,ed::*bat-string-color*)))
("\\<\\(SET\\)\\(?:[ \t]+\\([^=\n]+\\)\\(?:=\\(.*\\)\\)?\\)?"
t ((1 . ,ed::*bat-command-color*)
(2 . ,ed::*bat-variable-color*)
(3 . ,ed::*bat-string-color*)))
(,(concat "\\<"
"\\(PATH"
"\\|PROMPT"
"\\)\\>"
"\\(?:[ \t]*=[ \t]*\\(.*\\)\\)")
t ((1 . ,ed::*bat-command-color*)
(2 . ,ed::*bat-string-color*)))
(,(concat "\\<"
"\\(PATH"
"\\|PROMPT"
"\\|CALL"
"\\|PAUSE"
"\\|SHIFT"
"\\)\\>"
"\\(?:[ \t]+\\(.*\\)\\)?")
t ((1 . ,ed::*bat-command-color*)
(2 . ,ed::*bat-string-color*)))
("\\<\\(CHOICE\\)\\>"
t ,ed::*bat-command-color*)
("%~?[0-9]"
nil ,ed::*bat-argument-color*)
("%%[A-Za-z]"
nil ,ed::*bat-loop-variable-color*)
("%[A-Za-z][A-Za-z0-9_]*%"
nil ,ed::*bat-variable-reference-color*))))
(pushnew '("\\.bat$" . bat-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.cmd$" . bat-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; browserex
(require "browserex")
;;--------------------------------------------------------------------------------
;; buf2html
(require "buf2html")
(buf2html-set-app-menu)
; (buf2html-set-app-popup-menu)
;;--------------------------------------------------------------------------------
;; c-comment-macro
(require "c-comment-macro") ; うちの会社のスタイルのドキュメントコメント記述用
;;--------------------------------------------------------------------------------
;; caml-mode
(require "caml")
(pushnew '("\\.ml[iylp]?$" . caml-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; cfns2
(require "cfns2")
(let ((cmaketags (find 'ed::c-maketags *maketags-list* :key #'first)))
(when cmaketags
(setf (first cmaketags) 'ed::c-maketags2)))
;;--------------------------------------------------------------------------------
;; clickable-uri
(require "clickable-uri")
(setf *clickable-uri-keyword-color* '(:color 6 0 :underline))
(setf *clickable-uri-open-attribute* '(:foreground 6 :underline :bold))
(clickable-uri-set-regexp)
;;--------------------------------------------------------------------------------
;; color
(require "color")
;;--------------------------------------------------------------------------------
;; color-diff-mode
(require "colordiff-mode")
(setf *colordiff-new-text-color* 2)
(setf *colordiff-old-text-color* 1)
(setf *colordiff-diff-stuff-color* 5)
(setf *colordiff-cvs-stuff-color* 4)
(pushnew '("\\.diff$" . colordiff-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.patch$" . colordiff-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; complete+
(require "complete+")
(require "complete-bg")
(use-package :complete+)
(setf *complete+-and-search* ";")
(setf *complete+-show-drive* t)
(setf *complete+-current-item-attribute* '(:foreground 1))
(setf *complete+-highlight-color* '(:foreground 2))
(setf *virtual-file-add-slash-automatically* t)
(setf *complete+-create-new-file-check* t)
(setf complete+::*regexp-colorize-keyword-list* nil)
(complete+-toggle-incremental t)
(dolist (keymap (list minibuffer-local-completion-map
minibuffer-local-must-match-map
minibuffer-local-command-line-map))
(define-key keymap '#\C-n 'complete+-select-next-item)
(define-key keymap '#\C-p 'complete+-select-prev-item)
(define-key keymap '#\Down 'complete+-select-next-item)
(define-key keymap '#\Up 'complete+-select-prev-item)
(define-key keymap '#\C-< 'complete+-substring-match-rotate)
(define-key keymap '#\C-> 'complete+-skip-match-rotate)
(define-key keymap '#\C-\, 'complete+-case-fold-ratate)
(define-key keymap '#\C-. 'complete+-toggle-incremental))
;;--------------------------------------------------------------------------------
;; css+-mode
(require "css+-mode")
(require "css-mode")
(setf *css+-indent-tabs-mode* t)
(setf *css+-indent-column* 4)
(setf *css+-comment-column* 0)
(setf *css+-comment-indent* 0)
(setf *css+-mirror-mode* nil)
(setf *css+-regexp-keyword-list*
(compile-regexp-keyword-list
`(("#[a-f0-9][a-f0-9][a-f0-9]\\([a-f0-9][a-f0-9][a-f0-9]\\)?"
nil ,ed::*css+-srgb-colors-face*)
("#[A-F0-9][A-F0-9][A-F0-9]\\([A-F0-9][A-F0-9][A-F0-9]\\)?"
nil ,ed::*css+-srgb-colors-face*)
(,(concat "rgb("
"\\s *-?[0-9]+\\(\\.[0-9]+\\)?%?\\s *,"
"\\s *-?[0-9]+\\(\\.[0-9]+\\)?%?\\s *,"
"\\s *-?[0-9]+\\(\\.[0-9]+\\)?%?\\s *")
t ,ed::*css+-srgb-colors-face*)
("\\[\\(.[^[]*\\)\\]"
t ((0 . ,ed::*css+-attribute-selectors-bracket-face*)
(1 . ,ed::*css+-attribute-selectors-face*)))
("\\.\\([a-z][-_a-z0-9.]+\\)"
t ((0 . ,ed::*css+-class-selectors-dot-face*)
(1 . ,ed::*css+-class-selectors-face*)))
("#\\([-_a-z0-9]*\\)"
t ((0 . ,ed::*css+-id-selectors-sharp-face*)
(1 . ,ed::*css+-id-selectors-face*)))
(":\\(first-line\\|first-letter\\|after\\|before\\)+"
t ,ed::*css+-pseudo-elements-face*)
(":\\(active\\|first\\|first-child\\|focus\\|hover\\|lang\\|left\\|link\\|right\\|visited\\)+"
t ,ed::*css+-pseudo-classes-face*))))
(pushnew '("\\.css$" . css+-mode) *auto-mode-alist* :test #'equal)
(defun css+-set-local-variable ()
"css+-modeのlocal-variable設定"
(setf mode-name (format nil "CSS+~A" ed::*css-level*))
(setf ed::*css+-completion-list (ed::css-completion-list))
(and (ed::css-keyword-file)
(null (ed::css-keyword-hash-table))
(setf (ed::css-keyword-hash-table)
(load-keyword-file (ed::css-keyword-file) t)))
(when (ed::css-keyword-hash-table)
(make-local-variable 'keyword-hash-table)
(setf keyword-hash-table (ed::css-keyword-hash-table))))
(add-hook '*css+-mode-hook* 'css+-set-local-variable)
(defun css+2-mode ()
(interactive)
(setf ed::*css-level* 2)
(css+-mode))
(defun css+3-mode ()
(interactive)
(setf ed::*css-level* 3)
(css+-mode))
(defvar *css+-default-encoding* '*encoding-utf8n*
"css+-modeのデフォルトエンコーディング")
(defun css+-mode-encoding ()
"css+-modeのエンコーディング判定"
(save-excursion
; @charset 規則は文書の先頭に書かなければならない
; -> いかなる文字も先行しない
; http://www.w3.org/TR/CSS21/syndata.html#charset
(goto-char (point-min))
(let ((encoding (or (when (looking-at "@charset[ \t]+['\"]\\([0-9A-Za-z_\\-]+\\)")
(gethash (match-string 1) *mime-charset-name-hash-table*))
*css+-default-encoding*)))
(if (and *find-file-auto-encoding-use-utf8n*
(eq encoding *encoding-utf8*))
*encoding-utf8n*
encoding))))
(pushnew '("\\.css$" . css+-mode-encoding) *auto-encoding-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; csv-mode
(require "csv-mode")
(setf *csv-menu-name* "&CSV")
(pushnew '("\\.csv$" . csv-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.message$" . csv-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.tsv$" . tsv-mode) *auto-mode-alist* :test #'equal)
(add-hook '*init-app-menus-hook* 'ed::init-csv-menu)
;;--------------------------------------------------------------------------------
;; ctags
(require "ctags")
(require "ctags2")
(setf *ctags-command-path* (merge-pathnames "bin/ctags.exe" (si:system-root)))
(defun ctags-jump-tag-other-window ()
"次のウィンドウでタグジャンプ"
(interactive)
(if (> (count-windows) 1)
(let ((b (selected-buffer)))
(other-window)
(set-buffer b))
(split-window))
(ctags-jump-tag))
(defun ctags-jump-tag-other-pseudo-frame (name)
"新しいフレームでタグジャンプ"
(interactive
(list (progn
(ed::pseudo-frame-check-minibuffer)
(ed::make-pseudo-frame-name))))
(new-pseudo-frame name t)
(ctags-jump-tag))
;;--------------------------------------------------------------------------------
;; cygwin-mount
(require "cygwin-mount")
(cygwin-mount-activate)
;;--------------------------------------------------------------------------------
;; describe-bindings-mode
(require "describe-bindings-mode")
(setf *describe-bindings-show-explain* t)
(define-key *describe-bindings-mode-map* #\RET 'imm-refer-selection)
(require "igsearch")
(add-hook '*describe-bindings-mode-hook* 'igsearch-forward)
;;--------------------------------------------------------------------------------
;; diff-backup
(require "diff-backup")
;;--------------------------------------------------------------------------------
;; d-mode
(require "d-mode")
(setf *d-indent-tabs-mode* t)
(setf d-indent-level 4)
(setf d-continued-statement-offset 4)
(setf d-argdecl-indent 4)
(setf d-brace-offset -4)
(setf d-brace-imaginary-offset 0)
(setf d-label-offset -4)
(setf d-comment-indent 1)
(pushnew '("\\.ds?$" . d-mode) *auto-mode-alist* :test #'equal)
(defun d-mode-set-local-variable ()
"d-modeのlocal-variable設定"
(make-local-variable 'ed::local-help-variable)
(setf ed::local-help-variable (merge-pathnames "d-jp101230.chm" (etc-path))))
(add-hook '*d-mode-hook* 'd-mode-set-local-variable)
(defun d-mode-set-multi-major-mode ()
"d-modeのmulti-major-mode設定"
(multi-major-mode-start t "d-mode"
'("asm[ \t\n]*{" "}" "asm-mode" t)))
(add-hook '*d-mode-hook* 'd-mode-set-multi-major-mode)
; ;;--------------------------------------------------------------------------------
; ;; edited-line-mark
; (require "edited-line-mark")
; (setf *edited-line-attribute* '(:foreground 0))
; ;;--------------------------------------------------------------------------------
; ;; encoding-utility
; (require "encoding-utility")
;;--------------------------------------------------------------------------------
;; ext-lisp-maketags
(require "ext-lisp-maketags")
;;--------------------------------------------------------------------------------
;; ffap
(require "ffap")
(ffap-bindings)
(defun ed::ffap-get-path ()
(let ((str (substitute-string (ed::ffap-get-current-string-syntax)
"\\\\\\\\" "\\\\"))
(str1 (substitute-string (ed::ffap-get-current-string-uri-chars)
"\\\\\\\\" "\\\\")))
(ed::ffap-correct-uri
(or (and (not (string= str ""))
(file-exist-p str)
str)
(and (not (string-match "^ *$" str1))
(file-exist-p str1)
str1)
(ed::ffap-locate str)
(ed::ffap-locate-approx str)
(when ed::*ffap-find-uri*
(ed::ffap-get-uri str))
(ed::ffap-get-mail-address str)
(ed::ffap-locate str1)
(ed::ffap-locate-approx str1)
(when ed::*ffap-find-uri*
(ed::ffap-get-uri str1))
(ed::ffap-get-mail-address str1)))))
;;--------------------------------------------------------------------------------
;; fsharp-mode
(require "fsharp-mode")
(pushnew '("\\.fs$" . fsharp-mode) *auto-mode-alist* :test #'equal)
(defun fsharp-mode-set-local-variable ()
"fsharp-modeのlocal-variable設定"
(microsoft-help-viewer-set-local-variable))
(add-hook '*fsharp-mode-hook* 'fsharp-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; gauche-mode
(require "gauche-mode")
(setf *gauche-indent-tabs-mode* nil)
(setf *gauche-dynamic-completion* t)
(setf *gauche-browser-pathname* *browser-pathname*)
(setf *gauche-href-regexp*
(compile-regexp "\\(gauche-refj_[0-9]+.html#index-[0-9A-Za-z_-]+\\)\">\\(<code>\\)+\\(.+\\)\\(</code>\\)+</a>"))
(pushnew '("\\.scm$" . gauche-mode) *auto-mode-alist* :test #'equal)
(define-key *gauche-mode-map* #\F1 'help-prefix)
(define-key *gauche-interaction-mode-map* #\F1 'help-prefix)
(defun gauche-mode-set-local-variable ()
"gauche-modeのlocal-variable設定"
(make-local-variable 'ed::local-help-variable)
(setf ed::local-help-variable (merge-pathnames "gauche-refj-0.9.3.chm" (etc-path))))
(add-hook '*gauche-mode-hook* 'gauche-mode-set-local-variable)
(add-hook '*gauche-interaction-mode-hook* 'gauche-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; generic-comment-toggle
(require "generic-comment-toggle")
;;--------------------------------------------------------------------------------
;; ggrep
(require "ggrep")
;;--------------------------------------------------------------------------------
;; gmark-select
(require "gmark-select")
(export-from
'(#:gmark-select
#:gmark-select-set
#:gmark-select-search-forward
#:gmark-select-search-backward)
:ed)
;;--------------------------------------------------------------------------------
;; grep-a-lot
(require "grep-a-lot")
;;--------------------------------------------------------------------------------
;; grep-mode
(require "grep-mode")
(add-hook '*grep-hook* 'grep-mode)
(add-hook '*grepd-hook* 'grep-mode)
(defun ed::grep-mode ()
(interactive)
(toggle-read-only t) ; read-only
(make-local-variable 'need-not-save)
(setf need-not-save t)
(make-local-variable 'auto-save)
(setf auto-save nil)
(make-local-variable 'regexp-keyword-list)
(setf regexp-keyword-list
(compile-regexp-keyword-list
'(("^[^:]+[:]\\([0-9]+\\)[:]"
t :string t))))
(let ((keymap (copy-keymap (local-keymap))))
(define-key keymap #\LBtnUp 'ed::grep-mode-dblclick)
(define-key keymap #\RET 'first-error)
(define-key keymap #\q 'ed::grep-mode-close)
(define-key keymap #\d 'ed::grep-delete-wholeline)
(define-key keymap #\& 'ed::grep-and-dialog)
(use-keymap keymap))
(make-local-variable 'kept-undo-information)
(setf kept-undo-information nil)
(run-hooks '*grep-mode-hook*)) ; シングルクオーテーションが抜けてる…
(defun grep-mode-set-local-variable ()
"grep-modeのlocal-variable設定"
(make-local-variable 'regexp-keyword-list)
(setf regexp-keyword-list
(compile-regexp-keyword-list
'(("^\\([^:]+\\)\\([:]\\)\\([0-9]+\\)\\([:]\\)"
nil ((1 . (:color 6 0 :underline)) ; ファイル名
(2 . (:color 3 0 )) ; セパレータ 1
(3 . (:color 0 0 )) ; 行番号
(4 . (:color 3 0 :bold ))) ; セパレータ 2
t)))))
(add-hook '*grep-mode-hook* 'grep-mode-set-local-variable)
(defun grep-mode-for-before-hook (pattern)
(grep-mode)
(toggle-read-only nil))
(add-hook '*before-grep-hook* 'grep-mode-for-before-hook)
(add-hook '*before-grepd-hook* 'grep-mode-for-before-hook)
;;--------------------------------------------------------------------------------
;; guidgen
(require "guidgen")
(guidgen-setup-app-menu)
; (guidgen-setup-app-popup-menu)
;;--------------------------------------------------------------------------------
;; help
(require "help")
;;--------------------------------------------------------------------------------
;; hexl
(require "hexl/hexl")
(setf hexl-program (merge-pathnames "bin/hexl.exe" (si:system-root)))
(setf hexlify-command (format nil "~A ~A" hexl-program hexl-options))
(setf dehexlify-command (format nil "~A -de ~A" hexl-program hexl-options))
; (pushnew '("\\.bin$" . hexl-mode) *auto-mode-alist* :test #'equal)
; (pushnew '("\\.dat$" . hexl-mode) *auto-mode-alist* :test #'equal)
; (pushnew '("\\.exe$" . hexl-mode) *auto-mode-alist* :test #'equal)
(defvar *original-hexl-mode* #'hexl-mode
"user::hexl-mode の退避")
(defun hexl-mode ()
"A mode for editing binary files in hex dump format."
(interactive)
(when (file-exist-p (get-buffer-file-name))
(unless (= (point-min) (point-max))
(funcall *original-hexl-mode*))))
(defun hexl-mode-set-local-variable ()
"hexl-modeのlocal-variable設定"
(make-local-variable 'regexp-keyword-list)
(setf regexp-keyword-list
(compile-regexp-keyword-list
'(("^\\(\\w\\{8\\}\\)\\(:\\)"
nil ((1 . 2)
(2 . (:color 3 0 :bold))))
(" .+$"
nil :string)))))
(add-hook 'hexl-mode-hook 'hexl-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; highlight
(require "highlight")
(defun highlight-phrase (str)
"文字列をハイライト"
(interactive "sPhrase: \np")
(highlight-pickup (regexp-quote str)))
;;--------------------------------------------------------------------------------
;; howm-wrap
(push-load-path "howm" (merge-pathnames "site-lisp/howm/" (si:system-root)))
(require "elisp-lib")
(require "config/howm-pre-init")
(require "howm-wrap")
(require "config/howm-init")
;;--------------------------------------------------------------------------------
;; html+-mode
(require "html+-mode")
(setf *html+-indent-tabs-mode* t)
(setf *html+-indent-column* 4)
(pushnew '("\\.[ds]?html?$" . html+-mode) *auto-mode-alist* :test #'equal)
(define-key *html+-mode-map* '(#\C-x #\RET) 'kanji-prefix)
(defun html+-mode-set-multi-major-mode ()
"html+-modeのmulti-major-mode設定"
(multi-major-mode-start t "html+-mode"
'("<style" "</style>" "css+-mode")
'("<script" "</script>" "jscript-mode")
'("<?php" "?>" "php-mode")
'("<%" "%>" "ruby-mode")))
(add-hook '*html+-mode-hook* 'html+-mode-set-multi-major-mode)
;;--------------------------------------------------------------------------------
;; html-popup-menu
(require "html-popup-menu")
;;--------------------------------------------------------------------------------
;; igsearch
(require "igsearch")
(setf *igsearch-next-buffer-use-olt2* t)
(defun igsearch-popup-guide-text ()
"igserachのガイドテキストをポップアップ"
(message-box
(concat "C-,/C-.:select-buffer M-p/M-n:search-history C-o:grep-window\n"
"C-d:delete-char C-f:yank-char C-w:yank-word\n"
"C-t:toggle-method C-<:case-fold C->:escape-sequence\n"
"M-r:regexp-toggle M-a:approx-toggle M-m:migemo-toggle\n"
"M-c:refresh-highlight")))
(define-key *isearch-map* #\F1 'igsearch-popup-guide-text)
(defvar *original-igsearch-forward* #'ed::igsearch-forward
"ed::igsearch-forward の退避")
(defun ed::igsearch-forward (&optional reverse)
"通常検索でigsearch-forward"
(interactive)
(setf *igsearch-init-state* nil)
(funcall *original-igsearch-forward* reverse))
(defun ed::igsearch-backward ()
"通常検索でigsearch-backward"
(interactive)
(setf *igsearch-init-state* nil)
(funcall *original-igsearch-forward* t))
(defun igsearch-forward-migemo (&optional reverse)
"Migemo検索でigsearch-forward"
(interactive)
(setf *igsearch-init-state* :migemo)
(funcall *original-igsearch-forward* reverse))
(defun igsearch-backward-migemo ()
"Migemo検索でigsearch-backward"
(interactive)
(setf *igsearch-init-state* :migemo)
(funcall *original-igsearch-forward* t))
(defun igsearch-forward-approx (&optional reverse)
"曖昧検索でigsearch-forward"
(interactive)
(setf *igsearch-init-state* :approx)
(funcall *original-igsearch-forward* reverse))
(defun igsearch-backward-approx ()
"曖昧検索でigsearch-backward"
(interactive)
(setf *igsearch-init-state* :approx)
(funcall *original-igsearch-forward* t))
(defun igsearch-forward-regexp (&optional reverse)
"正規表現検索でigsearch-forward"
(interactive)
(setf *igsearch-init-state* :regexp)
(funcall *original-igsearch-forward* reverse))
(defun igsearch-backward-regexp ()
"正規表現検索でigsearch-backward"
(interactive)
(setf *igsearch-init-state* :regexp)
(funcall *original-igsearch-forward* t))
;;--------------------------------------------------------------------------------
;; indent-to-token+
(require "indent-to-token+")
(setf *indent-to-token+-nth-regexp* nil)
(defvar *align-regexp* "\\([\\*&0-9A-Za-z:_]+\\((.*)\\|\\[.*\\]\\|\".*\"\\)?\\|[\\-=!^&\\*\\+<>/|]+\\)"
"C:/Meadow/lisp/align.el")
(defun align ()
"indent-to-token+でalignっぽく"
(interactive)
(save-excursion
(selection-at-point)
(let ((p (selection-start-end (s e)
(list s e))))
(ed::indent-to-token+ *align-regexp* 0 1)
(when mode-specific-indent-command
(indent-region (first p) (second p))
(goto-char (first p))
(funcall mode-specific-indent-command)))))
;;--------------------------------------------------------------------------------
;; info-modoki-mode
(require "info-modoki-mode")
;;--------------------------------------------------------------------------------
;; info2
(require "info2")
(setf *info2-dir* (merge-pathnames "info" (si:system-root)))
;;--------------------------------------------------------------------------------
;; ini-mode
(require "ini-mode")
(pushnew '("\\.ini$" . ini-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; insert-directory-tree
(require "insert-directory-tree")
;;--------------------------------------------------------------------------------
;; jscript-mode
(require "jscript-mode")
(setf *jscript-indent-tabs-mode* t)
(setf jscript-comment-indent 1)
(pushnew '("\\.jsx?$" . jscript-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.jsfl?$" . jscript-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.json$" . jscript-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.pac$" . jscript-mode) *auto-mode-alist* :test #'equal)
(define-key *jscript-mode-map* #\: 'c-electric-insert)
(defun jscript-mode-encoding ()
"jscript-modeのエンコーディング判定"
*encoding-utf8n*)
(pushnew '("\\.jsx?$" . jscript-mode-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.jsfl?$" . jscript-mode-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.json$" . jscript-mode-encoding) *auto-encoding-alist* :test #'equal)
(pushnew '("\\.pac$" . jscript-mode-encoding) *auto-encoding-alist* :test #'equal)
(defun jscript-mode-set-local-variable ()
"jscript-modeのlocal-variable設定"
(make-local-variable 'regexp-keyword-list)
(setf regexp-keyword-list
(compile-regexp-keyword-list
'(("<[^>\n]+>"
nil (:color 15) :comment)
("@region\\|@endregion"
nil 2 :comment)))))
(add-hook '*jscript-mode-hook* 'jscript-mode-set-local-variable)
(defun jscript-mode-set-multi-major-mode ()
"jscript-modeのmulti-major-mode設定"
(multi-major-mode-start t "jscript-mode"
'("<![CDATA[" "]]>" "css+-mode")
'("<overlay" "</overlay>" "xml-mode")))
(add-hook '*jscript-mode-hook* 'jscript-mode-set-multi-major-mode)
;;--------------------------------------------------------------------------------
;; KaTeX-mode
(push-load-path "katex" (merge-pathnames "site-lisp/katex/" (si:system-root)))
(require "katex")
(require "kahtml")
(export-from
'(#:katex-mode
#:kahtml-mode)
:el)
(setf el::KaTeX-user-completion-table (merge-pathnames ".xyzzy.d/.katexrc" (user-homedir-pathname)))
(setf el::*KaTeX-menu-name* "&KaTeX")
(pushnew '("\\.katexrc$" . lisp-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.tex$" . katex-mode) *auto-mode-alist* :test #'equal)
; (pushnew '("\\.html?$" . kahtml-mode) *auto-mode-alist* :test #'equal)
; (set-extended-key-translate-table exkey-M-return #\M-RET)
;;--------------------------------------------------------------------------------
;; key-chord
(require "key-chord")
;;--------------------------------------------------------------------------------
;; ldoc2
(require "ldoc2")
(turn-on-ldoc)
; ;;--------------------------------------------------------------------------------
; ;; lisp-keyword
; (require "ni-autoload/lisp-keywords")
; (setf *lisp-keyword-highlight* t)
(def-show-html-help reference-show (merge-pathnames "reference.chm" (etc-path)))
;;--------------------------------------------------------------------------------
;; lisp-minibuffer-mode
(require "lisp-minibuffer-mode")
(define-key *lisp-minibuffer-mode-map* #\TAB 'ac-mode-complete-or-indent)
;;--------------------------------------------------------------------------------
;; lisp-mode
(require "lispmode")
(setf *lisp-indent-tabs-mode* nil)
(setf (get 'defvar-local 'lisp-indent-hook) 'defun)
(setf (get 'define-history-variable 'lisp-indent-hook) 'defun)
(setf ed::*indent-def-file* (merge-pathnames "site-lisp/lispmode/lindent.l" (si:system-root)))
(pushnew '("\\.c?l$" . lisp-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.clisp$" . lisp-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.li?sp$" . lisp-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.xyzzy$" . lisp-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.xyzzy\\.history$" . lisp-mode) *auto-mode-alist* :test #'equal)
(define-key ed::*lisp-mode-map* '(#\ESC #\i) 'align)
(define-key ed::*lisp-interaction-mode-map* '(#\ESC #\i) 'align)
(defun lisp-mode-set-local-variable ()
"lisp-modeのlocal-variable設定"
(make-local-variable 'ed::local-help-variable)
(setf ed::local-help-variable 'user::imm1)
(set-tab-columns 8 (selected-buffer)))
(add-hook '*lisp-mode-hook* 'lisp-mode-set-local-variable)
(add-hook '*lisp-interaction-mode-hook* 'lisp-mode-set-local-variable)
(defun lisp-save-buffer-and-byte-compile ()
"保存してバイトコンパイル"
(interactive "*")
(let* ((l (get-buffer-file-name (selected-buffer)))
(lc (merge-pathnames (concat (pathname-name l) ".lc")
(directory-namestring l))))
(save-buffer)
(long-operation
(unwind-protect
(progn
(eval-buffer (selected-buffer))
(and (file-exist-p lc)
(byte-compile-file l)))))))
(define-key ed::*lisp-mode-map* '(#\C-x #\C-s) 'lisp-save-buffer-and-byte-compile)
(defvar *elisp-mode-hook* nil
"elisp-modeのhook")
(defvar *elisp-keyword-hash-table* nil
"elisp-modeのkey-word-hash-table")
(defvar *elisp-keyword-highlight* t
"elisp-modeのkeyword-highlight の有無")
(defvar *elisp-mode-abbrev-table* nil
"elisp-modeのaabrev-table")
(unless *elisp-mode-abbrev-table*
(define-abbrev-table '*elisp-mode-abbrev-table*))
(defvar *elisp-mode-map* nil
"elisp-modeのkeymap")
(unless *elisp-mode-map*
(setf *elisp-mode-map* (copy-keymap ed::*lisp-mode-map*))
(undefine-key *elisp-mode-map* '(#\C-x #\C-s)))
(defun elisp-mode ()
"Major mode for editing Emacs Lisp."
(interactive)
(lisp-mode)
(setf buffer-mode 'elisp-mode)
(setf mode-name "Elisp")
(setf *local-abbrev-table* *elisp-mode-abbrev-table*)
(setf *elisp-keyword-hash-table*
(or *elisp-keyword-hash-table*
(load-keyword-file "elisp")))
(and *elisp-keyword-highlight*
*elisp-keyword-hash-table*
(make-local-variable 'keyword-hash-table)
(setf keyword-hash-table *elisp-keyword-hash-table*))
(use-keymap *elisp-mode-map*)
(run-hooks '*elisp-mode-hook*))
(pushnew '("\\.el$" . elisp-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.emacs$" . elisp-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; lua-mode
(require "lua")
(pushnew '("\\.lua$" . lua-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; makefile-mode
(require "make-mode")
(export-from
'#:makefile-mode
:el)
(pushnew '("makefile" . makefile-mode) *auto-mode-alist* :test #'equal)
(pushnew '("GNUmakefile" . makefile-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.ma?k$" . makefile-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; markdown-mode
(require "markdown-mode")
(setf md:*h3-style* '(:color 1 0 :underline :bold))
(setf md:*h4-style* '(:color 3 0 :underline))
(setf md:*h5-style* '(:color 6 0))
(setf md:*h6-style* '(:color 4 0))
(setf md:*listmarker-style* '(:color 2 0 :bold))
(pushnew '("\\.md$" . markdown-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.mkdn?$" . markdown-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.markdown$" . markdown-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.howm$" . markdown-mode) *auto-mode-alist* :test #'equal)
(defun markdown-mode-set-local-variable ()
"markdown-modeのlocal-variable設定"
(make-local-variable 'indent-tabs-mode)
(setf indent-tabs-mode nil))
(add-hook 'md::*markdown-mode-hook* 'markdown-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; mayu-mode
(require "mayu-mode")
(setf ed::mayu-font-lock-keywords
`((,(concat "\\<\\("
"[AMCWSUDR]-"
"\\|[NCSK]L-"
"\\|[ML][0-9]-"
"\\|E[01]-"
"\\|MAX-"
"\\|MIN-"
"\\|MMAX-"
"\\|MMIN-"
"\\|I[CHJKLW]-"
"\\|T[LR]?[S]?-"
"\\|K[0-3]-"
"\\)")
t . ,*mayu-font-lock-keyword-face*)
("/[^/\n]*/"
t . ,*mayu-font-lock-string-face*)
("\\\\$"
t . ,*mayu-font-lock-warning-face*)
(,(concat "^\\s *\\<\\("
"key"
"\\|event\\s +\\(prefixed\\|after-key-up\\|before-key-down\\)"
"\\|keyseq"
"\\|def\\s +\\(key\\|alias\\|mod\\|sync\\|subst\\|option\\)"
"\\|mod"
"\\|keymap"
"\\|keymap2"
"\\|window"
"\\|include"
"\\|if"
"\\|define"
"\\|else"
"\\|elseif"
"\\|elsif"
"\\|elif"
"\\|endif"
"\\)\\>")
t . ,*mayu-font-lock-builtin-face*)
(,(concat "&\\("
"Default"
"\\|KeymapParent"
"\\|KeymapWindow"
"\\|KeymapPrevPrefix"
"\\|OtherWindowClass"
"\\|Prefix"
"\\|Keymap"
"\\|Sync"
"\\|Toggle"
"\\|EditNextModifier"
"\\|Variable"
"\\|Repeat"
"\\|Undefined"
"\\|Ignore"
"\\|PostMessage"
"\\|ShellExecute"
"\\|SetForegroundWindow"
"\\|LoadSetting"
"\\|VK"
"\\|Wait"
"\\|InvestigateCommand"
"\\|MayuDialog"
"\\|DescribeBindings"
"\\|HelpMessage"
"\\|HelpVariable"
"\\|WindowRaise"
"\\|WindowLower"
"\\|WindowMinimize"
"\\|WindowMaximize"
"\\|WindowHMaximize"
"\\|WindowVMaximize"
"\\|WindowHVMaximize"
"\\|WindowMove"
"\\|WindowMoveTo"
"\\|WindowMoveVisibly"
"\\|WindowClingToLeft"
"\\|WindowClingToRight"
"\\|WindowClingToTop"
"\\|WindowClingToBottom"
"\\|WindowClose"
"\\|WindowToggleTopMost"
"\\|WindowIdentify"
"\\|WindowSetAlpha"
"\\|WindowRedraw"
"\\|WindowResizeTo"
"\\|WindowMonitor"
"\\|WindowMonitorTo"
"\\|MouseMove"
"\\|MouseWheel"
"\\|ClipboardChangeCase"
"\\|ClipboardUpcaseWord"
"\\|ClipboardDowncaseWord"
"\\|ClipboardCopy"
"\\|EmacsEditKillLinePred"
"\\|EmacsEditKillLineFunc"
"\\|LogClear"
"\\|DirectSSTP"
"\\|PlugIn"
"\\|Recenter"
"\\|SetImeStatus"
"\\|SetImeString"
"\\)\\>")
t . ,*mayu-font-lock-builtin-face*)))
(setf ed::*mayu-regexp-keyword-list* (compile-regexp-keyword-list ed::mayu-font-lock-keywords))
(pushnew '("\\.mayu$" . mayu-mode) *auto-mode-alist* :test #'equal)
(pushnew '("\\.nodoka$" . mayu-mode) *auto-mode-alist* :test #'equal)
(defvar *nodoka-help-pathname* "C:/Program Files/nodoka/doc/README-ja.html"
"のどかのヘルプのパス")
(defun nodoka-show-help ()
"のどかのヘルプを開く"
(interactive)
(shell-execute *browser-pathname* nil (concat "\"file:///" *nodoka-help-pathname* "\"")))
(defun mayu-mode-set-local-variable ()
"mayu-modeのlocal-variable設定"
(make-local-variable 'indent-tabs-mode)
(setf indent-tabs-mode nil)
(make-local-variable 'ed::local-help-variable)
(setf ed::local-help-variable 'nodoka-show-help))
(add-hook '*mayu-mode-hook* 'mayu-mode-set-local-variable)
;;--------------------------------------------------------------------------------
;; mercurial
(require "mercurial")
(require "mercurial-cygwin")
(setf *hg-cyg-shell* "sh -c")
(setf *hg-default-diff* "nkfdiff")
(def-hg-extdiff "nkfdiff")
(setf ed::*hg-output-color-cvs-stuff* 4)
(setf ed::*hg-output-color-added* 2)
(setf ed::*hg-output-color-removed* 1)
(setf ed::*hg-output-color-lines* 5)
(setf ed::*hg-output-color-description* 4)
(setf ed::*hg-output-color-error* 15)
(setf ed::*hg-output-color-tag* 3)
(setf ed::*hg-output-color-branch* 2)
(setf ed::*hg-output-color-bookmark* 1)
(setf ed::*hg-output-color-glog* 3)
(setf ed::hg-output-keywords
(let ((cvs ed::*hg-output-color-cvs-stuff*)
(added ed::*hg-output-color-added*)
(removed ed::*hg-output-color-removed*)
(dif ed::*hg-output-color-lines*)
(desc ed::*hg-output-color-description*)
(tag ed::*hg-output-color-tag*)
(brc ed::*hg-output-color-branch*)
(bmk ed::*hg-output-color-bookmark*)
(glog ed::*hg-output-color-glog*))
(compile-regexp-keyword-list
`(("^\\([-+ |/\\o@]*\\)[0-9]+.* [0-9a-f]\\{12\\} .*\n\\([ |/\\]*\\)\\(.*\\)$"
t ((1 . (:color ,glog))
(2 . (:color ,glog))
(3 . (:color ,desc))) nil 1)
("^\\([-+ |/\\o@]*\\)changeset: \\(.*\\)$"
t ((1 . (:color ,glog))) nil 1)
("^\\(Index: \\|=\\{4,\\}\\|RCS file: \\|retrieving \\|diff \\).*$"
t (:color ,cvs))
("^\\+.*$"
t (:color ,added))
("^\\-.*$"
t (:color ,removed))
("^@@ .* @@.*$"
t (:color ,dif))
("^\\([ |/\\]*\\)tag: \\(.*\\)$"
t ((1 . (:color ,glog))
(2 . (:color ,tag))) nil 1)
("^\\([ |/\\]*\\)branch: \\(.*\\)$"
t ((1 . (:color ,glog))
(2 . (:color ,brc))) nil 1)
("^\\([ |/\\]*\\)bookmark: \\(.*\\)$"
t ((1 . (:color ,glog))
(2 . (:color ,bmk))) nil 1)
("^\\([ |/\\]*\\)summary: \\(.*\\)$"
t ((1 . (:color ,glog))
(2 . (:color ,desc))) nil 1)
("^\\([ |/\\]*\\)description:\n\\([ |/\\]*\\)\\(.*\\)$"
t ((1 . (:color ,glog))
(2 . (:color ,glog))
(3 . (:color ,desc))) nil 1)
("^\\([ |/\\]*\\)\t\\* .*:\n\\(.*\\)$"
t ((1 . (:color ,glog))
(2 . (:color ,desc))) nil 1)
("^\\([ |/\\]*\\).*$"
t ((1 . (:color ,glog))) nil 1)))))
(defvar ed::*hg-git-format* t
"git 拡張差分形式の使用")
(defmacro def-hg-cmd-repo (sym cmd doc &optional prompt git-format)
"コマンド生成(リポジトリ単位)"
`(progn
(export (intern (symbol-name ',sym) :ed) :ed)
(defun ,(intern (concat "ed::" (symbol-name sym))) ()
,doc
(interactive)
(ed::hg-command-wrapper ,(if (and git-format
ed::*hg-git-format*)
(concat cmd " -g")
cmd)
,(if prompt
t
'*prefix-args*)))))
(defmacro def-hg-cmd-file (sym cmd doc &optional prompt git-format)
"コマンド生成(ファイル単位とリポジトリ単位両方)"
`(progn
(export (intern (symbol-name ',sym) :ed) :ed)
(export (intern (concat (symbol-name ',sym) "-repo") :ed) :ed)
(defun ,(intern (concat "ed::" (symbol-name sym))) ()
,doc
(interactive)
(ed::hg-command-wrapper ,(if (and git-format
ed::*hg-git-format*)
(concat cmd " -g")
cmd)
,(if prompt
t
'*prefix-args*)
t))
(defun ,(intern (concat "ed::hg-" (symbol-name sym) "-repo")) ()
,doc
(interactive)
(ed::hg-command-wrapper ,(if (and git-format
ed::*hg-git-format*)
(concat cmd " -g")
cmd)
,(if prompt
t
'*prefix-args*)))))
(defmacro def-hg-cmd-pop (sym cmd doc &optional prompt git-format)
"コマンド生成(別窓起動)"
`(progn
(export (intern (symbol-name ',sym) :ed) :ed)
(defun ,(intern (concat "ed::" (symbol-name sym))) ()
,doc
(interactive)
(let ((option))
(when (or ,prompt
*prefix-args*)
(setf option (read-string (format nil ,(concat "~A>>>hg " cmd ": ") (default-directory)))))
(shell-execute "C:/cygwin/bin/zsh" (default-directory)
(concat "-c \"hg "
,(if (and git-format
ed::*hg-git-format*)
(concat cmd " -g")
cmd)
" " option "\""))))))
(def-hg-cmd-file #:hg-diff "diff" "作業領域全体(ないし指定ファイル)の差分抽出" nil t)
(def-hg-cmd-repo #:hg-bookmarks "bookmarks" "移動可能なマーキングによる履歴進展の追跡")
(def-hg-cmd-repo #:hg-fetch "fetch" "遠隔リポジトリからの取り込みと、 必要におうじたマージ実施")
(def-hg-cmd-file #:hg-glog "glog" "ASCII 文字によるリビジョングラフ表示を持つ履歴表示")
(def-hg-cmd-repo #:hg-gclear "gclear" "Clears out the Git cached data")
(def-hg-cmd-repo #:hg-gexport "gexport" " ")
(def-hg-cmd-repo #:hg-gimport "gimport" " ")
(def-hg-cmd-repo #:hg-git-cleanup "git-cleanup" "Cleans up git repository after history editing")
(def-hg-cmd-repo #:mq-applied "qapplied" "適用中のパッチ一覧の表示")
(def-hg-cmd-repo #:mq-clone "qclone" "リポジトリとパッチ管理領域の同時複製" t)
(def-hg-cmd-repo #:mq-delete "qdelete" "管理対象からのパッチ除外")
(def-hg-cmd-file #:mq-diff "qdiff" "現行パッチと作業領域変更の結合結果の表示" nil t)
(def-hg-cmd-repo #:mq-finish "qfinish" "適用中パッチの通常リビジョン化")
(def-hg-cmd-repo #:mq-finish-all "qfinish -a" "全ての適用中パッチを通常リビジョン化")
(def-hg-cmd-repo #:mq-fold "qfold" "指定パッチの現行パッチへの統合" t)
(def-hg-cmd-repo #:mq-goto "qgoto" "指定パッチを適用パッチの最上位にする qpush/qpop の実施" t)
(def-hg-cmd-repo #:mq-guard "qguard" "パッチのガード設定ないし表示")
(def-hg-cmd-repo #:mq-header "qheader" "現行パッチないし指定パッチのヘッダ表示")
(def-hg-cmd-repo #:mq-import "qimport" "パッチの取り込み" t t)
(def-hg-cmd-repo #:mq-new "qnew" "新規パッチの作成" t t)
(def-hg-cmd-repo #:mq-next "qnext" "現行パッチの「次」の既知のパッチの名前表示")
(def-hg-cmd-repo #:mq-pop "qpop" "現行パッチの適用解除")
(def-hg-cmd-repo #:mq-pop-all "qpop -a" "全てのパッチの適用を解除")
(def-hg-cmd-repo #:mq-prev "qprev" "現行パッチの「前」の既知のパッチの名前表示")
(def-hg-cmd-repo #:mq-push "qpush" "次のパッチの適用")
(def-hg-cmd-repo #:mq-push-all "qpush -a" "全てのパッチを適用")
(def-hg-cmd-repo #:mq-queue "qqueue" "複数のパッチキューの管理")
(def-hg-cmd-repo #:mq-refresh "qrefresh" "現行パッチの更新" nil t)
(def-hg-cmd-repo #:mq-refresh-edit "qrefresh -e" "コミットメッセージの編集")
(def-hg-cmd-repo #:mq-rename "qrename" "パッチの改名" t)
(def-hg-cmd-repo #:mq-select "qselect" "作業領域におけるガード選択の設定ないし表示")
(def-hg-cmd-repo #:mq-series "qseries" "既知のパッチ一覧の表示")
(def-hg-cmd-repo #:mq-top "qtop" "現行パッチの名前表示")
(def-hg-cmd-repo #:mq-unapplied "qunapplied" "未適用のパッチ一覧の表示")
(def-hg-cmd-repo #:hg-strip "strip" "リポジトリからの、 特定リビジョンおよびその子孫の除外" t)
(def-hg-cmd-repo #:hg-rebase "rebase" "別な履歴位置へのリビジョン(およびその子孫)の移動")
(def-hg-cmd-pop #:hg-record "record" "コミットする内容を対話的に選択します" t)
(def-hg-cmd-pop #:hg-transplant "transplant" "別のブランチへのチェンジセットの移植" t)
(export-from
'(#:*hg-flow-master*
#:*hg-flow-develop*
#:hg-flow-init
#:hg-flow-feature-start
#:hg-flow-feature-change
#:hg-flow-feature-finish
#:hg-flow-feature-close
#:hg-flow-release-start
#:hg-flow-release-finish
#:hg-flow-release-close
#:hg-flow-hotfix-start
#:hg-flow-hotfix-finish
#:hg-flow-hotfix-close)
:ed)
(defvar ed::*hg-flow-master* "default"
"master ブランチの名前")
(defvar ed::*hg-flow-develop* "development"
"develop ブランチの名前")
(defun ed::hg-flow-init ()
"Initialising your project."
(interactive)
(let ((option))
(when *prefix-args*
(setf option (read-string (format nil "~A>>>hg flow init: " (default-directory)))))
(shell-execute "C:/cygwin/bin/zsh" (default-directory)
(concat "-c \"hg flow init " option "\""))
(ed::hg-command-wrapper (format nil "bookmark -f master -r ~A"
ed::*hg-flow-master*) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f develop -r ~A"
ed::*hg-flow-develop*) *prefix-args*)))
(defun ed::hg-flow-feature-start ()
"Create a new feature/bugfix branch based on develop branch, it named as feature/<name>. And change to this branch automatic."
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow feature start" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -f feature-~A -r feature/~A"
(first *minibuffer-default-history*) (first *minibuffer-default-history*)) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f develop -r ~A"
ed::*hg-flow-develop*) *prefix-args*))))
(defun ed::hg-flow-feature-change ()
"Change the branch between feature/bugfix branches. It will change into feature/<name> branch."
(interactive)
(ed::hg-command-wrapper "flow feature change" t))
(defun ed::hg-flow-feature-finish ()
"Close the feature/bugfix branch feature/<name>. The content in this branch will merge to develop branch."
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow feature finish" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -d feature-~A"
(first *minibuffer-default-history*)) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f master -r ~A"
ed::*hg-flow-master*) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f develop -r ~A"
ed::*hg-flow-develop*) *prefix-args*))))
(defun ed::hg-flow-feature-close ()
"Close this branch and drop the code."
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow feature close" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -d feature-~A"
(first *minibuffer-default-history*)) *prefix-args*))))
(defun ed::hg-flow-release-start ()
"Create a new branch named release/<name> based on develop branch, and change to this branch automatically. "
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow release start" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -f release-~A -r release/~A"
(first *minibuffer-default-history*) (first *minibuffer-default-history*)) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f develop -r ~A"
ed::*hg-flow-develop*) *prefix-args*))))
(defun ed::hg-flow-release-finish ()
"Close this branch release/<name>, then do the following actions:
- Merge into production branch default
- If tag_name give, merge tag tag_name into production branch
- If no tag_name here, merge branch release/<name> into production branch
- Give a tag <version_tag_prefix><name>, like hg-flow_v1.0
- Merge branch release/<name> into develop branch develop
- Close branch release/<name>"
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow release finish" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -d release-~A"
(first *minibuffer-default-history*)) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f master -r ~A"
ed::*hg-flow-master*) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f develop -r ~A"
ed::*hg-flow-develop*) *prefix-args*))))
(defun ed::hg-flow-release-close ()
"Close this release, drop the code."
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow release close" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -d release-~A"
(first *minibuffer-default-history*)) *prefix-args*))))
(defun ed::hg-flow-hotfix-start ()
"Create a new hotfix/<name> branch based on production branch default. And change into this branch automatically."
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow hotfix start" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -f hotfix-~A -r hotfix/~A"
(first *minibuffer-default-history*) (first *minibuffer-default-history*)) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f master -r ~A"
ed::*hg-flow-master*) *prefix-args*))))
(defun ed::hg-flow-hotfix-finish ()
"Close hotfix branch hotfix/<name>, then do the following actions:
- Merge into production branch default
- If tag_name given, merge tag tag_name into production branch.
- If no tag_name given, merge branch hotfix/<name> into production branch.
- Give a tag named <version_tag_prefix><name>, such as hg-flow_v1.1
- Merge branch hotfix/<name> into develop branch develop
- Close this branch hotfix/<name>"
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow hotfix finish" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -d hotfix-~A"
(first *minibuffer-default-history*)) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f master -r ~A"
ed::*hg-flow-master*) *prefix-args*)
(ed::hg-command-wrapper (format nil "bookmark -f develop -r ~A"
ed::*hg-flow-develop*) *prefix-args*))))
(defun ed::hg-flow-hotfix-close ()
"Close hotfix branch and drop the code."
(interactive)
(let ((buf (selected-buffer)))
(ed::hg-command-wrapper "flow hotfix close" t)
(save-excursion
(set-buffer buf)
(ed::hg-command-wrapper (format nil "bookmark -d hotfix-~A"
(first *minibuffer-default-history*)) *prefix-args*))))
(define-key ed::*hg-mode-map* '(#\C-c #\f #\f #\c) 'hg-flow-feature-close)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\f #\f) 'hg-flow-feature-finish)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\f #\s) 'hg-flow-feature-start)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\f #\u) 'hg-flow-feature-change)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\h #\c) 'hg-flow-hotfix-close)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\h #\f) 'hg-flow-hotfix-finish)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\h #\s) 'hg-flow-hotfix-start)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\i) 'hg-flow-init)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\r #\c) 'hg-flow-release-close)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\r #\f) 'hg-flow-release-finish)
(define-key ed::*hg-mode-map* '(#\C-c #\f #\r #\s) 'hg-flow-release-start)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\M-<) 'hg-fetch)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\%) 'hg)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\,) 'hg-incoming)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\.) 'hg-outgoing)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\<) 'hg-pull)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\=) 'hg-nkfdiff-repo)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\>) 'hg-push)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\?) 'hg-help)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\A) 'hg-addremove)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\B) 'hg-bookmarks)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\C) 'hg-record)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\R) 'hg-rebase)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\T) 'hg-transplant)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\U) 'hg-revert)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\a) 'hg-add)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\b) 'hg-branch)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\c) 'hg-commit)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\f) 'hg-revert)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\g #\c) 'hg-gclear)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\g #\e) 'hg-gexport)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\g #\i) 'hg-gimport)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\g #\u) 'hg-git-cleanup)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\h) 'hg-help)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\i) 'hg-init)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\l) 'hg-glog-repo)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\m) 'hg-merge)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\n) nil)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\r) 'hg-root)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\s) 'hg-status)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\t) 'hg-tag)
(define-key ed::*hg-mode-map* '(#\C-c #\h #\u) 'hg-update)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\,) 'mq-pop)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\.) 'mq-push)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\<) 'mq-pop-all)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\=) 'mq-diff)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\>) 'mq-push-all)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\e) 'mq-refresh-edit)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\i) 'mq-new)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\n) 'mq-next)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\p) 'mq-prev)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\r) 'mq-refresh)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\s) 'mq-series)
(define-key ed::*hg-mode-map* '(#\C-c #\q #\t) 'mq-top)
;;--------------------------------------------------------------------------------
;; merge-tags
(require "merge-tags")
;;--------------------------------------------------------------------------------
;; migemo
(require "migemo")
;;--------------------------------------------------------------------------------
;; module-definition-mode
(require "module-definition-mode")
(setf ed::module-definition-indent-level 4)
(setf ed::module-definition-label-offset -4)
(setf *module-definition-tab-always-indent* t)
(setf *module-definition-indent-tabs-mode* t)
(pushnew '("\\.def$" . module-definition-mode) *auto-mode-alist* :test #'equal)
;;--------------------------------------------------------------------------------
;; multiple-replace
(require "multiple-replace")
;;--------------------------------------------------------------------------------
;; my-bookamrk
(require "my-bookmark")
(setf *my-bookmark-save-file* (merge-pathnames ".xyzzy.d/bookmarklist" (user-homedir-pathname)))
(pushnew '("bookmarklist$" . lisp-mode) *auto-mode-alist* :test #'equal)
(defun my-bookmark-menu-popup ()
"my-bookmark のメニュー"
(interactive)
(my-bookmark-menu nil :button2))
;;--------------------------------------------------------------------------------
;; open-backup
(require "open-backup")
(defun ed::open-backup-get-list-dir (dir file no-dup)
(let* ((regexp (compile-regexp "\\.\\([0-9]+\\)~$"))
(olist (sort (delete nil
(mapcar #'(lambda (f)
(and (string-equal (pathname-name f) (file-namestring file))
(string-match regexp f)
f))
(directory dir :absolute t :file-only t)))
#'>=
:key #'(lambda (f)
(and (string-match regexp f)
(parse-integer (match-string 1)))))))
(if no-dup
(let ((l) (day))
(dolist (f olist (nreverse l))
(let ((s (format-date-string "%Y-%m-%d" (file-write-time f))))
(and (string/= day s)
(setf day s)
(push f l)))))
olist)))
;;--------------------------------------------------------------------------------
;; paren
(require "paren")
(turn-on-global-paren)
(add-hook 'ed::*diff-mode-hook* 'turn-off-paren)
;;--------------------------------------------------------------------------------
;; php-mode
(require "php-mode")
(require