From 374a8f8ba221ac2f714ee0894a02810591f8631e Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 9 Mar 1998 07:10:07 +0000 Subject: [PATCH] tm 6.76. --- Changes-6.75-6.76.en | 46 ++++++++++++++++ Changes-6.75-6.76.ja | 46 ++++++++++++++++ Makefile | 2 +- README.eng | 4 +- gnus/Makefile | 2 +- gnus/mk-tgnus | 17 +++--- gnus/tm-dgnus.el | 18 +++++-- mk-tm | 16 +++++- tm-comp.el | 56 ++++++++++++++++--- tm-view.el | 146 +++++++++++++++++++++++++++++--------------------- 10 files changed, 270 insertions(+), 83 deletions(-) create mode 100644 Changes-6.75-6.76.en create mode 100644 Changes-6.75-6.76.ja diff --git a/Changes-6.75-6.76.en b/Changes-6.75-6.76.en new file mode 100644 index 0000000..5a907b3 --- /dev/null +++ b/Changes-6.75-6.76.en @@ -0,0 +1,46 @@ +* tm + + Fixed mk-tm. + +tm/tm-view.el +---------------------------- +revision 6.76 +date: 1995/08/31 15:05:50; author: morioka; state: Exp; lines: +6 -2 +Fixed function `mime-viewer/make-preview-buffer' about using of function +`mime-viewer/get-subject'. +---------------------------- +revision 6.75 +date: 1995/08/31 14:10:04; author: morioka; state: Exp; lines: +81 -61 +Show content-subject in body part of preview-buffer for single part +hidden body message. So separated content-subject inserter from +function `mime-viewer/default-content-subject-function' to function +`mime-viewer/insert-content-subject'. +---------------------------- + +tm/tm-comp.el +---------------------------- +revision 6.10 +date: 1995/08/30 05:37:50; author: morioka; state: Exp; lines: +5 -6 +Rewrote regexps of constant `mime/message-nuke-headers' and constant +`mime/message-blind-headers'. +---------------------------- +revision 6.9 +date: 1995/08/30 05:01:46; author: morioka; state: Exp; lines: +46 -1 +Defined function `tm-comp::mime-insert-file' to expand parameter +expression of variable `mime-file-types'. +---------------------------- + + +* tm/gnus + + Attached version 6.17. + + Fixed mk-tgnus. + +tm/gnus/tm-dgnus.el +---------------------------- +revision 6.17 +date: 1995/08/31 05:55:52; author: morioka; state: Exp; lines: +13 -5 +According to Mr.Nishijima 's report, +measured to (ding) GNUS 0.99.28 changes. +---------------------------- diff --git a/Changes-6.75-6.76.ja b/Changes-6.75-6.76.ja new file mode 100644 index 0000000..f1b6558 --- /dev/null +++ b/Changes-6.75-6.76.ja @@ -0,0 +1,46 @@ +* tm + + mk-tm を修正した。 + +tm/tm-view.el +---------------------------- +revision 6.76 +date: 1995/08/31 15:05:50; author: morioka; state: Exp; lines: +6 -2 +関数 mime-viewer/make-preview-buffer における、関数 +mime-viewer/get-subject の使い方に関する不具合を修正した。 +---------------------------- +revision 6.75 +date: 1995/08/31 14:10:04; author: morioka; state: Exp; lines: +81 -61 +single part で body が表示されない message の body 部に +content-subject を表示するようにした。このため、関数 +mime-viewer/default-content-subject-function の content-subject 表示部 +を関数 mime-viewer/insert-content-subject に分離した。 +---------------------------- + +tm/tm-comp.el +---------------------------- +revision 6.10 +date: 1995/08/30 05:37:50; author: morioka; state: Exp; lines: +5 -6 +定数 mime/message-nuke-headers と定数 mime/message-blind-headers の正 +規表現を書き直した。 +---------------------------- +revision 6.9 +date: 1995/08/30 05:01:46; author: morioka; state: Exp; lines: +46 -1 +関数 tm-comp::mime-insert-file を定義し、変数 mime-file-types の +parameters を拡張した。 +---------------------------- + + +* tm/gnus + + Version 6.17 を添付した。 + + mk-tgnus を修正した。 + +tm/gnus/tm-dgnus.el +---------------------------- +revision 6.17 +date: 1995/08/31 05:55:52; author: morioka; state: Exp; lines: +13 -5 +西島 孝徳 さんの指摘に従い、(ding) GNUS +0.99.28 に対応した。 +---------------------------- diff --git a/Makefile b/Makefile index b84867a..3a26d36 100644 --- a/Makefile +++ b/Makefile @@ -67,7 +67,7 @@ TL_FILES = tl/README.eng \ FILES = $(TM_FILES) $(TM_MUA_FILES) $(MEL_FILES) $(TL_FILES) -TARFILE = tm6.74.tar +TARFILE = tm6.76.tar nemacs: diff --git a/README.eng b/README.eng index 7c70661..b5dd5f2 100644 --- a/README.eng +++ b/README.eng @@ -1,6 +1,6 @@ [README for tm (English Version)] by MORIOKA Tomohiko -$Id: README.eng,v 6.3 1995/08/14 17:46:22 morioka Exp $ +$Id: README.eng,v 6.4 1995/08/31 14:22:04 morioka Exp $ 1 What's tm? @@ -139,7 +139,7 @@ tl. Please read tl/README.eng. If you want to use automatic MIME preview support, please apply a patch to (ding) GNUS. This patch is called `with tm patch'. It is available from ftp.jaist.ac.jp:/pub/GNU/elisp/dgnus/. Current version -is dgnus-0.98.7-tm.diff. +is dgnus-0.99.23-tm.diff. 5.1 tm-mh-e diff --git a/gnus/Makefile b/gnus/Makefile index 1c142a2..8afd5a4 100644 --- a/gnus/Makefile +++ b/gnus/Makefile @@ -17,7 +17,7 @@ TMDIR19 = $(HOME)/lib/emacs19/lisp FILES = tm/gnus/*.el -TARFILE = tm-gnus6.16.tar +TARFILE = tm-gnus6.17.tar gnus3: diff --git a/gnus/mk-tgnus b/gnus/mk-tgnus index 2e9924c..7171b82 100644 --- a/gnus/mk-tgnus +++ b/gnus/mk-tgnus @@ -4,12 +4,17 @@ (require 'gnus) (require 'tm-view) (princ (format "%s\n" gnus-version)) - (if (string-match "(ding)" gnus-version) - (byte-compile-file "tm-dgnus.el") - (if (string-match "GNUS 3" gnus-version) - (byte-compile-file "tm-gnus3.el") - (byte-compile-file "tm-gnus4.el") - )) + (cond ((string-match "(ding)" gnus-version) + (if (string-lessp "(ding) Gnus v0.99.27" gnus-version) + (byte-compile-file "tm-dgnus.el") + ) + ) + ((string-match "GNUS 3" gnus-version) + (byte-compile-file "tm-gnus3.el") + ) + (t + (byte-compile-file "tm-gnus4.el") + )) (byte-compile-file "tm-gnus.el") ) diff --git a/gnus/tm-dgnus.el b/gnus/tm-dgnus.el index bedfe88..1c69e6e 100644 --- a/gnus/tm-dgnus.el +++ b/gnus/tm-dgnus.el @@ -10,7 +10,7 @@ ;;; @ version ;;; (defconst tm-gnus/RCS-ID - "$Id: tm-dgnus.el,v 6.16 1995/08/30 02:44:11 morioka Exp $") + "$Id: tm-dgnus.el,v 6.17 1995/08/31 05:55:52 morioka Exp $") (defconst tm-gnus/version (concat (get-version-string tm-gnus/RCS-ID) " (ding)")) @@ -29,6 +29,14 @@ (concat "*Preview-" gnus-clean-article-buffer "*")) ) +(if (not (fboundp 'mail-header-from)) + (progn + (defalias 'mail-header-from 'header-from) + (defalias 'mail-header-set-from 'header-set-from) + (defalias 'mail-header-subject 'header-subject) + (defalias 'mail-header-set-subject 'header-set-subject) + )) + ;;; @ autoload ;;; @@ -85,13 +93,13 @@ article is automatic MIME decoded.") (defun tm-gnus/decode-summary-from-and-subjects () (mapcar (function (lambda (header) - (header-set-from + (mail-header-set-from header - (mime/decode-string (or (header-from header) "")) + (mime/decode-string (or (mail-header-from header) "")) ) - (header-set-subject + (mail-header-set-subject header - (mime/decode-string (or (header-subject header) "")) + (mime/decode-string (or (mail-header-subject header) "")) ) )) gnus-newsgroup-headers) diff --git a/mk-tm b/mk-tm index df145e8..e743639 100644 --- a/mk-tm +++ b/mk-tm @@ -28,7 +28,7 @@ '("signature" "tiny-mime" "tm-misc" "tm-view" - "tm-ftp" "tm-latex" + "tm-latex" "tm-rmail" "tm-comp" "tm-setup" "mime-setup" )) @@ -48,6 +48,20 @@ (if (catch 'tag (let ((paths load-path) path) (while paths + (setq path (expand-file-name "ange-ftp.el" (car paths))) + (if (file-exists-p path) + (throw 'tag path) + ) + (setq paths (cdr paths)) + ))) + (setq tm-modules (append tm-modules '("tm-ftp"))) + (setq tm-uncompile-el-files + (append tm-uncompile-el-files '("tm-ftp.el"))) + ) + +(if (catch 'tag + (let ((paths load-path) path) + (while paths (setq path (expand-file-name "vm.el" (car paths))) (if (file-exists-p path) (throw 'tag path) diff --git a/tm-comp.el b/tm-comp.el index 1ae12f0..bb865e6 100644 --- a/tm-comp.el +++ b/tm-comp.el @@ -22,7 +22,7 @@ ;;; (defconst mime/composer-RCS-ID - "$Id: tm-comp.el,v 6.8 1995/08/30 00:40:26 morioka Exp $") + "$Id: tm-comp.el,v 6.10 1995/08/30 05:37:50 morioka Exp $") (defconst mime/composer-version (get-version-string mime/composer-RCS-ID)) @@ -36,9 +36,8 @@ '((news-reply-mode . 500))) (defconst mime/message-nuke-headers - "\\(^[Cc]ontent-\\|^[Ss]ubject:\\|^[Mm][Ii][Mm][Ee]-[Vv]ersion:\\)") -(defvar mime/message-blind-headers - "\\(^[BDFbdf][Cc][Cc]:\\|^[Cc][Cc]:[ \t]*$\\)") + "\\(^Content-\\|^Subject:\\|^MIME-Version:\\)") +(defvar mime/message-blind-headers "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") (defvar mime/message-default-sender-alist '((mail-mode . mail-send-and-exit) @@ -115,6 +114,45 @@ ;;; @ edit ;;; +(defun tm-comp::mime-insert-file (file) + "Insert a message from a file." + (interactive "fInsert file as MIME message: ") + (let* ((guess (mime-find-file-type file)) + (pritype (nth 0 guess)) + (subtype (nth 1 guess)) + (parameters (nth 2 guess)) + (default (nth 3 guess)) ;Guess encoding from its file name. + (encoding + (if (not (interactive-p)) + default + (completing-read + (concat "What transfer encoding" + (if default + (concat " (default " + (if (string-equal default "") "\"\"" default) + ")" + )) + ": ") + mime-transfer-encoders nil t nil)))) + (if (string-equal encoding "") + (setq encoding default)) + (if (consp parameters) + (let ((rest parameters) cell attribute value) + (setq parameters "") + (while rest + (setq cell (car rest)) + (setq attribute (car cell)) + (setq value (cdr cell)) + (if (eq value 'file) + (setq value (file-name-nondirectory file)) + ) + (setq parameters (concat parameters "; " attribute "=" value)) + (setq rest (cdr rest)) + ))) + (mime-insert-tag pritype subtype parameters) + (mime-insert-binary-file file encoding) + )) + ;; Insert the binary content after MIME tag. ;; modified by MORITA Masahiro ;; for x-uue @@ -304,6 +342,12 @@ Optional argument ENCODING specifies an encoding method such as base64." (add-hook 'mime-mode-hook (function (lambda () + (if (not (fboundp 'original::mime-insert-file)) + (progn + (fset 'original::mime-insert-file + (symbol-function 'mime-insert-file)) + (fset 'mime-insert-file 'tm-comp::mime-insert-file) + )) (if (not (fboundp 'original::mime-insert-binary-file)) (progn (fset 'original::mime-insert-binary-file @@ -422,6 +466,6 @@ Optional argument ENCODING specifies an encoding method such as base64." ) -(run-hooks 'tm-comp-load-hook) - (provide 'tm-comp) + +(run-hooks 'tm-comp-load-hook) diff --git a/tm-view.el b/tm-view.el index 517856f..dc97f26 100644 --- a/tm-view.el +++ b/tm-view.el @@ -21,7 +21,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 6.74 1995/08/27 19:05:58 morioka Exp $") + "$Id: tm-view.el,v 6.76 1995/08/31 15:05:50 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -154,6 +154,34 @@ ;;; @@ content subject ;;; +(defun mime-viewer/insert-content-subject + (cnum cinfo ctype params subj) + (insert + (let ((access-type (assoc "access-type" params)) + (num (or (assoc-value "x-part-number" params) + (if (listp cnum) + (mapconcat (function + (lambda (num) + (format "%s" (+ num 1)) + )) + cnum ".") + "0")) + )) + (if access-type + (let ((server (assoc "server" params))) + (setq access-type (cdr access-type)) + (if server + (format "[%s %s ([%s] %s)]\n" num subj + access-type (cdr server)) + (let ((site (assoc-value "site" params)) + (dir (assoc-value "directory" params)) + ) + (format "[%s %s ([%s] %s:%s)]\n" num subj + access-type site dir) + ))) + (format "[%s %s (%s)]\n" num subj ctype) + )))) + (defun mime-viewer/default-content-subject-function (cnum cinfo ctype params subj) (if (and (listp cnum) @@ -161,31 +189,9 @@ ctype mime-viewer/content-subject-omitting-Content-Type-list)) ) - (insert - (let ((access-type (assoc "access-type" params)) - (num (or (assoc-value "x-part-number" params) - (if (listp cnum) - (mapconcat (function - (lambda (num) - (format "%s" (+ num 1)) - )) - cnum ".") - "0")) - )) - (if access-type - (let ((server (assoc "server" params))) - (setq access-type (cdr access-type)) - (if server - (format "[%s %s ([%s] %s)]\n" num subj - access-type (cdr server)) - (let ((site (assoc-value "site" params)) - (dir (assoc-value "directory" params)) - ) - (format "[%s %s ([%s] %s:%s)]\n" num subj - access-type site dir) - ))) - (format "[%s %s (%s)]\n" num subj ctype) - ))))) + (mime-viewer/insert-content-subject + cnum cinfo ctype params subj) + )) (defvar mime-viewer/content-subject-function (function mime-viewer/default-content-subject-function)) @@ -557,6 +563,11 @@ it is regarded as current-buffer. [tm-view]" (if (> he (point-max)) (setq he (point-max)) ) + (save-excursion + (save-restriction + (narrow-to-region beg he) + (setq subj (mime-viewer/get-subject params)) + )) (switch-to-buffer obuf) (setq nb (point)) (narrow-to-region nb nb) @@ -577,47 +588,60 @@ it is regarded as current-buffer. [tm-view]" (run-hooks 'mime-viewer/content-header-filter-hook) (switch-to-buffer the-buf) )) - (if (mime-viewer/body-visible-p cnum cinfo ctype) - (let (be) - (setq str (buffer-substring he end)) - (switch-to-buffer obuf) - (save-restriction - (setq be (point-max)) - (narrow-to-region be be) - (insert str) - (setq ne (point-max)) - (let ((f (or (assoc-value - ctype - mime-viewer/content-filter-alist) - ))) - (if (and f (fboundp f)) - (funcall f ctype params encoding) - (mime-viewer/default-content-filter - cnum cinfo ctype params subj) - )) - (setq ne (point-max)) - ) - (switch-to-buffer the-buf) + (cond ((mime-viewer/body-visible-p cnum cinfo ctype) + (let (be) + (setq str (buffer-substring he end)) + (switch-to-buffer obuf) + (save-restriction + (setq be (point-max)) + (narrow-to-region be be) + (insert str) + (setq ne (point-max)) + (let ((f (or (assoc-value + ctype + mime-viewer/content-filter-alist) + ))) + (if (and f (fboundp f)) + (funcall f ctype params encoding) + (mime-viewer/default-content-filter + cnum cinfo ctype params subj) + )) + (setq ne (point-max)) + ) + (switch-to-buffer the-buf) + )) + ((equal ctype "message/partial") + (let (be) + (switch-to-buffer obuf) + (save-restriction + (setq be (point-max)) + (narrow-to-region be be) + (insert + mime-viewer/announcement-for-message/partial) + (setq ne (point-max)) + ) + (switch-to-buffer the-buf) + )) + ((and (eq cnum t) + (null (mime::content-info/children cinfo)) + ) + (let (be) + (switch-to-buffer obuf) + (save-restriction + (setq be (point-max)) + (narrow-to-region be be) + (mime-viewer/insert-content-subject + cnum cinfo ctype params subj) + (setq ne (point-max)) + ) + (switch-to-buffer the-buf) + )) ) - (if (equal ctype "message/partial") - (let (be) - (switch-to-buffer obuf) - (save-restriction - (setq be (point-max)) - (narrow-to-region be be) - (insert - mime-viewer/announcement-for-message/partial) - (setq ne (point-max)) - ) - (switch-to-buffer the-buf) - )) - ) (switch-to-buffer obuf) (mime-viewer/default-content-separator cnum cinfo ctype params subj) (prog1 (progn - (setq subj (mime-viewer/get-subject params)) (goto-char nb) (funcall mime-viewer/content-subject-function cnum cinfo ctype params subj) -- 1.7.10.4