From: morioka Date: Mon, 9 Mar 1998 17:37:07 +0000 (+0000) Subject: tm 7.52.1. X-Git-Tag: tm7_52_1~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f23312823073375ef7443064a48f3175063bb7b3;p=elisp%2Ftm.git tm 7.52.1. --- diff --git a/ChangeLog b/ChangeLog index 97d3eec..7091546 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,183 @@ +Mon Apr 22 12:40:55 1996 MORIOKA Tomohiko + + * tm: Version 7.52.1 was released. + * tm/mh-e: Version 7.58 was released. + + * tm-def.el (mime/code-convert-region-to-emacs): use function + `code-convert-region' instead of `code-convert'. + (mime/code-convert-region-from-emacs): use function + `code-convert-region' instead of `code-convert'. + (mime/charset-coding-system-alist): fixed. + +Sun Apr 21 19:57:22 1996 MORIOKA Tomohiko + + * tm-play.el (mime-article/start-external-method-region): display + message ``External method is starting...''. + +Sun Apr 21 19:42:23 1996 MORIOKA Tomohiko + + * inst-tm (make-mime-setup): setting for variable + `mime-viewer/external-progs'. + + * tm-play.el (mime-viewer/external-progs): New variable. + (mime-article/start-external-method-region): use variable + `mime-viewer/external-progs'. + +Sun Apr 21 18:10:08 1996 MORIOKA Tomohiko + + * inst-tm (compile-tm): modified about tm-gnus compiling. + (compile-tm-gnus): abolished. + + * TM-CFG: Variable `TM_GNUS_COMPILE_FORMAT' was abolished. + + * Makefile (elc): use .gnus-compile. + +Sun Apr 21 17:08:16 1996 MORIOKA Tomohiko + + * tm-view.el (mime-viewer/following-method-alist): New variable. + (mime-viewer/follow-content): New function; + it is bound to `a' key. + (mime-preview/get-original-major-mode): New function. + (mime/viewer-mode-map): Key of function + `mime-viewer/display-x-face' was changed to `x'; + `f' is reserved to forwarding command. + + +Sat Apr 20 12:35:34 1996 MORIOKA Tomohiko + + * tl: Version 7.19.2 was released. + * tm: Version 7.52 was released. + + * tm-def.el (mime/charset-coding-system-alist): add + "X-ISO-2022-JP-2" for old mime.el. + +Sat Apr 20 12:17:27 1996 MORIOKA Tomohiko + + * tm-parse.el (mime/parse-message): use `1+' + + * tm-parse.el (mime/parse-message): use `string-equal' instead of + `string=' + + * tm-parse.el (mime/parse-multipart): use `string-equal' instead + of `string=' + + * tm-parse.el (mime/parse-multipart): use `nreverse' + + * tm-parse.el (mime/parse-multipart): fixed + +Fri Apr 19 18:49:19 1996 Shuhei KOBAYASHI + + * tm-vm.el: Oscar Figueiredo 's patch + was applied; require vm-reply and add comments to vm-yank-message. + (tm-vm/enclose-messages): Don't make nested multipart/digest. + (tm-vm/send-digest): "preamble" code was moved to + `tm-vm/enclose-messages'. + +Fri Apr 19 18:12:43 1996 MORIOKA Tomohiko + + * signature.el (signature/get-signature-file-name): string check + for `field' + +Fri Apr 19 17:29:32 1996 MORIOKA Tomohiko + + * README.en: tm/tm-nemacs, tm/tm-orig.el and tm/tm-mule.el was + abolished. + +Fri Apr 19 13:40:55 1996 Shuhei KOBAYASHI + + * tm-edit.el (mime-editor/insert-signature): Modified for new + implementation of signature.el; Use `signature-insert-hook'. + + * tm-bbdb.el (signature/get-bbdb-sigtype), + (signature/set-bbdb-sigtype), (signature/get-sigtype-from-bbdb): + New implementation of `signature-check-in-bbdb'. + + * signature.el (signature-load-hook), (signature-insert-hook): New + hooks. + (signature-use-bbdb): New variable. + (signature/get-sigtype-interactively), (insert-signature): New + implementation of `insert-signature'; + signature/insert-signature-at-(point|eof) were merged. + +Fri Apr 19 08:47:44 1996 MORIOKA Tomohiko + + * tm-edit.el (mime-editor/normalize-body): use function + `mime/code-convert-region-from-emacs' and `mime-encode-region' + instead of `mime-editor/encode-string'. Function + `mime-editor/encode-string' and `mime-encode-string' was + abolished. + +Fri Apr 19 08:11:30 1996 MORIOKA Tomohiko + + * tm-ew-d.el (mime/decode-encoded-text): arguments order of + function `mime/convert-string-to-emacs' was changed. + + * tm-def.el (mime/convert-string-to-emacs): order of arguments was + changed. + +Fri Apr 19 07:59:28 1996 MORIOKA Tomohiko + + * tm-def.el (mime/lc-charset-alist): use function `foldr'. + +Fri Apr 19 07:29:13 1996 MORIOKA Tomohiko + + * tm-def.el (mime/charset-coding-system-alist): + use function `foldr' + +Fri Apr 19 06:57:56 1996 MORIOKA Tomohiko + + * tm-def.el (mime/code-convert-region-from-emacs): New function + +Fri Apr 19 06:54:11 1996 MORIOKA Tomohiko + + * TM-ELS, Makefile, tm-def.el: tm/tm-nemacs.el was abolished. + + * TM-ELS, Makefile, tm-def.el: tm/tm-orig.el was abolished. + + * TM-ELS, Makefile, tm-def.el: tm/tm-mule.el was abolished. + + * tm-def.el (mime/lc-charset-alist, mime/unknown-charset): + New variable + +Fri Apr 19 05:36:03 1996 MORIOKA Tomohiko + + * tm-def.el (mime/code-convert-region-to-emacs): + New implementation + +Fri Apr 19 04:48:48 1996 Shuhei KOBAYASHI + + * tm-view.el (mime-viewer/up-content): Extra `setq' was removed. + +Wed Apr 17 14:51:25 1996 MORIOKA Tomohiko + + * tm-def.el: Function `mime/convert-string-to-emacs', + `mime/convert-string-from-emacs' and + `mime/code-convert-region-to-emacs' were moved from tm-mule.el. + +Wed Apr 17 14:50:33 1996 MORIOKA Tomohiko + + * tm-mule.el: Function `mime/convert-string-to-emacs', + `mime/convert-string-from-emacs' and + `mime/code-convert-region-to-emacs' were moved to tm-def.el. + +Wed Apr 17 14:30:12 1996 MORIOKA Tomohiko + + * tm-def.el (mime/charset-coding-system-alist): New variable. + + * tm-mule.el: Variable `mime/charset-coding-system-alist' was + deleted. + +Wed Apr 17 14:05:10 1996 MORIOKA Tomohiko + + * tm-view.el (mime-viewer/code-converter-alist): set + `mime/code-convert-region-to-emacs' for + `mime/temporary-message-mode'. (for `mime-editor/preview-message') + +Wed Apr 17 09:20:42 1996 MORIOKA Tomohiko + + * README.en: KOBAYASHI Shuhei's address was changed. + + Tue Apr 16 18:26:13 1996 MORIOKA Tomohiko * tm: Version 7.50 was released. diff --git a/Makefile b/Makefile index 798a238..154dede 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,8 @@ # -# $Id: Makefile,v 7.17 1996/04/09 17:28:49 morioka Exp morioka $ +# $Id: Makefile,v 7.21 1996/04/21 18:06:22 morioka Exp morioka $ # +SHELL = /bin/sh MAKE = make CC = gcc CFLAGS = -O2 @@ -11,12 +12,13 @@ EMACS = emacs BINS = src/ol2 src/decode-b UTILS = $(BINS) -GOMI = $(BINS) mime-setup.el mime-setup.el~ \#mime-setup.el\# *.elc +GOMI = $(BINS) mime-setup.el mime-setup.el~ \#mime-setup.el\# *.elc \ + .gnus-compile* FLAGS = -batch -q -no-site-file TM_FILES = tm/README.en tm/ChangeLog \ tm/Makefile tm/inst-tm tm/TM-ELS tm/TM-CFG \ - tm/tm-mule.el tm/tm-nemacs.el tm/tm-orig.el tm/tm-def.el \ + tm/tm-def.el \ tm/tm-eword.el tm/tm-ew-d.el tm/tm-ew-e.el \ tm/tm-view.el tm/tm-parse.el \ tm/tm-rich.el tm/tm-image.el \ @@ -45,10 +47,11 @@ TL_FILES = tl/README.en tl/Makefile tl/mk-tl tl/tl-els tl/*.el \ FILES = $(TM_FILES) $(TM_MUA_FILES) $(MEL_FILES) $(TL_FILES) -TARFILE = tm7.50.tar.gz +TARFILE = tm7.52.1.tar.gz elc: $(EMACS) $(FLAGS) -l inst-tm -f compile-tm + $(SHELL) .gnus-compile install-elc: elc $(EMACS) $(FLAGS) -l inst-tm -f install-tm diff --git a/README.en b/README.en index 9cd6991..d3c3741 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.15 1996/03/06 02:12:36 morioka Exp $ +and KOBAYASHI Shuhei +$Id: README.en,v 7.17 1996/04/19 17:29:32 morioka Exp $ 1 What's tm? @@ -53,10 +53,6 @@ $Id: README.en,v 7.15 1996/03/06 02:12:36 morioka Exp $ - tm-edit : MIME composer (mime.el and tm-comp.el were merged) - tm-ew-e.el : MIME encoded-word encoder - tm-def : definition module for tm - - tm-nemacs.el : NEmacs depended part of tm - - tm-orig.el : FSF original Emacs and XEmacs - depended part of tm - - tm-mule.el : Mule depended part of tm - tm-MUAs : MIME extender for MUAs - tm-mh-e : tm-MUA for mh-e - tm-gnus : tm-MUA for GNUS @@ -73,8 +69,8 @@ $Id: README.en,v 7.15 1996/03/06 02:12:36 morioka Exp $ You can edit tm/TM-CFG file. - In default, tm is installed into your home directory. If you want to -install into /usr/local/, please modify the variable `PREFIX'. + In default, tm is installed into /usr/local/. If you want to change, +please modify the variable `PREFIX'. 4.2 tm-gnus (optional) @@ -131,7 +127,7 @@ mmencode. 6 .emacs - Please insert (load "mime-setup") in ~/.emacs. + Please insert `(load "mime-setup")' in ~/.emacs. 6.1 automatic MIME preview support @@ -265,7 +261,7 @@ please insert following into ~/.emacs: ====================================================================== -6.5 setting sample for browse +6.5 setting sample for browse-url If you have browse-url.el (included in Gnus 5.*, September Gnus and Emacs 19.30 or later), you can use URL button in diff --git a/TM-CFG b/TM-CFG index 9736aee..c8e92f5 100644 --- a/TM-CFG +++ b/TM-CFG @@ -1,6 +1,6 @@ ;;; -*-Emacs-Lisp-*- ;;; -;;; $Id: TM-CFG,v 3.0 1996/03/27 19:38:12 morioka Exp morioka $ +;;; $Id: TM-CFG,v 4.0 1996/04/21 18:10:08 morioka Exp morioka $ ;;; (setq load-path (append @@ -93,7 +93,7 @@ (defvar BIN_DIR (expand-file-name "bin/" PREFIX)) ;; Please specify binary path. (for external method scripts) -(setq METHOD_DIR BIN_DIR) +(setq METHOD_DIR (expand-file-name "share/tm/" PREFIX)) @@ -139,8 +139,8 @@ (setq TM_MHE_DIR TM_KERNEL_DIR) (setq TM_GNUS_DIR TM_KERNEL_DIR) -(setq TM_GNUS_COMPILE_FORMAT "cd gnus; PWD=`pwd` make %s EMACS=%s") -(setq TM_GNUS_INSTALL_FORMAT "cd gnus; PWD=`pwd` make install-19 EMACS=%s TMDIR19=%s") +(setq TM_GNUS_INSTALL_FORMAT + "cd gnus; PWD=`pwd` make install-19 EMACS=%s TMDIR19=%s") (setq el-file-mode (+ (* 64 6)(* 8 4) 4)) diff --git a/TM-ELS b/TM-ELS index d1b19a6..d8d663d 100644 --- a/TM-ELS +++ b/TM-ELS @@ -1,31 +1,21 @@ ;;; -*-Emacs-Lisp-*- ;;; -;;; $Id: TM-ELS,v 1.2 1996/03/04 08:57:38 morioka Exp $ +;;; $Id: TM-ELS,v 4.0 1996/04/19 06:53:14 morioka Exp $ ;;; (require 'tl-misc) (setq tm-modules - (cons - (cond ((boundp 'NEMACS) - "tm-nemacs" - ) - ((boundp 'MULE) - "tm-mule" - ) - (t - "tm-orig" - )) - '("signature" - "tm-def" - "tm-ew-d" "tm-parse" "tm-view" "tm-play" "tm-partial" - "tm-rich" - "tm-latex" "tm-html" "tm-tar" "tm-file" - "tm-ew-e" - "tm-edit" - "tm-rmail" "tm-mail" - "tm-setup" - ))) + '("signature" + "tm-def" + "tm-ew-d" "tm-parse" "tm-view" "tm-play" "tm-partial" + "tm-rich" + "tm-latex" "tm-html" "tm-tar" "tm-file" + "tm-ew-e" + "tm-edit" + "tm-rmail" "tm-mail" + "tm-setup" + )) (setq tm-uncompile-el-files '("sc-setup.el")) diff --git a/doc/Makefile b/doc/Makefile index 34fbfdf..ba122bc 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -1,5 +1,5 @@ # -# $Id: Makefile,v 2.0 1995/12/17 17:58:43 morioka Exp morioka $ +# $Id: Makefile,v 3.0 1996/04/19 13:39:16 morioka Exp morioka $ # EMACS=mule @@ -7,12 +7,16 @@ MAKEINFO=$(EMACS) -batch -q -no-site-file $< -l texinfmt -f texinfo-format-buffe # MAKEINFO=$(EMACS) -batch -q -no-site-file $< -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer # MAKEINFO=makeinfo $< +TEXI2DVI = texi2dvi $< + +TEXFILES= signature-jp.tex + INFO_JA = tm_ja.info tm-gnus_ja.info tm-mh-e_ja.info INFO_EN = tm_en.info tm-gnus_en.info tm-mh-e_en.info +DVI_JA = tm_ja.dvi tm-gnus_ja.dvi tm-mh-e_ja.dvi signature-jp.dvi +DVI_EN = tm_en.dvi tm-gnus_en.dvi tm-mh-e_en.dvi -TEXFILES= signature-jp.tex -DVIFILES= signature-jp.dvi GOMI = *.aux *.toc *.log \ *.cp *.cps *.fn *.fns *.vr *.vrs *.ky *.pg *.tp \ $(DVIFILES) *.ps *~ @@ -23,6 +27,9 @@ GOMI = *.aux *.toc *.log \ .texi.info: $(MAKEINFO) +.texi.dvi: + $(TEXI2DVI) + .ol.tex: ol2 < $< | plain2 -tex -tstyle=a4j > $@ @@ -31,19 +38,32 @@ GOMI = *.aux *.toc *.log \ jlatex $< -all: $(DVI) +all: world + +world: all-ja all-en -info: $(INFO_JA) $(INFO_EN) +ja: info-ja dvi-ja + +en: info-en info-ja + +info: info-ja info-en + +info-ja: $(INFO_JA) + +info-en: $(INFO_EN) tex: $(TEXFILES) $(TEXFILES): $(OLFILES) -dvi: $(DVIFILES) -$(DVIFILES): $(TEXFILES) +dvi: dvi-ja dvi-en + +dvi-ja: $(DVI_JA) + +dvi-en: $(DVI_EN) clean: diff --git a/inst-tm b/inst-tm index 8df092c..c25c76a 100644 --- a/inst-tm +++ b/inst-tm @@ -1,6 +1,6 @@ ;;; -*-Emacs-Lisp-*- ;;; -;;; $Id: inst-tm,v 3.3 1996/04/09 17:13:36 morioka Exp $ +;;; $Id: inst-tm,v 5.0 1996/04/21 19:43:46 morioka Exp $ ;;; (load-file "TM-CFG") @@ -36,6 +36,8 @@ (insert (format " \(add-path \"%s\")" tm-path))) + (insert (format " +(defvar mime-viewer/external-progs \"%s\")" METHOD_DIR)) (write-file "mime-setup.el") )) @@ -52,17 +54,6 @@ ))) modules)) -(defun compile-tm-gnus (type) - (erase-buffer) - (call-process SHELL - nil t t - SHELLOPTION - (format TM_GNUS_COMPILE_FORMAT - type (car command-line-args)) - ) - (princ (buffer-string)) - ) - (defun install-tm-gnus () (erase-buffer) (call-process SHELL @@ -86,22 +77,27 @@ (compile-el-files "../mel/" mel-modules) (compile-el-files "./" tm-modules) (compile-el-files "mh-e/" tm-mh-e-modules) - (compile-tm-gnus "gnus") - (cond ((string-match "XEmacs" emacs-version) - (compile-tm-gnus "sgnus") - ) - (t (cond ((<= emacs-major-version 18) - (compile-tm-gnus "gnus3") - (compile-tm-gnus "gnus4") - ) - ((< emacs-minor-version 30) - (compile-tm-gnus "gnus4") - (compile-tm-gnus "gnus5") - ) - (t - (compile-tm-gnus "sgnus") - )))) (compile-el-files "./" '("mime-setup")) + (save-excursion + (set-buffer (get-buffer-create ".gnus-compile")) + (let ((emacs (car command-line-args))) + (insert (format "cd gnus\nmake gnus EMACS=%s PWD=`pwd`\n" emacs)) + (cond ((string-match "XEmacs" emacs-version) + (insert (format "make sgnus EMACS=%s PWD=`pwd`\n" emacs)) + ) + (t (cond ((<= emacs-major-version 18) + (insert (format "make gnus3 EMACS=%s PWD=`pwd`\n" emacs)) + (insert (format "make gnus4 EMACS=%s PWD=`pwd`\n" emacs)) + ) + ((< emacs-minor-version 30) + (insert (format "make gnus4 EMACS=%s PWD=`pwd`\n" emacs)) + (insert (format "make gnus5 EMACS=%s PWD=`pwd`\n" emacs)) + ) + (t + (insert (format "make sgnus EMACS=%s PWD=`pwd`\n" emacs)) + ))))) + (write-file ".gnus-compile") + ) ) (defun install-el-file (src dest file) diff --git a/methods/tmdecode b/methods/tmdecode index f98401b..65fbe0c 100755 --- a/methods/tmdecode +++ b/methods/tmdecode @@ -38,5 +38,4 @@ case "$1" in ;; esac -echo "$2 was removed." - +# echo "$2 was removed." diff --git a/mh-e/ChangeLog b/mh-e/ChangeLog index 5fe6cd4..6cfb431 100644 --- a/mh-e/ChangeLog +++ b/mh-e/ChangeLog @@ -1,3 +1,12 @@ +Mon Apr 22 12:52:17 1996 MORIOKA Tomohiko + + * tm/mh-e: Version 7.58 was released. + +Sun Apr 21 17:11:20 1996 MORIOKA Tomohiko + + * tm-mh-e.el (tm-mh-e/following-method): New function. + + Mon Mar 25 11:57:17 1996 MORIOKA Tomohiko * tm/mh-e: Version 7.57 was released. diff --git a/mh-e/Makefile b/mh-e/Makefile index b26948b..7573c64 100644 --- a/mh-e/Makefile +++ b/mh-e/Makefile @@ -24,7 +24,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.57.tar +TARFILE = tm-mh-e7.58.tar elc: diff --git a/mh-e/tm-mh-e.el b/mh-e/tm-mh-e.el index cb56498..7488572 100644 --- a/mh-e/tm-mh-e.el +++ b/mh-e/tm-mh-e.el @@ -9,7 +9,7 @@ ;;; modified by YAMAOKA Katsumi ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1993/11/21 (obsolete mh-e-mime.el) -;;; Version: $Revision: 7.57 $ +;;; Version: $Revision: 7.58 $ ;;; Keywords: mail, MH, MIME, multimedia, encoded-word, multilingual ;;; ;;; This file is part of tm (Tools for MIME). @@ -50,7 +50,7 @@ ;;; (defconst tm-mh-e/RCS-ID - "$Id: tm-mh-e.el,v 7.57 1996/03/25 11:57:17 morioka Exp $") + "$Id: tm-mh-e.el,v 7.58 1996/04/21 17:11:20 morioka Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) @@ -301,6 +301,21 @@ digest are inserted into the folder after that message." ;; (add-hook 'mh-show-hook 'tm-mh-e/set-window-configuration) +(defun tm-mh-e/following-method (to cc subj) + (let ((buf (current-buffer))) + (setq mh-show-buffer buf) + (mh-send (or to "") (or cc "") (or subj "")) + (setq mh-sent-from-folder buf) + (setq mh-sent-from-msg 1) + (let ((last (point))) + (mh-yank-cur-msg) + (goto-char last) + ))) + +(set-alist 'mime-viewer/following-method-alist + 'mh-show-mode + (function tm-mh-e/following-method)) + ;;; @@ for tm-partial ;;; diff --git a/signature.el b/signature.el index 129f28c..d72825e 100644 --- a/signature.el +++ b/signature.el @@ -5,13 +5,16 @@ ;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko ;;; Copyright (C) 1994 OKABE Yasuo ;;; Copyright (C) 1996 Artur Pioro +;;; Copyright (C) 1996 KOBAYASHI Shuhei ;;; ;;; Author: MORIOKA Tomohiko ;;; OKABE Yasuo ;;; Artur Pioro +;;; KOBAYASHI Shuhei +;;; Maintainer: KOBAYASHI Shuhei ;;; Created: 1994/7/11 ;;; Version: -;;; $Id: signature.el,v 7.7 1996/03/14 13:39:57 morioka Exp $ +;;; $Id: signature.el,v 7.9 1996/04/19 18:12:43 morioka Exp $ ;;; Keywords: mail, news, signature ;;; ;;; This file is part of tm (Tools for MIME). @@ -34,134 +37,127 @@ (require 'tl-822) +;;; @ valiables +;;; + (defvar signature-insert-at-eof nil - "*Insert signature at the end of file if non-nil. [signature.el]") + "*Insert signature at the end of file if non-nil.") (defvar signature-delete-blank-lines-at-eof nil - "*Signature-insert-at-eof deletes blank lines at the end of file -if non-nil. [signature.el]") + "*If non-nil, signature-insert-at-eof deletes blank lines at the end +of file.") + +(defvar signature-load-hook nil + "*List of functions called after signature.el is loaded.") (defvar signature-file-name "~/.signature" - "*Name of file containing the user's signature. [signature.el]") + "*Name of file containing the user's signature.") (defvar signature-file-alist nil) (defvar signature-file-prefix nil "*String containing optional prefix for the signature file names") +(defvar signature-insert-hook nil + "*List of functions called before inserting a signature.") + +(defvar signature-use-bbdb nil + "*If non-nil, Register sigtype to BBDB.") + ;;; ;;; Example: ;;; ;;; (setq signature-file-alist -;;; '((("To" . signature-check-in-bbdb) . nil) -;;; (("Newsgroups" . "zxr") . "~/.signature-sun") -;;; (("To" . "uramimi") . "~/.signature-sun") -;;; (("Newsgroups" . "jokes") . "~/.signature-jokes") -;;; (("To" . "tea") . "~/.signature-jokes") -;;; (("To" . ("sim" "oku")) . "~/.signature-formal") -;;; )) +;;; '((("Newsgroups" . "zxr") . "~/.signature-sun") +;;; (("To" . "uramimi") . "~/.signature-sun") +;;; (("Newsgroups" . "jokes") . "~/.signature-jokes") +;;; (("To" . "tea") . "~/.signature-jokes") +;;; (("To" . ("sim" "oku")) . "~/.signature-formal") +;;; )) + +(autoload 'signature/get-sigtype-from-bbdb "tm-bbdb") -(autoload 'signature-check-in-bbdb "tm-bbdb") +(defun signature/get-sigtype-interactively (&optional default) + (read-file-name "Insert your signature: " + (or default (concat signature-file-name "-")) + (or default signature-file-name) + nil)) (defun signature/get-signature-file-name () - (catch 'tag - (let ((r signature-file-alist) cell b f) - (save-excursion - (save-restriction - (narrow-to-region - (point-min) - (progn - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (match-beginning 0) - (point-max) - ))) - (while r - (setq cell (car r)) - (setq b (car cell)) - (if (setq f (rfc822/get-field-body (car b))) - (cond ((listp (cdr b)) - (let ((r (cdr b))) - (while r - (if (string-match (car r) f) - (throw 'tag - (concat - signature-file-prefix (cdr cell))) - ) - (setq r (cdr r)) - )) - ) - ((stringp (cdr b)) - (if (string-match (cdr b) f) - (throw 'tag - (concat - signature-file-prefix (cdr cell))) - )) - ((functionp (cdr b)) - (let ((name (apply (cdr b) f (cdr cell)))) - (if name - (throw 'tag - (concat signature-file-prefix name)) - ))) - )) - (setq r (cdr r)) - )) - signature-file-name)))) - -(defun signature/insert-signature-at-point (&optional arg) - "Insert the file named by signature-file-name at the current point." - (interactive "P") - (let ((signature - (expand-file-name - (if arg - (read-file-name "Insert your signature: " - (concat signature-file-name "-") - signature-file-name - nil) - (signature/get-signature-file-name))))) - (insert-file-contents signature) - (set-buffer-modified-p (buffer-modified-p)) ; force mode line update - signature)) + (save-excursion + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (match-beginning 0) + (point-max) + )) + (catch 'found + (let ((alist signature-file-alist) cell field value) + (while alist + (setq cell (car alist) + field (rfc822/get-field-body (car (car cell))) + value (cdr (car cell))) + (cond ((functionp value) + (let ((name (apply value field (cdr cell)))) + (if name + (throw 'found + (concat signature-file-prefix name)) + ))) + ((stringp field) + (cond ((consp value) + (while value + (if (string-match (car value) field) + (throw 'found + (concat + signature-file-prefix (cdr cell))) + (setq value (cdr value)) + ))) + ((stringp value) + (if (string-match value field) + (throw 'found + (concat + signature-file-prefix (cdr cell))) + ))))) + (setq alist (cdr alist)) + )) + signature-file-name)))) -(defun signature/insert-signature-at-eof (&optional arg) - "Insert the file named by signature-file-name at the end of file." +(defun insert-signature (&optional arg) + "Insert the file named by signature-file-name. +It is inserted at the end of file if signature-insert-at-eof in non-nil, +and otherwise at the current point. A prefix argument enables user to +specify a file named -DISTRIBUTION interactively." (interactive "P") (let ((signature - (expand-file-name - (if arg - (read-file-name "Insert your signature: " - (concat signature-file-name "-") - signature-file-name - nil) - (signature/get-signature-file-name))))) - (if (file-readable-p signature) - (progn - (goto-char (point-max)) - (if (not (bolp)) - (insert "\n")) - (if signature-delete-blank-lines-at-eof (delete-blank-lines)) - (insert-file-contents signature) - (set-buffer-modified-p (buffer-modified-p)) - ; force mode line update - )) + (expand-file-name + (or (and signature-use-bbdb + (signature/get-sigtype-from-bbdb arg)) + (and arg + (signature/get-sigtype-interactively)) + (signature/get-signature-file-name)) + ))) + (or (file-readable-p signature) + (error "Cannot open signature file: %s" signature)) + (if signature-insert-at-eof + (progn + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (or signature-delete-blank-lines-at-eof (delete-blank-lines)) + )) + (run-hooks 'signature-insert-hook) + (insert-file-contents signature) + (force-mode-line-update) signature)) -(defun insert-signature (&optional arg) - "Insert the file named by signature-file-name. It is inserted at the -end of file if signature-insert-at-eof in non-nil, and otherwise at -the current point. A prefix argument enables user to specify a file -named -DISTRIBUTION interactively." - (interactive "P") - (if signature-insert-at-eof - (call-interactively 'signature/insert-signature-at-eof) - (call-interactively 'signature/insert-signature-at-point))) - ;;; @ end ;;; (provide 'signature) +(run-hooks 'signature-load-hook) + ;;; signature.el ends here diff --git a/tm-bbdb.el b/tm-bbdb.el index 0d7e896..c0bc685 100644 --- a/tm-bbdb.el +++ b/tm-bbdb.el @@ -8,7 +8,7 @@ ;;; Artur Pioro ;;; modified by Pekka Marjola ;;; Maintainer: KOBAYASHI Shuhei -;;; Version: $Id: tm-bbdb.el,v 7.5 1996/04/16 18:19:48 morioka Exp $ +;;; Version: $Id: tm-bbdb.el,v 7.6 1996/04/19 13:40:17 shuhei-k Exp $ ;;; Keywords: mail, news, MIME, multimedia, multilingual, BBDB ;;; ;;; This file is part of tm (Tools for MIME). @@ -197,35 +197,49 @@ displaying the record corresponding to the sender of the current message." ;;; @ for signature.el ;;; -(defun signature-check-in-bbdb (address) - "Returns 'sigtype field from BBDB for user specified by ADDRESS" - (let ((addr-comp (mail-extract-address-components address)) - full-name net-name records record sigtype) - (setq full-name (car addr-comp)) - (setq net-name (mapconcat (lambda (x) x) (cdr addr-comp) "\\|")) - (setq records - (or - (and full-name - (bbdb-search (bbdb-records) full-name)) - (and net-name - (bbdb-search (bbdb-records) nil nil net-name)))) - (setq record (car records)) - (setq records (cdr records)) - (setq sigtype (and record (bbdb-record-getprop record 'sigtype))) - (while (and (not sigtype) records) - (setq record (car records)) - (setq records (cdr records)) - (setq sigtype (bbdb-record-getprop record 'sigtype))) - (if sigtype - (message (concat "Using signature for: " - (bbdb-record-firstname record) " " - (bbdb-record-lastname record) - (and (bbdb-record-aka record) - (concat " (AKA: " - (car (bbdb-record-aka record)) - ")")) - " <" (car (bbdb-record-net record)) ">"))) - sigtype)) +(defun signature/get-bbdb-sigtype (addr) + "Extract sigtype information from BBDB." + (let ((record (bbdb-search-simple nil addr))) + (and record + (bbdb-record-getprop record 'sigtype)) + )) + +(defun signature/set-bbdb-sigtype (sigtype addr) + "Add sigtype information to BBDB." + (let* ((bbdb-notice-hook nil) + (record (bbdb-annotate-message-sender + addr t + (bbdb-invoke-hook-for-value + bbdb/mail-auto-create-p) + t))) + (if record + (progn + (bbdb-record-putprop record 'sigtype sigtype) + (bbdb-change-record record nil)) + ))) + +(defun signature/get-sigtype-from-bbdb (&optional verbose) + (let* ((to (rfc822/get-field-body "To")) + (addr (and to + (car (cdr (mail-extract-address-components to))))) + (sigtype (signature/get-bbdb-sigtype addr)) + return + ) + (if addr + (if verbose + (progn + (setq return (signature/get-sigtype-interactively sigtype)) + (if (and (not (string-equal return sigtype)) + (y-or-n-p + (format "Register \"%s\" for <%s>? " return addr)) + ) + (signature/set-bbdb-sigtype return addr) + ) + return) + (or sigtype + (signature/get-signature-file-name)) + )) + )) ;;; @ end diff --git a/tm-def.el b/tm-def.el index d57ee5f..c08363f 100644 --- a/tm-def.el +++ b/tm-def.el @@ -6,7 +6,7 @@ ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: tm-def.el,v 7.20 1996/03/05 21:12:40 morioka Exp $ +;;; $Id: tm-def.el,v 7.33 1996/04/22 12:40:55 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia, definition ;;; ;;; This file is part of tm (Tools for MIME). @@ -53,13 +53,50 @@ (defconst mime/temp-buffer-name " *MIME-temp*") -;;; @ for various Emacs variants +;;; @ leading-character and charset ;;; -(cond ((boundp 'MULE) (require 'tm-mule)) - ((boundp 'NEMACS)(require 'tm-nemacs)) - (t (require 'tm-orig)) - ) +(defvar mime/lc-charset-alist + (foldr (function + (lambda (a cell) + (or (catch 'tag + (cons (cons (foldr (function + (lambda (a sym) + (if (boundp sym) + (cons (symbol-value sym) a) + (throw 'tag nil) + ))) + nil + (car cell)) + (cdr cell)) + a)) + a) + )) + nil + '(((lc-ascii) . "US-ASCII") + ((lc-ascii lc-ltn1) . "ISO-8859-1") + ((lc-ascii lc-ltn2) . "ISO-8859-2") + ((lc-ascii lc-ltn3) . "ISO-8859-3") + ((lc-ascii lc-ltn4) . "ISO-8859-4") +;;; ((lc-ascii lc-crl) . "ISO-8859-5") + ((lc-ascii lc-crl) . "KOI8-R") + ((lc-ascii lc-grk) . "ISO-8859-7") + ((lc-ascii lc-hbw) . "ISO-8859-8") + ((lc-ascii lc-ltn5) . "ISO-8859-9") + ((lc-ascii lc-jp) . "ISO-2022-JP") + ((lc-ascii lc-kr) . "EUC-KR") + ((lc-ascii + lc-jp lc-cn + lc-kr lc-jp2 + lc-ltn1 lc-grk) . "ISO-2022-JP-2") + ((lc-ascii + lc-jp lc-cn + lc-kr lc-jp2 + lc-cns1 lc-cns2 + lc-ltn1 lc-grk) . "ISO-2022-INT-1") + ))) + +(defvar mime/unknown-charset "ISO-2022-INT-1") ;;; @ charset and encoding @@ -122,8 +159,64 @@ ;;; @ coding-system ;;; +(defvar mime/charset-coding-system-alist + (foldr (function + (lambda (a cell) + (if (boundp (cdr cell)) + (cons (cons (car cell) (symbol-value (cdr cell))) a) + a))) + nil + '(("ISO-2022-JP" . *junet*) + ("ISO-2022-KR" . *iso-2022-kr*) + ("EUC-KR" . *euc-kr*) + ("ISO-8859-1" . *ctext*) + ("ISO-8859-2" . *iso-8859-2*) + ("ISO-8859-3" . *iso-8859-3*) + ("ISO-8859-4" . *iso-8859-4*) + ("ISO-8859-5" . *iso-8859-5*) + ("KOI8-R" . *koi8*) + ("ISO-8859-7" . *iso-8859-7*) + ("ISO-8859-8" . *iso-8859-8*) + ("ISO-8859-9" . *iso-8859-9*) + ("ISO-2022-JP-2" . *iso-2022-ss2-7*) + ("X-ISO-2022-JP-2" . *iso-2022-ss2-7*) + ("ISO-2022-INT-1" . *iso-2022-int-1*) + ("SHIFT_JIS" . *sjis*) + ("X-SHIFTJIS" . *sjis*) + ))) + (defvar mime/default-coding-system *ctext*) +(defun mime/convert-string-to-emacs (str charset) + (let ((cs (cdr (assoc charset mime/charset-coding-system-alist)))) + (if cs + (code-convert-string str cs *internal*) + ))) + +(defun mime/convert-string-from-emacs (str charset) + (let ((cs (cdr (assoc charset mime/charset-coding-system-alist)))) + (if cs + (code-convert-string str *internal* cs) + ))) + +(defun mime/code-convert-region-to-emacs (beg end charset &optional encoding) + (let ((ct + (if (stringp charset) + (cdr (assoc (upcase charset) mime/charset-coding-system-alist)) + mime/default-coding-system))) + (if ct + (code-convert-region beg end ct *internal*) + ))) + +(defun mime/code-convert-region-from-emacs (beg end charset &optional encoding) + (let ((ct + (if (stringp charset) + (cdr (assoc (upcase charset) mime/charset-coding-system-alist)) + mime/default-coding-system))) + (if ct + (code-convert-region beg end *internal* ct) + ))) + ;;; @ button ;;; diff --git a/tm-edit.el b/tm-edit.el index 90b69f6..6bed766 100644 --- a/tm-edit.el +++ b/tm-edit.el @@ -8,7 +8,7 @@ ;;; MORIOKA Tomohiko ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1994/08/21 renamed from mime.el -;;; Version: $Revision: 7.50 $ +;;; Version: $Revision: 7.52 $ ;;; Keywords: mail, news, MIME, multimedia, multilingual ;;; ;;; This file is part of tm (Tools for MIME). @@ -122,7 +122,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 7.50 1996/04/16 14:32:43 morioka Exp $") + "$Id: tm-edit.el,v 7.52 1996/04/19 13:40:55 shuhei-k Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -957,30 +957,15 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." (defun mime-editor/insert-signature (&optional arg) "Insert a signature file specified by mime-signature-file." (interactive "P") - (let ((signature - (expand-file-name - (if arg - (read-file-name "Insert your signature: " - (concat signature-file-name "-") - signature-file-name - nil) - (signature/get-signature-file-name)))) - ) - (if signature-insert-at-eof - (goto-char (point-max)) - ) - (apply (function mime-editor/insert-tag) - (mime-find-file-type signature)) - (if (file-readable-p signature) - (progn - (goto-char (point-max)) - (if (not (bolp)) - (insert "\n")) - (delete-blank-lines) - (insert-file-contents signature) - (set-buffer-modified-p (buffer-modified-p)) - ; force mode line update - )))) + (let ((signature-insert-hook + (function + (lambda () + (apply (function mime-editor/insert-tag) + (mime-find-file-type signature)) + ))) + ) + (insert-signature arg) + )) ;; Insert a new tag around a point. @@ -1408,31 +1393,6 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter))))) )) -(defun mime-encode-string (encoding string) - "Using ENCODING encode a STRING. -If the STRING is too long, the encoded string may be broken into -several lines." - (save-excursion - (set-buffer (get-buffer-create " *MIME encoding*")) - (erase-buffer) - (insert string) - (mime-encode-region encoding (point-min) (point-max)) - (prog1 - (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))))) - -(defun mime-editor/encode-string (method string) - "For given METHOD that is a cons of charset and encoding, -encode a STRING. [tm-edit.el]" - (let* ((charset (car method)) - (encoding (cdr method))) - (setq string (mime/convert-string-from-emacs string charset)) - (cond ((stringp encoding) - (mime-encode-string encoding string) - ) - (t string) - ))) - (defun mime-flag-region (from to flag) "Hides or shows lines from FROM to TO, according to FLAG. If FLAG is `\\n' (newline character) then text is shown, @@ -1967,18 +1927,12 @@ Content-Transfer-Encoding: 7bit mime-editor/charset-default-encoding-alist) )) (beg (mime-editor/content-beginning)) - (end (mime-editor/content-end)) - (body (buffer-substring beg end)) - (encoded (mime-editor/encode-string - (cons charset encoding) body)) ) - (if (and encoded (not (string-equal body encoded))) - (progn - (goto-char beg) - (delete-region beg end) - (insert encoded) - (goto-char beg))) - (mime-editor/define-encoding encoding))) + (mime/code-convert-region-from-emacs + beg (mime-editor/content-end) charset) + (mime-encode-region encoding + beg (mime-editor/content-end)) + (mime-editor/define-encoding encoding))) (forward-line 1)) ((null encoding) ;Encoding is not specified. ;; Application, image, audio, video, and any other @@ -1988,16 +1942,9 @@ Content-Transfer-Encoding: 7bit (beg (mime-editor/content-beginning)) (end (mime-editor/content-end)) (body (buffer-substring beg end)) - (encoded (mime-editor/encode-string - (cons nil encoding) body)) - ) - (if (not (string-equal body encoded)) - (progn - (goto-char beg) - (delete-region beg end) - (insert encoded) - (goto-char beg))) - (mime-editor/define-encoding encoding)) + ) + (mime-encode-region encoding beg end) + (mime-editor/define-encoding encoding)) (forward-line 1)) ) ))) diff --git a/tm-ew-d.el b/tm-ew-d.el index d7a5145..3232770 100644 --- a/tm-ew-d.el +++ b/tm-ew-d.el @@ -10,7 +10,7 @@ ;;; MORIOKA Tomohiko ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1993/6/3 (1995/10/3 obsolete tiny-mime.el) -;;; Version: $Revision: 7.8 $ +;;; Version: $Revision: 7.10 $ ;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). @@ -41,7 +41,7 @@ ;;; (defconst tm-ew-d/RCS-ID - "$Id: tm-ew-d.el,v 7.8 1996/01/25 06:36:44 morioka Exp $") + "$Id: tm-ew-d.el,v 7.10 1996/04/19 08:24:15 morioka Exp $") (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID)) @@ -184,7 +184,7 @@ (t (message "unknown encoding %s" encoding) nil)))) (if dest - (mime/convert-string-to-emacs charset dest) + (mime/convert-string-to-emacs dest charset) ))) @@ -192,3 +192,5 @@ ;;; (provide 'tm-ew-d) + +;;; tm-ew-d.el ends here diff --git a/tm-parse.el b/tm-parse.el index 6f27844..d6fe8ca 100644 --- a/tm-parse.el +++ b/tm-parse.el @@ -2,11 +2,11 @@ ;;; tm-parse.el --- MIME message parser ;;; ;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1994,1995 MORIOKA Tomohiko +;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: tm-parse.el,v 7.3 1996/04/14 15:42:14 morioka Exp $ +;;; $Id: tm-parse.el,v 7.8 1996/04/20 12:17:27 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia ;;; ;;; This file is part of tm (Tools for MIME). @@ -125,18 +125,21 @@ and return parsed it. [tm-parse.el]" (defun mime/parse-multipart (boundary ctype params encoding rcnum) (goto-char (point-min)) (let* ((dash-boundary (concat "--" boundary)) - (delimiter (concat "\n" dash-boundary)) - (close-delimiter (concat delimiter "--")) + (delimiter (concat "\n" (regexp-quote dash-boundary))) + (close-delimiter (concat delimiter "--[ \t]*$")) (beg (point-min)) - (end (if (search-forward close-delimiter nil t) - (match-beginning 0) - (point-max) - )) - (rsep (concat (regexp-quote delimiter) "[ \t]*\n")) + (end (progn + (goto-char (point-max)) + (if (re-search-backward close-delimiter nil t) + (match-beginning 0) + (point-max) + ))) + (rsep (concat delimiter "[ \t]*\n")) (dc-ctl - (cond ((string= ctype "multipart/digest") '("message/rfc822")) - (t '("text/plain")) - )) + (if (string-equal ctype "multipart/digest") + '("message/rfc822") + '("text/plain") + )) cb ce ct ret ncb children (i 0)) (save-restriction (narrow-to-region beg end) @@ -164,7 +167,7 @@ and return parsed it. [tm-parse.el]" ) (mime::content-info/create rcnum beg (point-max) ctype params encoding - (reverse children)) + (nreverse children)) )) (defun mime/parse-message (&optional ctl encoding rcnum) @@ -179,7 +182,7 @@ and return parsed it. [tm-parse.el]" (setq boundary (rfc822/strip-quoted-string (cdr boundary))) (mime/parse-multipart boundary ctype params encoding rcnum) ) - ((string= ctype "message/rfc822") + ((string-equal ctype "message/rfc822") (goto-char (point-min)) (mime::content-info/create rcnum (point-min) (point-max) @@ -187,7 +190,7 @@ and return parsed it. [tm-parse.el]" (save-restriction (narrow-to-region (if (re-search-forward "^$" nil t) - (+ (match-end 0) 1) + (1+ (match-end 0)) (point-min) ) (point-max)) @@ -207,3 +210,5 @@ and return parsed it. [tm-parse.el]" ;;; (provide 'tm-parse) + +;;; tm-parse.el ends here diff --git a/tm-play.el b/tm-play.el index 9d6e8f5..b2cc49a 100644 --- a/tm-play.el +++ b/tm-play.el @@ -8,7 +8,7 @@ ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1995/9/26 (separated from tm-view.el) ;;; Version: -;;; $Id: tm-play.el,v 7.14 1996/02/05 05:00:27 morioka Exp $ +;;; $Id: tm-play.el,v 7.16 1996/04/21 19:57:22 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia ;;; ;;; This file is part of tm (Tools for MIME). @@ -31,6 +31,9 @@ (require 'tm-view) +(defvar mime-viewer/external-progs "/usr/local/share/tm/" + "*Directory containing tm external methods.") + ;;; @ content decoder ;;; @@ -127,6 +130,7 @@ ) (goto-char b) (write-region b end file) + (message "External method is starting...") (setq cal (put-alist 'name (replace-as-filename name) cal)) (setq cal (put-alist 'file file cal)) @@ -137,7 +141,24 @@ (mime-article/make-method-args cal (cdr (cdr method))) )) - (apply (function start-process) args) + (let ((process-environment + (let ((rest process-environment) + dest cell) + (while (setq cell (car rest)) + (setq dest + (cons + (if (string-match "^PATH=" cell) + (format "PATH=%s:%s" + mime-viewer/external-progs + (substring cell (match-end 0))) + cell) + dest)) + (setq rest (cdr rest)) + ) + (nconc (nreverse dest) rest) + ))) + (apply (function start-process) args) + ) (mime-article/show-output-buffer) )) )))) diff --git a/tm-view.el b/tm-view.el index 3d6626b..4e88e2b 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.46 $ +;;; Version: $Revision: 7.50 $ ;;; 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.46 1996/04/14 00:19:59 morioka Exp $") + "$Id: tm-view.el,v 7.50 1996/04/21 17:33:21 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -330,6 +330,12 @@ Each elements are regexp of field-name. [tm-view.el]") (defvar mime-viewer/show-summary-method nil) +;;; @@ following method +;;; + +(defvar mime-viewer/following-method-alist nil) + + ;;; @@ X-Face ;;; @@ -362,6 +368,18 @@ The compressed face will be piped to this command.") )))) +;;; @@ utility +;;; + +(defun mime-preview/get-original-major-mode () + (if mime::preview/mother-buffer + (save-excursion + (set-buffer mime::preview/mother-buffer) + (mime-preview/get-original-major-mode) + ) + mime::preview/original-major-mode)) + + ;;; @ data structures ;;; @@ -651,8 +669,9 @@ The compressed face will be piped to this command.") ;;; (defvar mime-viewer/code-converter-alist - '((mime/show-message-mode . mime/code-convert-region-to-emacs)) - ) + '((mime/show-message-mode . mime/code-convert-region-to-emacs) + (mime/temporary-message-mode . mime/code-convert-region-to-emacs) + )) (defun mime-viewer/default-code-convert-region (beg end charset &optional encoding) @@ -744,7 +763,9 @@ The compressed face will be piped to this command.") (define-key mime/viewer-mode-map "\C-c\C-p" (function mime-viewer/print-content)) (define-key mime/viewer-mode-map - "f" (function mime-viewer/display-x-face)) + "x" (function mime-viewer/display-x-face)) + (define-key mime/viewer-mode-map + "a" (function mime-viewer/follow-content)) (define-key mime/viewer-mode-map "q" (function mime-viewer/quit)) (define-key mime/viewer-mode-map @@ -897,6 +918,119 @@ listed in key order: (mime-preview/decode-content) )) +(defun mime-viewer/follow-content () + (interactive) + (let ((root-cinfo + (mime::preview-content-info/content-info + (car mime::preview/content-list))) + pc p-beg p-end cinfo rcnum) + (let ((rest mime::preview/content-list) + b e cell len rc) + (if (catch 'tag + (while (setq cell (car rest)) + (setq b (mime::preview-content-info/point-min cell) + e (mime::preview-content-info/point-max cell)) + (setq rest (cdr rest)) + (if (and (<= b (point))(<= (point) e)) + (throw 'tag cell) + ) + )) + (progn + (setq pc cell + cinfo (mime::preview-content-info/content-info pc) + rcnum (mime::content-info/rcnum cinfo)) + (setq len (length rcnum)) + (setq p-beg (mime::preview-content-info/point-min pc) + p-end (mime::preview-content-info/point-max pc)) + (while (and (setq cell (car rest)) + (progn + (setq rc + (mime::content-info/rcnum + (mime::preview-content-info/content-info + cell))) + (equal rcnum + (nthcdr (- (length rc) len) rc)) + )) + (setq p-end (mime::preview-content-info/point-max cell)) + (setq rest (cdr rest)) + )))) + (if pc + (let* ((mode (mime-preview/get-original-major-mode)) + (new-name (format "%s-%s" (buffer-name) (reverse rcnum))) + new-buf + (the-buf (current-buffer)) + from to cc reply-to subj mid f) + (save-excursion + (set-buffer mime::preview/article-buffer) + (setq from (rfc822/get-field-body "From") + to (rfc822/get-field-body "To") + cc (rfc822/get-field-body "cc") + reply-to (rfc822/get-field-body "Reply-To") + subj (rfc822/get-field-body "Subject") + mid (rfc822/get-field-body "Message-Id") + )) + (save-excursion + (set-buffer (setq new-buf (get-buffer-create new-name))) + (erase-buffer) + (insert-buffer-substring the-buf p-beg p-end) + (goto-char (point-min)) + (if (mime-viewer/header-visible-p rcnum root-cinfo) + (setq mid nil) + (insert "\n") + ) + (goto-char (point-min)) + (if (setq f (rfc822/get-field-body "From")) + (setq from f) + (and from + (insert (format "From: %s\n" + (mime-eword/decode-string from))) + )) + (if (setq f (rfc822/get-field-body "To")) + (setq to f) + (and to + (insert (format "To: %s\n" + (mime-eword/decode-string to))) + )) + (if (setq f (rfc822/get-field-body "cc")) + (setq cc f) + (and cc + (insert (format "cc: %s\n" + (mime-eword/decode-string cc))) + )) + (if (setq f (rfc822/get-field-body "Reply-To")) + (setq reply-to f) + (and reply-to + (insert (format "Reply-To: %s\n" + (mime-eword/decode-string reply-to))) + )) + (if (setq f (or (rfc822/get-field-body "Subject") + (rfc822/get-field-body "Content-Description"))) + (setq subj f) + (and subj + (insert (format "Subject: %s\n" + (mime-eword/decode-string subj))) + )) + (if (setq f (rfc822/get-field-body "Message-Id")) + (setq mid f) + (and mid + (insert (format "Message-Id: %s\n" + (mime-eword/decode-string mid))) + )) + (goto-char (point-max)) + (funcall (cdr (assq mode mime-viewer/following-method-alist)) + (or reply-to + (if (string-equal + (nth 1 (rfc822/extract-address-components from)) + user-mail-address) + to + from)) + cc (and subj + (if (string-match "^Re:" subj) + subj + (concat "Re: " subj)) + )) + ))))) + (defun mime-viewer/display-x-face () (interactive) (save-window-excursion @@ -913,7 +1047,7 @@ listed in key order: (if rcnum (let ((r (save-excursion (set-buffer (mime::preview-content-info/buffer pc)) - (setq r (mime-article/rcnum-to-cinfo (cdr rcnum))) + (mime-article/rcnum-to-cinfo (cdr rcnum)) )) (rpcl mime::preview/content-list) cell) diff --git a/tm-vm.el b/tm-vm.el index 3e6479c..dd876f7 100644 --- a/tm-vm.el +++ b/tm-vm.el @@ -9,20 +9,18 @@ ;;; Author: MASUTANI Yasuhiro ;;; Kenji Wakamiya ;;; MORIOKA Tomohiko -;;; Shuhei KOBAYASHI +;;; KOBAYASHI Shuhei ;;; Oscar Figueiredo ;;; modified by SHIONO Jun'ichi ;;; ISHIHARA Akito ;;; Rob Kooper ;;; Maintainer: KOBAYASHI Shuhei ;;; Created: 1994/10/29 -;;; Version: $Revision: 7.51 $ +;;; Version: $Revision: 7.52 $ ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). ;;; -;;; Plese insert `(require 'tm-vm)' in your ~/.vm file. -;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as ;;; published by the Free Software Foundation; either version 2, or @@ -37,13 +35,17 @@ ;;; along with This program. If not, write to the Free Software ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; +;;; Commentary: +;;; +;;; Plese insert `(require 'tm-vm)' in your ~/.vm file. +;;; ;;; Code: (require 'tm-view) (require 'vm) (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 7.51 1996/04/16 18:26:13 morioka Exp $") + "$Id: tm-vm.el,v 7.52 1996/04/19 18:49:19 shuhei-k Exp $") (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) (define-key vm-mode-map "Z" 'tm-vm/view-message) @@ -564,12 +566,20 @@ tm-vm uses `vm-select-message-hook', use this hook instead.") ;;; @@ vm-yank-message ;;; ;; 1996/3/28 by Oscar Figueiredo + +(require 'vm-reply) + (defun vm-yank-message (message) "Yank message number N into the current buffer at point. When called interactively N is always read from the minibuffer. When called non-interactively the first argument is expected to be a message struct. +This function originally provided by vm-reply has been patched for TM in +order to provide better citation of MIME messages : if a MIME Preview +buffer is displayed for the message then its contents are inserted +instead of the raw message. + This command is meant to be used in VM created Mail mode buffers; the yanked message comes from the mail buffer containing the message you are replying to, forwarding, or invoked VM's mail command from. @@ -751,7 +761,7 @@ 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) +(defun tm-vm/enclose-messages (mlist &optional preamble) "Enclose the messages in MLIST as multipart/digest. The resulting digest is inserted at point in the current buffer. @@ -759,6 +769,7 @@ MLIST should be a list of message structs (real or virtual). These are the messages that will be enclosed." (if mlist (let ((digest (consp (cdr mlist))) + (mp mlist) m) (save-restriction (narrow-to-region (point) (point)) @@ -768,6 +779,21 @@ These are the messages that will be enclosed." (tm-mail/insert-message m) (goto-char (point-max)) (setq mlist (cdr mlist))) + (if preamble + (progn + (goto-char (point-min)) + (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))))) (if digest (mime-editor/enclose-digest-region (point-min) (point-max))) )))) @@ -812,7 +838,7 @@ Subject: header manually." (run-hooks 'tm-vm/forward-message-hook) (run-hooks 'vm-mail-mode-hook))))) -(defun tm-vm/send-digest (&optional prefix) +(defun tm-vm/send-digest (&optional arg) "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 @@ -822,45 +848,26 @@ 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-send-digest arg) (vm-select-folder-buffer) (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-forward-list (if (eq last-command 'vm-next-command-uses-marks) + (vm-select-marked-or-prefixed-messages 0) + 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))))) + (tm-vm/enclose-messages vm-forward-list arg) (mail-position-on-field "To") (message "Building %s digest... done" vm-digest-send-type))) (run-hooks 'tm-vm/send-digest-hook) @@ -870,9 +877,6 @@ only marked messages will be put into the digest." 'tm-vm/forward-message vm-mode-map) (substitute-key-definition 'vm-send-digest 'tm-vm/send-digest vm-mode-map) - -;;; @@ for message/rfc822 -;;; ;;; @@ setting