From: morioka Date: Mon, 9 Mar 1998 07:59:10 +0000 (+0000) Subject: tm 6.92. X-Git-Tag: tm6_92~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b179f4a4cadf140ecea4ac8714e8dab808f79862;p=elisp%2Ftm.git tm 6.92. --- diff --git a/Changes-6.89-6.92.en b/Changes-6.89-6.92.en new file mode 100644 index 0000000..18b4e7a --- /dev/null +++ b/Changes-6.89-6.92.en @@ -0,0 +1,65 @@ +* tm + +tm/tm-def.el +---------------------------- +revision 6.6 +date: 1995/09/24 22:24:17; author: morioka; state: Exp; lines: +9 -4 +Function `tm:browse-url' was defined. +---------------------------- +revision 6.5 +date: 1995/09/24 20:19:02; author: morioka; state: Exp; lines: +14 -4 +Function `tm:button-dispatcher' was modified to call variable +`tm:mother-button-dispatcher' when tm-callback is not found. +---------------------------- +revision 6.4 +date: 1995/09/22 00:08:37; author: morioka; state: Exp; lines: +14 -1 +Variable `tm:URL-regexp' and variable `browse-url-browser-function' +are defined. +---------------------------- + +tm/tm-view.el +---------------------------- +revision 6.92 +date: 1995/09/24 22:25:24; author: morioka; state: Exp; lines: +2 -2 +Function `tm:browse-url' was called instead of variable +`browse-url-browser-function'. +---------------------------- +revision 6.91 +date: 1995/09/24 20:16:11; author: morioka; state: Exp; lines: +16 -10 +Some functions were added optional arguments to specify article-buffer +and preview-buffer. It is to support preview buffer support feature of +September Gnus. +---------------------------- +revision 6.90 +date: 1995/09/22 00:02:55; author: morioka; state: Exp; lines: +41 -25 +(1) Does not decode X-Face automatically. New command + `mime-viewer/display-x-face' to decode X-Face was bound to `f' key + of mime/viewer-mode. +(2) If variable `browse-url-browser-function' is set, button to call + it is set for URL regions of text/plain contents. +---------------------------- +revision 6.89 +date: 1995/09/21 23:20:55; author: morioka; state: Exp; lines: +4 -6 +Format of variable `mime-viewer/ignored-field-regexp' was changed. Its +head is `^', bottom is `:'. +---------------------------- + + +* tm/gnus + + Attached version 6.23. + +tm/gnus/tm-gnus.el +---------------------------- +revision 6.4 +date: 1995/09/24 20:22:40; author: morioka; state: Exp; lines: +5 -2 +(require 'tm-sgnus) when September Gnus. +---------------------------- + +tm/gnus/tm-sgnus.el +---------------------------- +revision 6.23 +date: 1995/09/24 20:20:32; author: morioka; state: Exp; +It was created for September Gnus. +Notice that it needs September Gnus v0.02 or later. +---------------------------- diff --git a/Changes-6.89-6.92.ja b/Changes-6.89-6.92.ja new file mode 100644 index 0000000..b576f83 --- /dev/null +++ b/Changes-6.89-6.92.ja @@ -0,0 +1,64 @@ +* tm + +tm/tm-def.el +---------------------------- +revision 6.6 +date: 1995/09/24 22:24:17; author: morioka; state: Exp; lines: +9 -4 +関数 tm:browse-url を定義した。 +---------------------------- +revision 6.5 +date: 1995/09/24 20:19:02; author: morioka; state: Exp; lines: +14 -4 +変数 tm:mother-button-dispatcher を追加し、tm-callback が見つからない +時これを呼ぶように、関数 tm:button-dispatcher を修正した。 +---------------------------- +revision 6.4 +date: 1995/09/22 00:08:37; author: morioka; state: Exp; lines: +14 -1 +変数 tm:URL-regexp と変数 browse-url-browser-function を定義した。 +---------------------------- + +tm/tm-view.el +---------------------------- +revision 6.92 +date: 1995/09/24 22:25:24; author: morioka; state: Exp; lines: +2 -2 +変数 browse-url-browser-function を直接呼ぶ代わりに、関数 +tm:browse-url を呼ぶようにした。 +---------------------------- +revision 6.91 +date: 1995/09/24 20:16:11; author: morioka; state: Exp; lines: +16 -10 +September Gnus に対応するため、optional 変数として article-buffer と +preview-buffer を指定できるようにした。 +---------------------------- +revision 6.90 +date: 1995/09/22 00:02:55; author: morioka; state: Exp; lines: +41 -25 +(1) 自動的に X-Face を decode するのはやめ、mime/viewer-mode の `f' + key に decode するための command `mime-viewer/display-x-face' を + bind した。 +(2) もし、変数 browse-url-browser-function が設定されていれば、 + text/plain content の URL に対して、これを呼ぶ button を設定するよ + うにした。 +---------------------------- +revision 6.89 +date: 1995/09/21 23:20:55; author: morioka; state: Exp; lines: +4 -6 +変数 mime-viewer/ignored-field-regexp の先頭に `^', 末尾に `:' を付け +るようにした。 +---------------------------- + + +* tm/gnus + + Version 6.23 を添付した。 + +tm/gnus/tm-gnus.el +---------------------------- +revision 6.4 +date: 1995/09/24 20:22:40; author: morioka; state: Exp; lines: +5 -2 +September Gnus の時 tm-sgnus を require するようにした。 +---------------------------- + +tm/gnus/tm-sgnus.el +---------------------------- +revision 6.23 +date: 1995/09/24 20:20:32; author: morioka; state: Exp; +September Gnus 用の module として新設した。 +September Gnus v0.02 以降が必要なので注意すること。 +---------------------------- diff --git a/Makefile b/Makefile index 77bde7a..d2136b3 100644 --- a/Makefile +++ b/Makefile @@ -33,7 +33,7 @@ TL_FILES = tl/README.eng tl/Makefile tl/mk-tl tl/*.el tl/doc/*.texi FILES = $(TM_FILES) $(TM_MUA_FILES) $(MEL_FILES) $(TL_FILES) -TARFILE = tm6.88.tar +TARFILE = tm6.92.tar nemacs: diff --git a/gnus/Makefile b/gnus/Makefile index 8d576e7..8936255 100644 --- a/gnus/Makefile +++ b/gnus/Makefile @@ -1,5 +1,5 @@ # -# $Id: Makefile,v 6.3 1995/06/17 18:54:48 morioka Exp morioka $ +# $Id: Makefile,v 6.4 1995/09/24 20:23:39 morioka Exp morioka $ # # Please specify emacs executables: @@ -17,7 +17,7 @@ TMDIR19 = $(HOME)/lib/emacs19/lisp FILES = tm/gnus/*.el tm/doc/tm-gnus*.texi -TARFILE = tm-gnus6.22.1.tar +TARFILE = tm-gnus6.23.tar gnus3: @@ -32,6 +32,9 @@ dgnus: gnus5: $(EMACS) -batch -l g5-path -l mk-tgnus -f compile-tm-gnus +sgnus: + $(EMACS) -batch -l s-path -l mk-tgnus -f compile-tm-gnus + install-18: $(EMACS) -batch -l g3-path -l mk-tgnus -f install-tm-gnus $(TMDIR18) diff --git a/gnus/mk-tgnus b/gnus/mk-tgnus index 0d27d1e..c6005bc 100644 --- a/gnus/mk-tgnus +++ b/gnus/mk-tgnus @@ -19,6 +19,9 @@ ) ((string-match "Gnus v5" gnus-version) (byte-compile-file "tm-gnus5.el") + ) + ((string-match "September Gnus" gnus-version) + (byte-compile-file "tm-sgnus.el") )) (byte-compile-file "tm-gnus.el") ) @@ -72,11 +75,11 @@ ) (progn (install-el-files path - "tm-gnus.el" "tm-gnus5.el" - "tm-dgnus.el" + "tm-gnus.el" "tm-sgnus.el" + "tm-gnus5.el" "tm-dgnus.el" "tm-ognus.el" "tm-gnus4.el") (install-elc-files path - "tm-gnus.elc" "tm-gnus5.elc" - "tm-dgnus.elc" + "tm-gnus.elc" "tm-sgnus.elc" + "tm-gnus5.elc" "tm-dgnus.elc" "tm-gnus4.elc") )))) diff --git a/gnus/s-path b/gnus/s-path new file mode 100644 index 0000000..bc9ea48 --- /dev/null +++ b/gnus/s-path @@ -0,0 +1,17 @@ +;;; -*-Emacs-Lisp-*- + +(setq load-path + (append + (mapcar (function + (lambda (path) + (expand-file-name path (getenv "PWD")) + )) + '("." ".." "../../tl/" "../../mel/")) + ;; + ;; (ding) GNUS path + ;; + ;; please edit this + ;; + '("/usr/local/lib/emacs/site-lisp/sgnus/lisp") + ;; + load-path)) diff --git a/gnus/tm-gnus.el b/gnus/tm-gnus.el index 59782c5..5e0df97 100644 --- a/gnus/tm-gnus.el +++ b/gnus/tm-gnus.el @@ -6,7 +6,7 @@ ;;; ;;; Author: Morioka Tomohiko ;;; Version: -;;; $Id: tm-gnus.el,v 6.3 1995/09/21 02:59:55 morioka Exp $ +;;; $Id: tm-gnus.el,v 6.4 1995/09/24 20:22:40 morioka Exp $ ;;; Keywords: news, MIME, multimedia, encoded-word, multilingual ;;; ;;; This file is part of tm (Tools for MIME). @@ -33,8 +33,11 @@ ((string-match "(ding)" gnus-version) (require 'tm-dgnus) ) - ((string-match "^Gnus v5\\|^September Gnus" gnus-version) + ((string-match "^Gnus v5" gnus-version) (require 'tm-gnus5) + ) + ((string-match "^September Gnus" gnus-version) + (require 'tm-sgnus) )) diff --git a/gnus/tm-sgnus.el b/gnus/tm-sgnus.el new file mode 100644 index 0000000..abc4cf4 --- /dev/null +++ b/gnus/tm-sgnus.el @@ -0,0 +1,153 @@ +;;; +;;; tm-sgnus.el --- tm-gnus module for September GNUS +;;; + +(require 'tl-str) +(require 'tl-list) +(require 'tl-misc) +(require 'gnus) + + +;;; @ version +;;; + +(defconst tm-gnus/RCS-ID + "$Id: tm-sgnus.el,v 6.23 1995/09/24 20:20:32 morioka Exp $") + +(defconst tm-gnus/version + (concat (get-version-string tm-gnus/RCS-ID) " for September")) + + +;;; @ autoload +;;; + +(autoload 'mime/viewer-mode "tm-view" "View MIME message." t) +(autoload 'mime/decode-message-header + "tiny-mime" "Decode MIME encoded-word." t) +(autoload 'mime/decode-string "tiny-mime" "Decode MIME encoded-word." t) + + +;;; @ variables +;;; + +(defvar tm-gnus/decode-all t + "If it is non-nil and +tm-gnus/automatic-MIME-preview-support is non-nil, +article is automatic MIME decoded.") + + +;;; @ command functions +;;; + +(defun tm-gnus/view-message (arg) + "MIME decode and play this message." + (interactive "P") + (let ((gnus-break-pages nil)) + (gnus-summary-select-article t t) + ) + (pop-to-buffer gnus-original-article-buffer t) + (let (buffer-read-only) + (if (text-property-any (point-min) (point-max) 'invisible t) + (remove-text-properties (point-min) (point-max) + gnus-hidden-properties) + )) + (mime/viewer-mode) + ) + +(defun tm-gnus/summary-scroll-down () + "Scroll down one line current article." + (interactive) + (gnus-summary-scroll-up -1) + ) + +(define-key gnus-summary-mode-map "v" (function tm-gnus/view-message)) +(define-key gnus-summary-mode-map + "\e\r" (function tm-gnus/summary-scroll-down)) + + +;;; @ for tm-view +;;; + +(defun mime-viewer/quitting-method-for-sgnus () + (mime-viewer/kill-buffer) + (delete-other-windows) + (gnus-article-show-summary) + (gnus-summary-display-article (gnus-summary-article-number)) + ) + +(call-after-loaded + 'tm-view + (function + (lambda () + (set-alist 'mime-viewer/quitting-method-alist + 'fundamental-mode + (function mime-viewer/quitting-method-for-sgnus)) + (set-alist 'tm:callback-property-alist + 'fundamental-mode 'gnus-callback) + (set-alist 'tm:data-property-alist + 'fundamental-mode 'gnus-data) + ))) + + +;;; @ summary filter +;;; + +(defun tm-gnus/decode-summary-from-and-subjects () + (mapcar (function + (lambda (header) + (mail-header-set-from + header + (mime/decode-string (or (mail-header-from header) "")) + ) + (mail-header-set-subject + header + (mime/decode-string (or (mail-header-subject header) "")) + ) + )) + gnus-newsgroup-headers) + ) + +(add-hook 'gnus-select-group-hook + (function tm-gnus/decode-summary-from-and-subjects)) + + +;;; @ article filter +;;; + +(defun tm-gnus/preview-article () + (let (mime-viewer/ignored-field-list) + (make-local-variable 'tm:mother-button-dispatcher) + (setq tm:mother-button-dispatcher + (function gnus-article-push-button)) + (mime/viewer-mode nil nil nil gnus-original-article-buffer + gnus-article-buffer) + )) + +(defun tm-gnus/set-mime-method (mode) + (setq gnus-show-mime-method + (if mode + (function tm-gnus/preview-article) + (function mime/decode-message-header) + ))) + +(tm-gnus/set-mime-method tm-gnus/decode-all) + +(setq gnus-show-mime t) + + +;;; @ for tm-comp +;;; + +(call-after-loaded + 'tm-comp + (lambda () + (set-alist 'mime/message-sender-alist + 'news-reply-mode + (function gnus-inews-news)) + )) + + +;;; @ end +;;; + +(provide 'tm-sgnus) diff --git a/methods/tm-au b/methods/tm-au index 255d9a4..b454c28 100755 --- a/methods/tm-au +++ b/methods/tm-au @@ -6,7 +6,7 @@ fi case "$4" in "play") - filename = /dev/audio + filename=/dev/audio ;; "extract") if [ "$5" = "" ]; then diff --git a/mh-e/tm-mh-e.el b/mh-e/tm-mh-e.el index 287b5b0..a64edb1 100644 --- a/mh-e/tm-mh-e.el +++ b/mh-e/tm-mh-e.el @@ -26,7 +26,7 @@ ;;; (defconst tm-mh-e/RCS-ID - "$Id: tm-mh-e.el,v 6.32 1995/09/21 00:20:10 morioka Exp $") + "$Id: tm-mh-e.el,v 6.34 1995/09/22 00:07:42 morioka Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) @@ -225,11 +225,8 @@ With arg, turn MIME processing on if arg is positive." (symbol-function 'mime/code-convert-region-to-emacs)) (defun tm-mh-e/content-header-filter () - (mime-viewer/x-face-function) (goto-char (point-min)) - (while (and (re-search-forward - (concat "^" mime-viewer/ignored-field-regexp ":") - nil t) + (while (and (re-search-forward mime-viewer/ignored-field-regexp nil t) (progn (delete-region (match-beginning 0) diff --git a/mk-tm b/mk-tm index e5b08ed..3c371cd 100644 --- a/mk-tm +++ b/mk-tm @@ -1,6 +1,6 @@ ;;; -*-Emacs-Lisp-*- ;;; -;;; $Id: mk-tm,v 2.0 1995/09/04 00:50:39 morioka Exp morioka $ +;;; $Id: mk-tm,v 3.0 1995/09/24 20:41:39 morioka Exp morioka $ ;;; (setq load-path (append @@ -30,7 +30,7 @@ )) '("signature" "tiny-mime" "tm-def" "tm-view" - "tm-latex" "tm-w3" + "tm-latex" "tm-w3" "tm-tar" "tm-rmail" "tm-comp" "tm-setup" "mime-setup" )) diff --git a/tm-def.el b/tm-def.el index db57699..5b6d5fb 100644 --- a/tm-def.el +++ b/tm-def.el @@ -6,7 +6,7 @@ ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: tm-def.el,v 6.3 1995/09/21 00:12:52 morioka Exp $ +;;; $Id: tm-def.el,v 6.6 1995/09/24 22:24:17 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia, definition ;;; ;;; This file is part of tm (Tools for MIME). @@ -38,6 +38,10 @@ (t (require 'tm-orig)) ) + +;;; @ button +;;; + (defun tm:set-face-region (b e face) (let ((overlay (tl:make-overlay b e))) (tl:overlay-put overlay 'face face) @@ -58,14 +62,38 @@ )) ) +(defvar tm:mother-button-dispatcher nil) + (defun tm:button-dispatcher (event) "Select the button under point." (interactive "e") (mouse-set-point event) - (let ((func (get-text-property (point) 'tm-callback))) + (let ((func (get-text-property (point) 'tm-callback)) + (data (get-text-property (point) 'tm-data)) + ) (if func - (call-interactively func) - ))) + (apply func data) + (if (fboundp tm:mother-button-dispatcher) + (funcall tm:mother-button-dispatcher event) + ) + ))) + + +;;; @ for URL +;;; + +(defvar tm:URL-regexp + "\\(http\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]") + +(defvar browse-url-browser-function nil) + +(defun tm:browse-url () + (if (fboundp browse-url-browser-function) + (call-interactively browse-url-browser-function) + (if (fboundp tm:mother-button-dispatcher) + (funcall tm:mother-button-dispatcher event) + ) + )) ;;; @ definitions about MIME diff --git a/tm-view.el b/tm-view.el index 730e261..6c86489 100644 --- a/tm-view.el +++ b/tm-view.el @@ -27,7 +27,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 6.88 1995/09/21 02:33:28 morioka Exp $") + "$Id: tm-view.el,v 6.92 1995/09/24 22:25:24 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -218,34 +218,9 @@ ;;; @@ content header filter ;;; -;;; @@@ X-Face -;;; - -;; hack from Gnus 5.0.4. - -(defvar mime-viewer/x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" - "String to be executed to display an X-Face field. -The command will be executed in a sub-shell asynchronously. -The compressed face will be piped to this command.") - -(defun mime-viewer/x-face-function () - "Function to display X-Face field. You can redefine to customize." - (goto-char (point-min)) - (if (re-search-forward "^X-Face:[ \t]*" nil t) - (let ((beg (match-end 0)) - (end (message/field-end)) - ) - (call-process-region beg end "sh" nil 0 nil - "-c" mime-viewer/x-face-command) - ))) - (defun mime-viewer/default-content-header-filter () - (mime-viewer/x-face-function) (goto-char (point-min)) - (while (and (re-search-forward - (concat "^" mime-viewer/ignored-field-regexp ":") - nil t) + (while (and (re-search-forward mime-viewer/ignored-field-regexp nil t) (progn (delete-region (match-beginning 0) @@ -316,6 +291,29 @@ The compressed face will be piped to this command.") )) +;;; @@ X-Face +;;; + +;; hack from Gnus 5.0.4. + +(defvar mime-viewer/x-face-command + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" + "String to be executed to display an X-Face field. +The command will be executed in a sub-shell asynchronously. +The compressed face will be piped to this command.") + +(defun mime-viewer/x-face-function () + "Function to display X-Face field. You can redefine to customize." + (goto-char (point-min)) + (if (re-search-forward "^X-Face:[ \t]*" nil t) + (let ((beg (match-end 0)) + (end (message/field-end)) + ) + (call-process-region beg end "sh" nil 0 nil + "-c" mime-viewer/x-face-command) + ))) + + ;;; @ data structures ;;; @@ -333,10 +331,15 @@ The compressed face will be piped to this command.") ;;; @ parser ;;; -(defun mime-viewer/parse-message (&optional ctl encoding) +(defun mime-viewer/parse-message (&optional ctl encoding ibuf obuf) + (if ibuf + (set-buffer ibuf) + (setq ibuf (current-buffer)) + ) (make-variable-buffer-local 'mime::article/content-info) (setq mime::article/content-info (mime-viewer/parse ctl encoding)) - (let ((ret (mime-viewer/make-preview-buffer))) + (let ((ret (mime-viewer/make-preview-buffer + ibuf mime::article/content-info obuf))) (make-variable-buffer-local 'mime::article/preview-buffer) (setq mime::article/preview-buffer (car ret)) ret)) @@ -968,7 +971,13 @@ it is regarded as current-buffer. [tm-view]" (if (not (eq (char-after (1- (point))) ?\n)) (insert "\n") ) - ;;(hide-sublevels 1) + (if browse-url-browser-function + (save-excursion + (goto-char (point-min)) + (while (re-search-forward tm:URL-regexp nil t) + (tm:add-button (match-beginning 0)(match-end 0) + (function tm:browse-url)) + ))) (run-hooks 'mime-viewer/plain-text-preview-hook) ) @@ -1004,6 +1013,8 @@ it is regarded as current-buffer. [tm-view]" (define-key mime/viewer-mode-map "\C-c\C-p" (function mime-viewer/print-content)) (define-key mime/viewer-mode-map + "f" (function mime-viewer/display-x-face)) + (define-key mime/viewer-mode-map "q" (function mime-viewer/quit)) (define-key mime/viewer-mode-map "\C-c\C-x" (function mime-viewer/kill-buffer)) @@ -1013,7 +1024,7 @@ it is regarded as current-buffer. [tm-view]" ) )) -(defun mime/viewer-mode (&optional mother ctl encoding) +(defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf) "Major mode for viewing MIME message. Here is a list of the standard keys for mime/viewer-mode. @@ -1032,6 +1043,7 @@ M-RET Move to previous line v Decode current content as `play mode' e Decode current content as `extract mode' C-c C-p Decode current content as `print mode' +f Display X-Face q Quit button-2 Move to point under the mouse cursor and decode current content as `play mode' @@ -1044,20 +1056,21 @@ listed in key order: " (interactive) (setq mime-viewer/ignored-field-regexp - (concat "\\(" + (concat "^\\(" (mapconcat (function regexp-quote) mime-viewer/ignored-field-list "\\|") - "\\)")) - (let ((buf (get-buffer mime/output-buffer-name)) - (the-buf (current-buffer)) - ) + "\\):")) + (if (null ibuf) + (setq ibuf (current-buffer)) + ) + (let ((buf (get-buffer mime/output-buffer-name))) (if buf (progn - (switch-to-buffer buf) + (set-buffer buf) (erase-buffer) - (switch-to-buffer the-buf) + (set-buffer ibuf) ))) - (let ((ret (mime-viewer/parse-message ctl encoding))) + (let ((ret (mime-viewer/parse-message ctl encoding ibuf obuf))) (prog1 (switch-to-buffer (car ret)) (if mother @@ -1149,6 +1162,13 @@ listed in key order: (mime-preview/decode-content) )) +(defun mime-viewer/display-x-face () + (interactive) + (save-window-excursion + (set-buffer mime::preview/article-buffer) + (mime-viewer/x-face-function) + )) + (defun mime-viewer/up-content () (interactive) (let ((pc (mime::point-preview-content (point))) cinfo