Emacsでファイルの自動保存 より。使ってみて大変便利なことがわかったのですが、SKKと併用すると変換候補の上にファイル保存時のメッセージが重なってしまいます。
また、基底バッファより先に間接バッファを保存してしまうと、どうなってしまうのか忘れましたが、手を加えているところを見るとイライラさせられたのだと思います(間接バッファって結構便利です)。
その二点を改善するための変更を加えています。
save-bufferの中身をみてみます。
(defun save-buffer (&optional args)
(interactive "p")
(let ((modp (buffer-modified-p))
(large (> (buffer-size) 50000))
(make-backup-files (or (and make-backup-files (not (eq args 0)))
(memq args '(16 64)))))
(and modp (memq args '(16 64)) (setq buffer-backed-up nil))
(if (and modp large (buffer-file-name))
(message "Saving file %s..." (buffer-file-name)))
(basic-save-buffer)
(and modp (memq args '(4 64)) (setq buffer-backed-up nil))))オリジナルのauto-save-buffersでは、このsave-bufferを(save-buffer)として、引数無しでよんでいます。そこで、上のコードの中のargsに1((interactive "p")は引数を数値にします)を入れて簡単化してみますと、
(let ((modp (buffer-modified-p))
(large (> (buffer-size) 50000))
(make-backup-files (or (and make-backup-files t)
nil)))
(and modp nil (setq buffer-backed-up nil)) ;; => nil
(if (and modp large (buffer-file-name))
(message "Saving file %s..." (buffer-file-name)))
(basic-save-buffer)
(and modp nil (setq buffer-backed-up nil))) ;; => nilとなり、(basic-save-buffer)の前後は(message "Saving file %s..." (buffer-file-name))を除いて何もしないことがわかります。そこで、save-bufferのかわりにbasic-save-bufferをよびます。
ファイル保存時の"Wrote ..."は組み込みのwrite-regionが出しています。幸いにも、write-regionの第二省略可能引数に文字列でも真偽値でもない値を与えるとメッセージを表示しなくなります。
If VISIT is neither t nor nil nor a string, that means do not print the "Wrote file" message.そこで
auto-save-buffers内で一時的にwrite-regionをメッセージが出ないようにしたものにおきかえます。ただし、この場合バッファの更新時刻とファイルの更新時刻の同期が取られず、また、バッファが変更されていないという印をつけてくれなくなります。そこで、set-visited-file-modtimeとset-buffer-modified-pをよんでこれらの処理をしています。
auto-save-buffersを動かしていると、頻繁にタイム・スタンプを更新してしまいます。このままアンドゥをするとわけがわからなくなってくるので、アンドゥ・リストにはタイム・スタンプの更新を記録しないようにしたいところです。
ただし、タイム・スタンプの変更をアンドゥできないので、間違ってファイルを変更してしまったとき後戻りが効きません。要注意。
(add-hook 'write-file-hooks 'time-stamp)
(defadvice time-stamp (around time-stamp-around activate)
(let (buffer-undo-list)
ad-do-it))アウトライン・モードを使い始めようとするも、キーバインドを覚えることができない… アタマを使わずに操作したい。
(global-set-key [?\M-\[] 'outline-hide)
(global-set-key [?\M-\]] 'outline-show)
(defun outline-search-lays (beg end)
(let ((lays (delete nil
(apply 'append
(mapcar
'(lambda (o)
(when (eq 'outline (overlay-get o 'invisible))
(list (overlay-start o) (overlay-end o))))
(overlays-in beg end)))))
pnts)
(while lays
(setq pnts (if (member (car lays) pnts)
(delete (car lays) pnts)
(cons (car lays) pnts)))
(setq lays (cdr lays)))
(sort pnts '<)))
(defun outline-check-points (beg end points)
(equal points (outline-search-lays beg end)))
(defun outline-hide (arg)
(interactive "P")
(cond ((not arg)
(condition-case nil
(let* ((beg (save-excursion
(outline-back-to-heading)
(outline-end-of-heading)
(point)))
(end (save-excursion
(outline-end-of-subtree)
(point)))
(lays (outline-search-lays beg end))
pnt)
(save-excursion
(hide-entry)
(when (outline-check-points beg end lays)
(hide-leaves)
(when (outline-check-points beg end lays)
(hide-subtree)
(unless (outline-check-points beg end lays)
(show-children)
(when (outline-check-points beg end lays)
(hide-subtree)))))
(setq pnt (point)))
(unless (outline-on-heading-p)
(goto-char pnt)))
(error (let ((lays (outline-search-lays (point-min) (point-max))))
(hide-body)
(when (outline-check-points (point-min) (point-max) lays)
(call-interactively 'hide-sublevels))))))
((listp arg) (hide-other))
((numberp arg) (hide-sublevels arg))))
(defun outline-show (arg)
(interactive "P")
(if (not arg)
(condition-case nil
(save-excursion
(let* ((beg (save-excursion
(outline-back-to-heading)
(outline-end-of-heading)
(point)))
(end (save-excursion
(outline-end-of-subtree)
(point)))
(lays (outline-search-lays beg end)))
(show-children)
(when (outline-check-points beg end lays)
(show-branches)
(when (outline-check-points beg end lays)
(show-entry)
(when (outline-check-points beg end lays)
(show-subtree))))))
(error (let ((lays (outline-search-lays (point-min) (point-max))))
(show-all)
(unless (outline-check-points (point-min) (point-max) lays)
(hide-body)
(when (outline-check-points (point-min) (point-max) lays)
(show-all))))))
(show-all)))ロードパスの設定なんてめんどうでやっていられない。
~/lisp 以下のディレクトリをロードパスに追加。normal-top-level-add-subdirs-to-load-path だけだと~/lisp そのものが登録されないので、そこはガマンして手で設定しておきます。normal-... がどのような動きをするかにちょっと注意が必要 (.nosearch など)。normal-... 内部で default-directory を用いているので、そのバインドを一時的に変更して再利用しています。
(let ((default-directory "~/lisp")) (setq load-path (cons default-directory load-path)) (normal-top-level-add-subdirs-to-load-path))
設定ファイルを見返していたら見つけた、レジスタを気楽に使うためのもの。hyperキーに割り当てているようだ。
;; ? mark-active
;; |
;; +-t ->? region-beginning = region-end
;; | |
;; | +-t -> (point) to Register
;; | |
;; | +-f ->? Arg
;; | |
;; | +-t -> Selected rectangle to Register
;; | |
;; | +-f -> Selected text to Register
;; |
;; +-f ->? Arg
;; |
;; +-t ->? numberp Arg
;; | |
;; | +-t ->? numberp Contents of Register
;; | | |
;; | | +-t -> Add Arg to the number in Register
;; | | |
;; | | +-f -> Arg to Register.
;; | |
;; | +-f -> Recover deleted contents of Register
;; |
;; +-f -> (jump-to-register) / (insert-register)
(defvar rj:deleted-alist nil)
;; ((key . old-contents) ...)
(defun rj:set-key (key)
(global-set-key key 'rj:self-register)
(mapcar
(lambda (help-key)
(global-set-key (vconcat help-key key) 'rj:what-is-in-self))
(where-is-internal 'help-command)))
;; (let ((key ? ))
;; (while (<= key ?~)
;; (rj:set-key (vector (event-convert-list `(hyper ,key))))
;; (setq key (+ 1 key))))
(defun rj:recover-deleted (regi)
(let ((cur (assoc regi register-alist))
(old (assoc regi rj:deleted-alist)))
(when cur
(setq rj:deleted-alist
(cons cur (delete old rj:deleted-alist)))
(setq register-alist
(cons old (delete cur register-alist))))))
(defun rj:get-register ()
(event-basic-type
(aref (this-command-keys-vector)
(- (length (this-command-keys-vector)) 1))))
(defun rj:self-register (arg)
(interactive "P")
(let ((regi (rj:get-register)))
(if (null transient-mark-mode) (error "transient mark mode ... nil."))
(if mark-active
(progn
(rj:recover-deleted regi)
(if (= (mark) (point))
(point-to-register regi)
(if arg
(copy-rectangle-to-register regi
(region-beginning)
(region-end))
(copy-to-register regi
(region-beginning)
(region-end))))
(rj:what-is-in-self regi)
(deactivate-mark))
(if arg
(progn
(if (numberp arg)
(if (numberp (get-register regi))
(increment-register arg regi)
(rj:recover-deleted regi)
(number-to-register arg regi))
(rj:recover-deleted regi))
(rj:what-is-in-self regi))
(if (get-register regi)
(or (condition-case nil
(jump-to-register regi)
(error nil))
(condition-case nil
(insert-register regi)
(error nil)))
(message "Register is empty."))))))
(defun rj:what-is-in-self (regi)
(interactive (list (rj:get-register)))
(let ((string (rj:what-is-it (get-register regi))))
(message
(substring string 0
(min (length string)
(- (window-width) 1))))))
(defun rj:what-is-it (contents)
(cond ((null contents) (message "Empty."))
((integerp contents)
(concat "Integer: " (number-to-string contents)))
((markerp contents)
(concat "Mark: " (prin1-to-string contents)))
((stringp contents)
(concat "String: "
(mapconcat 'identity (split-string contents) " ")))
((listp contents)
(cond ((eq 'file-query (car contents))
(concat "FileQuery: "
(number-to-string (or (nth 2 contents) ""))
" in "
(file-name-nondirectory (or (nth 1 contents) ""))
" ("
(file-name-directory (or (nth 1 contents) ""))
")"))
(t (concat "Rectangle: "
(mapconcat
(function
(lambda (str)
(mapconcat 'identity (split-string str) " ")))
contents "^J")))))))