[Message Prev][Message Next][Thread Prev][Thread Next][Message Index][Thread Index]
[meadow-develop:1997/69]Where are logs of this ML?
- X-ml-count: 69
- Subject: [meadow-develop:1997/69]Where are logs of this ML?
- From: KORIYAMA Naohiro <koriyama@xxxxxxxxxxx>
- Date: Wed, 05 Nov 1997 16:51:54 +0900 (LMT)
- X-mailer: Mew version 1.92.1 on Emacs 20.2 / Mule 3.0 (MOMIJINOGA)
>>> Wed, 5 Nov 1997 16:07:23 +0900 (JST) の刻に 「つ」、すなわち
>>> zorac@xxxxxxxxxxxx(Hiroya Tsubakimoto) 氏曰く
つ> この辺が良く分からなかったのですが、Meadowではbitmapフォントを使って
つ> Inlineでx-faceの表示が出来るのでしょうか？
一応表示できてます。あと、x-face-mule.elを改造して、XEmacsのようにFrom
のところに表示するものを作っています。(まだalpha版程度の出来ですが。)
よかったら、試してみて下さい。
仮称 x-face-mule-ng.elです。
(x-face-mule no good... もとい next generations)
一応、Gnus5以降、Mew 1.92以降用の設定は作っています。他のMUAは使ってな
いので対応していませんが、簡単に対応出来ると思います。
もともと、Mew用に作ったもの(mew-xface-mule.el)を変数名とか変えてるだけ
です。
一応、x-face utilityのgeometry=MxNにも対応してます。
Gnusの場合、mime-view-content-header-filter-hookに
x-face-decode-message-headerが入っているとまずいので、remove-hook
しています。あと、TMとかSEMIを使っている人は、(mime-setup)してから、
(require 'x-face-mule-ng)などしたほうがよいと思います。
詳しくは、ソースを見てください。
不具合、バグ等ありましたら教えていただけるとうれしいです。
--
こおりやま
;;; x-face-mule-ng.el -- show X-Face in Mew message buffer for Emacs, MULE
;;; Original is x-face-mule.el, part of bitmap-mule package.
;;; Copyright (C) 1997 KORIYAMA Naohiro
;;; Author: KORIYAMA Naohiro <kory@xxxxxxxxxxxxxxxx>
;;; Version: 0.06
;;; Created: 1997/10/24
;;; Revised: 1997/11/03
;;; Keywords: X-Face, bitmap, Emacs, MULE
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;; [USAGE]
;;; 1. "bitmap-mule" package and related packages or
;;; "bitmap.tar.gz" (etl version bitmap.el) are required.
;;; also "compface.tar.gz" (uncompface) is required.
;;;
;;; 2. add the following in your .emacs
;;;
;;; (if window-system
;;; (progn
;;; ;; From: (default)
;;; ;(setq highlight-x-face-style 'from)
;;; (setq highlight-x-face-use-Mew t) ;;; for Mew 1.92 or later
;;; (setq highlight-x-face-use-Gnus t) ;;; for Gnus 5
;;; (require 'x-face-mule-ng)))
;;;
;;; If you use TM or SEMI, you should write "(mime-setup)" before this.
;;;
;;; 3. that's all!
;;;
;;; [CUSTOMIZATION]
;;; 1. If you don't want to show X-Face at "From:" field,
;;; add the following in your .emacs
;;; (setq highlight-x-face-style 'x-face)
;;; and you can show X-Face at "X-Face:" field.
;;; 2. If you want to change hilight color for X-Face,
;;; add like the following in your .emacs
;;; (setq highlight-x-face-fgcolor "Red") ;;; foreground color
;;; (setq highlight-x-face-bgcolor "Green") ;;; background color
;;;
;;; [USER FUNCTION]
;;; (toggle-x-face-type) toggle show method. from->x-face->nil->from...
;;;
;;; [TODO]
;;; 1. cool code!
;;; 2. and many many things
;;;
;;; [THANKS TO]
;;; OKUNISHI Fujikazu <fuji0924@xxxxxxxxxxxxxxxxxxxxx>
;;; Yuuichi Teranishi <teranisi@xxxxxxxxxxxxx>
;;; TSUMURA Tomoaki <tsumura@xxxxxxxxxxxxxxxxxx>
;;;
;;; Code:
(require 'bitmap)
(defvar uncompface-programm "uncompface")
(defvar highlight-x-face-style 'from
"*Where to show X-Face.
'from at From: field, 'x-face at X-Face: field.")
(defvar highlight-x-face-use-Mew nil
"* If use x-face-mule-ng with Mew 1.92, set non-nil to this variable.")
(defvar highlight-x-face-use-Gnus nil
"* If use x-face-mule-ng with Gnus 5, set non-nil to this variable.")
;;; for Mew version 1.92 or later
(if highlight-x-face-use-Mew
(progn
(setq mew-opt-highlight-x-face t)
(setq mew-opt-highlight-x-face-function
(function
(lambda (beg end)
(interactive)
(if (and window-system mew-opt-highlight-x-face)
(cond
((memq highlight-x-face-style '(from x-face))
(x-face-decode-message-header-ng beg end)))))))))
;;; for Gnus 5 or later (?)
(if highlight-x-face-use-Gnus
(progn
(remove-hook 'mime-view-content-header-filter-hook 'x-face-decode-message-header) ;;; not to use x-face-decode-message-header in "x-face-mule.el"
(require 'gnus)
(add-hook 'gnus-article-display-hook
(function
(lambda ()
(x-face-decode-message-header-ng (point-min) (point-max)))) t)))
;;
;; highlihgt face for X-Face
;;
(defvar highlight-x-face nil)
(defvar highlight-x-face-fgcolor "Black")
(defvar highlight-x-face-bgcolor "White")
(defun x-face-make-face ()
(set 'highlight-x-face 'highlight-x-face)
(copy-face 'default highlight-x-face)
(set-face-foreground highlight-x-face highlight-x-face-fgcolor)
(set-face-background highlight-x-face highlight-x-face-bgcolor))
(if highlight-x-face ;; make face for x-face if not defined.
()
(x-face-make-face))
;; functions
;;; toggle x-face-style
(defun toggle-x-face-style ()
(interactive)
(cond ((equal highlight-x-face-style 'from)
(message "Show X-Face at X-Face:")
(setq highlight-x-face-style 'x-face))
((equal highlight-x-face-style 'x-face)
(message "Don't Show X-Face")
(setq highlight-x-face-style nil))
(t
(message "Show X-Face at From:")
(setq highlight-x-face-style 'from))))
;;
;; originate from 'x-face-decode-message-header () in x-face-mule-ng.el
;;
(defun x-face-convert-x-face-to-icon (string)
"decode x-face string to UN|X ICON."
(save-excursion
(let ((tmp-buffer (get-buffer-create "*x-face-tmp*"))
ret-string)
(set-buffer tmp-buffer)
(insert string)
(call-process-region (point-min) (point-max)
uncompface-programm t t nil)
(setq ret-string (buffer-substring (point-min) (point-max)))
(kill-buffer tmp-buffer)
ret-string
)))
(defun x-face-convert-vector-to-rectangle (vector)
"make x-face rectangle from vector."
(let ((ret nil)
line i k k+6)
(setq k 0)
(setq i 0)
(while (< i 3)
(setq line "")
(setq k (* i 6) k+6 (+ k 6))
(while (< k k+6)
(setq line (concat line (bitmap-compose (aref vector k))))
(setq k (1+ k))
)
(setq ret (append ret (list line)))
(setq i (1+ i)))
ret
))
(defun x-face-convert-icon-to-rectangle (icon)
"decode UN|X ICON to rectangle."
(save-excursion
(let ((tmp-buffer (get-buffer-create "*x-face-tmp*"))
i temp cmp k k+6)
(set-buffer tmp-buffer)
(insert icon)
(goto-char (point-min))
(search-forward "0x" nil t)
(setq cmp (make-vector 18 nil))
(setq i 0)
(while (< i 48)
(setq k (* (/ i 16) 6))
(setq k+6 (+ k 6))
(while (< k k+6)
(setq temp (buffer-substring (point)
(+ (point) 2)))
(aset cmp k (concat (aref cmp k) temp))
(setq k (1+ k))
(setq temp (buffer-substring (+ (point) 2)
(+ (point) 4)))
(aset cmp k (concat (aref cmp k) temp))
(setq k (1+ k))
(search-forward "0x" nil t))
(setq i (1+ i))
)
(kill-buffer tmp-buffer)
(x-face-convert-vector-to-rectangle cmp))))
(defun x-face-insert-at-point (rectangle)
"insert x-face rectangle and overlay its face."
(let ((lines rectangle)
(insertcolumn (current-column))
(first t)
beg-point)
(while lines
(or first
(progn
(forward-line 1)
(or (bolp) (insert ?\n))
(if (fboundp 'move-to-column-strictly)
(move-to-column-strictly insertcolumn t) ;; XEmacs only ??
(move-to-column insertcolumn t)) )) ;; text Emacs
(setq first nil)
(setq beg-point (point))
(insert (car lines))
(overlay-put (make-overlay beg-point (point)) 'face highlight-x-face)
(setq lines (cdr lines)))))
(defun x-face-allocate-lines (beg end height)
"allocate new lines according to highlight-x-face-style.
returns the begin-point of the x-face rectangle."
(let (begin-point n)
(cond
((eq highlight-x-face-style 'from)
(goto-char beg)
(if (re-search-forward "^From:" end t)
(progn
(beginning-of-line)
(insert " ")
(setq begin-point (point))
(insert "\n \n")
(setq n 0)
(while (< n (- height 1))
(insert " \n \n \n")
(setq n (1+ n)))
)))
((eq highlight-x-face-style 'x-face)
(insert "X-Face: ")
(setq begin-point (point))
(setq n 0)
(while (< n height)
(insert " \n \n \n")
(setq n (1+ n)))
))
begin-point ;; return value.
))
(defun x-face-decode-message-header-ng (beg end)
(let ((buffer-read-only nil) x-face faces faces-s first)
(setq geometry (analyze-x-face-geometry beg end))
(setq xp (string-match "x" geometry))
(setq M (string-to-number (substring geometry 0 xp)))
(setq N (string-to-number (substring geometry (1+ xp))))
(goto-char beg)
(setq n 0)
(while (< n N)
(setq m 0)
(while (< m M)
(re-search-forward
"^X-Face: *\\(.*\\(\n[ \t].*\\)*\\)\n" end t)
(setq faces-s (cons
(buffer-substring (match-beginning 1) (match-end 1))
faces-s
))
(delete-region (match-beginning 0) (match-end 0))
(setq m (1+ m)))
(setq faces (append faces faces-s))
(setq faces-s nil)
(setq n (1+ n)))
;;
(setq first t)
(let (begin-point m n)
(setq n 0)
(while (< n N)
(setq m 0)
(while (< m M)
(setq x-face
(x-face-convert-icon-to-rectangle
(x-face-convert-x-face-to-icon (car faces))))
(if first ;; allocate lines for face field
(setq begin-point (x-face-allocate-lines beg end N)))
(goto-char begin-point)
(x-face-insert-at-point x-face)
(setq faces (cdr faces))
(setq first nil)
(setq m (1+ m)))
(setq n (1+ n))
(if (< n N)
(progn
(end-of-line 2)
(setq begin-point (point))))
))))
(defun analyze-x-face-geometry (beg end)
(goto-char beg)
(if (re-search-forward
"^X-Face-Type: geometry=[0-9]+x[0-9]+" end t)
(let ((sp (+ 22 (match-beginning 0))) (ep (match-end 0)))
(buffer-substring sp ep))
(let ((i 0))
(while (re-search-forward
"^X-Face: *\\(.*\\(\n[ \t].*\\)*\\)\n" end t)
(setq i (1+ i)))
(concat i "x1"))))
(provide 'x-face-mule-ng)
;;; x-face-mule-ng.el ends here