日記

3 月はあまりブログを書いていない。書くことがないわけではない。むしろ「あ、これブログに書こう。」とメモったものがだいぶ溜まってる。でも、なんか書く気がしなくて書いてない。ちなみに Gauche-dbd-pg と Gauche-gd を触る時間が長かったので、それ系のメモが多いかも。

• Gauche-gd
• Gauche:DBI/DBD

Emacs の org-remember でメモってひと段落してしまってるから「ブログに書くのは今度で良いか。」となっていたりする。org-remember ばりに思いつきザマに即ブログ書けたら幸せかもしれない。いつかブログに書くのだろうか。たぶん書きます。

3 月は体調崩して風邪引いたり、11 年ぶりにぎっくり腰になったりして、合わせて 5 日も仕事をお休みしてしまいました。ぎっくり腰まじ怖い。
3 月はすっげぇー良い（嬉しい）ことがありました。あんまり良くないこともありました。そのうち書きます。


ところで、結構いまさらかもしれないけど outputz 良いですねー。日々 Emacs で入力したタイプ量がモードごとに統計になっていく様はなんだか快感です。面白いです。これも毎度のことながら @SaitoAtsushi さんに教えてもらいました。ありがとうございます。

• Record how much do you output to the Internet? with Outputz. - Outputz
• typing-outputz.el - 日記を書く [・w・] はやみずさん

さて、ブラウジングしているページをマークして一日ごとのまとめを吐くような chrome 拡張とかないですかね。何がしたいかというとこちら↓のようなことを真似したいわけです。

• ときどきの雑記帖 混迷編2011年3月(下旬)

あー chrome と言えば、Emacs から chrome をスクロールしたりできたら嬉しいですよね。で、mac だと作った方がいらっしゃるようです。これ全部 emacs lisp で完結できれば良いわけですよね。やる気があるときにやりたい。--remote-shell-port ですか。

• Google Chromeで閲覧中のページをEmacsからスクロールする　※Mac限定 - (＃＾ω＾)ﾋﾟｷﾋﾟｷ

あと growl for windows 入れたので、emacs からも growl できるようにしたんです。で、Emacs ならそういうモードもあるだろうと思って探したら todochiku.el というのがありました。todochiku って何？中を見てみたら「todochiku（とどろく）」と書いてありました。「ろ」を「ち」と間違えたんでしょうね。。あちゃー。ちなみに自分の環境では todochiku.el はうまく動きませんでした。設定が悪かったかも。

• Growl for Windows
• EmacsWiki: To Do Chi Ku

明日から 4 月ですねー。春。ところで 9LISP は今週ではなく来週です。延期です。
取りあえずこう、とりとめもなく。

Gauche-gd: 再帰曲線（フラクタル）

といっても「もうひとつの Scheme 入門」の手続き群から出力されたデータを適当に加工して使用しました。つまりデータを基に線を引いただけだったりします。

• Scheme 入門 8. 高階関数

(use graphics.gd)
(use util.list)
(use srfi-1)

(define (file->data p x path)
  (let1 ls (call-with-input-file path
             (^p (port-map identity (^ _ (read p)))))
    (let1 ls (map (^e (x->integer (floor (+ p (* e x))))) ls)
      (let1 ls (slices ls 2)
        (map (^ (e1 e2)
                (append e1 e2))
             ls (cdr ls))))))

(define (data->img w h data)
  (let1 im (gd-image-create-true-color w h)
    (gd-image-fill im 0 0 (gd-true-color 255 255 255))
    (for-each (^e (line! im
                         (first e)
                         (second e)
                         (third e)
                         (fourth e)
                         (gd-true-color 0 0 0))) data)
    im))

(define d (file->data 150 400 "/cygdrive/c/tmp/d14.dat"))
(define c (file->data 250 70 "/cygdrive/c/tmp/c14.dat"))
(define k (file->data 80 600 "/cygdrive/c/tmp/k5.dat"))

(save-as (data->img 800 450 d) "/cygdrive/c/tmp/dragon.png")
(save-as (data->img 500 800 c) "/cygdrive/c/tmp/c.png")
(save-as (data->img 750 300 k) "/cygdrive/c/tmp/k.png")

