From 5f475747415e85811cbce8865777585c1c56fa86 Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 9 Mar 1998 12:29:24 +0000 Subject: [PATCH] tm 7.37. --- Changes-7.37.en | 38 +++++++++++ Makefile | 8 +-- README.en | 6 +- gnus/ChangeLog-7.26.en | 16 +++++ gnus/Makefile | 2 +- gnus/s-path | 2 +- gnus/tm-gnus4.el | 14 ++-- gnus/tm-sgnus.el | 109 ++++++++++++++++++++++--------- tm-edit.el | 150 +++++++++++++++++++++++++++--------------- tm-pgp.el | 11 ++-- tm-view.el | 13 ++-- tm-vm.el | 170 ++++++++++++++++++++++++++---------------------- 12 files changed, 355 insertions(+), 184 deletions(-) create mode 100644 Changes-7.37.en create mode 100644 gnus/ChangeLog-7.26.en diff --git a/Changes-7.37.en b/Changes-7.37.en new file mode 100644 index 0000000..1607384 --- /dev/null +++ b/Changes-7.37.en @@ -0,0 +1,38 @@ +Wed Dec 20 13:05:06 1995 Morioka Tomohiko + + * tl: Version 7.03.4 was released. + * tm: Version 7.37 was released. + * tm/gnus: Version 7.26 was released. + +Tue Dec 19 18:06:49 1995 Morioka Tomohiko + + * tm-pgp.el: draft-elkins-pem-pgp-01.txt was renewed to + draft-elkins-pem-pgp-02.txt. + +Tue Dec 19 17:50:09 1995 Morioka Tomohiko + + * Makefile: tm/src/tmpgp was abolished. + +Tue Dec 19 17:47:16 1995 Morioka Tomohiko + + * tm-edit.el: + pgp-elkins spec was renewed to draft-elkins-pem-pgp-02.txt. + +Tue Dec 19 17:13:19 1995 Morioka Tomohiko + + * tm-pgp.el (mime-article/check-pgp-signature): treats encoding + + * tm-edit.el: `(autoload 'mc-pgp-lookup-key "mc-pgp")' was added. + +Tue Dec 18 03:52:48 1995 Katsumi Yamaoka + + * tm-view.el (mime-viewer/filter-text/plain): put URL into + text-property. (cf. [tm-ja:1367]) + +Mon Dec 15 21:32:16 1995 Shuhei KOBAYASHI + + * tm-vm.el (tm-vm-load-hook): New hook + + * tm-vm.el (tm-vm/preview-current-message): fixed to end as + current-buffer is folder buffer. Some problem is still rest. + (cf. [tm-ja:1348]) diff --git a/Makefile b/Makefile index ec7fbfe..57912af 100644 --- a/Makefile +++ b/Makefile @@ -1,11 +1,11 @@ # -# $Id: Makefile,v 7.9 1995/12/14 17:03:27 morioka Exp morioka $ +# $Id: Makefile,v 7.10 1995/12/19 17:50:09 morioka Exp morioka $ # include config.tm BINS = src/ol2 src/decode-b -UTILS = $(BINS) src/tmpgp +UTILS = $(BINS) GOMI = $(BINS) *.elc loadpath TM_FILES = tm/README.en tm/Changes* \ @@ -21,7 +21,7 @@ TM_FILES = tm/README.en tm/Changes* \ tm/tm-setup.el tm/mime-setup.el \ tm/sc-setup.el \ tm/methods/tm* \ - tm/src/*.c tm/src/tmpgp \ + tm/src/*.c \ tm/doc/Makefile tm/doc/*.ol tm/doc/*.tex \ tm/doc/*.texi @@ -38,7 +38,7 @@ TL_FILES = tl/README.en tl/Makefile tl/mk-tl tl/*.el tl/doc/*.texi \ FILES = $(TM_FILES) $(TM_MUA_FILES) $(MEL_FILES) $(TL_FILES) -TARFILE = tm7.36.tar.gz +TARFILE = tm7.37.tar.gz 18: diff --git a/README.en b/README.en index 5c5e962..93da0a2 100644 --- a/README.en +++ b/README.en @@ -1,7 +1,7 @@ [README for tm (English Version)] by MORIOKA Tomohiko and KOBAYASHI Shuhei -$Id: README.en,v 7.6 1995/12/18 11:16:18 morioka Exp $ +$Id: README.en,v 7.7 1995/12/19 18:30:02 morioka Exp $ 1 What's tm? @@ -20,14 +20,14 @@ $Id: README.en,v 7.6 1995/12/18 11:16:18 morioka Exp $ (1) English edition - tm/doc/tm_en.texi : tm Reference Manual (TeXinfo) -- tm/doc/tm-view_en.texi: tm-view Reference Manual (TeXinfo) - tm/doc/tm-gnus_en.texi: tm-gnus Reference Manual (TeXinfo) +- tm/doc/tm-mh-e_en.texi: tm-mh-e Reference Manual (TeXinfo) (2) Japanese edition - tm/doc/tm_ja.tex : tm Reference Manual (TeXinfo) -- tm/doc/tm-view_ja.texi : tm-view Reference Manual (TeXinfo) - tm/doc/tm-gnus_ja.texi : tm-gnus Reference Manual (TeXinfo) +- tm/doc/tm-mh-e_ja.texi : tm-mh-e Reference Manual (TeXinfo) - tm/doc/signature-jp.ol : signature.el Reference Manual (Emacs Outline) - tm/doc/signature-jp.tex: signature.el Reference Manual (LaTeX) diff --git a/gnus/ChangeLog-7.26.en b/gnus/ChangeLog-7.26.en new file mode 100644 index 0000000..94d4e49 --- /dev/null +++ b/gnus/ChangeLog-7.26.en @@ -0,0 +1,16 @@ +Wed Dec 20 12:00:19 1995 Morioka Tomohiko + + * tm/gnus: Version 7.26 was released. + + * tm-gnus4.el: (tm-gnus/preview-article-if-you-need): + `(setq buffer-read-only nil)' for GNUS. + +Wed Dec 20 07:04:55 1995 MURATA Masahiro + + * tm-sgnus.el: use text property to hide fields. + (cf. [tm-ja:1384]) + +Mon Dec 18 11:08:33 1995 Morioka Tomohiko + + * tm-gnus4.el, tm-sgnus.el: + setting for `mime-viewer/show-summary-method' diff --git a/gnus/Makefile b/gnus/Makefile index 8e9bd81..8afe897 100644 --- a/gnus/Makefile +++ b/gnus/Makefile @@ -27,7 +27,7 @@ TMDIR19_29 = $(DATADIR19_29)/$(EMACS_PREFIX)/site-lisp FILES = tm/gnus/*.el tm/doc/tm-gnus*.texi -TARFILE = tm-gnus7.25.tar +TARFILE = tm-gnus7.26.tar gnus: diff --git a/gnus/s-path b/gnus/s-path index 2c64d98..1500eb5 100644 --- a/gnus/s-path +++ b/gnus/s-path @@ -7,4 +7,4 @@ ;;; ;; please edit -(add-path "sgnus-0.24/lisp" 'all-paths) +(add-path "sgnus-0.25/lisp" 'all-paths) diff --git a/gnus/tm-gnus4.el b/gnus/tm-gnus4.el index d416d59..e59f8e6 100644 --- a/gnus/tm-gnus4.el +++ b/gnus/tm-gnus4.el @@ -8,7 +8,7 @@ ;;; modified by OKABE Yasuo ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1993/11/20 (merged tm-gnus5.el) -;;; Version: $Revision: 7.14 $ +;;; Version: $Revision: 7.15 $ ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). @@ -37,7 +37,7 @@ ;;; (defconst tm-gnus/RCS-ID - "$Id: tm-gnus4.el,v 7.14 1995/12/18 11:08:33 morioka Exp $") + "$Id: tm-gnus4.el,v 7.15 1995/12/20 12:00:19 morioka Exp $") (defconst tm-gnus/version (concat (get-version-string tm-gnus/RCS-ID) " for 3.15 .. 5.1")) @@ -190,14 +190,18 @@ This variable is set to `gnus-show-mime'.") (make-local-variable 'tm:mother-button-dispatcher) (setq tm:mother-button-dispatcher (function gnus-article-push-button)) - (mime/viewer-mode - nil nil nil tm-gnus/original-article-buffer gnus-article-buffer) - (gnus-article-show-summary) + (save-window-excursion + (mime/viewer-mode + nil nil nil tm-gnus/original-article-buffer gnus-article-buffer) + ) (setq tm-gnus/automatic-mime-preview t) (setq gnus-original-article-buffer tm-gnus/original-article-buffer) (let (buffer-read-only) (run-hooks 'tm-gnus/article-prepare-hook) ) + (if (featurep 'tm-gd3) + (setq buffer-read-only nil) + ) ))) (setq gnus-show-mime-method diff --git a/gnus/tm-sgnus.el b/gnus/tm-sgnus.el index 70c5673..6870be6 100644 --- a/gnus/tm-sgnus.el +++ b/gnus/tm-sgnus.el @@ -7,7 +7,7 @@ ;;; Author: MORIOKA Tomohiko ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1995/09/24 -;;; Version: $Revision: 7.25 $ +;;; Version: $Revision: 7.26 $ ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). @@ -40,7 +40,7 @@ ;;; (defconst tm-gnus/RCS-ID - "$Id: tm-sgnus.el,v 7.25 1995/12/18 11:08:07 morioka Exp $") + "$Id: tm-sgnus.el,v 7.26 1995/12/20 12:49:27 morioka Exp $") (defconst tm-gnus/version (concat (get-version-string tm-gnus/RCS-ID) " for September")) @@ -84,36 +84,31 @@ This variable is set to `gnus-show-mime'.") (defun tm-gnus/summary-toggle-header (&optional arg) (interactive "P") (if tm-gnus/automatic-mime-preview - (let ((mime-viewer/ignored-field-regexp - (if (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (narrow-to-region - (point-min) - (if (re-search-forward "^$" nil t) - (match-beginning 0) - (point-max) - )) - (some-element - (lambda (field) - (goto-char (point-min)) - (and (re-search-forward - (concat "^" field ":") nil t) - (setq field - (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (not - (string-match - mime-viewer/visible-field-regexp field)) - ) - ) - mime-viewer/ignored-field-list))) - mime-viewer/ignored-field-regexp - "^:$"))) - (gnus-summary-select-article t t) - ) - (gnus-summary-toggle-header arg) - )) + (save-excursion + (set-buffer gnus-article-buffer) + (let* ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (hidden (text-property-any + (goto-char (point-min)) (search-forward "\n\n") + 'invisible t)) + e) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (delete-region (point-min) (1- (point)))) + (goto-char (point-min)) + (save-excursion + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) + (insert-buffer-substring gnus-original-article-buffer 1 e) + (if (or (not hidden) (and (numberp arg) (< arg 0))) + (tm-gnus/content-header-filter) + (mime/decode-message-header)) + (let ((gnus-inhibit-hiding t)) + (run-hooks 'gnus-article-display-hook)) + )) + (gnus-summary-toggle-header arg)) + ) (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message)) (define-key gnus-summary-mode-map @@ -208,6 +203,56 @@ This variable is set to `gnus-show-mime'.") (tm::gnus-article-hide-headers-if-wanted) )) +(defun tm-gnus/preview-cut-header () + (save-restriction + (let ((ignored mime-viewer/ignored-field-regexp) + (visible mime-viewer/visible-field-regexp) + want-list beg) + (goto-char (point-min)) + (narrow-to-region + (point) + (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) + (goto-char (point-min)) + (while (re-search-forward "^[^ \t]*:" nil t) + (beginning-of-line) + ;; We add the headers we want to keep to a list and delete + ;; them from the buffer. + (if (or (and visible (looking-at visible)) + (and ignored (not (looking-at ignored)))) + (progn + (push (buffer-substring + (setq beg (point)) + (progn + (forward-line 1) + ;; Be sure to get multi-line headers... + (re-search-forward "^[^ \t]*:" nil t) + (beginning-of-line) + (point))) + want-list) + (delete-region beg (point))) + (forward-line 1))) + ;; Sort the headers that we want to display. + (setq want-list (sort want-list 'gnus-article-header-less)) + (goto-char (point-min)) + (while want-list + (insert (pop want-list))) + (add-text-properties + (point) (point-max) gnus-hidden-properties) + ))) + +(defun tm-gnus/content-header-filter () + (tm-gnus/preview-cut-header) + (mime/decode-message-header) + ) + + +;;; @ set up +;;; + +(set-alist 'mime-viewer/content-header-filter-alist + 'gnus-original-article-mode + (function tm-gnus/content-header-filter)) + ;;; @ for BBDB ;;; diff --git a/tm-edit.el b/tm-edit.el index 909d2f1..aac9c17 100644 --- a/tm-edit.el +++ b/tm-edit.el @@ -7,7 +7,7 @@ ;; Author: UMEDA Masanobu ;; MORIOKA Tomohiko -;; Version: $Revision: 7.36 $ +;; Version: $Revision: 7.37 $ ;; Keywords: mail, news, MIME, multimedia, multilingual ;; This file is not part of GNU Emacs. @@ -108,7 +108,7 @@ ;; LCD Archive Entry: ;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp| ;; Simple MIME Composer| -;; $Date: 1995/12/17 14:37:28 $|$Revision: 7.36 $|~/misc/mime.el.Z| +;; $Date: 1995/12/19 17:47:16 $|$Revision: 7.37 $|~/misc/mime.el.Z| ;;; Code: @@ -126,7 +126,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 7.36 1995/12/17 14:37:28 morioka Exp $") + "$Id: tm-edit.el,v 7.37 1995/12/19 17:47:16 morioka Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -744,9 +744,11 @@ User customizable variables (not documented all of them): (setq selective-display t) ;; I don't care about saving these. (setq paragraph-start - (concat mime-editor/single-part-tag-regexp "\\|" paragraph-start)) + (regexp-or mime-editor/single-part-tag-regexp + paragraph-start)) (setq paragraph-separate - (concat mime-editor/single-part-tag-regexp "\\|" paragraph-separate)) + (regexp-or mime-editor/single-part-tag-regexp + paragraph-separate)) (run-hooks 'mime/editor-mode-hook) (message (substitute-command-keys @@ -1527,16 +1529,83 @@ while if FLAG is `\\^M' (control-M) the text is hidden." )) boundary)))) -(defun mc-tmpgp-generic-parser (result) - (if (or (not (eq result 0)) - (mc-message "^\aError: +Bad pass phrase\\.$" (current-buffer)) - ) - (progn - (mc-deactivate-passwd t) - nil) - result)) +(defun tm:mc-pgp-generic-parser (result) + (let ((ret (mc-pgp-generic-parser result))) + (if (consp ret) + (vector (car ret)(cdr ret)) + ))) -(defvar mc-tmpgp-path "tmpgp") +(autoload 'mc-pgp-lookup-key "mc-pgp") + +(defun tm:mc-process-region + (beg end passwd program args parser &optional buffer boundary) + (let ((obuf (current-buffer)) + (process-connection-type nil) + mybuf result rgn proc) + (unwind-protect + (progn + (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp"))) + (set-buffer mybuf) + (erase-buffer) + (set-buffer obuf) + (buffer-disable-undo mybuf) + (setq proc + (apply 'start-process "*PGP*" mybuf program args)) + (if passwd + (progn + (process-send-string proc (concat passwd "\n")) + (or mc-passwd-timeout (mc-deactivate-passwd t)))) + (process-send-region proc beg end) + (process-send-eof proc) + (while (eq 'run (process-status proc)) + (accept-process-output proc 5)) + (setq result (process-exit-status proc)) + ;; Hack to force a status_notify() in Emacs 19.29 + (delete-process proc) + (set-buffer mybuf) + (goto-char (point-max)) + (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + ;; CRNL -> NL + (while (search-forward "\r\n" nil t) + (replace-match "\n")) + ;; Hurm. FIXME; must get better result codes. + (if (stringp result) + (error "%s exited abnormally: '%s'" program result) + (setq rgn (funcall parser result)) + ;; If the parser found something, migrate it + (if (consp rgn) + (progn + (set-buffer obuf) + (if boundary + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (insert (format "--%s\n" boundary)) + (goto-char (point-max)) + (insert (format "\n--%s +Content-Type: application/pgp-signature +Content-Transfer-Encoding: 7bit + +" boundary)) + (insert-buffer-substring mybuf (car rgn) (cdr rgn)) + (goto-char (point-max)) + (insert (format "\n--%s--\n" boundary)) + ) + (delete-region beg end) + (goto-char beg) + (insert-buffer-substring mybuf (car rgn) (cdr rgn)) + ) + (set-buffer mybuf) + (delete-region (car rgn) (cdr rgn))))) + ;; Return nil on failure and exit code on success + (if rgn result)) + ;; Cleanup even on nonlocal exit + (if (and proc (eq 'run (process-status proc))) + (interrupt-process proc)) + (set-buffer obuf) + (or buffer (null mybuf) (kill-buffer mybuf))))) (defun tm:mc-pgp-sign-region (start end &optional id unclear boundary) (if (not (boundp 'mc-pgp-user-id)) @@ -1544,8 +1613,10 @@ while if FLAG is `\\^M' (control-M) the text is hidden." ) (let ((process-environment process-environment) (buffer (get-buffer-create mc-buffer-name)) - passwd args key parser pgp-path - signature-file) + passwd args key + (parser (function mc-pgp-generic-parser)) + (pgp-path mc-pgp-path) + ) (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id))) (setq passwd (mc-activate-passwd @@ -1553,31 +1624,19 @@ while if FLAG is `\\^M' (control-M) the text is hidden." (format "PGP passphrase for %s (%s): " (car key) (cdr key)))) (setenv "PGPPASSFD" "0") (setq args - (list "+verbose=1" "+language=en" - (format "+clearsig=%s" (if unclear "off" "on")) - "+batchmode" "-u" (cdr key))) - (if boundary - (progn - (setq parser 'mc-tmpgp-generic-parser - pgp-path mc-tmpgp-path - signature-file (make-temp-name - (expand-file-name "tm-sign" mime/tmp-dir)) - args (cons "-fbst" args)) - (if mc-pgp-comment - (setq args (cons (format "+comment=%s" mc-pgp-comment) args)) - ) - (setq args (cons signature-file args)) - ) - (setq parser 'mc-pgp-generic-parser - pgp-path mc-pgp-path - args (cons "-fast" args) - ) - (if mc-pgp-comment - (setq args (cons (format "+comment=%s" mc-pgp-comment) args)) - ) + (cons + (if boundary + "-fbast" + "-fast") + (list "+verbose=1" "+language=en" + (format "+clearsig=%s" (if unclear "off" "on")) + "+batchmode" "-u" (cdr key)))) + (if mc-pgp-comment + (setq args (cons (format "+comment=%s" mc-pgp-comment) args)) ) (message "Signing as %s ..." (car key)) - (if (mc-process-region start end passwd pgp-path args parser buffer) + (if (tm:mc-process-region + start end passwd pgp-path args parser buffer boundary) (progn (if boundary (progn @@ -1585,19 +1644,8 @@ while if FLAG is `\\^M' (control-M) the text is hidden." (insert (format "\ --[[multipart/signed; protocol=\"application/pgp-signature\"; - boundary=\"%s\"; micalg=pgp-md5][7bit]] ---%s\n" boundary boundary)) - (goto-char (point-max)) - (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature -Content-Transfer-Encoding: base64 - -") - (insert-file-contents signature-file) - (goto-char (point-max)) - (insert (format "\n--%s--\n" boundary)) + boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary)) )) - (delete-file signature-file) (message "Signing as %s ... Done." (car key)) t) nil))) diff --git a/tm-pgp.el b/tm-pgp.el index 1d2c1f0..33cdda5 100644 --- a/tm-pgp.el +++ b/tm-pgp.el @@ -8,7 +8,7 @@ ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1995/12/7 ;;; Version: -;;; $Id: tm-pgp.el,v 7.2 1995/12/17 14:29:17 morioka Exp $ +;;; $Id: tm-pgp.el,v 7.4 1995/12/19 18:06:49 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia, PGP, security ;;; ;;; This file is part of tm (Tools for MIME). @@ -29,9 +29,9 @@ ;;; ;;; Commentary: ;;; This module is based on 2 drafts about PGP MIME integration: -;;; - draft-elkins-pem-pgp-01.txt +;;; - draft-elkins-pem-pgp-02.txt ;;; ``MIME Security with Pretty Good Privacy (PGP)'' -;;; by Michael Elkins (1995/9) +;;; by Michael Elkins (1995/11) ;;; - draft-kazu-pgp-mime-00.txt ;;; ``PGP MIME Integration'' ;;; by Kazuhiko Yamamoto (1995/10) @@ -115,7 +115,8 @@ ;;; It is based on draft-elkins-pem-pgp-01.txt (defun mime-article/check-pgp-signature (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) + (let* ((encoding (cdr (assq 'encoding cal))) + (cnum (mime-article/point-content-number beg)) (rcnum (reverse cnum)) (rmcnum (cdr rcnum)) (knum (car rcnum)) @@ -152,7 +153,7 @@ end)) (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name))) (insert str) - (base64-decode-region (point-min)(point-max)) + (mime/decode-region encoding (point-min)(point-max)) (let ((mc-flag nil) ; for Mule (file-coding-system (if (featurep 'mule) *noconv*)) diff --git a/tm-view.el b/tm-view.el index 5c27012..7acb55a 100644 --- a/tm-view.el +++ b/tm-view.el @@ -8,7 +8,7 @@ ;;; modified by Steven L. Baur ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el) -;;; Version: $Revision: 7.36 $ +;;; Version: $Revision: 7.37 $ ;;; Keywords: mail, news, MIME, multimedia ;;; ;;; This file is part of tm (Tools for MIME). @@ -44,7 +44,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.36 1995/12/18 10:45:02 morioka Exp $") + "$Id: tm-view.el,v 7.37 1995/12/19 15:40:46 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -122,7 +122,7 @@ (defvar mime-viewer/ignored-field-list '(".*Received" ".*Path" ".*Id" "Replied" "Errors-To" - "Lines" "Sender" "Nntp-Posting-Host" + "Lines" "Sender" "Nntp-Posting-Host" "Xref" "Content-Type" "Precedence" "X-Face" "Status" "X-VM-.*") "All fields that match this list will be hidden in MIME preview buffer. @@ -687,8 +687,11 @@ The compressed face will be piped to this command.") (progn (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)) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (tm:add-button beg end + (function tm:browse-url) + (list (buffer-substring beg end)))) ))) (run-hooks 'mime-viewer/plain-text-preview-hook) ) diff --git a/tm-vm.el b/tm-vm.el index 1da346a..bcc34e8 100644 --- a/tm-vm.el +++ b/tm-vm.el @@ -12,7 +12,7 @@ ;;; and ISHIHARA Akito ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1994/10/29 -;;; Version: $Revision: 7.36 $ +;;; Version: $Revision: 7.37 $ ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). @@ -39,13 +39,16 @@ (require 'vm) (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 7.36 1995/12/15 13:58:51 morioka Exp $") + "$Id: tm-vm.el,v 7.37 1995/12/18 19:25:24 morioka Exp $") (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) (define-key vm-mode-map "Z" 'tm-vm/view-message) (define-key vm-mode-map "T" 'tm-vm/decode-message-header) (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode) +(defvar tm-vm-load-hook nil + "*List of functions called after tm-vm is loaded.") + ;;; @ for MIME encoded-words ;;; @@ -138,87 +141,85 @@ all marked messages are affected, other messages are ignored." (defvar tm-vm/automatic-mime-preview t "*If non-nil, show MIME processed article.") +(defvar tm-vm/select-message-hook nil + "*List of functions called every time a message is selected. +tm-vm uses `vm-select-message-hook', use this hook instead.") + (defun tm-vm/preview-current-message () ;;; suggested by Simon Rowe ;;; (cf. [tm-eng:163]) ;; Selecting a new mail message, but we're already displaying a mime ;; on in the window, make sure that the mail buffer is displayed. - (if (get-buffer-window mime/output-buffer-name) - (delete-window (get-buffer-window (get-buffer mime/output-buffer-name))) - ) - ;; fixed by Shuhei KOBAYASHI - ;; 1995/12/4 (cf. [tm-ja:1190]) - (if (and vm-message-pointer tm-vm/automatic-mime-preview - ;; fixed by SHIONO Jun'ichi - ;; 1995/11/17 (cf. [tm-ja:1120]) - (display-buffer (current-buffer)) - (let* ((mp (car vm-message-pointer)) - (ct (vm-get-header-contents mp "Content-Type:")) - (cte (vm-get-header-contents - mp "Content-Transfer-Encoding:")) - ) - ;; Check if this message actually is a mime, or just a text - ;; one sent by someone using PINE or similar. - (and ct - (not (and (string= (car (mime/parse-Content-Type ct)) - "text/plain") - (member cte '("7bit" "8bit" "binary")) - )))) - ) - (let ((win (selected-window)) buf) - (setq buf (window-buffer win)) - (let ((pwin (and mime::article/preview-buffer - (get-buffer mime::article/preview-buffer) - (get-buffer-window mime::article/preview-buffer)))) - (if (and pwin - (not (eq win pwin))) - (delete-window pwin) - )) - (vm-display nil nil - '(vm-next-message - vm-previous-message - vm-delete-message - vm-undelete-message - vm-scroll-forward vm-scroll-backward) - (list this-command 'reading-message)) - (setq win (get-buffer-window buf)) - (if win - (select-window win) - ) - (save-window-excursion - (vm-select-folder-buffer) - (setq win (get-buffer-window (current-buffer))) - ;; (vm-display (current-buffer) t - ;; '(vm-scroll-forward vm-scroll-backward) - ;; (list this-command 'reading-message)) - ;; (select-window (get-buffer-window (current-buffer))) - (mime/viewer-mode) - (setq buf (current-buffer)) - (run-hooks 'tm-vm/select-message-hook) - ) - (set-window-buffer win buf) - ;;(select-window win) - ) - ;; fixed by Oscar Figueiredo - ;; 1995/11/17 - (if (and mime::article/preview-buffer - (get-buffer mime::article/preview-buffer)) - (kill-buffer mime::article/preview-buffer)) - (if tm-vm/automatic-mime-preview - (let (buffer-read-only) - (mime/decode-message-header) - (run-hooks 'tm-vm/select-message-hook) - )) - )) + (vm-save-buffer-excursion + (if (get-buffer-window mime/output-buffer-name) + (delete-window (get-buffer-window (get-buffer mime/output-buffer-name))) + ) + ;; fixed by Shuhei KOBAYASHI + ;; 1995/12/4 (cf. [tm-ja:1190]) + (if (and vm-message-pointer tm-vm/automatic-mime-preview + ;; fixed by SHIONO Jun'ichi + ;; 1995/11/17 (cf. [tm-ja:1120]) + (display-buffer (current-buffer)) + (let* ((mp (car vm-message-pointer)) + (ct (vm-get-header-contents mp "Content-Type:")) + (cte (vm-get-header-contents + mp "Content-Transfer-Encoding:")) + ) + ;; Check if this message actually is a mime, or just a text + ;; one sent by someone using PINE or similar. + (and ct + (not (and (string= (car (mime/parse-Content-Type ct)) + "text/plain") + (member cte '("7bit" "8bit" "binary")) + )))) + ) + (let ((win (selected-window)) buf) + (setq buf (window-buffer win)) + (let ((pwin (and mime::article/preview-buffer + (get-buffer mime::article/preview-buffer) + (get-buffer-window mime::article/preview-buffer)))) + (if (and pwin + (not (eq win pwin))) + (delete-window pwin) + )) + (vm-display nil nil + '(vm-next-message + vm-previous-message + vm-delete-message + vm-undelete-message + vm-scroll-forward vm-scroll-backward) + (list this-command 'reading-message)) + (setq win (get-buffer-window buf)) + (if win + (select-window win) + ) + (save-window-excursion + (vm-select-folder-buffer) + (setq win (get-buffer-window (current-buffer))) + ;; (vm-display (current-buffer) t + ;; '(vm-scroll-forward vm-scroll-backward) + ;; (list this-command 'reading-message)) + ;; (select-window (get-buffer-window (current-buffer))) + (mime/viewer-mode) + (setq buf (current-buffer)) + ) + (set-window-buffer win buf) + ;;(select-window win) + ) + ;; fixed by Oscar Figueiredo + ;; 1995/11/17 + (if (and mime::article/preview-buffer + (get-buffer mime::article/preview-buffer)) + (kill-buffer mime::article/preview-buffer)) + (if tm-vm/automatic-mime-preview + (let (buffer-read-only) + (mime/decode-message-header) + )) + )) + (run-hooks 'tm-vm/select-message-hook)) (add-hook 'vm-select-message-hook 'tm-vm/preview-current-message) - -(defun tm-vm/visit-folder-function () - (tm-vm/preview-current-message) - (and vm-mail-buffer (set-buffer vm-mail-buffer)) - ) - -(add-hook 'vm-visit-folder-hook 'tm-vm/visit-folder-function) +(add-hook 'vm-visit-folder-hook 'tm-vm/preview-current-message) ;; fixed by Oscar Figueiredo ;; 1995/11/14 (cf.[tm-eng:162]) @@ -318,7 +319,6 @@ all marked messages are affected, other messages are ignored." (get-buffer mime::article/preview-buffer)) (progn (select-window mail-win) -; (goto-char (point-max)) (switch-to-buffer mime::article/preview-buffer) (select-window summary-win))) ))) @@ -516,6 +516,18 @@ This function is called by `mime-viewer/quit' command via ;;; @@ for multipart/digest ;;; +(defvar tm-vm/forward-message-hook nil + "*List of functions called after a Mail mode buffer has been +created to forward a message in message/rfc822 type format. +If `vm-forwarding-digest-type' is \"rfc1521\", tm-vm runs this +hook instead of `vm-forward-message-hook'.") + +(defvar tm-vm/send-digest-hook nil + "*List of functions called after a Mail mode buffer has been +created to send a digest in multipart/digest type format. +If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook +instead of `vm-send-digest-hook'.") + (defun tm-vm/enclose-messages (mlist) "Enclose the messages in MLIST as multipart/digest. The resulting digest is inserted at point in the current buffer. @@ -723,3 +735,7 @@ only marked messages will be put into the digest." ;;; (provide 'tm-vm) + +(run-hooks 'tm-vm-load-hook) + +;;; tm-vm.el ends here. -- 1.7.10.4