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

○ 三連休

なのだがうちで結構働いている。が、進捗しない。

○ 土曜日

葛西のイトーヨーカ堂で買い物したりした。ヨドバシカメラからデジカメの退院の連絡があったけど、もうひとつ頼んでいるものがそろったら取りに行こう。

○ 野球

日曜日に初練習。軽くやって、あまりに寒いので "コーヒ飲もうね" って入ったサイゼリヤ篠崎店なのに、1500ml入りイタリアワインを白赤合わせて 5本飲んでしまったよ。昔はサイゼリヤって千葉と東京東部にしかなかったけど、今はすごいたくさんあるよな。

○ *Mew refile view* buffer

ダイレクトメールで "*Mew refile view* buffer" に色がつかないとの指摘あり。とりあえず積極的に色をつけるようにして、パッチをその方に送った。Mew-dist にパッチを送るかどうか考え中。

○ Yet another mew-summary-overricde-body

;; fancy-refile-body
(defvar mew-override-fancy-setup nil)
;; (setq mew-summary-form-body-starter nil)
 
(defvar mew-override-fancy-body-open "<")
(defvar mew-override-fancy-body-prefix1 ?\ )
(defvar mew-override-fancy-body-prefix2 ?.)
(defvar mew-override-fancy-body-close ">")
(defvar mew-override-fancy-body-regex0 nil)
(defvar mew-override-fancy-body-regex1 nil)
(defvar mew-override-fancy-body-regex2 nil)
 
(setq mew-override-fancy-body-regex0
      (concat (regexp-quote mew-override-fancy-body-open)
	      "[^" (regexp-quote mew-override-fancy-body-open) "]+"
	      (regexp-quote mew-override-fancy-body-close)))
 
(setq mew-override-fancy-body-regex1
      (concat (regexp-quote (string mew-override-fancy-body-prefix2))
	      (regexp-quote (string mew-override-fancy-body-prefix1)) "+"
	      "\\(" mew-override-fancy-body-regex0 "\\)"))
 
(setq mew-override-fancy-body-regex2
      (concat "^[^\r]+"
	      "\\(" (regexp-quote (string mew-override-fancy-body-prefix2))
	      (regexp-quote (string mew-override-fancy-body-prefix1)) "+"
	      mew-override-fancy-body-regex0 "\\)\r"))
 
(defface mew-face-fancy-body nil
  "*Face to highlight the fancy body"
  :group 'mew-highlight)
 
(mew-face-spec-set
 'mew-face-fancy-body
 '((((class color) (type tty)) (:foreground "blue"))
   (((class color) (background light)) (:foreground "medium blue"))
   (((class color) (background dark))  (:foreground "dodger blue"))
   (t (:underline t))))
 
;; (mew-face-spec-set
;;  'mew-face-fancy-body
;;  '((((class color) (type tty)) (:foreground "green"))
;;    (((class color) (background light)) (:foreground "green yellow"))
;;    (((class color) (background dark))  (:foreground "LimeGreen"))
;;    (t (:underline t))))
 
(unless mew-override-fancy-setup
  (setq mew-override-fancy-setup t)
  (defalias 'mew-summary-refile-override-body 'mew-summary-refile-override-fancy-body)
  (defalias 'mew-summary-refile-remove-body 'mew-summary-refile-remove-fancy-body)
  (if mew-xemacs-p
      (progn
	(defalias 'mew-line-beginning-position 'point-at-bol)
	(defalias 'mew-line-end-position 'point-at-eol))
    (defalias 'mew-line-beginning-position 'line-beginning-position)
    (defalias 'mew-line-end-position 'line-end-position)))
 
(add-hook 'mew-thread-display-hook 'mew-thread-refile-override-fancy-body)
 
(defun mew-summary-refile-override-fancy-body (folders-str)
  (save-excursion
    (let* ((flds (concat (make-string 2 mew-override-fancy-body-prefix1)
			 mew-override-fancy-body-open
			 folders-str
			 mew-override-fancy-body-close))
	   (fldsw (string-width flds))
	   invs invsw beg end)
      (mew-summary-refile-remove-fancy-body)
      (while (> fldsw (/ (mew-scan-width) 3))
	(setq flds (concat (make-string 2 mew-override-fancy-body-prefix1)
			   mew-override-fancy-body-open
			   (setq folders-str
				 (substring folders-str
					    0 (* 2 (/ (string-width folders-str) 3))))
			   "..."
			   mew-override-fancy-body-close))
	(setq fldsw (string-width flds)))
      (beginning-of-line)
      (if (search-forward "\r" (mew-line-end-position) t)
	  (setq end (match-beginning 0))
	(setq end (mew-line-end-position)))
      (setq beg end)
      (goto-char beg)
      (while (> fldsw
		(setq invsw (string-width (setq invs (mew-buffer-substring beg end)))))
	(forward-char -1)
	(setq beg (point)))
      (when (< fldsw invsw)
	(setq flds (concat (make-string (- invsw fldsw) mew-override-fancy-body-prefix1)
			   flds)))
      (setq flds (concat (string mew-override-fancy-body-prefix2)
			 (substring flds 1)))
      (goto-char end)
      (mew-elet
       (if mew-xemacs-p
	   (let ((pos (point)))
	     (insert flds)
	     (set-text-properties pos (point) nil))
	 (insert-and-inherit flds))
       (put-text-property beg end 'invisible t)
       (goto-char end)
       (when (looking-at mew-override-fancy-body-regex1)
	 (setq ovl (mew-overlay-make (match-beginning 1) (match-end 1)))
	 (overlay-put ovl 'face 'mew-face-fancy-body)
	 (overlay-put ovl 'evaporate t))))))
 
(defun mew-summary-refile-remove-fancy-body ()
  (save-excursion
    (beginning-of-line)
    (when (looking-at mew-override-fancy-body-regex2)
      (let ((end (match-beginning 1))
	    beg)
	(mew-elet
	 (delete-region end (match-end 1))
	 (when (and (get-text-property end 'invisible)
		    (setq beg (previous-single-property-change
				end 'invisible nil (mew-line-beginning-position)))
		    (not (eq beg (mew-line-beginning-position))))
	   (remove-text-properties beg end '(invisible nil))))))))
 
(defun mew-thread-refile-override-fancy-body ()
  (let ((ofld (mew-thread-to-folder (mew-summary-folder-name 'ext)))
	refalst msg flds)
    (save-excursion
      (when (get-buffer ofld)
	(save-excursion
	  (set-buffer ofld)
	  (setq refalst (mew-sinfo-get-refile)))
	(while refalst
	  (setq msg (car (car refalst)))
	  (setq flds (mapconcat 'identity (cdr (car refalst)) ","))
	  (goto-char (point-min))
	  (when (re-search-forward (mew-regex-sumsyn-msg msg) nil t)
	    (mew-summary-refile-override-fancy-body flds))
 	  (setq refalst (cdr refalst)))))))

○ line-beginning-position(), line-end-position()

あぁ、これは XEmacs には無いんだと思い出す。 point-at-bol(), point-at-eol() って、もう何年も書いたこと無かった。

○ プリンプリン物語

あら、やっているのね。今子供が見ている。リアルタイムではさすがにもう見る年齢じゃなかったけど、ちょっと懐かしいな。

個人的には、五人と一匹探偵団、七瀬さんシリーズ、タイムトラベラー、オヨヨ大統領などの少年ドラマシリーズ(で良いんだよな？)が見たいし、子供に見せたい。