Gauche-gd: インストールと Hello, world !!

• Gauche-gd
• Gauche-gd リファレンスマニュアル

CentOS, Cygwin に入れました。

CentOS では何事もなく入ったので特に書くことがありません。
Cygwin では何やら --host を求められました。

configure: WARNING: If you wanted to set the --build type, don't use --host.
   If a cross compiler is detected then cross compile mode will be used.

以下のようにしてインストールしました。

$ ./configure --host i686-pc-cygwin

取りあえずサンプル。

• グラフィックスライブラリ「GD」を使ってみよう – PHP入門（GD編 1） – イクケン

これをそのまま Gauche-gd で。

(use graphics.gd)

(define test-file-name
  (let1 cnt 0
    (^ (:optional (dir "./")(prefix "")(ext "jpg")(reset #f))
       (rlet1 r (format "~a~a~a.~a" dir prefix cnt ext)
              (when reset
                (set! cnt 0))
              (inc! cnt)))))

(define (test-save im :optional (reset #f))
  (save-as im (test-file-name "/cygdrive/c/temp/test-gd/" "hoge" "png")))

(let1 img (gd-image-create-true-color 200 200)
  (gd-image-fill img 0 0 (gd-true-color 100 0 0))
  (string! img 10 25 "こんにちわ、世界！"
           :font "/cygdrive/c/WINDOWS/Fonts/bdfShnmGothic.ttf"
           ;;           :font "/cygdrive/c/WINDOWS/Fonts/MSMINCHO.TTC"
           :fg (gd-true-color 255 255 0))
  (line! img 10 25 190 25 (gd-true-color 255 255 0))
  (gd-image-filled-ellipse img 100 110 160 140 (gd-true-color 255 200 100))
  (gd-image-filled-rectangle img 60 60 80 100 (gd-true-color 255 255 255))
  (gd-image-filled-rectangle img 120 60 140 100 (gd-true-color 255 255 255))
  (gd-image-filled-arc img 100 120 120 100 0 180 (gd-true-color 200 100 100) 0)
  (test-save img))

CL-GD くらい抽象度の高いラッパーが欲しいです。。現状で必要最低限の簡単なものは自分で作り始めました（with-image とか）が、うーん。。といったところ。やっぱり PostScript でいうところの translate, rotate, rlineto みたいなのが欲しい。

• CL-GD - Use the GD Graphics library from Common Lisp

CL-GD を読んだりしてますが、これも Gauche-gd 相当のライブラリの上にラップしてあるようですね。Gauche-gd の上にも同じようなのを作ろうと思えば作れるんですよね、きっと。例えば、CL-GD の with-transformation などが Gauche-gd にもあると嬉しいけど、パッと見結構大変そうかなーと。

Gauche-dbd-pg にも、もう少し抽象度の高い（？）ラッパーなどがあったら良いのになーと思っています。自分で薄いラッパー（with-connection, with-transaction など）は作ったりしています。ですが正直、我ながらいまいちです。

エラい人が作ってくれないかなー・・・と気長に待つのもアレなので、やっぱり自分で作る方向・・・？誰か誘って一緒に作るとか、そういうことになるのかなー。。

Emacs: iimage.el （画像表示）

Twitter の TL で知りました。これ良いっすね。

../temp/9lisp2.png

と書いて、M-x iimage-mode して C-l で表示されました。

• Seeing is believing

Emacs で改行マーク、全角スペースマーク、タブマークなどを表示する

• おまけ for GNU Emacs
• ubulog: Emacsで全角空白、タブ、改行文字を表示させる

これは良いかもしれない。

(require 'jaspace)
(setq jaspace-alternate-jaspace-string "□")
(setq jaspace-alternate-eol-string "\xab\n")
(setq jaspace-highlight-tabs t)
(setq jaspace-highlight-tabs ?^)
;; (setq jaspace-mdoes '(org-mode))
(custom-set-faces
 `(jaspace-highlight-eol-face ((t :foreground "dark slate grey"))))

org-paste-subtree: The kill is not a (set of) tree(s) - please use to yank anyway

org-paste-subtree: The kill is not a (set of) tree(s) - please use  to yank anyway

org-remember でメモってたらこんなメッセージが。なんだこれ、と思ったら「見出しの * のネストが変ですよ」ってことみたいですね。

Emacs で Scheme （Gauche）する設定

主にどこそこからのコピペなので汚いですが、貼ってみます。
（quack とか auto-complete とか scheme-complete とか他にもいくつか必要かもしれないので、このままコピペしても動かないと思いますが）

;; ********************************************************************
;;  scheme
;; ********************************************************************

;; (defvar gauche-program-path "~/../gauche/bin/gosh")
(defvar gauche-program-path "~/../cygwin/usr/local/bin/gosh")
(defvar gauche-program-params
  (apply #'concat (intersperse " "
                               `("-i"
                                 ;; "-I" ,(expand-file-name "~/../gauche/liv")
                                 ;; "-I" ,(expand-file-name "~/../gauche/other")
                                 ;; "-u" "liv.init"
                                 ))))

;; scheme-mode-hook
(defvar ac-source-scheme
  '((candidates
     . (lambda ()
         (require 'scheme-complete)
         (all-completions ac-target (car (scheme-current-env)))))))

(add-hook 'scheme-mode-hook
          '(lambda ()
             (make-local-variable 'ac-sources)
             (setq ac-sources (append ac-sources '(ac-source-scheme)))))

(defun gauche-info-index (topic)
  (interactive
   (list (read-string
          (concat "Gauche help topic : ")
          (current-word))))
  (get-buffer-create "*info*")
  (info "gauche-refj.info")
  (Info-index topic))

(define-key global-map "\C-xH" 'gauche-info-index)

(setq process-coding-system-alist
      (cons '("gosh" utf-8 . utf-8) process-coding-system-alist))

(autoload 'scheme-mode "cmuscheme" "Major mode for Scheme." t)
(autoload 'run-scheme "cmuscheme" "Run an inferior Scheme process." t)

(add-hook
 'cmuscheme-load-hook
 '(lambda()
    (defun scheme-args-to-list (string)
      (if (string= string "") nil
        (let ((where (string-match "[ \t]" string)))
          (cond ((null where) (list string))
                ((not (= where 0))
                 (let ((qpos (string-match "^\"\\([^\"]*\\)\"" string)))
                   (if (null qpos)
                       (cons (substring string 0 where)
                             (scheme-args-to-list
                              (substring string (+ 1 where)
                                         (length string))))
                     (cons (substring string
                                      (match-beginning 1)
                                      (match-end 1))
                           (scheme-args-to-list
                            (substring string
                                       (match-end 0)
                                       (length string)))))))
                (t (let ((pos (string-match "[^ \t]" string)))
                     (if (null pos)
                         nil
                       (scheme-args-to-list
                        (substring string pos
                                   (length string))))))))))))

(setq gauche-program-name
      (apply #'concat
             (intersperse " "
                          `(,gauche-program-path
                            ,gauche-program-params))))

;; split window
(defun scheme-other-window ()
  "Run Gauche on other window"
  (interactive)
  (setq scheme-program-name gauche-program-name)
  (split-window-horizontally 90)
  (let ((buf-name (buffer-name (current-buffer))))
    (scheme-mode)
    (switch-to-buffer-other-window
     (get-buffer-create "*scheme*"))
    (run-scheme scheme-program-name)
    (switch-to-buffer-other-window
     (get-buffer-create buf-name))))

;; indent settings
(put 'and-let* 'scheme-indent-function 1)
(put 'begin0 'scheme-indent-function 0)
(put 'call-with-client-socket 'scheme-indent-function 1)
(put 'call-with-input-conversion 'scheme-indent-function 1)
(put 'call-with-input-file 'scheme-indent-function 1)
(put 'call-with-input-process 'scheme-indent-function 1)
(put 'call-with-input-string 'scheme-indent-function 1)
(put 'call-with-iterator 'scheme-indent-function 1)
(put 'call-with-output-conversion 'scheme-indent-function 1)
(put 'call-with-output-file 'scheme-indent-function 1)
(put 'call-with-output-string 'scheme-indent-function 0)
(put 'call-with-temporary-file 'scheme-indent-function 1)
(put 'call-with-values 'scheme-indent-function 1)
(put 'dolist 'scheme-indent-function 1)
(put 'dotimes 'scheme-indent-function 1)
(put 'if-match 'scheme-indent-function 2)
(put 'let*-values 'scheme-indent-function 1)
(put 'let-args 'scheme-indent-function 2)
(put 'let-keywords* 'scheme-indent-function 2)
(put 'let-match 'scheme-indent-function 2)
(put 'let-optionals* 'scheme-indent-function 2)
(put 'let-syntax 'scheme-indent-function 1)
(put 'let-values 'scheme-indent-function 1)
(put 'let/cc 'scheme-indent-function 1)
(put 'let1 'scheme-indent-function 2)
(put 'letrec-syntax 'scheme-indent-function 1)
(put 'make 'scheme-indent-function 1)
(put 'multiple-value-bind 'scheme-indent-function 2)
(put 'match 'scheme-indent-function 1)
(put 'parameterize 'scheme-indent-function 1)
(put 'parse-options 'scheme-indent-function 1)
(put 'receive 'scheme-indent-function 2)
(put 'rxmatch-case 'scheme-indent-function 1)
(put 'rxmatch-cond 'scheme-indent-function 0)
(put 'rxmatch-if 'scheme-indent-function 2)
(put 'rxmatch-let 'scheme-indent-function 2)
(put 'syntax-rules 'scheme-indent-function 1)
(put 'unless 'scheme-indent-function 1)
(put 'until 'scheme-indent-function 1)
(put 'when 'scheme-indent-function 1)
(put 'while 'scheme-indent-function 1)
(put 'with-builder 'scheme-indent-function 1)
(put 'with-error-handler 'scheme-indent-function 0)
(put 'with-error-to-port 'scheme-indent-function 1)
(put 'with-input-conversion 'scheme-indent-function 1)
(put 'with-input-from-port 'scheme-indent-function 1)
(put 'with-input-from-process 'scheme-indent-function 1)
(put 'with-input-from-string 'scheme-indent-function 1)
(put 'with-iterator 'scheme-indent-function 1)
(put 'with-module 'scheme-indent-function 1)
(put 'with-output-conversion 'scheme-indent-function 1)
(put 'with-output-to-port 'scheme-indent-function 1)
(put 'with-output-to-process 'scheme-indent-function 1)
(put 'with-output-to-string 'scheme-indent-function 1)
(put 'with-port-locking 'scheme-indent-function 1)
(put 'with-string-io 'scheme-indent-function 1)
(put 'with-time-counter 'scheme-indent-function 1)
(put 'with-signal-handlers 'scheme-indent-function 1)
(put 'with-locking-mutex 'scheme-indent-function 1)
(put 'guard 'scheme-indent-function 1)

;; scheme-mode
(autoload 'scheme-smart-complete "scheme-complete" nil t)
(eval-after-load 'scheme
  '(progn (define-key scheme-mode-map "\t" 'scheme-complete-or-indent)))
(autoload 'scheme-get-current-symbol-info "scheme-complete" nil t)
(add-hook 'scheme-mode-hook
          (lambda ()
            (make-local-variable 'eldoc-documentation-function)
            (setq eldoc-documentation-function 'scheme-get-current-symbol-info)
            (eldoc-mode t)
            (setq lisp-indent-function 'scheme-smart-indent-function)))

;; ********************************************************************
;;  quak.el
;; ********************************************************************

;; C-c C-q m   View a manual in your Web browser.
;; C-c C-q k   View the manual documentation for a keyword
;;             (currently only works for PLT manuals).
;; C-c C-q s   View an SRFI.
;; C-c C-q r   Run an inferior Scheme process.
;; C-c C-q f   Find a file using context of point for default.
;; C-c C-q l   Toggle `lambda' syntax of `define'-like form.
;; C-c C-q t   Tidy the formatting of the buffer.

;;(load "unparen")
(load "quack")
(setq quack-remap-find-file-bindings-p nil)
(setq quack-pltish-keywords-to-fontify
      (append '("let1" "rlet1" "if-let1" "and-let*" "let/cc"
                "use" "export" "export-all" "extend" "select-module"
                "guard" "error" "apply"
                "^" "^_" "^a" "^b" "^c" "^d" "^e" "^f" "^g"
                "^h" "^i" "^j" "^k" "^l" "^m" "^n" "^o" "^p"
                "^q" "^r" "^s" "^t" "^u" "^v" "^w" "^x" "^y" "^z")
              quack-pltish-keywords-to-fontify))
(custom-set-variables
 '(quack-default-program gauche-program-name)
 '(quack-fontify-style 'plt)
 '(quack-pretty-lambda-p t)
 '(quack-programs '("/server:[email protected]#1234:/usr/local/bin/gosh" "gauche" "gosh" "guile" "ironscheme.console.exe" "mit-scheme" "mzscheme" "mzscheme3m" "mzschemecgc" "scheme" ))
 '(quack-run-scheme-always-prompts-p t)
 '(quack-smart-open-paren-p nil))

;; custom faces
;; quack-pltish-comment-face
;; quack-pltish-selfeval-face
;; quack-pltish-paren-face
;; quack-banner-face
;; quack-pltish-class-defn-face
;; quack-pltish-module-defn-face
;; quack-pltish-keyword-face
;; quack-threesemi-h2-face
;; quack-threesemi-h3-face
;; quack-pltfile-prologue-face
;; quack-pltfile-dir-face
;; quack-pltfile-file-face
;; quack-about-title-face
;; quack-about-face
;; quack-smallprint-face
(custom-set-faces
 '(quack-pltish-defn-face ((t (:bold t :foreground "darkgoldenrod3"))))
 '(quack-pltish-keyword-face ((t (:bold t :foreground "maroon2"))))
 '(quack-threesemi-semi-face ((t (:bold t :foreground "blue1"))))
 '(quack-threesemi-text-face ((t (:bold t :foreground "royalblue2")))))

(define-key global-map
  "\C-cG" 'scheme-other-window)

プログラミングGauche に載っている設定をベースにしたような記憶があります。

参考

• Emacs+Scheme - 紫藤のWiki
• scheme-complete.el を auto-complete.el で使う - tigre
• auto-complete.el で scheme のシンボル補完なんとなくできた - 日記を書く [・w・] はやみずさん
• vallog: Gauche の info を anything で引く

gauche-mode というのもいくつかあるそうで。

• gauche-mode - 月の塵
• www.katch.ne.jp/~leque/software/repos/gauche-mode/gauche-mode.el
• Gauche mode
• gauche-mode
• Inferior Gauche ModeInferior Gauche Mode

scramble (The Seasoned Schemer)

;; scranmble

;; (scramble '(1 1 1 3 4 2 1 1 9 2))
;;  -> (1 1 1 1 1 4 1 1 1 9)
;; (scramble '(1 2 3 4 5 6 7 8 9))
;;  -> (1 1 1 1 1 1 1 1 1)
;; (scramble '(1 2 3 1 2 3 4 1 8 2 10))
;;  -> (1 1 1 1 1 1 1 1 2 8 2)

となるような手続き scramble 。

これが複雑というかなんというか、わかりにくい。「何をしているか」がまずわかりにくく、それがわかっても「目的」がよくわからないのです。。それはともかく「できるだけ見やすく」「できるだけわかりやすく」できないものか、いくつか書いてみました。

取りあえず named-let による末尾再帰版。

(define (scramble tup)
  (define (pick ls n)
    (list-ref ls (- n 1)))
  (let rec ((ls tup)(rev '())(acc '()))
    (if (null? ls)
        (reverse acc)
        (let* ((head (car ls))
               (rev (cons (car ls) rev))
               (ret (cons (pick rev (car ls)) acc)))
          (rec (cdr ls) rev ret)))))


(scramble '(1 1 1 3 4 2 1 1 9 2))
;; -> (1 1 1 1 1 4 1 1 1 9)
(scramble '(1 2 3 4 5 6 7 8 9))
;; -> (1 1 1 1 1 1 1 1 1)
(scramble '(1 2 3 1 2 3 4 1 8 2 10))
;; -> (1 1 1 1 1 1 1 1 2 8 2)

次いで、gauche.collection から map-accum を用いた版。

(use gauche.collection)

(define (scramble tup)
  (receive (ret rev)
      (map-accum (^ (e acc)
                    (let1 rev (cons e acc)
                      (values (list-ref rev (- e 1)) rev)))
                 '() tup)
    ret))

(scramble '(1 1 1 3 4 2 1 1 9 2))
;; -> (1 1 1 1 1 4 1 1 1 9)
(scramble '(1 2 3 4 5 6 7 8 9))
;; -> (1 1 1 1 1 1 1 1 1)
(scramble '(1 2 3 1 2 3 4 1 8 2 10))
;; -> (1 1 1 1 1 1 1 1 2 8 2)

次いで、gauche.sequence から map-with-index を用いた版。わざわざ反転したリストを内部で作る必要はないだろうということで書いてみました。が、厳密にはエラーケースが異なりそうです。

(use gauche.sequence)

(define (scramble tup)
  (map-with-index (^ (idx e)
                     (list-ref tup (- idx (- e 1))))
                  tup))

(scramble '(1 1 1 3 4 2 1 1 9 2))
;; -> (1 1 1 1 1 4 1 1 1 9)
(scramble '(1 2 3 4 5 6 7 8 9))
;; -> (1 1 1 1 1 1 1 1 1)
(scramble '(1 2 3 1 2 3 4 1 8 2 10))
;; -> (1 1 1 1 1 1 1 1 2 8 2)

オリジナル（に近い版？）は以前書いています。

• vallog: TSS scramble
• vallog: TSS scramble
• vallog: TSS letting, scramble, fold2

ニコニコわいこんびねーた

Gauche が 0.9.1 になってっから（？）、それまで gauche.experimental.apps モジュールにあった ^ とか ^x とかが使えるようになっているみたいです。引数をリストで受け取る時とか笑顔の顔文字みたいになりますよね。(^ _ ^) みたいな。

これで Y コンビネータもすっきりー！

(define Y (^c ((^f (f f))(^g (c (^ x (apply (g g) x)))))))

ということで以前書いた Y コンビネータ関連エントリ。

• vallog: メモ化された Y Combinator
• vallog: pluggable Y Combinator
• vallog: pluggable Y Combinator 2
• vallog: また出てきたYコンビネータ。Y!。
• vallog: TSS length, Y!, Y-bang
• vallog: 「そのプロセスにおいて、Schemeを使うことに関する多くの勘を やしなうだろう。」
• vallog: Scheme 紙面プログラミング
• vallog: Yコンビネータ 継続編

そういえば、Emacs で scheme を書くときに scheme-mode と一緒に quack.el を使っているのですが、その quack.el の pretty-lambda って機能。lambda が自動で λ って表記になるんです。これ、ちょっといじれば emacs-lisp-mode とかに使えるようになるんじゃないかなー。（誰得）

• neilvandyke.org - Quack: Enhanced Emacs Support for Editing and Running Scheme Code

Emacs: popwin.el が快適過ぎる

• ヘルプバッファや補完バッファをポップアップで表示してくれるpopwin.elをリリースしました - Functional Emacser
• popwin.el v0.2をリリースしました - Functional Emacser

まだ昨日から使い始めたばかりですが、とてもとても快適です。作者様に感謝でございます。

取りあえずは、今まで特に気になっていたものを popup するようにしました。org-remember, backtrace の挙動は特に特に気に入らず、イラついていたのが超快適になりました！最後に popup したものは C-x p で再度 popup するようにしました。

あと dired の o を上書きして、対象のファイルを popup で表示するようにしました。たくさんのファイル（例えば自動で保存してある *scratch* バッファの履歴とか）を一つ一つ確認するのが大変で困っていたのが、これまた大変快適になりました。

あとは、試しに key-chord の mn で message バッファを popup するようにしています。

(require 'popwin)
(defvar popwin:special-display-config-backup popwin:special-display-config)
(setq display-buffer-function 'popwin:display-buffer)
(setq popwin:special-display-config
      (append '(("*Remember*" :stick t)("*Org Agenda*")("*Backtrace*")
                ("*sdic*" :noselect))
              popwin:special-display-config))
(define-key global-map (kbd "C-x p") 'popwin:display-last-buffer)
(define-key dired-mode-map "o" #'(lambda ()
                                   (interactive)
                                   (popwin:find-file (dired-get-file-for-visit))))
(key-chord-define-global "mn" 'popwin:messages)

Emacs: 「次の単語（というかS式）を指定した文字で囲む」 earmuff.el

• Twitter / `(,@valvallow): #Emacs に「リージョンを指定した文字で囲む」と ...

#Emacs に「リージョンを指定した文字で囲む」とか「次の単語（というかS式）を指定した文字で囲む」みたいなコマンドありませんか？

で、insert-pair

• ⚛ Useful: insert-pair

とか lisp-electric.el

• lisp-electric — Gist

などを教えて頂きました。

ですが、素朴なものであれば簡単に書けそうだったので書いてみました。ただのコード辺なわけですが、せっかくなのでパッケージ（？）にしてみました。

download

• earmuff.el — Gist

auto-install.el があれば auto-install-from-url とか auto-install-from-gist でインストールできます。

何ができるのか

• 現在のカーソル位置の次にある S 式を「耳当て記法」にする。
• 例） hoge -> *hoge* とか hoge -> +hoge+ とか
• foo -> "foo" とか foo -> 'foo' とか foo -> {foo} なども「耳当て記法」扱いすることにしました
• 「耳当て」は、emacs 既存の insert-pair-alist か、自分で指定した alist から選択される
• 実行するたびに alist の中から順番に適用される

それと「現在のカーソル位置の次にある S 式を耳当て記法にして次の S 式に進む」みたいなのも用意しました。

耳当て（笑）

いやいや、lisp 界隈では大域変数なんかに *global-var* や、定数に +const-var+ というような名前の付け方をする慣習があるのです。で、これを「耳当て記法」と呼ぶそうです。
なので、名前も earmuff.el にしました。

設定例

(require 'earmuff)
(define-key global-map [f11] (emf:cycle-earmuff-gen '((?" ?")(?* ?*)(?+ ?+))))
(define-key global-map (kbd "M-<f11>") (emf:earmuff-and-move-next-gen '(?" ?")))

上記設定だと、例えば hoge という S 式があってその直前にカーソルがある状態で F11 を連打すると以下のように切り替わります。

hoge    ;;
"hoge"  ;; 1 回
*hoge*  ;; 2 回
+hoge+  ;; 3 回
hoge    ;; 4 回

Emacs には insert-pair-alist という alist が組み込み（？）であるようなのですが、それをそのまま使っても良いかもしれません。以下の設定で insert-pair-alist を基に耳当てします。

(require 'earmuff)
(add-to-list 'insert-pair-alist '(?" ?"))
(add-to-list 'insert-pair-alist '(?* ?*))
(add-to-list 'insert-pair-alist '(?+ ?+))
(define-key global-map [f11] (emf:cycle-earmuff-gen))
(define-key global-map (kbd "M-<f11>") (emf:earmuff-and-move-next-gen '(?" ?")))

M-F11 に割当てているのは、連続で耳当てできるようにするものです。例えば上記の設定だと下記のようになります。

foo bar baz       ;;
"foo" bar baz       ;; 1 回
"foo" "bar" baz     ;; 2 回
"foo" "bar" "baz"   ;; 3 回

コレはキーボードマクロで定義してもよさそうだったんですが、取りあえず用意しました。

この例では F11 と M-F11 に割当てていますが、好みのキーに割り当ててください。

コードは以下の通りです。