Emacsで単語の省略形を定義する

最近どうにかして同じようなコードを何度も何度も何度も書くような真似をしなくて良い方法はないだろうかと考えています。

基本的にEmacsユーザーなので、Elispでそれっぽい機能を書けばいいんじゃないかと考えて思いついたネタの一つが、劣化yasnippetといいますか、単にある文章(単語)の省略形を登録しておいて、それを展開してもとの文章(単語)になるようにする、というものでした。

まぁ、補完があるのでたいして役に立たないかもしれません。

(require 'cl)
;;; メジャーモードで分けたほうがよいだろうか
(defvar shorthand:*shorthand-expand-ht*
  (make-hash-table :test 'equal))
(defvar shorthand:*shorthand-fold-ht*
  (make-hash-table :test 'equal))

(defun shorthand:add (short long)
  (interactive "Sshort:\nslong:")
  (setf (gethash long shorthand:*shorthand-fold-ht*) short
	(gethash short shorthand:*shorthand-expand-ht*) long))


(fset 'sh:add #'shorthand:add)


;; syntax-tableによっては. や / で区切られてしまう
(defun shorthand:word-at-point ()
  (let ((s (sexp-at-point)))
    (typecase s
      (string (format "\"%s\"" s))
      (list nil)
      (symbol (symbol-name s))
      (t nil))))

(defun shorthand:symbol-at-point ()
  (symbol-at-point))

(defun shorthand:add-at-point-short (long)
  (interactive "slong:")
  (let ((short (shorthand:symbol-at-point)))
    (when short
      (shorthand:add short long))))
(fset 'sh:add-at-point-short #'shorthand:add-at-point-short)

(defun shorthand:add-at-point-long (short)
  (interactive "Sshort:")
  (let ((long (shorthand:word-at-point)))
    (when long
      (shorthand:add short long))))
(fset 'sh:add-at-point-long #'shorthand:add-at-point-long)

(defun shorthand:get (short)
  (gethash short shorthand:*shorthand-expand-ht*))
(fset 'sh:get #'shorthand:get)

(defun shorthand:get-short (long)
  (gethash long shorthand:*shorthand-fold-ht*))

(defun shorthand:expand (short)
  (interactive (list (shorthand:symbol-at-point)))
  (let ((long (shorthand:get short)))
    (when long
      (cond
       ((functionp long) (funcall long short))
       ((not (interactive-p)) long)
       (t (shorthand:replace long))))))
(fset 'sh:expand #'shorthand:expand)

(defun shorthand:fold (long)
  (interactive (list (shorthand:word-at-point)))
  (let ((short (shorthand:get-short long)))
    (when short
      (if (not (interactive-p))
	  short
	(let ((short (format "%S" short)))
	  (shorthand:replace short))))))
(fset 'sh:fold #'shorthand:fold)

(defun shorthand:replace (new)
  (backward-sexp)
  (kill-sexp)
  (pop kill-ring-yank-pointer)
  (let ((pos (point))
	(len (length new)))
    (insert new)
    (goto-char (+ pos len))))

(defvar shorthand:*expand-fold-toggle-flag* nil)

(defun shorthand:expand-and-fold ()
  (interactive)
  (if (and (eq this-command last-command)
	   shorthand:*expand-fold-toggle-flag*)
      (progn
	(setf shorthand:*expand-fold-toggle-flag* nil)
	(command-execute 'shorthand:fold))
    (progn
      (setf shorthand:*expand-fold-toggle-flag* t)
      (command-execute 'shorthand:expand)))
  (when (interactive-p)
    (setf this-command 'shorthand:expand-and-fold)))

;; key bindings
(global-set-key (kbd "C-o") 'shorthand:expand-and-fold)
(global-set-key (kbd "M-RET") 'shorthand:add-at-point-long)
(global-set-key (kbd "M-SPC") 'shorthand:add-at-point-short)

;; example
;; (sh:add 'sysout "System.out.println")
;; sysout [M-x sh:expand]
;; =>
;; System.out.println
;; System.out.println [M-x sh:fold]
;; =>
;; sysout


(sh:add 'file
	(lambda (short)
	  (let ((name (read-file-name "Filename:")))
	    (when name
	      (shorthand:replace name)))))

単語の展開だけではつまらないので関数の呼び出しも行えるようにしました。

syntax-tableによって、単語やS式(シンボル)の範囲が異なるあたりがめんどくさそうです。

とりあえず、interactiveについての勉強にはなりました。