xyzzyでブックマーク機能

Emacsのブックマーク機能で紹介したEmacsのブックマーク機能が便利だったので、xyzzyでも使いたくなりました。
Lispの勉強も兼ねて、自分で実装してみました。
プログラムは記事の最後に載せます。

機能
実装済みの機能は以下のとおりです。

• 現在表示しているバッファをブックマークとして登録する
• ブックマークの一覧を表示する
• ブックマークの一覧からファイルを開く
• ブックマークを削除する

使用方法

まず、プログラムを読み込みます。専用のパッケージを定義したので、合わせてuse-packageします。

(require "bookmark")
(use-package "bookmark")

次に、キーバインドの設定をします。今のところ公開している関数は次の2つです。

1. bookmark-add-current-buffer: 表示しているバッファをブックマークする
2. bookmark-list-bookmarks: ブックマークの一覧を表示する

(global-set-key '(#\C-c #\a #\b) 'bookmark-add-current-buffer)
(global-set-key '(#\C-c #\l #\b) 'bookmark-list-bookmarks)

bookmark-add-current-bufferを呼ぶと、現在のバッファをブックマークします。その際、ブックマーク名を入力できます。

bookmark-list-bookmarksを呼ぶと、ブックマーク一覧を表示します。一覧からファイルの表示と、ブックマークの削除ができます。ブックマークしたファイルの表示は[f]キーを押下し、ブックマークの削除は[d]キーです。

ブックマーク一覧を実装するときは、xyzzy付属のbuf-menu.lが参考になりました。

よろしければ使ってみてください。

; bookmark.l v0.0.1

(provide "bookmark")

(defpackage "bookmark" (:use "lisp" "editor"))

(export '(bookmark-add-current-buffer
          bookmark-list-bookmarks))

(defvar *bookmark-file* "~/.bookmark")
(defvar *bookmarks* nil)
(defvar *bookmark-menu-mode-hook* nil)

(defstruct bookmark name path)

(defun bookmark-add-current-buffer (&optional name)
  "現在のバッファをブックマークへ追加する。"
  (interactive "sBookmark Name: ")
  (add-bookmark (make-bookmark :name name :path (get-buffer-file-name)))
  (save-bookmarks *bookmarks* *bookmark-file*))

(defun add-bookmark (bookmark)
  "bookmarkを*bookmarks*へ追加する。"
  (push bookmark *bookmarks*))

(defun delete-bookmark (bookmark)
  "*bookmarks*からbookmarkを取り除いたリストを返す。"
  (let ((name (bookmark-name bookmark))
        (path (bookmark-path bookmark)))
    (delete-if (lambda (bm)
                 (and (equal name (bookmark-name bm))
                      (equal path (bookmark-path bm))))
               *bookmarks*)))

(defun open-bookmark (bookmark)
  "bookmarkからpathを取得し、バッファを開く。"
  (find-file (bookmark-path bookmark)))

(defun save-bookmarks (bookmarks bookmark-file)
  "bookmarksをbookmark-fileへ出力する"
  (with-open-file (s bookmark-file
                     :direction :output
                     :if-exists :overwrite
                     :if-does-not-exist :create)
    (dolist (bookmark bookmarks)
      (save-bookmark bookmark s))))

(defun save-bookmark (bookmark output-stream) 
  "output-streamへbookmarkを出力する"
  (format output-stream "~A?~A~%"
          (bookmark-name bookmark)
          (bookmark-path bookmark)))

(defun load-bookmarks (bookmark-file)
  "bookmark-fileを読み込み、構造体bookmarkのリストを返す。"
  (let ((bookmarks nil)
        (line nil))
    (with-open-file (file-stream bookmark-file
                                 :direction :input
                                 :if-does-not-exist nil)
      (while (and file-stream
                  (setq line (read-line file-stream nil)))
            (push (load-bookmark line) bookmarks)))
    bookmarks))

(defun load-bookmark (line)
  "lineを解析し、構造体bookmarkを返す。"
  (let ((separator-position (position #\? line :from-end t)))
    (if separator-position
        (make-bookmark :name (subseq line 0 separator-position)
                       :path (subseq line (1+ separator-position))))))

(defun bookmark-menu-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq buffer-mode 'bookmark-menu-mode)
  (setq mode-name "Bookmark")
  (use-keymap *bookmark-menu-mode-map*)
  (setq buffer-read-only t)
  (set-buffer-fold-width nil)
  (make-local-variable 'kept-undo-information)
  (setq kept-undo-information nil)
  (make-local-variable 'need-not-save)
  (setq need-not-save t)
  (make-local-variable 'auto-save)
  (setq auto-save nil)
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function #'bookmark-list-bookmarks)
  (run-hooks '*bookmark-menu-mode-hook*))

(defun bookmark-menu-open-bookmark ()
  (interactive)
  (open-bookmark (elt *bookmarks* (1- (current-line-number)))))

(defun bookmark-menu-delete-bookmark ()
  (interactive)
  (setq *bookmarks*
        (delete-bookmark (elt *bookmarks* (1- (current-line-number)))))
  (save-bookmarks *bookmarks* *bookmark-file*)
  (revert-buffer))
  
(defun bookmark-menu-delete-buffer ()
  (interactive)
  (delete-buffer (selected-buffer)))

(defvar *bookmark-menu-mode-map* nil)
(unless *bookmark-menu-mode-map*
  (setq *bookmark-menu-mode-map* (make-sparse-keymap))
  (define-key *bookmark-menu-mode-map* #\f 'bookmark-menu-open-bookmark)
  (define-key *bookmark-menu-mode-map* #\d 'bookmark-menu-delete-bookmark)
  (define-key *bookmark-menu-mode-map* #\q 'bookmark-menu-delete-buffer))

(defun bookmark-list-bookmarks ()
  "*bookmarks*を*Bookmarks*へ出力し、bookmark-menu-modeを起動する。"
  (interactive "p")
  (setq *bookmarks* (load-bookmarks *bookmark-file*))
  (with-output-to-temp-buffer ("*Bookmarks*")
    (dolist (bookmark *bookmarks*)
      (format t "~A ~A~%" (bookmark-name bookmark) (bookmark-path bookmark))))
  (bookmark-menu-mode))