Gnu Emacs 拡張ガイド: Emacs Lispプログラミング　まとめ

GNU Emacs拡張ガイドは既に絶版した本らしいですが、一年くらいAmazonのマーケットプライスで買って,本の内容を色々と設定した後しばらくの間放置していたのですが久々に見つけたのでなんとなくまとめてみます。内容はEmacs Lispの実践的なtips集とでもいうべきか. これを一通り読めばEmacs Lispのソースが読める + マイナーモード or メジャーモードが作れるくらいにはなるかと思います。古い本ですがまあなかなか内容はいいんじゃないかと。

とりあえず始めに目次と概要について触れときます

• 1ç«  Emacsをカスタマイズする
  • 簡単なカスタマイズ + aproposコマンド重要という内容

• 2ç«  簡単なコマンドを作る
  • 簡単だけれども非常に役に立つコマンドの作成. Lispの解説をしつつ実装. 実際この手のコマンドはあまり見かけないが結構便利.

• 3ç«  コマンド間の強調
  • 要するにundoっぽい事をやりたいという感じ。unscroll

• 4ç«  バッファのなかを検索し変更する
  • 4章からそこそこ本格的内容になってくる。bufferの中を検索しある条件を満たした箇所におけるタイムスタンプの更新を行うという感じの内容。 save-excursion, save-restriction, save-match-data, search-forward, Lispにおける正規表現の使い方に関する説明など。

• 5ç«  Lispファイル
  • 4章の内容を踏まえた内容. 4賞で作った内容をtimestam.elというファイルにまとめる。それを踏まえて、Lispファイルの作り方 + load, require, autoload, eval-after-loadの違いに関する説明 + バイトコンパイルについての説明がなされている。

• 6ç«  リスト
  • リストの説明。 Lispをそこそこ知っている場合スルー可

• 7ç«  マイナーモード
  • 7章以降は何らかのモードを実装するという内容になっています。 7章ではモードに関する説明 + refillモードという段落の行詰めをするマイナーモードを実際に実装していたりします。

• 8章　評価とエラー処理
  • 7章の内容を踏まえた内容save-excursionは結構重い処理をするのでlimited-excursionというマクロを実装する。マクロの説明が多い。

• 9ç«  メジャーモード
  • メジャーモードの説明とquip-mode(名言編集モード)の実装.ナローイングと派生モードの説明など

• 10ç«  総合的な例
  • これまでの応用というわけでクロスワードパズルっぽいメジャーモードを作りまする

以降は具体的な内容になります

1章 Emacsをカスタマイズする

特になし, apropos重要

2章 便利なコマンドを作成する

タイトルの通り便利なコマンドを作っていく

• その１ other-window-backward
  • other-windowというコマンドは標準で搭載されているがother-window-backwardはないのでそれの実装を行う

具体的には以下のような実装をする

(defun other-window-backward (&optional n)
  "Select nth previous window."
  (interactive "P")
  (other-window (- (prefix-numeric-value n))))

