Ctrl+up/downでカーソルと一緒に領域を動かす(修正版)

Ctrl+up/downでカーソルと一緒に領域を動かす
というのをちょっと前に書いたけど、いろいろ良くないところがあったのでちょっと修正。

(save-excursion &rest BODY)

こいつを使うと現在の位置、マーク、カレントバッファを記憶し、
BODY部の処理を行ったあとに元に戻してくれます。便利。
知らなかったので(let ((p (point ))) (....(goto-char p)))とかやってた。

(exchange-point-and-mark &optional ARG)

そうだ、マーク位置に移動するにはこれが手っ取り早かった。

(push-mark &optional LOCATION NOMSG ACTIVATE)

(mark)や(set-mark POS)はあまり使わないほうが良いようだ。
(set-mark POS)ではその前のマーク情報は失われてしまう。
(push-mark)はマークリングを使うのでその問題は解消される。

(rotatef PLACE....)

Common Lisp の本眺めてて見つけた。
だから(require 'cl)しないと使えないかも。
(rotatef A B C)とやると、A->B、B->C、C->A、のように値がローテートされる。

２つをswapするのも、ひとつをtmpに保存して。。。とかやらなくて良いわけだ。
(rotatef A B)でオッケー

というわけで修正版↓

(defun line-number-at-mark ()
  (save-excursion
    (exchange-point-and-mark)
    (line-number-at-pos)))

(defun push-mark-at-line (num)
  (let ((p (point)))
    (goto-line num)
    (push-mark)
    (goto-char p)))

(defun exchange-lines-up ()
  (interactive)
  (cond ((= 1 (line-number-at-pos)) nil)
        (t (transpose-lines 1)
           (previous-logical-line 2))))

(defun exchange-lines-down ()
  (interactive)
  (next-logical-line 1)
  (transpose-lines 1)
  (previous-logical-line 1))

(defun move-region-up ()
  (interactive)
  (let ((lp (line-number-at-pos))
        (lm (line-number-at-mark)))
    (when (< lm lp)
      (rotatef lm lp))
    (cond ((= lp 1) nil)
          (t (goto-line (1- lp))
             (dotimes (i (- lm lp -1))
               (exchange-lines-down))
             (goto-line (1- lp))
             (push-mark-at-line (1- lm))))))

(defun move-region-down ()
  (interactive)
  (let ((lp (line-number-at-pos))
        (lm (line-number-at-mark)))
    (when (> lm lp)
      (rotatef lm lp))
    (goto-line (1+ lp))
    (dotimes (i (- lp lm -1))
      (exchange-lines-up))
    (goto-line (1+ lp))
    (push-mark-at-line (1+ lm))))

(global-set-key [(meta up)] 'exchange-lines-up)
(global-set-key [(meta down)] 'exchange-lines-down)
(global-set-key [(control up)] 'move-region-up)
(global-set-key [(control down)] 'move-region-down)