[Mew-dist 1588] select-xface
Yuuichi Teranishi 寺西裕一
teranisi at example.com
1997年 8月 22日 (金) 12:35:38 JST
寺西＠ＮＴＴ情報研です。
こないだここで出ていた x-face 関連の話題で、
かずさん> c-sig のようにくるくるまわせるといいと思います。XEmacs だと選択
かずさん> のときに、バッファーに絵を表示してくれると嬉しいな。
というかずさんのお言葉を見て、むしょうに欲しくなってしまい、
3 時間ほど elisp と格闘してそれっぽいのを作ってみました。
＃ 海外出張前で忙しいのに...:-)。
X-Face-Utility のことはよく知らないのですが、もしかしたら
こういうのは既にある機能だったでしょうか？
以下、使い方:
＃ XEmacs 以外では動きません。
1. 次のパートを select-xface.el として load-path のどこかに置きます。
2. ホームディレクトリに .xfaces というディレクトリをつくります。
3. 2. の .xfaces ディレクトリに、候補にする複数の xface ファイル
を置きます。ファイル名は何でもいいです。
ちなみにぼくの .xfaces は、こんなかんじです。
% ls ~/.xfaces/
angry laugh normal
normal の中身:
--ここから--
03C/yqeE_(Zt at example.com\)0fxhT=lLIuKJta/Sj<*DS_Q,"j&y-h|uJ]TaIuL_x5 at example.com|#+rx|
`W2z%G`\W{p>(FmB61%|"qcI|?#CP05 at example.com?|jU.\A9le6f|+mQ7ShQS.Gd~t9vT<5?Y9$F_GmF$#RRF
0xHeO."!N[wDl)B|0?/Qtn[LI&has6UQe_NYaStsZb;K"TE_}X9YjG[)YU*7K
--ここまで--
4. .emacs に以下の設定をします。
(require 'select-xface)
(add-hook 'mew-draft-mode-hook
(lambda ()
(define-key mew-draft-mode-map "\C-c\C-x"
'select-xface)))
5. Mew の Draftモードで
* C-c C-x をおすと、顔の候補の絵がポップアップします。
* C-p, C-n で次/前の候補になります。
* リターンキーで決定します。
* C-g でやめられます。
既に X-Face: フィールドが存在する場合は、その顔が最初に現れます。
.xfaces に同じ顔の候補が複数ある場合は、それらは 1 つの候補になります。
いちおう手元の XEmacs-20.3b18, XEmacs-20.2 で動作確認しました。
なけなしの elisp power なのであやしいことをしているかも知れませんが
ゆるしてください。
--
Yuuichi Teranishi (寺西裕一) <teranisi at example.com>
NTT Information and Communication Systems Laboratories
TEL: 0468-59-2839 FAX: 0468-59-2768 PHS: 050-106-7597
MyCar: RAV4J (23903km since Nov.1995)
-------------- next part --------------
;; select-xface.el --- select xfaces graphically in XEmacs.
;; Copyright (C) 1997 Yuuichi Teranishi
;; Author: Yuuichi Teranishi <teranisi at example.com>
;; Maintainer: Yuuichi Teranishi <teranisi at example.com>
;; Version: 0.01
;; Created: 22 Aug 1997
;; Date: 22 Aug 1997
;; Select-XFace 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
;; any later version.
;; Select-XFace 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.
;;
;; Setup:
;;
;; For Mew:
;; (require 'select-xface)
;; (add-hook 'mew-draft-mode-hook
;; (lambda ()
;; (define-key mew-draft-mode-map "\C-c\C-x"
;; 'select-xface)))
;;
(defconst select-xface-version "select-xface.el version 0.01")
(provide 'select-xface)
(require 'highlight-headers)
;;
;; Users may set these variables
;;
(defvar select-xface-directory "~/.xfaces"
"Files in this directory become the candidates.")
(defvar select-xface-file-list nil
"An ordered list of xface files in the select-xface-directory.")
(defvar select-xface-height 4
"select-xface buffer height")
(defvar select-xface-field-insert-before "X-Mailer:"
"Insert xface field before this field")
(defvar select-xface-mode-hook nil
"Hooks to be called after select-xface-mode starts.")
;;
;; No setting is needed for these variables.
;;
(defvar select-xface-current-list-pos 0
"current list position of select-xface-face-list")
(defvar select-xface-face-list nil)
(defvar select-xface-entry-num 0)
(defvar select-xface-buffer "Select-X-Face")
(defvar select-xface-mode-map nil)
(if select-xface-mode-map
nil
(setq select-xface-mode-map (make-sparse-keymap))
(define-key select-xface-mode-map "p" 'select-xface-prev-face)
(define-key select-xface-mode-map "\C-p" 'select-xface-prev-face)
(define-key select-xface-mode-map "n" 'select-xface-next-face)
(define-key select-xface-mode-map "\C-n" 'select-xface-next-face)
(define-key select-xface-mode-map "\C-m" 'select-xface-out)
(define-key select-xface-mode-map "q" 'select-xface-exit)
(define-key select-xface-mode-map "\C-g" 'select-xface-exit)
)
(defun select-xface-mode ()
"Major mode for inserting X-Face: field in the current draft buffer.
RET select-xface-out
C-n select-xface-next-face
n select-xface-next-face
C-p select-xface-prev-face
p select-xface-prev-face
C-g select-xface-exit"
(interactive)
(setq major-mode 'select-xface-mode)
(setq mode-name "Select X-Face")
(use-local-map select-xface-mode-map)
(run-hooks 'select-xface-mode-hook))
(defun select-xface-out ()
(interactive)
(save-window-excursion
(delete-window)
(save-excursion
(goto-char (point-min))
(if (re-search-forward
"^\\(X-Face:\\) *\\(.*\\(\n[ \t].*\\)*\\)\n" nil t)
(progn
(delete-region (match-beginning 2)
(+ 1 (match-end 2)))
(insert-buffer select-xface-buffer)
(goto-char (mark))
(insert "\n")
)
(progn
(goto-char (point-min))
(search-forward select-xface-field-insert-before nil t)
(beginning-of-line)
(insert "X-Face: ")
(insert-buffer select-xface-buffer)
(goto-char (mark))
(insert "\n")
))))
(select-xface-exit))
(defun select-xface-next-face ()
(interactive)
(if (= 0 select-xface-current-list-pos)
(select-xface-set-list-pos (1- select-xface-entry-num))
(select-xface-set-list-pos (1- select-xface-current-list-pos))))
(defun select-xface-prev-face ()
(interactive)
(if (= select-xface-current-list-pos (1- select-xface-entry-num))
(select-xface-set-list-pos 0)
(select-xface-set-list-pos (1+ select-xface-current-list-pos))))
(defun select-xface-set-list-pos (pos)
(setq select-xface-current-list-pos pos)
;; (message (format "%d th entry." pos))
(let ((buffer-read-only nil)
(xface nil)
)
(erase-buffer)
(insert (nth pos select-xface-face-list))
(setq xface (highlight-headers-x-face-to-pixmap
(point-min)
(point-max)))
(if xface
(progn
(set-extent-end-glyph
(make-extent (point-max) (point-max)) xface)
(set-extent-property
(make-extent (point-min) (point-max)) 'invisible t)
)
)))
(defun select-xface-make-face-list (default)
(save-excursion
(let ((alist nil)
(face nil)
(found nil)
(falist select-xface-file-list)
(tmp-buffer (get-buffer-create "*Select XFace*"))
curface)
(if default
(progn
(setq alist (list default))
(setq select-xface-entry-num 1)))
(set-buffer tmp-buffer)
(while falist
(erase-buffer tmp-buffer)
(insert-file-contents (expand-file-name (car falist)
select-xface-directory))
;; reduce a newline character in the end of buffer.
(if (char-equal (char-before (point-max)) ?\n)
(progn
(goto-char (1- (point-max)))
(delete-char 1)))
(setq curface (buffer-substring (point-min) (point-max)))
;; if the same face is already in the list, setq found t.
(let ((cur alist))
(while cur
(if (string= (car alist) curface)
(setq found t))
(setq cur (cdr cur))))
(if (not found)
(progn
(setq select-xface-entry-num (1+ select-xface-entry-num))
(if alist
(setq alist (append alist (list curface)))
(setq alist (list curface)))))
(setq found nil)
(setq falist (cdr falist))
)
(kill-buffer tmp-buffer)
alist ;return value
)))
(defun select-xface ()
"select xfaces graphically"
(interactive)
(setq select-xface-entry-num 0)
(setq select-xface-parent-buffer (buffer-name))
(save-excursion
(goto-char (point-min))
(setq select-xface-current-entry
(if (re-search-forward
"^\\(X-Face:\\) *\\(.*\\(\n[ \t].*\\)*\\)\n" nil t)
(buffer-substring (match-beginning 2)
(match-end 2))
nil)))
;; if select-xface-file-list is nil, all files
;; in the select-xface-directory became the candidate.
(if (not select-xface-file-list)
(progn
(setq select-xface-file-list (directory-files
select-xface-directory))
(setq select-xface-file-list
(delete "." select-xface-file-list))
(setq select-xface-file-list
(delete ".." select-xface-file-list))))
(setq select-xface-face-list
(select-xface-make-face-list select-xface-current-entry))
(if select-xface-face-list
(progn
(setq select-xface-orig-window-config (current-window-configuration))
(if (get-buffer select-xface-buffer)
(pop-to-buffer select-xface-buffer)
(let* ()
(pop-to-buffer select-xface-buffer)
(enlarge-window (- select-xface-height (window-height)))
(select-xface-set-list-pos 0)
(toggle-read-only)))
(select-xface-mode))
(message "No X-Face candidates.")))
(defun select-xface-exit ()
(interactive)
(pop-to-buffer select-xface-parent-buffer)
(set-window-configuration select-xface-orig-window-config)
(kill-buffer select-xface-buffer)
(let ((highlight-headers-hack-x-face-p nil))
(highlight-headers (point-min) (point-max) nil))
; (goto-char (point-max))
)
Mew-dist メーリングリストの案内