猫熊は燃えつきた？！日記

○ 今

うらのローソンに昼飯を買いに行ったら、小関さんとすれ違った。見つめ愛は無かったような気がする。

○ 卓球大会

で日曜日は終わってしまった。ぼくは弱いが、高学年男子が優勝したし、低学年男子は決勝トーナメントに残ったので良しとする。

○ たくさん To:, Cc: がついてくるとうざい(汎用品)

(add-hook 'mew-message-hook 'mail-header-tocc-narrowing)
(add-hook 'wl-message-display-internal-hook 'mail-header-tocc-narrowing)
(add-hook 'wl-message-redisplay-hook 'mail-header-tocc-narrowing)
(add-hook 'gnus-article-prepare-hook 'mail-header-tocc-narrowing)
 
(defvar mail-header-tocc-narrowing-lines 4)
(defvar mail-header-tocc-narrowing-header-end
  "^\\(----\\|--text follows this line--\\|\\)$")
 
(defface mail-header-tocc-narrowing-face
  '((((class color) (background light))
     (:foreground "black" :background "dark khaki"))
    (((class color) (background dark))
     (:background "khaki"))
    (t (:bold t)))
  "*tocc narrowing face."
  :group 'mail)
 
(defun mail-header-tocc-narrowing ()
  (when (boundp 'line-move-ignore-invisible)
    (set (make-local-variable 'line-move-ignore-invisible) t))
  (unless (and (memq this-command '(mew-summary-display wl-summary-redisplay))
	       current-prefix-arg)
    (save-excursion
      (save-restriction
	(goto-char (point-min))
	(if (re-search-forward mail-header-tocc-narrowing-header-end
			       nil t)
	    (beginning-of-line)
	  (goto-char (point-max)))
	(narrow-to-region (point-min) (point))
	(mail-header-tocc-narrowing-1 "^to:")
	(mail-header-tocc-narrowing-1 "^cc:")))))
 
(defun mail-header-tocc-narrowing-1 (hregexp)
  (let ((case-fold-search t)
	(addstr " ...")
	ov start end)
    (goto-char (point-min))
    (when (re-search-forward hregexp nil t)
      (setq start (match-beginning 0))
      (forward-line 1)
      (setq end (progn (while (looking-at "^[ \t]") (forward-line))
		       (forward-line -1)
		       (line-end-position)))
      (when (> (count-lines start end) mail-header-tocc-narrowing-lines)
	(goto-char start)
	(forward-line (1- mail-header-tocc-narrowing-lines))
	(end-of-line)
	(setq start (point))
	(unless (eq (get-char-property start 'invisible) 'tocc-narrowing)
	  (setq ov (make-overlay start end))
	  (put-text-property 0 (length addstr)
			     'face 'mail-header-tocc-narrowing-face addstr)
	  (overlay-put ov 'evaporate t)
	  (overlay-put ov 'invisible 'tocc-narrowing)
	  (overlay-put ov 'after-string addstr))))))

○ そういえば

上みたいなのをするときって、outline-mode みたいに add-to-invisibility-spec を使った方が楽だと思うのだけど、XEmacs でどうやるのかわからない(色もつかないし ^^;;;)のでパス。だけど intangible 使うより line-move-ignore-invisible 設定した方がこの場合は良さそうなので、そこのところを変更。

○ Wanderlustは

一度作った message buffer を使い回すので、"..." が増殖してしまった。またまた変更。

Mew の message buffer は使い捨てだから、cache をいじらない限りなにをやっても OK なので、その辺は気が楽だ。

○ なんかへんだな？

と思って edebug して(またまた)バグ発見。overlays-at だもんな。というわけで、18:50以前に持っていった人はもう一度よろしく (_ _)。

とかいいながら、なんでこんなことやっているんだろう？というのを帰りの電車で気付いてしまった。なぜだか、この Meadow1.15 で Wanderlust が立ち上がらないので動作未確認だけど、もう一回変更。