[xyzzy:04732] カーソル行にマークを付ける

[Masaaki KANEKO <kaneko@xxxxxxxxxxxx>]

こんにちは、名古屋の金子です。

　先日、find-text-attribute について質問させていただいたものです。

　Version 0.2.1.149 で find-text-attribute-point と 
delete-text-attribute-point を実装していただき、何となく思ってい
たようなものが出来ました。亀井さん、どうもありがとうございます。

　Lisp でのプログラムははじめてですので「Lispでは、ここはこう書
いた方がよい」みたいなところを添削していただけたらと思います。

# 仕様的な問題点も多々ありますが、その辺はご容赦を。


; カーソル行に色を付けマークする
;--------------------------------
(defun toggle-line-mark ()
  (interactive)
  (save-excursion
	(multiple-value-bind (from to tag)
		(find-text-attribute-point (point))
	  (if (equal tag 'marked-line)
		  (delete-text-attribute-point (point))
		(set-text-attribute (progn (goto-bol) (point))
							(progn (goto-eol) (point))
						    'marked-line
							:foreground 1 :background 0)))))

; マークされた行を前方に検索する
;--------------------------------
(defun search-forward-marked-line ()
  (interactive)
  (let (pos)
	(save-excursion
	  (setq pos
		   (find-text-attribute
			'marked-line :start (progn (next-virtual-line) (point)))))
	(if pos
		(goto-char pos)
	  (plain-error "マークされた行はありません"))))


; マークされた行を後方に検索する
;--------------------------------
(defun search-backward-marked-line ()
  (interactive)
  (let ((start 0) end pos pass)
	(save-excursion
	  (setq end (progn (goto-bol) (point)))
	  (loop
		(setq pos
			  (find-text-attribute 'marked-line :start start :end end))
		(unless pos
			(return))
		(setq pass t)
		(goto-char pos)
		(setq start (progn (next-virtual-line) (point)))))
	(if pass
		(progn (goto-char start) (previous-virtual-line))
	  (plain-error "マークされた行はありません"))))


(define-key *global-keymap* #\C-j 'toggle-line-mark)
(define-key *global-keymap* #\C-n 'search-forward-marked-line)
(define-key *global-keymap* #\C-b 'search-backward-marked-line)


== 金子 真昭 <kaneko@xxxxxxxxxxxx>