From: morioka Date: Mon, 9 Mar 1998 11:34:57 +0000 (+0000) Subject: tm 7.25. X-Git-Tag: tm7_25~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=01504f7f328c9ac49e9720c85c0d80ea776d8415;p=elisp%2Ftm.git tm 7.25. --- diff --git a/Changes-7.25.en b/Changes-7.25.en new file mode 100644 index 0000000..5dd7fa1 --- /dev/null +++ b/Changes-7.25.en @@ -0,0 +1,102 @@ +* tl + + Attached version 7.01.6. + + +* tm + +tm-def.el +---------------------------- +revision 7.3 +date: 1995/11/15 14:21:50; author: morioka; state: Exp; lines: +5 -3 +fixed problem of function `tm:add-fields' and `tm:delete-fields'. +---------------------------- + +tm-edit.el +---------------------------- +revision 7.25 +date: 1995/11/15 14:17:09; author: morioka; state: Exp; lines: +6 -4 +(1) fixed problem of initialize of variable + `mime-editor/yank-ignored-field-regexp'. +(2) In function `mime-viewer::quitting-method/draft-preview', it was + fixed problem of renaming mistake `mime/mother-buffer' -> + `mime::preview/mother-buffer'. +---------------------------- + +tm-parse.el +---------------------------- +revision 6.0 +date: 1995/11/15 11:56:10; author: morioka; state: Exp; lines: +15 -12 +According to KOBAYASHI Shuuhei , I +fixed error of function `mime/parse-multipart'. +---------------------------- + +tm-view.el +---------------------------- +revision 7.25 +date: 1995/11/15 13:57:33; author: morioka; state: Exp; lines: +4 -2 +fixed problem of initialize of variable +`mime-viewer/ignored-field-regexp'. +---------------------------- + +tm-vm.el +---------------------------- +revision 7.7 +date: 1995/11/15 15:35:54; author: morioka; state: Exp; lines: +101 -61 +Function `tm-vm/preview-current-message' was modified based of Simon +Rowe 's code. (c.f. [tm-eng:163]) +---------------------------- +revision 7.6 +date: 1995/11/15 10:20:05; author: morioka; state: Exp; lines: +28 -5 +applied KOBAYASHI Shuuhei 's patch. +(c.f. [tm ML:1102]) +---------------------------- +revision 7.5 +date: 1995/11/15 09:06:19; author: morioka; state: Exp; lines: +38 -31 +applied Oscar Figueiredo 's modification. +---------------------------- + + +* tm/mh-e + + Attached version 7.20. + +tm-mh-e.el +---------------------------- +revision 7.20 +date: 1995/11/15 12:45:44; author: morioka; state: Exp; lines: +3 -3 +Function `tm-mh-e/mh-forward' was renamed to `tm-mh-e/forward'. +---------------------------- +revision 7.19 +date: 1995/11/15 12:37:25; author: morioka; state: Exp; lines: +82 -1 +New function `tm-mh-e/mh-forward' by OKABE Yasuo +. (c.f. [tm ML:1099]) +---------------------------- +revision 7.18 +date: 1995/11/15 12:25:25; author: morioka; state: Exp; lines: +28 -14 +applied OKABE Yasuo 's modification. +(c.f. [tm ML:1096]) +---------------------------- + + +* tm/gnus + + Attached version 7.16. + +tm-gnus5.el +---------------------------- +revision 7.9 +date: 1995/11/15 10:41:02; author: morioka; state: Exp; lines: +4 -3 +According to Masahiro MURATA , I fixed +problem of function `tm-gnus/summary-toggle-header'. +(c.f. [tm ML:1104]) +---------------------------- + +tm-sgnus.el +---------------------------- +revision 7.16 +date: 1995/11/15 10:36:09; author: morioka; state: Exp; lines: +4 -3 +According to Masahiro MURATA , I fixed +problem of function `tm-gnus/summary-toggle-header'. +(c.f. [tm ML:1104]) +---------------------------- diff --git a/Changes-7.25.ja b/Changes-7.25.ja new file mode 100644 index 0000000..3d4bbee --- /dev/null +++ b/Changes-7.25.ja @@ -0,0 +1,101 @@ +* tl + + Version 7.01.6 を添付した。 + + +* tm + +tm-def.el +---------------------------- +revision 7.3 +date: 1995/11/15 14:21:50; author: morioka; state: Exp; lines: +5 -3 +関数 tm:add-fields と関数 tm:delete-fields の不具合を修正した。 +---------------------------- + +tm-edit.el +---------------------------- +revision 7.25 +date: 1995/11/15 14:17:09; author: morioka; state: Exp; lines: +6 -4 +(1) 変数 mime-editor/yank-ignored-field-regexp の初期化における不具合 + を修正した。 +(2) 関数 mime-viewer::quitting-method/draft-preview において、変数 + mime/mother-buffer を `mime::preview/mother-buffer' に改名し忘れて + いたのを修正した。 +---------------------------- + +tm-parse.el +---------------------------- +revision 6.0 +date: 1995/11/15 11:56:10; author: morioka; state: Exp; lines: +15 -12 +小林 修平 さんの指摘に従い、関数 +mime/parse-multipart の誤りを修正した。 +---------------------------- + +tm-view.el +---------------------------- +revision 7.25 +date: 1995/11/15 13:57:33; author: morioka; state: Exp; lines: +4 -2 +変数 mime-viewer/ignored-field-regexp の初期化における誤りを修正した。 +---------------------------- + +tm-vm.el +---------------------------- +revision 7.7 +date: 1995/11/15 15:35:54; author: morioka; state: Exp; lines: +101 -61 +[tm-eng:163] における Simon Rowe さんの code +をもとに関数 tm-vm/preview-current-message を修正した。 +---------------------------- +revision 7.6 +date: 1995/11/15 10:20:05; author: morioka; state: Exp; lines: +28 -5 +小林 修平 さんの patch を当てた。 +(c.f. [tm ML:1102]) +---------------------------- +revision 7.5 +date: 1995/11/15 09:06:19; author: morioka; state: Exp; lines: +38 -31 +Oscar Figueiredo さんの修正を加えた。 +---------------------------- + + +* tm/mh-e + + Version 7.20 を添付した。 + +tm-mh-e.el +---------------------------- +revision 7.20 +date: 1995/11/15 12:45:44; author: morioka; state: Exp; lines: +3 -3 +関数 tm-mh-e/mh-forward を `tm-mh-e/forward' に改名した。 +---------------------------- +revision 7.19 +date: 1995/11/15 12:37:25; author: morioka; state: Exp; lines: +82 -1 +岡部 寿男 さんの作の関数 +tm-mh-e/mh-forward を追加した。(c.f. [tm ML:1099]) +---------------------------- +revision 7.18 +date: 1995/11/15 12:25:25; author: morioka; state: Exp; lines: +28 -14 +[tm ML:1096] での、岡部　寿男 さんの修正を +採り入れる。 +---------------------------- + + +* tm/gnus + + Version 7.16 を添付した。 + +tm-gnus5.el +---------------------------- +revision 7.9 +date: 1995/11/15 10:41:02; author: morioka; state: Exp; lines: +4 -3 +[tm ML:1104] における、村田全寛 (Masahiro MURATA) + さんの指摘に従い、関数 +tm-gnus/summary-toggle-header の不具合を修正した。 +---------------------------- + +tm-sgnus.el +---------------------------- +revision 7.16 +date: 1995/11/15 10:36:09; author: morioka; state: Exp; lines: +4 -3 +[tm ML:1104] における、村田全寛 (Masahiro MURATA) + さんの指摘に従い、関数 +tm-gnus/summary-toggle-header の不具合を修正した。 +---------------------------- diff --git a/Makefile b/Makefile index a62acba..c69ddba 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.24.tar.gz +TARFILE = tm7.25.tar.gz nemacs: diff --git a/gnus/Makefile b/gnus/Makefile index 061bfd9..60cef77 100644 --- a/gnus/Makefile +++ b/gnus/Makefile @@ -17,7 +17,7 @@ TMDIR19 = $(HOME)/lib/emacs19/lisp FILES = tm/gnus/*.el tm/doc/tm-gnus*.texi -TARFILE = tm-gnus7.15.tar +TARFILE = tm-gnus7.16.tar gnus3: diff --git a/gnus/tm-gnus5.el b/gnus/tm-gnus5.el index f92c6a0..25b1443 100644 --- a/gnus/tm-gnus5.el +++ b/gnus/tm-gnus5.el @@ -22,7 +22,7 @@ ;;; (defconst tm-gnus/RCS-ID - "$Id: tm-gnus5.el,v 7.8 1995/11/10 10:07:15 morioka Exp $") + "$Id: tm-gnus5.el,v 7.9 1995/11/15 10:41:02 morioka Exp $") (defconst tm-gnus/version (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 5.0.x")) @@ -81,7 +81,7 @@ This variable is set to `gnus-show-mime'.") (set-buffer gnus-article-buffer) (gnus-fetch-field "Mime-Version") ))) - (let ((mime-viewer/ignored-field-list + (let ((mime-viewer/ignored-field-regexp (if (save-excursion (set-buffer gnus-article-buffer) (some-element @@ -89,7 +89,8 @@ This variable is set to `gnus-show-mime'.") (rfc822/get-field-body field) ) mime-viewer/ignored-field-list)) - mime-viewer/ignored-field-list))) + mime-viewer/ignored-field-regexp + "^:$"))) (gnus-summary-select-article t t) ) (gnus-summary-toggle-header arg) diff --git a/gnus/tm-sgnus.el b/gnus/tm-sgnus.el index 23afbaa..c253d00 100644 --- a/gnus/tm-sgnus.el +++ b/gnus/tm-sgnus.el @@ -21,7 +21,7 @@ ;;; (defconst tm-gnus/RCS-ID - "$Id: tm-sgnus.el,v 7.15 1995/11/13 09:29:19 morioka Exp $") + "$Id: tm-sgnus.el,v 7.16 1995/11/15 10:36:09 morioka Exp $") (defconst tm-gnus/version (concat (get-version-string tm-gnus/RCS-ID) " for September")) @@ -70,7 +70,7 @@ This variable is set to `gnus-show-mime'.") (set-buffer gnus-article-buffer) (gnus-fetch-field "Mime-Version") ))) - (let ((mime-viewer/ignored-field-list + (let ((mime-viewer/ignored-field-regexp (if (save-excursion (set-buffer gnus-article-buffer) (some-element @@ -78,7 +78,8 @@ This variable is set to `gnus-show-mime'.") (rfc822/get-field-body field) ) mime-viewer/ignored-field-list)) - mime-viewer/ignored-field-list))) + mime-viewer/ignored-field-regexp + "^:$"))) (gnus-summary-select-article t t) ) (gnus-summary-toggle-header arg) diff --git a/mh-e/Makefile b/mh-e/Makefile index d5f98c8..448bc11 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.17.tar +TARFILE = tm-mh-e7.20.tar elc: diff --git a/mh-e/tm-mh-e.el b/mh-e/tm-mh-e.el index 9907f71..559388e 100644 --- a/mh-e/tm-mh-e.el +++ b/mh-e/tm-mh-e.el @@ -5,6 +5,7 @@ ;;; Copyright (C) 1993,1994,1995 MORIOKA Tomohiko ;;; ;;; Author: MORIOKA Tomohiko +;;; OKABE Yasuo ;;; Keywords: mail, MH, MIME, multimedia, encoded-word, multilingual ;;; ;;; This file is part of tm (Tools for MIME). @@ -26,7 +27,7 @@ ;;; (defconst tm-mh-e/RCS-ID - "$Id: tm-mh-e.el,v 7.17 1995/11/14 06:29:27 morioka Exp $") + "$Id: tm-mh-e.el,v 7.20 1995/11/15 12:45:44 morioka Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) @@ -289,18 +290,30 @@ With arg, turn MIME processing on if arg is positive." (tm-mh-e::message/number message) (mh-expand-file-name (tm-mh-e::message/folder message)) )) - + +;;; modified by OKABE Yasuo +;;; 1995/11/14 (c.f. [tm ML:1096]) (defun tm-mh-e/prompt-for-message (prompt folder &optional default) - (let ((files - (directory-files (mh-expand-file-name folder) nil "^[0-9]+$") - ) - (default (and (boundp 'mh-sent-from-msg) mh-sent-from-msg)) - ) - (setq default - (if default - (int-to-string default) - (car files) - )) + (let* ((files + (directory-files (mh-expand-file-name folder) nil "^[0-9]+$") + ) + (folder-buf (get-buffer folder)) + (default + (if folder-buf + (save-excursion + (set-buffer folder-buf) + (let ((show-buffer (get-buffer mh-show-buffer))) + (if show-buffer + (file-name-nondirectory + (buffer-file-name show-buffer)) + )))))) + (if (or (null default) + (not (string-match "^[0-9]+$" default))) + (setq default + (if (string= folder mh-sent-from-folder) + (int-to-string mh-sent-from-msg) + (car files) + ))) (completing-read prompt (let ((i 0)) (mapcar (function @@ -313,11 +326,86 @@ With arg, turn MIME processing on if arg is positive." )) (defun tm-mh-e/query-message () - (let* ((folder (mh-prompt-for-folder "Visit" "+inbox" nil)) - (number (tm-mh-e/prompt-for-message "Number: " folder)) + (let* ((folder (mh-prompt-for-folder + "Message from" (or mh-sent-from-folder "+inbox") nil)) + (number (tm-mh-e/prompt-for-message "Message number: " folder)) ) (tm-mh-e::make-message folder number) )) +;;; end + +;;; by OKABE Yasuo +;;; 1995/11/14 (c.f. [tm ML:1099]) +(defun tm-mh-e/forward (to cc &optional msg-or-seq) + "Forward a message or message sequence as MIME multipart/digest. +Defaults to displayed message. If optional prefix argument provided, +then prompt for the message sequence. See also documentation for +`\\[mh-send]' function." + (interactive (list (mh-read-address "To: ") + (mh-read-address "Cc: ") + (if current-prefix-arg + (mh-read-seq-default "Forward" t) + (mh-get-msg-num t)))) + (or msg-or-seq + (setq msg-or-seq (mh-get-msg-num t))) + (if (numberp msg-or-seq) + (setq msg-or-seq (int-to-string msg-or-seq))) + (let* ((folder mh-current-folder) + (config (current-window-configuration)) + ;; use "draft" for compatibility with forw. + ;; forw always leaves file in "draft" since it doesn't have -draft + (draft-name (expand-file-name "draft" mh-user-path)) + (draft (cond ((or (not (file-exists-p draft-name)) + (y-or-n-p "The file 'draft' exists. Discard it? ")) + (mh-exec-cmd "comp" + "-noedit" "-nowhatnowproc" + "-nodraftfolder") + (prog1 + (mh-read-draft "" draft-name t) + (mh-insert-fields "To:" to "Cc:" cc) + (set-buffer-modified-p nil))) + (t + (mh-read-draft "" draft-name nil))))) + (let (orig-from + orig-subject) + (goto-char (point-min)) + (save-excursion + (save-restriction + (re-search-forward "^-*\n") + (insert "--<>-{\n") + (mh-exec-cmd-output "pick" nil folder msg-or-seq) + (narrow-to-region (point) (mark t)) + (while (re-search-forward "^\\([0-9]+\\)\n" nil t) + (let ((forw-msg + (buffer-substring (match-beginning 1) (match-end 1)))) + (replace-match "--[[message/rfc822]]\n" nil nil) + (insert-file (mh-expand-file-name + forw-msg (mh-expand-file-name folder))) + (if (not (bolp)) (insert "\n")) + (mime-editor/inserted-message-filter)) + (goto-char (mark t))) + (insert-string "--}-<>"))) + (re-search-forward "^--\\[\\[message/rfc822\\]") + (forward-line 1) + (save-restriction + (narrow-to-region (point) (point-max)) + (setq orig-from (mh-get-header-field "From:")) + (setq orig-subject (mh-get-header-field "Subject:"))) + (let ((forw-subject + (mh-forwarded-letter-subject orig-from orig-subject))) + (mh-insert-fields "Subject:" forw-subject) + (goto-char (point-min)) + (re-search-forward "^--\\[\\[message/rfc822\\]") + (forward-line -1) + (delete-other-windows) + (if (numberp msg-or-seq) + (mh-add-msgs-to-seq msg-or-seq 'forwarded t) + (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)) + (mh-compose-and-send-mail draft "" folder msg-or-seq + to forw-subject cc + mh-note-forw "Forwarded:" + config))))) +;;; end (defun tm-mh-e/insert-message (&optional message) (if (null message) @@ -342,6 +430,13 @@ With arg, turn MIME processing on if arg is positive." 'news-reply-mode (function tm-mh-e/insert-message)) ))) +(call-after-loaded + 'mime-setup + (lambda () + (substitute-key-definition + 'mh-forward 'tm-mh-e/forward mh-folder-mode-map) + )) + ;;; @ set up ;;; diff --git a/mk-tm b/mk-tm index b8a2135..86e9d00 100644 --- a/mk-tm +++ b/mk-tm @@ -14,6 +14,9 @@ (require 'tl-misc) +;; Please specify VM path. +(add-path "vm-5.95beta/") + (setq tm-modules (append (cons diff --git a/tm-def.el b/tm-def.el index adda95a..2ecb1a4 100644 --- a/tm-def.el +++ b/tm-def.el @@ -6,7 +6,7 @@ ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: tm-def.el,v 7.2 1995/11/14 04:56:15 morioka Exp $ +;;; $Id: tm-def.el,v 7.3 1995/11/15 14:21:50 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia, definition ;;; ;;; This file is part of tm (Tools for MIME). @@ -227,7 +227,8 @@ ROT47 will be performed for Japanese text in any case." )) (reverse field-list) ) - (set regexp-sym (apply (function regexp-or) fields)) + (set regexp-sym + (concat "^" (apply (function regexp-or) fields) ":")) (set sym fields) )) @@ -248,7 +249,8 @@ ROT47 will be performed for Japanese text in any case." (setq fields (delete field fields)) )) field-list) - (set regexp-sym (apply (function regexp-or) fields)) + (set regexp-sym + (concat "^" (apply (function regexp-or) fields) ":")) (set sym fields) )) diff --git a/tm-edit.el b/tm-edit.el index 3e18008..05311fc 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/14 05:04:22 $|$Revision: 7.24 $|~/misc/mime.el.Z| +;; $Date: 1995/11/15 14:17:09 $|$Revision: 7.25 $|~/misc/mime.el.Z| ;;; Code: @@ -125,7 +125,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 7.24 1995/11/14 05:04:22 morioka Exp $") + "$Id: tm-edit.el,v 7.25 1995/11/15 14:17:09 morioka Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -311,7 +311,9 @@ 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)) + (concat "^" + (apply (function regexp-or) mime-editor/yank-ignored-field-list) + ":")) (defvar mime-editor/message-inserter-alist nil) (defvar mime-editor/mail-inserter-alist nil) @@ -2161,7 +2163,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" )) (defun mime-viewer::quitting-method/draft-preview () - (let ((mother mime/mother-buffer)) + (let ((mother mime::preview/mother-buffer)) (save-excursion (switch-to-buffer mother) (goto-char (point-min)) diff --git a/tm-parse.el b/tm-parse.el index 3f74127..3dbfa3f 100644 --- a/tm-parse.el +++ b/tm-parse.el @@ -6,7 +6,7 @@ ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: tm-parse.el,v 5.0 1995/10/12 14:29:30 morioka Exp $ +;;; $Id: tm-parse.el,v 6.0 1995/11/15 11:56:10 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia ;;; ;;; This file is part of tm (Tools for MIME). @@ -85,17 +85,20 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" (defun mime/parse-multipart (boundary ctype params encoding rcnum) (goto-char (point-min)) - (let ((beg (point-min)) - (end (if (re-search-forward - (concat "^--" (regexp-quote boundary) "--$") nil t) - (match-beginning 0) - (point-max) - )) - (rsep (concat "^--" (regexp-quote boundary) "\n")) - (dc-ctl - (cond ((string= ctype "multipart/digest") '("message/rfc822")) - (t '("text/plain")))) - cb ce ct ret ncb children (i 0)) + (let* ((dash-boundary (concat "--" boundary)) + (delimiter (concat "\n" dash-boundary)) + (close-delimiter (concat delimiter "--")) + (beg (point-min)) + (end (if (search-forward close-delimiter nil t) + (match-beginning 0) + (point-max) + )) + (rsep (concat (regexp-quote delimiter) "[ \t]*\n")) + (dc-ctl + (cond ((string= ctype "multipart/digest") '("message/rfc822")) + (t '("text/plain")) + )) + cb ce ct ret ncb children (i 0)) (save-restriction (narrow-to-region beg end) (goto-char beg) diff --git a/tm-view.el b/tm-view.el index 906f524..0d88b18 100644 --- a/tm-view.el +++ b/tm-view.el @@ -25,7 +25,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.24 1995/11/14 06:14:37 morioka Exp $") + "$Id: tm-view.el,v 7.25 1995/11/15 13:57:33 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -103,7 +103,9 @@ Each elements are regexp of field-name. [tm-view.el]") (defvar mime-viewer/ignored-field-regexp - (apply (function regexp-or) mime-viewer/ignored-field-list)) + (concat "^" + (apply (function regexp-or) mime-viewer/ignored-field-list) + ":")) (defvar mime-viewer/announcement-for-message/partial (if (and (>= emacs-major-version 19) window-system) diff --git a/tm-vm.el b/tm-vm.el index 2dc847b..adb0e0a 100644 --- a/tm-vm.el +++ b/tm-vm.el @@ -4,23 +4,25 @@ ;;; Copyright (C) 1995 Free Software Foundation, Inc. ;;; ;;; Author: MASUTANI Yasuhiro -;;; and Kenji Wakamiya +;;; Kenji Wakamiya +;;; MORIOKA Tomohiko +;;; Shuhei KOBAYASHI +;;; Oscar Figueiredo ;;; modified by SHIONO Jun'ichi , -;;; Steinar Bang , -;;; Shuhei KOBAYASHI , -;;; and MORIOKA Tomohiko +;;; and Steinar Bang , +;;; ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). ;;; -;;; Plese insert (require 'tm-vm) in your .vm or .emacs. +;;; Plese insert (require 'tm-vm) in your ~/.vm or ~/.emacs file. ;;; (require 'tm-view) (require 'vm) (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 7.4 1995/11/14 04:52:30 morioka Exp $") + "$Id: tm-vm.el,v 7.7 1995/11/15 15:35:54 morioka Exp $") (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) (define-key vm-mode-map "Z" 'tm-vm/view-message) @@ -120,7 +122,28 @@ all marked messages are affected, other messages are ignored." "If non-nil, show MIME processed article.") (defun tm-vm/preview-current-message () - (if tm-vm/automatic-mime-preview + ;;; suggested by Simon Rowe + ;;; (c.f. [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-out*") + (delete-window (get-buffer-window (get-buffer "*MIME-out*"))) + ) + (display-buffer (current-buffer)) + (if (and tm-vm/automatic-mime-preview + (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))) (vm-display (current-buffer) t '(tm-vm/preview-current-message @@ -128,81 +151,106 @@ all marked messages are affected, other messages are ignored." '(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) +;; fixed by Oscar Figueiredo +;; 1995/11/14 (c.f. [tm-eng:162]) (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) - )) + (if (not tm-vm/automatic-mime-preview) + (vm-scroll-forward) + (let* ((summary-buffer (or vm-summary-buffer + (and (eq major-mode 'vm-summary-mode) + (current-buffer)))) + (summary-win (get-buffer-window summary-buffer)) + (mail-buffer (save-excursion + (set-buffer summary-buffer) + vm-mail-buffer)) + (mail-win (get-buffer-window mail-buffer)) + (preview-win (get-buffer-window + (save-excursion + (set-buffer mail-buffer) + mime::article/preview-buffer)))) + (if preview-win + (progn + (select-window preview-win) + (if (pos-visible-in-window-p (point-max) preview-win) + (progn + (switch-to-buffer mail-buffer) + (goto-char (point-max)) + (select-window summary-win)) + (scroll-up) + (switch-to-buffer mail-buffer) + (select-window summary-win)))) + (vm-scroll-forward) + (save-excursion + (set-buffer summary-buffer) + (setq mail-win (get-buffer-window vm-mail-buffer))) + (if mail-win + (progn + (select-window mail-win) + (switch-to-buffer mime::article/preview-buffer) + (select-window summary-win))) + ))) (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) - )) + (if (not tm-vm/automatic-mime-preview) + (vm-scroll-backward) + (let* ((summary-buffer (or vm-summary-buffer + (and (eq major-mode 'vm-summary-mode) + (current-buffer)))) + (summary-win (get-buffer-window summary-buffer)) + (mail-buffer (save-excursion + (set-buffer summary-buffer) + vm-mail-buffer)) + (mail-win (get-buffer-window mail-buffer)) + (preview-win (get-buffer-window + (save-excursion + (set-buffer mail-buffer) + mime::article/preview-buffer)))) + (if preview-win + (progn + (select-window preview-win) + (if (pos-visible-in-window-p (point-min) preview-win) + (progn + (switch-to-buffer mail-buffer) + (goto-char (point-min)) + (select-window summary-win)) + (scroll-down) + (switch-to-buffer mail-buffer) + (select-window summary-win)))) + (vm-scroll-backward nil) + (save-excursion + (set-buffer summary-buffer) + (setq mail-win (get-buffer-window vm-mail-buffer))) + (if mail-win + (progn + (select-window mail-win) + (switch-to-buffer mime::article/preview-buffer) + (select-window summary-win))) + ))) + +(defun tm-vm/quit () + (interactive) + (save-excursion + (set-buffer vm-mail-buffer) + (if mime::article/preview-buffer + (kill-buffer mime::article/preview-buffer))) + (vm-quit) + ) (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) +(substitute-key-definition 'vm-quit + 'tm-vm/quit vm-mode-map) +;; end + (defun tm-vm/toggle-preview-mode () (interactive) @@ -231,7 +279,7 @@ all marked messages are affected, other messages are ignored." ) )) - + ;;; @ for tm-view ;;; @@ -329,7 +377,8 @@ 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) + (let ((digest (consp (cdr mlist))) + m) (save-restriction (narrow-to-region (point) (point)) (while mlist @@ -338,7 +387,8 @@ These are the messages that will be enclosed." (tm-vm/insert-message m) (goto-char (point-max)) (setq mlist (cdr mlist))) - (mime-editor/enclose-digest-region (point-min) (point-max)) + (if digest + (mime-editor/enclose-digest-region (point-min) (point-max))) )))) (defun tm-vm/forward-message () @@ -396,20 +446,40 @@ only marked messages will be put into the digest." (vm-check-for-killed-summary) (vm-error-if-folder-empty) (let ((dir default-directory) + (mp vm-message-pointer) (mlist (if (eq last-command 'vm-next-command-uses-marks) (vm-select-marked-or-prefixed-messages 0) - vm-message-list))) + vm-message-list)) + start) (save-restriction (widen) (vm-mail-internal (format "digest from %s" (buffer-name))) (setq vm-system-state 'forwarding + vm-forward-list mlist default-directory dir) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (goto-char (match-end 0)) + (setq start (point) + mp mlist) (vm-unsaved-message "Building %s digest..." vm-digest-send-type) (tm-vm/enclose-messages mlist) + (goto-char start) + (setq mp mlist) + (if prefix + (progn + (mime-editor/insert-tag "text" "plain") + (vm-unsaved-message "Building digest preamble...") + (while mp + (let ((vm-summary-uninteresting-senders nil)) + (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n")) + (if vm-digest-center-preamble + (progn + (forward-char -1) + (center-line) + (forward-char 1))) + (setq mp (cdr mp))))) (mail-position-on-field "To") (message "Building %s digest... done" vm-digest-send-type))) ;; (run-hooks 'tm-vm/send-digest-hook) ; Is it necessary?