Emacs picture-modeの拡張 - 屯遁のパズルとプログラミングの日記

以下のようなditaa用入力テキストを簡単に描けるように， emacsのpicture-modeを拡張した．

+---------+          +--------+
|{s}      |          |        |
|  データ +--------->|  処理  |
|  ベース |          |        |
+---------+          +---+----+
                         |     
                         v                       
+---------+          +--------+      +---------+ 
|{s}      |          |        |      |{s}      | 
|  データ +--------->|  処理  |<---->|  データ | 
|  ベース |    ^     |        |      |  ベース | 
+---------+    |     +---+----+      +---------+ 
               |         |                       
               |         v                       
+---------+    |     +--------+                  
|{s}      |    |     |{d}     |                  
|  データ +----/     |  出力  |                    
|  ベース |          |        |                
+---------+          +--------+

リンク

d:id:tamura70:20100123:ditaa
ditaa
ditaa で遊ぶ
picture-mode
http://pitecan.com/Keisen/keisen.el (罫線引きプログラム)
orgtbl-mode
- 表を描くためのマイナーモード (orgtbl-mode)．便利!

インストール

最後に示すemacs lispファイルを load-pathの通っているディレクトリ中にpicture-init.elとして保存する．
.emacsファイル等に以下を追加する．

(add-hook 'picture-mode-hook 'picture-mode-init)
(autoload 'picture-mode-init "picture-init")

使い方

「M-x picture-mode RET」でpicture-modeにした後，以下が利用できる．

キー	処理
C-right	右方向に線を描く
C-left	左方向に線を描く
C-up	上方向に線を描く
C-down	下方向に線を描く
M-right (A-right)	右方向に線を消す
M-left (A-left)	左方向に線を消す
M-up (A-up)	上方向に線を消す
M-down (A-down)	下方向に線を消す
C-c C-right	リージョン(四角形)を右方向に移動
C-c C-left	リージョン(四角形)を左方向に移動
C-c C-up	リージョン(四角形)を上方向に移動
C-c C-down	リージョン(四角形)を下方向に移動

なお，元々のpicture-modeの機能で以下も利用できる．

キー	処理
C-c C-r	指定されたリージョンに四角形を描く
C-c C-k	リージョン(四角形)を空白でクリア
C-c C-y	クリアしたリージョン(四角形)を貼付
C-c right	右方向への移動モード
C-c left	左方向への移動モード
C-c up	上方向への移動モード
C-c down	下方向への移動モード
C-o	空行を追加
C-j	行を複製
C-c C-c	picture-modeの終了

バグ

全角文字の上に線を描く/線を消す/リージョンを移動すると，表示が崩れる．
Ubuntu 8.04上のEmacs 22以外では動作未確認．

プログラム

;;;
;;; (add-hook 'picture-mode-hook 'picture-mode-init)
;;; (autoload 'picture-mode-init "picture-init")
;;;
(require 'picture)

(defun picture-mode-init ()
  (define-key picture-mode-map [C-right] 'picture-line-draw-right)
  (define-key picture-mode-map [C-left]  'picture-line-draw-left)
  (define-key picture-mode-map [C-up]    'picture-line-draw-up)
  (define-key picture-mode-map [C-down]  'picture-line-draw-down)
  (define-key picture-mode-map [A-right] 'picture-line-delete-right)
  (define-key picture-mode-map [A-left]  'picture-line-delete-left)
  (define-key picture-mode-map [A-up]    'picture-line-delete-up)
  (define-key picture-mode-map [A-down]  'picture-line-delete-down)
  (define-key picture-mode-map [M-right] 'picture-line-delete-right)
  (define-key picture-mode-map [M-left]  'picture-line-delete-left)
  (define-key picture-mode-map [M-up]    'picture-line-delete-up)
  (define-key picture-mode-map [M-down]  'picture-line-delete-down)
  (define-key picture-mode-map [(control ?c) C-right] 'picture-region-move-right)
  (define-key picture-mode-map [(control ?c) C-left]  'picture-region-move-left)
  (define-key picture-mode-map [(control ?c) C-up]    'picture-region-move-up)
  (define-key picture-mode-map [(control ?c) C-down]  'picture-region-move-down)
  nil)

(defun picture-line-draw-str (h v str)
  (cond ((/= h 0) (cond ((string= str "|") "+")
			((string= str "+") "+")
			(t "-")))
	((/= v 0) (cond ((string= str "-") "+")
			((string= str "+") "+")
			(t "|")))
	(t str)
	))

(defun picture-line-delete-str (h v str)
  (cond ((/= h 0) (cond ((string= str "|") "|")
			((string= str "+") "|")
			(t " ")))
	((/= v 0) (cond ((string= str "-") "-")
			((string= str "+") "-")
			(t " ")))
	(t str)
	))

(defun picture-line-draw (num v h del)
  (let ((indent-tabs-mode nil)
	(old-v picture-vertical-step)
	(old-h picture-horizontal-step))
    (setq picture-vertical-step v)
    (setq picture-horizontal-step h)
    ;; (setq picture-desired-column (current-column))
    (while (>= num 0)
      (when (= num 0)
	(setq picture-vertical-step 0)
	(setq picture-horizontal-step 0)
	)
      (setq num (1- num))
      (let (str new-str)
	(setq str
	      (if (eobp) " " (buffer-substring (point) (+ (point) 1))))
	(setq new-str
	      (if del (picture-line-delete-str h v str)
		(picture-line-draw-str h v str)))
	(picture-clear-column (string-width str))
	(picture-update-desired-column nil)
	(picture-insert (string-to-char new-str) 1)
	))
    (setq picture-vertical-step old-v)
    (setq picture-horizontal-step old-h)
    ))

(defun picture-region-move (start end num v h)
  (let ((indent-tabs-mode nil)
	(old-v picture-vertical-step)
	(old-h picture-horizontal-step) rect)
    (setq picture-vertical-step v)
    (setq picture-horizontal-step h)
    (setq picture-desired-column (current-column))
    (setq rect (extract-rectangle start end))
    (clear-rectangle start end)
    (goto-char start)
    (picture-update-desired-column t)
    (picture-insert ?\  num)
    (picture-insert-rectangle rect nil)
    (setq picture-vertical-step old-v)
    (setq picture-horizontal-step old-h)
    ))

(defun picture-region-move-right (start end num)
  "Move a rectangle right."
  (interactive "r\np")
  (picture-region-move start end num 0 1))

(defun picture-region-move-left (start end num)
  "Move a rectangle left."
  (interactive "r\np")
  (picture-region-move start end num 0 -1))

(defun picture-region-move-up (start end num)
  "Move a rectangle up."
  (interactive "r\np")
  (picture-region-move start end num -1 0))

(defun picture-region-move-down (start end num)
  "Move a rectangle left."
  (interactive "r\np")
  (picture-region-move start end num 1 0))

(defun picture-line-draw-right (n)
  "Draw line right."
  (interactive "p")
  (picture-line-draw n 0 1 nil))
			  
(defun picture-line-draw-left (n)
  "Draw line left."
  (interactive "p")
  (picture-line-draw n 0 -1 nil))

(defun picture-line-draw-up (n)
  "Draw line up."
  (interactive "p")
  (picture-line-draw n -1 0 nil))

(defun picture-line-draw-down (n)
  "Draw line down."
  (interactive "p")
  (picture-line-draw n 1 0 nil))

(defun picture-line-delete-right (n)
  "Delete line right."
  (interactive "p")
  (picture-line-draw n 0 1 t))
			  
(defun picture-line-delete-left (n)
  "Delete line left."
  (interactive "p")
  (picture-line-draw n 0 -1 t))

(defun picture-line-delete-up (n)
  "Delete line up."
  (interactive "p")
  (picture-line-draw n -1 0 t))

(defun picture-line-delete-down (n)
  "Delete line down."
  (interactive "p")
  (picture-line-draw n 1 0 t))