矩形regionに色を付ける

xyzzy

昨日書いたのは暴走してくれて動かなくなる場合があるのを発見したので、一応書くのを差し控えて（本当は失敗していようが何でも残したいんだけど、昨日書いた奴は、xyzzyがおかしくなるほど危険だったので）、今手直ししたのを残しておくことに。

;------------------------------------------------------------
;矩形のリージョンをハイライト
;色の指定、この辺の所で色とかは好みで好きに
(defvar set-rectangle-reagion-color
	  '(:bold t :foreground 0 :background 2 :underline t))

(defun rectangle-region-view ()
  ;変更部分の重複がないよう前に表示した矩形regionを一度消す。
  (delete-text-attributes 'rectangle-reagion-view)
  ;一応設定がonになっているか確認。
  (when *rectangle-region-view-on*
	;cursor位置を保存して動作後にカーソル位置が変更しないように。
	(save-excursion
	  ;一応使いそうな変数にmarkとcursorの縦横の位置をセット
	  (let ((x1 (current-virtual-column))
		(y1 (current-virtual-line-number))
		(x2) (y2) (tmp))
		(goto-char (mark))
		(setq x2 (current-virtual-column))
		(setq y2 (current-virtual-line-number))
		;markとcursorどちらが上に来てもいいように入れ替え(1より2が大きい)
		(if (> x1 x2) (rotatef x1 x2))
		(if (> y1 y2) (rotatef y1 y2))
		;画面の表示範囲外での描画をしないように。regionが大きすぎるとき対策。
		(if (> (get-window-start-line) y1)
			(goto-virtual-line (get-window-start-line))
		  (goto-virtual-line y1)) ;この辺で色を塗る開始行に移動
		(if (< (+ (get-window-start-line) (window-lines)) y2)
			(setq y2 (+ (get-window-start-line) (1+ (window-lines)))))
		  ;以下regionの範囲を一行ずつ下がりながら色を変えていく。
		(while (>= y2 (current-virtual-line-number))
		  (goto-virtual-column x1) ;色を塗りはじめる桁
		  (setq tmp (point))
		  (goto-virtual-column x2) ;色を塗り終わる桁
		  (apply #'set-text-attribute tmp (point) 
				 'rectangle-reagion-view
				 set-rectangle-reagion-color);色は上に
		  ;一行下に移動して同じことをする。
		  (unless (next-virtual-line)
			(return)))
		;unlessとreturnは次の行がEOFだったりしたら酷い感じだったので、それ対策
		))))

;エラー対策？マークがないときとか、よくわからんけどエラーが出るので
(defun rectangle-region-check()
  (interactive)
  (handler-case
	  (rectangle-region-view)
	(error (c)
	  (delete-text-attributes 'rectangle-reagion-view)
	  (delete-hook '*post-command-hook* 'rectangle-region-check)
	  (setq *rectangle-region-view-on* nil)
	  (plain-error "マークがないよ" ))
	))

;toggleで切り替え
(defvar *rectangle-region-view-on* nil)
;フラグでトグル
(defun rectangle-region-view-toggle()
  (interactive)
  (delete-text-attributes 'rectangle-reagion-view)
  (if *rectangle-region-view-on*
	  (progn 
		(delete-hook '*post-command-hook* 'rectangle-region-check)
		(setq *rectangle-region-view-on* nil)
		(message "rectangle-region-view-off"))
	(progn
	  (add-hook '*post-command-hook* 'rectangle-region-check)
	  (setq *rectangle-region-view-on* t)
	  (message "rectangle-region-view-on"))
	))

;;矩形リージョンを表示　なんとなくS-F8に割り当て
(global-set-key #\C-F8 'rectangle-region-view-toggle)
;矩形のリージョンメニューのラベル
(set-function-bar-label #\C-F8 "F8 : rectangle-view")

之を書いてみてifばかりなのに気づいた。condとかの方が早いなら、condに変えようかと思ってみたりlispで書くならifよりcondなんじゃないかとか、色々考えてみた。
まあ、ぶっちゃけた話一夜漬けの所と適当にヘルプをみただけなので、まっとうなlispとしては変な所だらけではないかと想像は付くんだけど、まあ、動くから良いかなぁとか、そんな感じ。

■残っている問題点

  • 矩形regionを表示させていると、何故かカーソルの移動がおかしい。行末にカーソルを合わせて下に移動すると普段の移動と違う。