ChangeLogメモのエントリをタブ抜きコピーする関数：cl-item-copy

elisp

夏休みで普段やらないことをやろうと思い立ってelispを書いてみた．

ChangeLogメモを見ている際に，カーソルがアイテムの中にあったときに呼び出されると，そのアイテムをkill-ringにコピーする．その際行頭のタブを抜いてくれる．
# clmemoにタブ抜きコピーの機能あるのだが，まぁ，その，練習ということで．

Perlコードを書くときに覚えられない部分のために自分挿入関数はちょこちょこと書いたことがあったけれど，ちゃんとした（？）elispを書くのは初めて．

きれいに書こうとはせずに泥臭く書いてみた．一番ハマったのはcl-heading-regexpの部分．Perlで言うところの/^\t\* /を"^\\t\* "と勘違いしていて，検索できずに苦労した．結局，clgrepとかで使われているだろうとclmemo.elを参考にした．

こんなエントリがあったとする．

2008-05-05  Sleepy Yoshi  <hoge@example.com>

        * 自分一人で石を持ち上げる気がなかったら [quotes]:
        >>
　　　　自分一人で石を持ち上げる気がなかったら、二人でも持ち上がらない。
        Johann Wolfgang von Goethe
        <<

アイテムヘッダの*から次のアイテム（アイテムが無い場合は次のエントリ，それもない場合はファイル末尾）までの間にカーソルを置いてcl-item-copyを呼び出すと，kill-ringに以下のような文字列がコピーされる．

* スポーツは少年をいち早く男にする [quotes]:
>>
スポーツ（ラグビー）は少年をいち早く男にし，男にいつまでも少年の心を抱かせてくれる．
（ラグビー元フランス代表主将　ジャン・Ｐ・リーブ）
<<

ちゃんちゃん．


コードはこんな感じ．行頭のタブを削除するために，新しいバッファを作ってそこで処理をしている．確実に処理できるように知っている（数少ない）関数の組み合わせ．なんだかLOGOとかHyperCardを思い出した．そういう点ではエクセルVBAと同じ感じ？

(defvar cl-heading-regexp "^\t\\* ")
(defvar cl-entry-header-regexp "^[12][0-9][0-9][0-9]-[01][0-9]-[0-3][0-9]  ")
(defvar cl-tmp-buffer-name "*cl-tmp-copy-buffer*")

(defun cl-item-copy ()
  (interactive)
  (save-excursion
    (if (re-search-backward cl-heading-regexp nil t)
        (let ((begin-point (point))
              (tmp-copy-buffer (get-buffer-create cl-tmp-buffer-name)))
          (forward-char 1)

          ;; Obtain next item point
          (save-excursion
            (setq tmp-next-item-point
                  (and (re-search-forward cl-heading-regexp nil t)
                       (point))))

          ;; Obtain next entry header point
          (save-excursion
            (setq tmp-next-entry-header-point
                  (and (re-search-forward cl-entry-header-regexp nil t)
                       (point))))

          (setq tmp-next-point
                (if tmp-next-item-point
                    (if tmp-next-entry-header-point
                        (min tmp-next-item-point
                             tmp-next-entry-header-point)
                      tmp-next-item-point)
                  (point-max)))

          (progn
            (goto-char tmp-next-point)
            (forward-line -1)
            (copy-region-as-kill begin-point (point))
            ;; Edit in the tmp-copy-buffer
            (set-buffer tmp-copy-buffer)
            (yank)
            (goto-char (point-min))

            ;; Remove \t at the beginning of line
            (while (not (eobp))
              (beginning-of-line)
              ;; If the beginning of the line is \t then remove it
              (if (char-equal (following-char) ?\t) (delete-char 1))
              (forward-line 1))
            (copy-region-as-kill (point-min) (point-max))