scratch バッファ用の変なもの

なんか変なのができた。
ふつう scratch バッファは need-not-save が nil なので、xyzzy を終了するときに保存するかどうか、聞かれない。
これは emacs ゆずりのふつうの動作。
ただ、最近はちょこっと lisp のテストコードを書いては終了したりするので、「書き捨て」として扱うには忍びない。
そこでしばらく need-not-save を t にして使っていたんだけど、これはこれで、いちいち保存しますか？と聞いていくるのでうっとおしい。

じゃあ、xyzzy が終了するときに hook して、あらかじめ決めたファイル名で自動的に上書き保存してくれたらいい。
というのを書いてみた。

2011.4.19 変更　xyzzy を終了できなかったのを直した。

;;; scratch-util.l
;;;
;;; scratch buffer utility
;;;
(provide "scratch-util")
(in-package "editor")

;;
(let ((buf (find-buffer "*scratch*")))
  (when buf
    (with-set-buffer
      (set-buffer buf)
      (make-local-variable 'need-not-save)
      (setq need-not-save nil))))

(export '(scratch-util-save scratch-util-read
          *scratch-util-dir* *scratch-util-name*))

(defvar *scratch-util-dir* "~"
  "保存ファイルをつくる場所")

(defvar *scratch-util-name* "scratch-bak"
  "保存ファイルの名前")

(defvar *scratch-util-buf* "*scratch*")

;; (defun scratch-util-save ()
;;   (interactive)
;;   (let ((buf *scratch-util-buf*)
;;         (path (concat (append-trail-slash *scratch-util-dir*)
;;                       *scratch-util-name*)))
;;     (when (and (buffer-modified-p buf)
;;                (< 0 (buffer-size buf)))
;;       (with-set-buffer
;;         (set-buffer buf)
;;         (write-file path t)
;;         (set-buffer-modified-p nil))
;;       (message "saved."))))
(defun scratch-util-save ()
  (let ((buf *scratch-util-buf*)
        (path (concat (append-trail-slash *scratch-util-dir*)
                      *scratch-util-name*)))
    (when (and (buffer-modified-p buf)
               (< 0 (buffer-size buf)))
      (with-set-buffer
        (set-buffer buf)
        (write-file path t)
        (set-buffer-modified-p nil))))
  t)


(defun scratch-util-read ()
  (interactive)
  (let ((buf *scratch-util-buf*)
        (path (concat (append-trail-slash *scratch-util-dir*)
                      *scratch-util-name*)))
    (cond ((not (file-exist-p path)) (message "not exist ~A" path))
          ((> (buffer-size buf) 0) (switch-to-buffer (find-file-internal path))
                                   (lisp-interaction-mode))
          (t (switch-to-buffer buf)
             (insert-file path)))))

;(define-key ed::*lisp-interaction-mode-map* '(#\C-x #\C-s) 'scratch-util-save)
(add-hook '*query-kill-xyzzy-hook* 'scratch-util-save)

;;; scratch-util ends here

ちなみに scratch-util-read すれば、前回のscratchの内容を読み込む。