;; key settings
(global-set-key "\C-x\C-p" 'other-window-backward)
(global-set-key "\C-xp" 'other-window-backward)

other-window-backwardは以下のようにもかけるがEmacs Lisp的には上記のコードの方が良いとの事。実際Emacs Lispのソースは(interactive "p")ではなく(interactive "P")を使っている傾向がある気がする

(defun other-window-backward (&optional n)
  "Select nth previous window."
  (interactive "p")
  (other-window (- (or n 1))))

• その2　一回に一行のスクロール

内容的にはvimの, っぽい機能を実装するという感じです。実装内容は以下の通り. global-set-keyのC-zはなにかしらかぶっている可能性が高いので別のキーに設定しておいた方が良いかも

(defalias 'scroll-ahead 'scroll-up)
(defalias 'scroll-behind 'scroll-down)
 
(defun scroll-n-lines-ahead (&optional n)
  "Scroll ahead N lines."
  (interactive "P")
  (scroll-ahead (prefix-numeric-value n)))

(defun scroll-n-lines-behind (&optional n)
  "Scroll behind N lines."
  (interactive "P")
  (scroll-behind (prefix-numeric-value n)))

(global-set-key "\C-q" 'scroll-n-lines-ahead)
(global-set-key "\C-z" 'scroll-n-lines-behind)

• その3 その他のカーソル移動コマンド

その2以外のカーソル移動コマンド。以下の設定はいずれも結構便利です。
とりあえず実行してみるといいんじゃないですかね

(defun point-to-top()
  "put point on top line of window"
  (interactive)
  (move-to-window-line 0))

(global-set-key "\M-," 'point-to-top)

(defun point-to-bottom()
  "put point at beginning of last visible line."
  (interactive)
  (move-to-window-line -1))

(global-set-key "\M-." 'point-to-bottom)


(defun line-to-top()
  "Move current line to top of window"
  (interactive)
  (recenter 0))

(global-set-key "\M-!" 'line-to-top)
(global-set-key "\C-ct" 'line-to-top)

• その4 シンボリックを上書き
  • ファイルを読み込んだ時にそれがシンボリックリンクならバッファを読み込み専用にして"File is a symlink"というmessageを送るという趣旨

(defun read-only-if-symlink ()
  (if (file-symlink-p buffer-file-name)
      (progn
	(setq buffer-read-only t)
	(message "File is a symlink"))))

(add-hook 'find-file-hooks 'read-only-if-symlink)

以下はシンボリックリンクを扱うための二種類の関数。

(defun visit-target-instead ()
  "Replace this buffer with a buffer visiting the link target."
  (interactive)
  (if buffer-file-name
      (let ((target (file-symlink-p buffer-file-name)))
	(if target
	    (find-alternate-file target)
	  (error "Not visiting a symlink")))
    (error "Not visiting a file")))

(defun clobber-symlink()
  "Replace symlink with a copy of the file."
  (interactive)
  (if buffer-file-name
      (let ((target (file-symlink-p buffer-file-name)))
	(if target
	    (if (yes-or-no-p (format "Replace %s with %s? "
				      buffer-file-name
				      target))
	  (progn
	    (delete-file buffer-file-name)
	    (write-file buffer-file-name)))
	(error "Not visiting a symlink")))
  (error "Not visiting a file")))

(global-set-key "\C-xt" 'visit-target-instead)
(global-set-key "\C-x1" 'clobber-symlink)
	    

• その5 その次はバッファの切替時にアドバイスを与えるという内容,

• defadviceを使用する。defadviceはある関数が実行される前か後に実行するプログラムを指定出来るという機能。まあトリガーですね。名称謎
• やりたい事はbuffer切替時に現状存在しないbufferを読み込まないようにするというもの。 ソースは以下の通り。

(defadvice switch-to-buffer (before existing-buffer
				    activate compile)
  "when interactive, switch to existing buffers only, unless given a prefix argument."
  (interactive
   (list (read-buffer "Switch to buffer:"
		      (other-buffer)
		      (null current-prefix-arg)))))

まあそこそこ便利。

3章 コマンド間の協調

undoっぽい事を実装するんですが,あまり必要ないかも。まああったらあったで便利といえば便利

間違えてscroll-upなどを実行したときに元の場所に戻すコマンドが欲しいという感じの趣旨。

まあ取り敢えずざっとでてくるElispを載せておきます。最終型だけなのでかなり略しとります

(defvar unscroll-point (make-marker)
  "Cursor position for next call to 'unscroll'.")

(defvar unscroll-window-start (make-marker)
  "Window start for next call to 'unscroll'.")

(defvar unscroll-hscroll nil
  "Hscroll for next call to 'unscroll'.")

(defadvice scroll-up (before remember-for-unscroll
			     activate compile)
  "Remember where we started from, for 'unscroll'."
  (unscroll-maybe-remember))

(defadvice scroll-down (before remember-for-unscroll
			     activate compile)
  "Remember where we started from, for 'unscroll'."
  (unscroll-maybe-remember))

(defadvice scroll-left (before remember-for-unscroll
			     activate compile)
  "Remember where we started from, for 'unscroll'."
  (unscroll-maybe-remember))

(defadvice scroll-right (before remember-for-unscroll
			     activate compile)
  "Remember where we started from, for 'unscroll'."
  (unscroll-maybe-remember))

(put 'scroll-up 'unscrollable t)
(put 'scroll-down 'unscrollable t)
(put 'scroll-left 'unscrollable t)
(put 'scroll-right 'unscrollable t)


(defun unscroll-maybe-remember ()
  (if (not (get last-command 'unscrollable))
      (progn
	(set-marker unscroll-point (point))
	(set-marker unscroll-window-start (window-start))
	(setq unscroll-hscroll (window-hscroll)))))

(defun unscroll ()
  "Revert to 'unscroll-point', 'unscroll-window-start' and 'unscroll-hscroll'."
  (interactive)
  (goto-char unscroll-point)
  (set-window-start nil unscroll-window-start)
  (set-window-hscroll nil unscroll-hscroll))

3章のtips的な内容は以下の通り

• defvarについてあれこれ
  • defvarではdefunのように変数に説明をつけることが出来る。
  • 変数にデフォルト値を与える事が出来る
  • タグ関係のコマンドで変数宣言を見つけることが出来る
  • プログラムをバイトコンパイルした時defvarで宣言していない変数が見つかると警告を発する。
• goto-char, set-window-start, set-window-hscrollはそれぞれカーソルの位置の設定、ウインドウの開始位置の設定、水平方向のスクロール状態を設定出来る。
• point, window-start, window-hscrollはそれぞれ現在の位置、ウインドウの位置、水平方向の位置を保持しているグローバル変数
• 変数や関数にシンボル属性をつけておくと便利な事がある。設定はput, 取得はget
• last-commandは前回実行したコマンドを記憶している変数, this-commandは現在実行しているコマンドの内容を保持している変数である。
• ポジション関連の操作をする際にはマーカーは便利。なぜならバッファの編集も考慮してくれるから。

まあこんなところ。

4章 バッファのなかを検索し変更する。

• 時刻に関わりのある関数の説明 + バッファを検索して正規表現を利用してある条件を満たした箇所に現在時刻を加えるという内容。いろいろなテクニックの解説、特に正規表現。
  • ファイルが新たに更新する度にライトスタンプが更新される。

とりあえず順番にみていきます。

以下は単に現在の時刻を書き加えるコマンド。関数に出てくる(interactive "*")の意味は、もしカレントバッファが読み込み専用なら関数の実行を中止するという事。

(defun insert-current-time()
  "Insert the current time"
  (interactive "*")
  (insert (current-time-string)))

次に変数の定義。注目すべき事としては、defvarの定義において*が始めにきた場合はその変数が対話的に変更出来るという点。\\[insert-time]はそのまま文字列として現れることはなくinsert-timeのキーマップに置き換えられるという点があげられます。キーが割り当てられてない場合にはM-x insert-timeが使われます。

(defvar insert-time-format "%H:%M"
  "*Format for \\[insert-time] (c.f. 'format-time-string').")
(defvar insert-date-format "%m-%d"
  "*Format for \\[insert-date] (c.f. 'format-time-string').")
  

次にinsert-time, insert-dateを作成する

(defun insert-time ()
  "Insert the current time according to insert-time-format."
  (interactive "*")
  (insert (format-time-string insert-time-format
			      (current-time))))

(defun insert-date ()
  "Insert the current date according to insert-time-format."
  (interactive "*")
  (insert (format-time-string insert-date-format
			      (current-time))))

• 次にライトスタンプという関数を実装します。。ソースは以下の通り。
  • (add-hook 'local-write-file-hooks 'update-writestamps)により、ファイルをセーブする度に'update-writestampsが呼ばれたりします。

(defvar writestamp-format "%Y-%m-%d %H:%M"
  "*Format for writestamps (c.f. 'format-time-string').")
(defvar writestamp-prefix "WRITESTAMP(("
  "*Unique string identifying start of writestamp.")
(defvar writestamp-suffix "))"
  "*String that terminates a writestamp.")

(add-hook 'local-write-file-hooks 'update-writestamps)
(defun update-writestamps ()
  "Find writestamps and replace them with the current time."
  (save-excursion
    (save-restriction
      (save-match-data
	(widen)
	(goto-char (point-min))
	(let ((regexp (concat "^"
			      (regexp-quote writestamp-prefix)
			      "\\(.*\\)"
			      (regexp-quote writestamp-suffix)
			      "$")))
	  (while (re-search-forward regexp nil t)
	    (replace-match (format-time-string writestamp-format
					       (current-time))
			   t t nil 1))))))
  nil)

次にモディファイスタンプという物を作ります。これは、ファイルが最後に変更された時刻を記憶するライトスタンプであります。

作業の流れは以下の通りです。

• 手法その１ first-change-hookの利用
  • バッファが再後に保存されて以来始めてバッファが変更される場合はいつもfirst-change-hookのなかの関数が実行されるのでこれを利用する
  • 問題点はファイルを保存する前にいくらか変更を加えた場合、最初の変更時間が適用されるという点にあります。

(make-local-hook 'first-change-hook)

(defvar modifystamp-format "%Y-%m-%d %H:%M"
  "*Format for writestamps (c.f. 'format-time-string').")
(defvar modifystamp-prefix "WRITESTAMP(("
  "*Unique string identifying start of writestamp.")
(defvar modifystamp-suffix "))"
  "*String that terminates a writestamp.")

(defun update-modifystamps ()
  "Find writestamps and replace them with the current time."
  (interactive)
  (save-excursion
    (save-restriction
      (save-match-data
	(widen)
	(goto-char (point-min))
	(let ((regexp (concat "^"
			      (regexp-quote writestamp-prefix)
			      "\\(.*\\)"
			      (regexp-quote writestamp-suffix)
			      "$")))
	  (while (re-search-forward regexp nil t)
	    (replace-match (format-time-string writestamp-format
					       (current-time))
			   t t nil 1))))))
  nil)

(add-hook 'first-change-hook 'update-modifystamps)

• 手法その２ local-write-file-hooksの利用
  • バッファが保存される度に使われるlocal-write-file-hooksを利用する。ライトスタンプで実行済み
  • この手法の問題点はファイルが保存されるまで最終時刻が変更されない点にあります。

(defun maybe-update-modifystamps ()
  "Call 'update-modifystamps' if the buffer has been modified."
  (if (buffer-modified-p)
      (update-modifystamps)))

(add-hook 'local-write-file-hooks 'maybe-update-modifystamps)

• 手法その３ 賢い方法
  • 賢い。　ここまで到達するには色々と考える必要がある。。
  • 色んなエッセンスが凝縮されてる感じ。

(make-local-hook 'after-change-functions)

(defvar last-change-time nil
  "Time of last buffer modification.")

(make-variable-buffer-local 'last-change-time)

(defun remember-change-time (&rest unused)
  "Store the current time in 'last-change-time'."
  (setq last-change-time (current-time)))
  
(add-hook 'after-change-functions 'remember-change-time)


(defun maybe-update-modifystamps ()
  "Call 'update-modifystamps' if the buffer has been modified."
  (if last-change-time
      (update-modifystamps)))


(add-hook 'local-write-file-hooks
	  '(lambda ()
	     (if last-change-time
		 (update-modifystamps last-change-time))))

(defun update-modifystamps (time)
  "Find writestamps and replace them with the current time."
  (interactive)
  (save-excursion
    (save-restriction
      (save-match-data
	(widen)
	(goto-char (point-min))
	(let ((regexp (concat "^"
			      (regexp-quote writestamp-prefix)
			      "\\(.*\\)"
			      (regexp-quote writestamp-suffix)
			      "$")))
	  (while (re-search-forward regexp nil t)
	    (replace-match (format-time-string writestamp-format
					       time)
			   t t nil 1))))))
  (setq last-change-time nil)
  nil)

この章におけるtipsについては以下にまとめておきます。

• バッファ保存に関わるhookとしてはwrite-file-hooks, local-write-file-hooks, write-contents-hooksなどがある
• 文字列内で,\\[insert-date]というのはinsert-dateに割り振られているコマンドを表示したい場合に使う
• (interactive '*')はカレントバッファが読み込み専用なら関数の実行を中止する
• save-excursionはカーソルの位置を覚え,引数としての処理を評価した後,元の位置に戻す
• save-restrictionはナローイング(あるbufferにおいて一部のbufferのみを処理する場合に使う) 状態を覚えておいて,最終的に元のナローイングに戻す。(widen)とかと併用される事が多い。
• save-matchは検索結果を保持する
• save-excursion, save-restriction, save-matchは結局の所,処理内容は非常に良く似ていたりする。
• Lispの正規表現は他の言語とは少し違う. regexp-quoteを使うと便利

5章 Lispファイル

load, require, auto-load, eval-after-load,バイトコンパイルなどの説明

以下に内容をまとめておきます。

• load
  • 明示的なload. どうしてもロードが必要な時に使う. 滅多に使われない。
• require
  • Emacsにはfeatureという概念があり、それはLispシンボルで名付け,provideで宣言し, requireで読み込まれる。これを使うとファイルの読み込みが一回で済む。

ちなみに以下の式は同義になります

(require 'timestamp)
(require 'timestamp "timestamp")

• auto-load
  • ファイルのロードをそれが必要な時になるまで遅らせる事が出来る。関数と併用される
• eval-after-load
  • これを使うことであるコードの実行を特定のファイルがロードされるまで遅らせる事が可能。

ファイルのロードの順番は以下の通り.例えば(require 'test)は以下のような順番で検索され,実行される。test.elcsがあった場合はtest.elは読み込まれない。

• test.elc→test.el→test

• ファイルのロードをする際には.el,.elcなどという拡張子はなるべく付けないこと

6章 リスト

List処理. 特筆することは無いのでスルー

7 マイナーモード

• refill-modeを例としたマイナーモードの作成を行います。
  • refill.elというものを作成する。(refill.elってEmacsに標準搭載されていたりしますが。。。まあ、昔はなかったんじゃないかと)

• メジャーモードとマイナーモードは併用される(C-h mを実行した時にTopに出てくるEnabled minor modesがそれに他ならない)。マイナーモードには例えば以下のようなものがある。無意識の内に使ってるもの多し。
  • auto-save-mode
  • font-lock-mode
  • line-number-mode

• マイナーモードに必要な構成要素は(defvar refill-mode nil)と(defun refill-mode ...)と (defun refill ...)の3つのみだったりします。あとはminor-mode-alistにrefill-modeを追加するという作業が必要になります。
  • この章ではマイナーモードの作り方の流れを始めに説明し、(defun refill...)を作っては改良し作っては改良しという作業を行います。

• 始めに簡単な流れを見てみます。

• 名前の作成
  • refill-modeという名の変数を定義し、それをバッファローカルにする

(defvar refill-mode nil
  "Mode variable for refill minor mode.")
(make-variable-buffer-local 'refill-mode)

• refill-modeの作成

(defun refill-mode (&optional arg)
  "Refill minor mode."
  (interactive "P")
  (setq refill-mode
	(if (null arg))
	(not (refill-mode)
	     (> (prefix-numeric-value arg) 0)))
  (make-local-hook 'after-change-functions)
  (if refill-mode
      (add-hook 'after-change-functions 'refill)
    (remove-hook 'after-change-functions 'refill)))

• refill関数の作成

(defun refill (start end len)
  "After a text change, refill the current paragraph."
  (let ((left (if (zerop len)
		  start
		(save-excursion
		  (goto-char start)
		  (end-of-line 0)
		  (point))))
	(save-excursion
	  (fill-region left end nil nil t)))))

• minor-mode-alistにrefill-modeを追加
  • '(refill-mode " Refill")におけるRefillはモードラインに表示する短い文のことです。空白で始める必要があります。

(if (not (assq 'refill-mode minor-mode-alist))
    (setq minor-mode-alist
	  (cons '(refill-mode " Refill")
		minor-mode-alist)))

• refillã‚’provideしてrefill.elの作成終了

(provide 'refill)

• 基本的には上記の流れとなります。あとはrefill関数を修正するという作業を続ける感じですね。
• 途中skipしてlast verのrefill関数とrefill関数内で必要となる関数の実装部分を載っけておきます。

• skip-chars-forwardは便利ですとか

(defun before-2nd-word-p (pos)
  "Does Pos lie before the second word on the line?"
  (save-excursion
    (goto-char pos)
    (beginning-of-line)
    (skip-syntax-forward (concat "^ "
				 (char-to-string
				  (char-syntax ?\n))))
    (skip-syntax-forward " ")
    (< pos (point))))

(defun same-line-p (start end)
  "Are START and END on the same line?"
  (save-excursion
    (goto-char start)
    (end-of-line)
    (<= (point))))

(defun short-line-p (pos)
  "Does line containing POS stya within 'fill-column?"
  (save-excursion
    (goto-char pos)
    (end-of-line)
    (<= (current-column) fill-column)))

;; ver last refill

最終的なrefill関数は以下のような感じになりまする。　

(defun refill (start end len)
  "After a text change, refill the current paragraph."
  (let ((left (if (or (zerop len)
		      (not (before-2nd-word-p start)))
		  start
		(save-excursion
		  (max (progn
			 (goto-char start)
			 (end-of-line 0)
			 (point))
		       (progn
			 (goto-char start)
			 (backward-paragraph 1)
			 (point)))))))
    (if (or (and (zerop len)
		 (same-line-p start end)
		 (short-line-p end))
	    (and (eq (char-syntax (preceding-char))
		     ?\ )
		 (looking-at "\\s *$")))
	nil
      (save-excursion
	(fill-region left end nil nil t)))))
	

まあマイナーモードの流れとちょっとしたtipsの紹介, それに関数の修正作業の流れを見るという感じの内容ですね。

8章 評価とエラー処理

7章の内容を踏まえsave-excursionを改良するという章。マクロ解説。マクロを利用したlimited-save-excursionの実装+limited.elの作成という内容

マクロ知っていれば前半の内容はスルーしても可能。最終的には以下のようなlimited.elが出来上がっている。 後は7章におけるsave-excursionを(require 'limited)を実行しlimited-excursionに変更する事でrefill-modeが完成する

ちなみにlimited-save-excursionマクロに出てくるunwind-protectの意味は途中で例外処理がおきても(goto-char ,orig-point-symbol)は実行されるという意味。

>|lisp||
;; limited.el
(defmacro limited-save-excursion (&rest subexprs)
"Like save-excursion, but only restores point."
(let ((orig-point-symbol (make-symbol "orig-point")))
`(let ((,orig-point-symbol (point-marker)))
(unwind-protect
(progn ,@subexprs)
(goto-char ,orig-point-symbol)))))
(provide 'limited)
|

• .emacsに以下の様な内容を加えておけばrefillã‚‚refill-modeが起動するまでロードされなくなるとの事

(autoload 'refill-mocde "refill" "Refill minor mode." t)

9章 メジャーモード

quip-modeというものを作る。。メジャーモードの構造の説明 + ナローイングの説明 + 派生モードの説明(derived !!)といった感じですね。

• quip-modeというのは名言を編集するためのモードのこと

メジャーモードの構造は以下のような感じです。とりあえずquip-modeを作る事を例とします。

• メジャーモードの作り方の流れ
  • 名前を考える
  • quip.elというファイルを作る
  • quip-mode-hookという名前の変数の定義
  • 必要なら固有のキーマップを定義する
  • 必要ならシンタックステーブルを定義する
  • 必要ならモードの略称テーブルを定義する
  • quip-modeというコマンドの定義をする
    • kill-all-local-variablesで全てのバッファローカル変数を取り除く
    • メジャーモードをqup-modeにする
    • モードを表す文字列をmode-nameに設定する
    • 必要ならモード固有のキーマップをインストールする
    • ユーザーのフック関数を実行する
  • quipã‚’provideする

概要は以下のような感じです. とりあえず始めは最低限の設定にしておきます。

(defvar quip-mode-hook nil
  "*List of functions to call when entering Quip mode.")

(defun quip-mode()
  "Major mode for editing Quip files."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'quip-mode)
  (setq mode-name "Quip")
  (run-hook 'quip-mode-hook))

(provide 'quip)

次にquip-modeにおける段落の定義を行います。

(make-local-variable 'paragraph-start)
(make-local-variable 'paragraph-separate)
(make-local-variable 'page-delimiter)
(setq paragraph-start "%%\\|[ \t\n^L]")
(setq paragraph-separate "%%$\\|[ \t\n^L]*$")
(setq page-delimiter "^%%$")

• 次にキーマップの設定を行います。
  • メジャーモードにおけるキー設定をする際に,あまり設定するものがない場合にはmake-sparse-keymapを利用します。
  • 完全なキーマップが必要な場合にはmake-keymapを利用します。make-keymapはニダース以上の設定がある場合に於いて使うべしとのこと。

始めにキーマップの設定を行う前にQuipモード用にコマンドをdefaliasします。

(defalias 'backward-quip 'backward-page)
(defalias 'forward-quip 'forward-page)
(defalias 'narrow-to-quip 'narrow-to-page)
(defalias 'what-quip 'what-page)

次にキーマップの設定。感じとしては以下の通り

(if quip-mode-map
    nil
  (setq quip-mode-map (make-sparse-keymap))
  (define-key quip-mode "\C-x[" 'backward-quip)
  (define-key quip-mode "\C-x]" 'forward-quip)
  (define-key quip-mode "\C-xnq" 'narrow-to-quip))

• 存在するquipの数を数えるためのコマンドの定義
  • ここではナローイングについて考える必要があります。ナローイングとはバッファの編集などをする際に一部のバッファのみに特化して表示させたいときに使います。
  • quipの数を数えるためには現在のバッファがナローイングされている場合にも対応したコードを書く必要があります。

以下は結構頻繁に使われるコード。やっている事は現在のバッファのナローイングの状態を覚えておき、(widen)で全体バッファにアクセス出来るようにした後、再度元のナローイングの状態に戻すと言ったことをしています。

(save-restriction
  (widen)
  ...)

• コードの実装は以下のような感じになります

(defun count-quips()
  "Count the quips in the buffer."
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (count-matches "^%%$"))))

• とまあここまで色々と実装してきた訳ですが、quip-modeは実際の所text-modeに+α処理を付け加えた感じなのですが完全にtext-modeの内容を踏襲するためにはsyntax-tableなどをcopyする必要があります
• define-derived-modeという既に定義されたモードから新しいモードを派生する事ができるパッケージがある(derivedパッケージ)！！ これを使う事により、text-modeの内容を維持したままquip-modeを作ることができます。内容は以下の通り

quip.el(derivedパッケージを使った例)

(require 'derived)

(define-derived-mode quip-mode text-mode "Quip"
  "Major mode for editing Quip files.
Special commands:
\\quip-mode-map"
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-start)
  (make-local-variable 'page-delimiter)
  (setq paragraph-start "%%\\|[ \t\n\^L]")
  (setq paragraph-separate "%%\\|[ \t\^L]*$")
  (setq page-delimiter "^%%$"))

;; defalias parts

(defalias 'backward-quip 'backward-page)
(defalias 'forward-quip 'forward-page)
(defalias 'narrow-to-quip 'narrow-to-page)
(defalias 'what-quip 'what-page)

;; function definition parts
(defun count-quips()
  "Count the quips in the buffer."
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (count-matches "^%%$"))))

;; mapping parts

(if quip-mode-map
    nil
  (setq quip-mode-map (make-sparse-keymap)))
  (define-key quip-mode-map "\C-x[" 'backward-quip)
  (define-key quip-mode-map "\C-x]" 'forward-quip)
  (define-key quip-mode-map "\C-xnq" 'narrow-to-quip)
  (define-key quip-mode-map "\C-cw" 'what-quip))


(provide 'quip)

10章 総合的な例

クロスワードパズルを編集するためのメジャーモードの作成

• 9章の応用といった感じですかね。　結構長めのメジャーモードの作成 + 色々なテクニックの解説といった感じ。　マウスコマンドとか(interactive "@e")とか非同期egrepとかなんとか
• ソース打ち込みは長いんで止めましたｗ　まあ本にあるコードがあんま纏まっていないってのも理由になるのですが。。。

とまあこんなとこですね。なかなかいい感じの内容。 Common LispとかSchemeとか知ってるなら問題なく分かると思いますが、Lispそのものを知らない場合やや難しめの内容かもしれません。まあ内容が古いんで結構古い感じのコードなんですけど(defgroupとかないし。。)何かしら役に立つのではないかと。