[Mew-dist 07418] Re: mew-1.94b3 + x-face のトラブル

[TAKAHASHI Kaoru]

高橋です。

>>>>> In message "[Mew-dist 07414] Re: mew-1.94b3 + x-face のトラブル",
>>> kazu at example.com(Kazu Yamamoto (山本和彦))  writes:

kazu> かなり小手先のような気がします。本質的には違う部分を修正すべきでしょう。
kazu> x-face を使っていないので、何が原因で read-only のバグが発生するのか分
kazu> かりません。

kazu> x-face はどういう動作をするのが教えて下さい。

X-Face utility 1.3.4 の README.ja より
|  From フィールドにイメージを表示しているときは X-Face フィールド全体
|  を隠して、From フィールドと X-Face フィールド全体を read-only にしま
|  す。
|  X-Face フィールドにイメージを表示しているときは encoded string を隠
|  して X-Face フィールド全体を read-only にします。

|  いずれも見えなくなってしまった領域を不用意に書き変えてしまわないため
|  の対策なのですが、read-only にした後でさらにヘッダを書き変えるような
|  処理が行なわれると、その処理の正しい結果が得られなかったりエラーで止
|  まってしまう場合があります。

|  もしそのような事態が不幸にして起こってしまうようでしたら、簡単には
|
|(setq x-face-xmas-inhibit-read-only t)
|
|  と .emacs に書いておくと、見えないヘッダの領域を read-only にしない
|  ようにすることができます。

x-face-xmas-inhibit-read-only は x-face-xmas-display-x-face() に
だけ効いているようです。

-------------- next part --------------
(defun x-face-xmas-display-x-face (arg &optional beg end)
  "display X-Face fields as XEmacs glyph."
  (interactive "P")
  (and
   x-face-xmas-xface-p
   (save-excursion
     (save-restriction
       (apply 'narrow-to-region
	      (cond ((and beg end)
		     (list beg end))
		    ((and zmacs-regions (interactive-p) (region-exists-p))
		     (list (region-beginning) (region-end)))
		    (t (list (point-min) (point-max)))))
       (x-face-narrow-to-header)
       (let ((exists (x-face-xmas-search-extents))
	     lives on x-face from pt extent glyphs)
	 ;; extract live extents.
	 (mapcar
	  (lambda (i) (setq lives (append lives (cdddr i))))
	  (append (cdar exists) (cdadr exists)))
	 (setq x-face (mapcar
		       (lambda (i) (list (car i) (cadr i) (caddr i)))
		       (cdr (assq 'x-face exists))))
	 ;; delete all extents.
	 (put-text-property (point-min) (point-max) 'read-only nil)
	 (mapcar 'delete-extent lives)
	 ;; whether ON or OFF?
	 (setq on
	       (and
		(x-face-xmas-highlight-headers-hack-x-face-p-p)
		x-face
		(or (not (or lives (and (numberp arg) (< arg 0))))
		    (and (numberp arg) (> arg 0)))))
	 ;;
	 (when on
	   (cond ((setq from (mapcar
			      (lambda (i) (list (car i) (cadr i) (caddr i)))
			      (cdr (assq 'from exists))))
		  (setq pt (cadar from))
		  (mapcar
		   (lambda (i)
		     (put-text-property (car i) (caddr i) 'invisible t)
		     (or x-face-xmas-inhibit-read-only
			 (put-text-property (car i) (caddr i) 'read-only t)))
		   x-face))
		 (x-face
		  (setq pt (cadar x-face))
		  (put-text-property pt (1- (caddar x-face)) 'invisible t)
		  (or x-face-xmas-inhibit-read-only
		      (put-text-property pt (caddar x-face) 'read-only t))
		  (mapcar
		   (lambda (i)
		     (put-text-property (car i) (caddr i) 'invisible t)
		     (or x-face-xmas-inhibit-read-only
			 (put-text-property (car i) (caddr i) 'read-only t)))
		   (cdr x-face))))
	   (message "Decoding X-Face image...")
	   (setq glyphs (x-face-xmas-extract-x-face-fields-to-glyphs))
	   (if glyphs
	       (progn
		 (mapcar
		  (lambda (glyph)
		    (setq extent (make-extent (1- pt) pt))
		    (if (and x-face-xmas-like-highlight-headers from)
			(set-extent-end-glyph extent glyph)
		      (set-extent-begin-glyph extent glyph))
		    (set-extent-property extent 'x-face-image t))
		  (if (and x-face-xmas-like-highlight-headers (not from))
		      (nreverse glyphs)
		    glyphs))
		 (message ""))
	     (message "Decoding X-Face image...!! FAILED")
	     (setq on nil)))
	 (or on
	     (mapcar
	      (lambda (i) (put-text-property (car i) (caddr i) 'invisible nil))
	      x-face))
	 )))))