From: morioka Date: Mon, 9 Mar 1998 11:32:01 +0000 (+0000) Subject: tm 7.24. X-Git-Tag: tm7_24~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=2eb3ffb7b47ff1db2a4d414a190f3ae908653cde;p=elisp%2Ftm.git tm 7.24. --- diff --git a/Changes-7.24.en b/Changes-7.24.en new file mode 100644 index 0000000..777d200 --- /dev/null +++ b/Changes-7.24.en @@ -0,0 +1,69 @@ +* tl + + Attached version 7.01.5. + + +* tm + +tm/tm-def.el +---------------------------- +revision 7.2 +date: 1995/11/14 04:56:15; author: morioka; state: Exp; lines: +50 -1 +New function `tm:add-fields' and `tm:delete-fields' to modify +*-field-list and *-field-regexp variables. +---------------------------- + +tm/tm-edit.el +---------------------------- +revision 7.24 +date: 1995/11/14 05:04:22; author: morioka; state: Exp; lines: +21 -11 +(1) fixed mode of message/external-body; access-type = ftp or anon-ftp. +(2) New variable `mime-editor/yank-ignored-field-list'. +(3) Variable `mime-editor/yank-ignored-fields-regexp' was renamed to + `mime-editor/yank-ignored-field-regexp'. +(4) Constant `mime-editor/split-ignored-fields-regexp' was renamed to + `mime-editor/split-ignored-field-regexp'. +(5) Variable `mime-editor/split-blind-fields-regexp' was renamed to + `mime-editor/split-blind-field-regexp'. +---------------------------- + +tm/tm-view.el +---------------------------- +revision 7.24 +date: 1995/11/14 06:14:37; author: morioka; state: Exp; lines: +7 -8 +(1) Elements of variable `mime-viewer/ignored-field-list' were changes + to regexp. +(2) Function `mime/viewer-mode' was modified not to reset variable + `mime-viewer/ignored-field-regexp' from variable + `mime-viewer/ignored-field-list'. (Please use function + `tm:add-fields' and `tm:delete-fields' to modify them) +---------------------------- + +tm/tm-vm.el +---------------------------- +revision 7.4 +date: 1995/11/14 04:52:30; author: morioka; state: Exp; lines: +324 -53 +(1) New variable `tm-vm/use-tm-patch'. If it is nil, tm-vm.el sets to + decode encoded-word by itself. +(2) New variable `tm-vm/automatic-mime-preview'. If it is t, tm-vm.el + does automatic MIME preview. New function + `tm-vm/toggle-preview-mode' is bound to `M-t' key. +(3) New function `tm-vm/forward-message' and + `tm-vm/send-digest'. Function `vm-forward-message' and + `vm-send-digest' were replace by them. If mime-setup.el is loaded, + variable `vm-forwarding-digest-type' and variable + `vm-digest-send-type' are set to "rfc1522". +---------------------------- + + +* tm/mh-e + + Attached version 7.17. + +tm/mh-e/tm-mh-e.el +---------------------------- +revision 7.17 +date: 1995/11/14 06:29:27; author: morioka; state: Exp; lines: +14 -13 +Variable `tm-mh-e/decode-all' is renamed to +`tm-mh-e/automatic-mime-preview'. +---------------------------- diff --git a/Changes-7.24.ja b/Changes-7.24.ja new file mode 100644 index 0000000..ccd336d --- /dev/null +++ b/Changes-7.24.ja @@ -0,0 +1,70 @@ +* tl + + Version 7.01.5 を添付した。 + + +* tm + +tm/tm-def.el +---------------------------- +revision 7.2 +date: 1995/11/14 04:56:15; author: morioka; state: Exp; lines: +50 -1 +*-field-list と *-field-regexp を操作するための関数 tm:add-fields と関 +数 tm:delete-fields を追加した。 +---------------------------- + +tm/tm-edit.el +---------------------------- +revision 7.24 +date: 1995/11/14 05:04:22; author: morioka; state: Exp; lines: +21 -11 +(1) message/external-body の access-type = ftp, anon-ftp の時の mode + を修正した。 +(2) 変数 mime-editor/yank-ignored-field-list を設けた。 +(3) 変数 mime-editor/yank-ignored-fields-regexp を + `mime-editor/yank-ignored-field-regexp' に改名した。なお、この変数 + は直接操作せずに、tm:add-fields か tm:delete-fields を使って操作す + ることにする。 +(4) 定数 mime-editor/split-ignored-fields-regexp を + `mime-editor/split-ignored-field-regexp' に改名した。 +(5) 変数 mime-editor/split-blind-fields-regexp を + `mime-editor/split-blind-field-regexp' に改名した。 +---------------------------- + +tm/tm-view.el +---------------------------- +revision 7.24 +date: 1995/11/14 06:14:37; author: morioka; state: Exp; lines: +7 -8 +(1) 変数 mime-viewer/ignored-field-list の要素を正規表現とした。 +(2) 関数 mime/viewer-mode で変数 mime-viewer/ignored-field-regexp を設 + 定し直すのはやめた。（変数 mime-viewer/ignored-field-list と変数 + mime-viewer/ignored-field-regexp は直接設定せず、関数 + tm:add-fields と関数 tm:delete-fields を使うこと） +---------------------------- + +tm/tm-vm.el +---------------------------- +revision 7.4 +date: 1995/11/14 04:52:30; author: morioka; state: Exp; lines: +324 -53 +(1) 変数 tm-vm/use-tm-patch を設け、これが nil の場合は自力で + encoded-word を decode する設定を行うようにした。 +(2) 変数 tm-vm/automatic-mime-preview を設け、これが t の時 automatic + MIME preview を行うようにした。また、M-t に関数 + tm-vm/toggle-preview-mode を割り当てた。 +(3) 関数 tm-vm/forward-message, 関数 tm-vm/send-digest を設け、 + 関数 vm-forward-message, 関数 vm-send-digest と置き換えた。また、 + mime-setup.el が load された場合は、変数 + vm-forwarding-digest-type, 変数 vm-digest-send-type の値を + "rfc1522" にするようにした。 +---------------------------- + + +* tm/mh-e + + Version 7.17 を添付した。 + +tm/mh-e/tm-mh-e.el +---------------------------- +revision 7.17 +date: 1995/11/14 06:29:27; author: morioka; state: Exp; lines: +14 -13 +変数 tm-mh-e/decode-all を `tm-mh-e/automatic-mime-preview' に改名した。 +---------------------------- diff --git a/Makefile b/Makefile index 8568aca..a62acba 100644 --- a/Makefile +++ b/Makefile @@ -37,7 +37,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 = tm7.23.tar.gz +TARFILE = tm7.24.tar.gz nemacs: diff --git a/mh-e/Makefile b/mh-e/Makefile index 8413e61..d5f98c8 100644 --- a/mh-e/Makefile +++ b/mh-e/Makefile @@ -23,7 +23,7 @@ TMDIR19 = $(HOME)/lib/emacs19/lisp FILES = tm/mh-e/*.el tm/mh-e/Makefile tm/mh-e/mk-tmh tm/mh-e/*.ol -TARFILE = tm-mh-e7.16.tar +TARFILE = tm-mh-e7.17.tar elc: diff --git a/mh-e/tm-mh-e.el b/mh-e/tm-mh-e.el index 56f7d88..9907f71 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 7.16 1995/11/11 13:02:40 morioka Exp $") + "$Id: tm-mh-e.el,v 7.17 1995/11/14 06:29:27 morioka Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) @@ -34,10 +34,11 @@ ;;; @ variable ;;; -(defvar tm-mh-e/decode-all t - "*If t, decode all of the message. Otherwise decode header only.") +(defvar tm-mh-e/automatic-mime-preview t + "If non-nil, show MIME processed message.") -(defvar tm-mh-e/decode-encoded-word t) +(defvar tm-mh-e/decode-encoded-word t + "If non-nil, decode encoded-word when it is not MIME preview mode.") ;;; @ functions @@ -50,7 +51,7 @@ (defun mh-display-msg (msg-num folder &optional show-buffer mode) (or mode - (setq mode tm-mh-e/decode-all) + (setq mode tm-mh-e/automatic-mime-preview) ) ;; Display message NUMBER of FOLDER. ;; Sets the current buffer to the show buffer. @@ -140,13 +141,13 @@ (defun tm-mh-e/view-message (&optional msg) "MIME decode and play this message." (interactive) - (if (or (null tm-mh-e/decode-all) + (if (or (null tm-mh-e/automatic-mime-preview) (null (get-buffer mh-show-buffer)) (save-excursion (set-buffer mh-show-buffer) (not (eq major-mode 'mime/viewer-mode)) )) - (let ((tm-mh-e/decode-all t)) + (let ((tm-mh-e/automatic-mime-preview t)) (mh-invalidate-show-buffer) (mh-show-msg msg) )) @@ -157,13 +158,13 @@ "Toggle MIME processing mode. With arg, turn MIME processing on if arg is positive." (interactive "P") - (setq tm-mh-e/decode-all + (setq tm-mh-e/automatic-mime-preview (if (null arg) - (not tm-mh-e/decode-all) + (not tm-mh-e/automatic-mime-preview) arg)) (save-excursion (set-buffer mh-show-buffer) - (if (null tm-mh-e/decode-all) + (if (null tm-mh-e/automatic-mime-preview) (if (and mime::preview/article-buffer (get-buffer mime::preview/article-buffer)) (kill-buffer mime::preview/article-buffer) @@ -189,7 +190,7 @@ With arg, turn MIME processing on if arg is positive." (defun tm-mh-e/raw-display () (interactive) (mh-invalidate-show-buffer) - (let (tm-mh-e/decode-all + (let (tm-mh-e/automatic-mime-preview tm-mh-e/decode-encoded-word) (mh-header-display) )) @@ -233,7 +234,7 @@ With arg, turn MIME processing on if arg is positive." (let ((name (buffer-name buf))) (substring name 5) )) - (if (not tm-mh-e/decode-all) + (if (not tm-mh-e/automatic-mime-preview) (mh-invalidate-show-buffer) ) (mh-show (mh-get-msg-num t)) @@ -262,7 +263,7 @@ With arg, turn MIME processing on if arg is positive." 'mh-show-mode (function (lambda () - (let ((tm-mh-e/decode-all t)) + (let ((tm-mh-e/automatic-mime-preview t)) (tm-mh-e/show) )))) ))) diff --git a/tm-def.el b/tm-def.el index 297a3b3..adda95a 100644 --- a/tm-def.el +++ b/tm-def.el @@ -6,7 +6,7 @@ ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: tm-def.el,v 7.1 1995/11/10 10:43:15 morioka Exp $ +;;; $Id: tm-def.el,v 7.2 1995/11/14 04:56:15 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia, definition ;;; ;;; This file is part of tm (Tools for MIME). @@ -204,6 +204,55 @@ ROT47 will be performed for Japanese text in any case." (insert str))))) +;;; @ field +;;; + +(defun tm:add-fields (sym field-list &optional regexp-sym) + (or regexp-sym + (setq regexp-sym + (let ((name (symbol-name sym))) + (intern + (concat (if (string-match "\\(.*\\)-list" name) + (substring name 0 (match-end 1)) + name) + "-regexp") + ))) + ) + (let ((fields (eval sym))) + (mapcar (function + (lambda (field) + (or (member field fields) + (setq fields (cons field fields)) + ) + )) + (reverse field-list) + ) + (set regexp-sym (apply (function regexp-or) fields)) + (set sym fields) + )) + +(defun tm:delete-fields (sym field-list &optional regexp-sym) + (or regexp-sym + (setq regexp-sym + (let ((name (symbol-name sym))) + (intern + (concat (if (string-match "\\(.*\\)-list" name) + (substring name 0 (match-end 1)) + name) + "-regexp") + ))) + ) + (let ((fields (eval sym))) + (mapcar (function + (lambda (field) + (setq fields (delete field fields)) + )) + field-list) + (set regexp-sym (apply (function regexp-or) fields)) + (set sym fields) + )) + + ;;; @ end ;;; diff --git a/tm-edit.el b/tm-edit.el index 5aee31a..3e18008 100644 --- a/tm-edit.el +++ b/tm-edit.el @@ -107,7 +107,7 @@ ;; LCD Archive Entry: ;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp| ;; Simple MIME Composer| -;; $Date: 1995/11/11 12:48:30 $|$Revision: 7.23 $|~/misc/mime.el.Z| +;; $Date: 1995/11/14 05:04:22 $|$Revision: 7.24 $|~/misc/mime.el.Z| ;;; Code: @@ -125,7 +125,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 7.23 1995/11/11 12:48:30 morioka Exp $") + "$Id: tm-edit.el,v 7.24 1995/11/14 05:04:22 morioka Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -221,8 +221,12 @@ To insert a signature file specified by mime-signature-file ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp") ("directory" "/pub/GNU/elisp/mime") ("name") - ("mode" "binary" "ascii")) - ("ftp" ("site") ("directory") ("name") ("mode" "binary" "ascii")) + ("mode" "image" "ascii" "local8")) + ("ftp" + ("site") + ("directory") + ("name") + ("mode" "image" "ascii" "local8")) ("tftp" ("site") ("name")) ("afs" ("site") ("name")) ("local-file" ("site") ("name")) @@ -300,8 +304,14 @@ If encoding is nil, it is determined from its contents.") ;;; @@ about message inserting ;;; -(defvar mime-editor/yank-ignored-fields-regexp - "^\\(Received\\|X-UIDL\\|Sender\\|Approved\\|Path\\):") +(defvar mime-editor/yank-ignored-field-list + '("Received" "Sender" "Approved" "Path" "Status" "X-VM-.*" "X-UIDL") + "Delete these fields from original message when it is inserted +as message/rfc822 part. +Each elements are regexp of field-name. [tm-edit.el]") + +(defvar mime-editor/yank-ignored-field-regexp + (apply (function regexp-or) mime-editor/yank-ignored-field-list)) (defvar mime-editor/message-inserter-alist nil) (defvar mime-editor/mail-inserter-alist nil) @@ -316,10 +326,10 @@ If encoding is nil, it is determined from its contents.") (defvar mime-editor/message-max-length-alist '((news-reply-mode . 500))) -(defconst mime-editor/split-ignored-fields-regexp +(defconst mime-editor/split-ignored-field-regexp "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)") -(defvar mime-editor/split-blind-fields-regexp +(defvar mime-editor/split-blind-field-regexp "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") (defvar mime-editor/message-default-sender-alist @@ -1729,7 +1739,7 @@ a recording host instead of local host." ) (goto-char header-start) (while (and (re-search-forward - mime-editor/yank-ignored-fields-regexp nil t) + mime-editor/yank-ignored-field-regexp nil t) (setq beg (match-beginning 0)) (setq end (1+ (rfc822/field-end))) ) @@ -1959,7 +1969,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" "@" (system-name) "\""))) (run-hooks 'mime-editor/before-split-hook) (let* ((header (rfc822/get-header-string-except - mime-editor/split-ignored-fields-regexp separator)) + mime-editor/split-ignored-field-regexp separator)) (subject (mail-fetch-field "subject")) (total (+ (/ lines mime-editor/message-max-length) (if (> (mod lines mime-editor/message-max-length) 0) @@ -2019,7 +2029,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" )) (goto-char (point-min)) (while (re-search-forward - mime-editor/split-blind-fields-regexp nil t) + mime-editor/split-blind-field-regexp nil t) (delete-region (match-beginning 0) (let ((e (rfc822/field-end))) (if (< e (point-max)) diff --git a/tm-view.el b/tm-view.el index 5b9d83b..906f524 100644 --- a/tm-view.el +++ b/tm-view.el @@ -25,7 +25,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.23 1995/11/10 11:15:31 morioka Exp $") + "$Id: tm-view.el,v 7.24 1995/11/14 06:14:37 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -97,9 +97,13 @@ (defvar mime-viewer/ignored-field-list '("Received" "Return-Path" "Replied" "Errors-To" "Lines" "Sender" "Path" "Nntp-Posting-Host" - "Content-Type" "Precedence" "X-Face")) + "Content-Type" "Precedence" "X-Face" + "Status" "X-VM-.*") + "All fields that match this list will be hidden in MIME preview buffer. +Each elements are regexp of field-name. [tm-view.el]") -(defvar mime-viewer/ignored-field-regexp) +(defvar mime-viewer/ignored-field-regexp + (apply (function regexp-or) mime-viewer/ignored-field-list)) (defvar mime-viewer/announcement-for-message/partial (if (and (>= emacs-major-version 19) window-system) @@ -701,11 +705,6 @@ listed in key order: \\{mime/viewer-mode-map} " (interactive) - (setq mime-viewer/ignored-field-regexp - (concat "^\\(" - (mapconcat (function regexp-quote) - mime-viewer/ignored-field-list "\\|") - "\\):")) (let ((buf (get-buffer mime/output-buffer-name))) (if buf (save-excursion diff --git a/tm-vm.el b/tm-vm.el index f539621..2dc847b 100644 --- a/tm-vm.el +++ b/tm-vm.el @@ -5,7 +5,7 @@ ;;; ;;; Author: MASUTANI Yasuhiro ;;; and Kenji Wakamiya -;;; modified by SHIONO , +;;; modified by SHIONO Jun'ichi , ;;; Steinar Bang , ;;; Shuhei KOBAYASHI , ;;; and MORIOKA Tomohiko @@ -13,8 +13,6 @@ ;;; ;;; This file is part of tm (Tools for MIME). ;;; -;;; This version is tested under VM-5.76 with tm-6.20. -;;; ;;; Plese insert (require 'tm-vm) in your .vm or .emacs. ;;; @@ -22,69 +20,46 @@ (require 'vm) (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 7.3 1995/10/28 06:00:09 morioka Exp $") + "$Id: tm-vm.el,v 7.4 1995/11/14 04:52:30 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) - -(set-alist 'mime-viewer/quitting-method-alist - 'vm-mode - 'tm-vm/quit-view-message) - -(set-alist 'mime-viewer/quitting-method-alist - 'vm-virtual-mode - 'tm-vm/quit-view-message) +(define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode) ;;; @ for MIME encoded-words ;;; -;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji -;; ), please use following definition: - -;; (setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n") -;; (defun vm-summary-function-A (m) -;; (mime-ewords/decode-string (vm-su-subject m))) +(defvar tm-vm/use-tm-patch nil + "Does not decode encoded-words in summary buffer if it is t. +If you use tiny-mime patch for VM (by RIKITAKE Kenji +), please set it t [tm-vm.el]") -;;; @ functions +(or tm-vm/use-tm-patch + (progn ;;; +;; by Steinar Bang +(setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n") -(defun tm-vm/quit-view-message () - "Quit MIME-viewer and go back to VM. -This function is called by `mime-viewer/quit' command via -`mime-viewer/quitting-method-alist'." - (mime-viewer/kill-buffer) - (if (get-buffer mime/output-buffer-name) - (bury-buffer mime/output-buffer-name)) - (vm-select-folder-buffer) - (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content) - '(mime-viewer/quit reading-message))) +(defvar tm-vm/chop-full-name-function 'tm-vm/default-chop-full-name) +(setq vm-chop-full-name-function tm-vm/chop-full-name-function) -(defun tm-vm/view-message () - "Decode and view MIME encoded message, under VM." - (interactive) - (vm-follow-summary-cursor) - (vm-select-folder-buffer) - (vm-check-for-killed-summary) - (vm-error-if-folder-empty) - (vm-display (current-buffer) t '(tm-vm/view-message) - '(tm-vm/view-mesage reading-message)) - (let* ((mp (car vm-message-pointer)) - (ct (vm-get-header-contents mp "Content-Type:")) - (cte (vm-get-header-contents mp "Content-Transfer-Encoding:")) - (exposed (= (point-min) (vm-start-of mp)))) - (save-restriction - (vm-widen-page) - ;; vm-widen-page hides exposed header if pages are delimited. - ;; So, here we expose it again. - (if exposed - (narrow-to-region (vm-start-of mp) (point-max))) - (select-window (vm-get-buffer-window (current-buffer))) - (mime/viewer-mode nil - (mime/parse-Content-Type (or ct "")) - cte) - ))) +(defun tm-vm/default-chop-full-name (address) + (let* ((ret (vm-default-chop-full-name address)) + (full-name (car ret)) + ) + (if (stringp full-name) + (cons (mime-eword/decode-string full-name) + (cdr ret)) + ret))) + +;; by Steinar Bang +(defun vm-summary-function-A (m) + (mime-eword/decode-string (vm-su-subject m)) + ) +;;; +)) (defun tm-vm/decode-message-header (&optional count) "Decode MIME header of current message through tiny-mime. @@ -138,6 +113,173 @@ all marked messages are affected, other messages are ignored." (setq vbufs (cdr vbufs)))))) +;;; @ automatic MIME preview +;;; + +(defvar tm-vm/automatic-mime-preview t + "If non-nil, show MIME processed article.") + +(defun tm-vm/preview-current-message () + (if tm-vm/automatic-mime-preview + (let ((win (selected-window))) + (vm-display (current-buffer) t + '(tm-vm/preview-current-message + vm-preview-current-message) + '(tm-vm/preview-current-message reading-message)) + (mime/viewer-mode) + (select-window win) + ) + )) + +(add-hook 'vm-select-message-hook 'tm-vm/preview-current-message) +(add-hook 'vm-visit-folder-hook 'tm-vm/preview-current-message) + +(defun tm-vm/scroll-forward () + (interactive) + (if tm-vm/automatic-mime-preview + (let ((win (get-buffer-window + (save-excursion + (set-buffer vm-mail-buffer) + mime::article/preview-buffer))) + (the-win (selected-window)) + np) + (if win + (progn + (select-window win) + (setq np (save-excursion + (forward-line (window-height)) + (point) + )) + ) + (vm-scroll-forward) + (switch-to-buffer mime::article/preview-buffer) + (setq win (selected-window)) + (setq np (point-min)) + ) + (if (eq np (point-max)) + (progn + (select-window the-win) + (vm-next-message) + ) + (set-window-start (selected-window) np) + (select-window the-win) + )) + (vm-scroll-forward) + )) + +(defun tm-vm/scroll-backward () + (interactive) + (if tm-vm/automatic-mime-preview + (let ((win (get-buffer-window + (save-excursion + (set-buffer vm-mail-buffer) + mime::article/preview-buffer))) + (the-win (selected-window)) + np) + (if win + (progn + (select-window win) + (setq np (save-excursion + (forward-line (- (window-height))) + (point) + )) + (if (eq np (window-start)) + (progn + (select-window the-win) + (vm-previous-message) + ) + (set-window-start (selected-window) np) + (select-window the-win) + )) + (vm-scroll-forward) + (switch-to-buffer mime::article/preview-buffer) + (setq win (selected-window)) + (select-window the-win) + )) + (vm-scroll-backward) + )) + +(substitute-key-definition 'vm-scroll-forward + 'tm-vm/scroll-forward vm-mode-map) +(substitute-key-definition 'vm-scroll-backward + 'tm-vm/scroll-backward vm-mode-map) + +(defun tm-vm/toggle-preview-mode () + (interactive) + (if tm-vm/automatic-mime-preview + (progn + (setq tm-vm/automatic-mime-preview nil) + (vm-select-folder-buffer) + (vm-display (current-buffer) t + '(tm-vm/toggle-preview-mode) + '(tm-vm/toggle-preview-mode reading-message)) + ) + (setq tm-vm/automatic-mime-preview t) + (let ((win (selected-window))) + (vm-select-folder-buffer) + (save-window-excursion + (let* ((mp (car vm-message-pointer)) + (ct (vm-get-header-contents mp "Content-Type:")) + (cte (vm-get-header-contents mp "Content-Transfer-Encoding:")) + ) + (mime/viewer-mode nil (mime/parse-Content-Type (or ct "")) cte) + )) + (vm-display mime::article/preview-buffer t + '(tm-vm/toggle-preview-mode) + '(tm-vm/toggle-preview-mode reading-message)) + (select-window win) + ) + )) + + +;;; @ for tm-view +;;; + +(defun tm-vm/quit-view-message () + "Quit MIME-viewer and go back to VM. +This function is called by `mime-viewer/quit' command via +`mime-viewer/quitting-method-alist'." + (mime-viewer/kill-buffer) + (if (get-buffer mime/output-buffer-name) + (bury-buffer mime/output-buffer-name)) + (vm-select-folder-buffer) + (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content) + '(mime-viewer/quit reading-message))) + +(defun tm-vm/view-message () + "Decode and view MIME encoded message, under VM." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (vm-display (current-buffer) t '(tm-vm/view-message) + '(tm-vm/view-mesage reading-message)) + (let* ((mp (car vm-message-pointer)) + (ct (vm-get-header-contents mp "Content-Type:")) + (cte (vm-get-header-contents mp "Content-Transfer-Encoding:")) + (exposed (= (point-min) (vm-start-of mp)))) + (save-restriction + (vm-widen-page) + ;; vm-widen-page hides exposed header if pages are delimited. + ;; So, here we expose it again. + (if exposed + (narrow-to-region (vm-start-of mp) (point-max))) + (select-window (vm-get-buffer-window (current-buffer))) + (mime/viewer-mode nil + (mime/parse-Content-Type (or ct "")) + cte) + ))) + +(set-alist 'mime-viewer/quitting-method-alist + 'vm-mode + 'tm-vm/quit-view-message) + +(set-alist 'mime-viewer/quitting-method-alist + 'vm-virtual-mode + 'tm-vm/quit-view-message) + + ;;; @ for tm-partial ;;; @@ -163,12 +305,141 @@ all marked messages are affected, other messages are ignored." ;;; @ for tm-edit ;;; +;; 1995/11/9 by Shuhei KOBAYASHI +;; (c.f. [tm ML:1075]) +(defun tm-vm/insert-message (&optional message) + (interactive) + (let* (mail-yank-hooks + (mail-citation-hook '(mime-editor/inserted-message-filter)) + (mail-reply-buffer vm-mail-buffer) + ) + (if (null message) + (call-interactively 'vm-yank-message) + (vm-yank-message message)) + )) + + +;;; @@ for multipart/digest +;;; + +(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. + +MLIST should be a list of message structs (real or virtual). +These are the messages that will be enclosed." + (if mlist + (let (m) + (save-restriction + (narrow-to-region (point) (point)) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (mime-editor/insert-tag "message" "rfc822") + (tm-vm/insert-message m) + (goto-char (point-max)) + (setq mlist (cdr mlist))) + (mime-editor/enclose-digest-region (point-min) (point-max)) + )))) + +(defun tm-vm/forward-message () + "Forward the current message to one or more recipients. +You will be placed in a Mail mode buffer as you would with a +reply, but you must fill in the To: header and perhaps the +Subject: header manually." + (interactive) + (if (not (equal vm-forwarding-digest-type "rfc1521")) + (vm-forward-message) + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (if (eq last-command 'vm-next-command-uses-marks) + (let ((vm-digest-send-type vm-forwarding-digest-type)) + (setq this-command 'vm-next-command-uses-marks) + (command-execute 'tm-vm/send-digest)) + (let ((dir default-directory) + (mp vm-message-pointer)) + (save-restriction + (widen) + (vm-mail-internal + (format "forward of %s's note re: %s" + (vm-su-full-name (car vm-message-pointer)) + (vm-su-subject (car vm-message-pointer))) + nil + (and vm-forwarding-subject-format + (let ((vm-summary-uninteresting-senders nil)) + (vm-sprintf 'vm-forwarding-subject-format (car mp))))) + (make-local-variable 'vm-forward-list) + (setq vm-system-state 'forwarding + vm-forward-list (list (car mp)) + default-directory dir) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil 0) + (tm-vm/enclose-messages vm-forward-list) + (mail-position-on-field "To")) + ;; (run-hooks 'tm-vm/forward-message-hook) ; Is it necessary? + (run-hooks 'vm-mail-mode-hook))))) + +(defun tm-vm/send-digest (&optional prefix) + "Send a digest of all messages in the current folder to recipients. +The type of the digest is specified by the variable vm-digest-send-type. +You will be placed in a Mail mode buffer as is usual with replies, but you +must fill in the To: and Subject: headers manually. + +If invoked on marked messages (via vm-next-command-uses-marks), +only marked messages will be put into the digest." + (interactive "P") + (if (not (equal vm-digest-send-type "rfc1521")) + (vm-send-digest prefix) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (let ((dir default-directory) + (mlist (if (eq last-command 'vm-next-command-uses-marks) + (vm-select-marked-or-prefixed-messages 0) + vm-message-list))) + (save-restriction + (widen) + (vm-mail-internal (format "digest from %s" (buffer-name))) + (setq vm-system-state 'forwarding + default-directory dir) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) + "\n")) + (goto-char (match-end 0)) + (vm-unsaved-message "Building %s digest..." vm-digest-send-type) + (tm-vm/enclose-messages mlist) + (mail-position-on-field "To") + (message "Building %s digest... done" vm-digest-send-type))) + ;; (run-hooks 'tm-vm/send-digest-hook) ; Is it necessary? + (run-hooks 'vm-mail-mode-hook))) + + +;;; @@ setting +;;; + +(substitute-key-definition 'vm-forward-message + 'tm-vm/forward-message vm-mode-map) +(substitute-key-definition 'vm-send-digest + 'tm-vm/send-digest vm-mode-map) + +(call-after-loaded + 'tm-edit + (function + (lambda () + (set-alist 'mime-editor/message-inserter-alist + 'mail-mode (function tm-vm/insert-message)) + ))) + (call-after-loaded 'mime-setup (function (lambda () (remove-hook 'mail-mode-hook 'mime/editor-mode) (add-hook 'vm-mail-mode-hook 'mime/editor-mode) + (setq vm-forwarding-digest-type "rfc1521") + (setq vm-digest-send-type "rfc1521") )))