From d76805c485e461fecda9a4a7ea7d6e237fe13436 Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 9 Mar 1998 11:19:15 +0000 Subject: [PATCH] tm 7.20. --- Changes-7.20.en | 122 +++ Changes-7.20.ja | 125 +++ Makefile | 6 +- mh-e/Makefile | 2 +- mh-e/tm-mh-e.el | 33 +- mime-setup.el | 173 +---- mk-tm | 8 +- signature.el | 60 +- tm-edit.el | 2268 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ tm-ew-e.el | 5 +- tm-partial.el | 19 +- tm-rmail.el | 9 +- tm-setup.el | 9 +- tm-view.el | 5 +- 14 files changed, 2619 insertions(+), 225 deletions(-) create mode 100644 Changes-7.20.en create mode 100644 Changes-7.20.ja create mode 100644 tm-edit.el diff --git a/Changes-7.20.en b/Changes-7.20.en new file mode 100644 index 0000000..e94e834 --- /dev/null +++ b/Changes-7.20.en @@ -0,0 +1,122 @@ +* mel + + Attached version 3.0. + +mel/mel.el +---------------------------- +revision 3.0 +date: 1995/10/25 05:03:11; author: morioka; state: Exp; lines: +13 -8 +(1) setting for mel-u.el. +(2) New variable `mime-encoding-method-alist': it is used to choose + encoder in function `mime/encode-region'. +---------------------------- + +mel/mel-b.el +---------------------------- +revision 2.0 +date: 1995/10/25 02:40:49; author: morioka; state: Exp; lines: +15 -9 +Fixed a problem in Mule. +---------------------------- + +mel/mel-q.el +---------------------------- +revision 2.1 +date: 1995/10/25 05:00:54; author: morioka; state: Exp; lines: +15 -9 +Fixed a problem in Mule. +---------------------------- + +mel/mel-u.el +---------------------------- +revision 1.1 +date: 1995/10/25 05:01:17; author: morioka; state: Exp; +New module: it is for uuencode. +---------------------------- + + +* tm + +tm/mime-setup.el +---------------------------- +revision 7.7 +date: 1995/10/26 11:12:49; author: morioka; state: Exp; lines: +3 -112 +Setting for tm-edit.el instead of setting for mime.el and tm-comp.el. +---------------------------- +revision 7.6 +date: 1995/10/26 00:17:08; author: morioka; state: Exp; lines: +1 -39 +Setting for variable `mime-file-types' was deleted. +---------------------------- +revision 7.5 +date: 1995/10/24 00:23:57; author: morioka; state: Exp; lines: +11 -11 +According to KOBAYASHI Shuuhei in +[tm ML (Japanese):1031], setting for VM variables was deleted. +---------------------------- + +tm/signature.el +---------------------------- +revision 4.0 +date: 1995/10/26 09:25:23; author: morioka; state: Exp; lines: +5 -3 +Function `signature/insert-signature-at-point' and function +`signature/insert-signature-at-eof' were modified to return file name +of inserted signature. +---------------------------- +revision 3.0 +date: 1995/10/25 04:58:18; author: morioka; state: Exp; lines: +33 -21 +Fixed a problem of function `signature/get-signature-file-name'. +---------------------------- + +tm/tm-edit.el +---------------------------- +revision 7.11 +date: 1995/10/26 11:12:05; author: morioka; state: Exp; lines: +51 -67 +New module: it was created based on mime.el and tm-comp.el. +---------------------------- + +tm/tm-ew-e.el +---------------------------- +revision 7.5 +date: 1995/10/24 00:18:39; author: morioka; state: Exp; lines: +2 -3 +According to KOBAYASHI Shuuhei in +[tm ML (Japanese):1031], forgot part, which should be renamed, was +renamed. +---------------------------- + +tm/tm-partial.el +---------------------------- +revision 7.10 +date: 1995/10/25 05:25:28; author: morioka; state: Exp; lines: +10 -9 +Fixed for cut off Subject: field. +---------------------------- + +tm/tm-rmail.el +---------------------------- +revision 7.4 +date: 1995/10/24 00:19:52; author: morioka; state: Exp; lines: +3 -6 +(require 'rmail) was added. +---------------------------- + +tm/tm-setup.el +---------------------------- +revision 6.4 +date: 1995/10/24 00:24:48; author: morioka; state: Exp; lines: +7 -2 +(require 'tm-rmail) is setting for rmail-mode-hook. +---------------------------- + +tm/tm-view.el +---------------------------- +revision 7.20 +date: 1995/10/24 00:21:02; author: morioka; state: Exp; lines: +4 -1 +According to KOBAYASHI Shuuhei in +[tm ML (Japanese):1031], buffer local variables were defined. +---------------------------- + + +* tm/mh-e + + Attached version 7.9. + +tm/mh-e/tm-mh-e.el +---------------------------- +revision 7.9 +date: 1995/10/26 09:26:23; author: morioka; state: Exp; lines: +20 -13 +Setting for tm-edit.el instead of tm-comp.el. +---------------------------- diff --git a/Changes-7.20.ja b/Changes-7.20.ja new file mode 100644 index 0000000..a0639fc --- /dev/null +++ b/Changes-7.20.ja @@ -0,0 +1,125 @@ +* mel + + Version 3.0 を添付した。 + +mel/mel.el +---------------------------- +revision 3.0 +date: 1995/10/25 05:03:11; author: morioka; state: Exp; lines: +13 -8 +(1) mel-u.el に対する設定を行った。 +(2) 変数 mime-encoding-method-alist を設けて、関数 mime/encode-region + での encoder の選択にこれを用いるようにした。 +---------------------------- + +mel/mel-b.el +---------------------------- +revision 2.0 +date: 1995/10/25 02:40:49; author: morioka; state: Exp; lines: +15 -9 +Mule での不具合を修正した。 +---------------------------- + +mel/mel-q.el +---------------------------- +revision 2.1 +date: 1995/10/25 05:00:54; author: morioka; state: Exp; lines: +15 -9 +Mule での不具合を修正した。 +---------------------------- + +mel/mel-u.el +---------------------------- +revision 1.1 +date: 1995/10/25 05:01:17; author: morioka; state: Exp; +uuencode 用の module として作成した。 +---------------------------- + + +* tm + +tm/mime-setup.el +---------------------------- +revision 7.7 +date: 1995/10/26 11:12:49; author: morioka; state: Exp; lines: +3 -112 +mime.el, tm-comp.el 用の設定を削除し、tm-edit.el 用の設定を行った。 +---------------------------- +revision 7.6 +date: 1995/10/26 00:17:08; author: morioka; state: Exp; lines: +1 -39 +変数 mime-file-types を設定するのをやめた。 +---------------------------- +revision 7.5 +date: 1995/10/24 00:23:57; author: morioka; state: Exp; lines: +11 -11 +[tm ML（日本語版）:1031] での、小林 修平 + さんの指摘に従い、VM の変数に対する +設定を行うのを止めた。 +---------------------------- + +tm/signature.el +---------------------------- +revision 4.0 +date: 1995/10/26 09:25:23; author: morioka; state: Exp; lines: +5 -3 +関数 signature/insert-signature-at-point および関数 +signature/insert-signature-at-eof で挿入した signature の file 名を返 +すようにした。 +---------------------------- +revision 3.0 +date: 1995/10/25 04:58:18; author: morioka; state: Exp; lines: +33 -21 +関数 signature/get-signature-file-name の不具合を修正した。 +---------------------------- + +tm/tm-edit.el +---------------------------- +revision 7.11 +date: 1995/10/26 11:12:05; author: morioka; state: Exp; lines: +51 -67 +mime.el と tm-comp.el を基に作成した。 +---------------------------- + +tm/tm-ew-e.el +---------------------------- +revision 7.5 +date: 1995/10/24 00:18:39; author: morioka; state: Exp; lines: +2 -3 +[tm ML（日本語版）:1031] での、小林 修平 + さんの指摘に従い、renameし忘れていた +部分を修正した。 +---------------------------- + +tm/tm-partial.el +---------------------------- +revision 7.10 +date: 1995/10/25 05:25:28; author: morioka; state: Exp; lines: +10 -9 +Subject: field が途中で切れている場合の事を考慮した。 +---------------------------- + +tm/tm-rmail.el +---------------------------- +revision 7.4 +date: 1995/10/24 00:19:52; author: morioka; state: Exp; lines: +3 -6 +(require 'rmail) するようにした。 +---------------------------- + +tm/tm-setup.el +---------------------------- +revision 6.4 +date: 1995/10/24 00:24:48; author: morioka; state: Exp; lines: +7 -2 +(require 'tm-rmail) を rmail-mode-hook に対して設定するようにした。 +---------------------------- + +tm/tm-view.el +---------------------------- +revision 7.20 +date: 1995/10/24 00:21:02; author: morioka; state: Exp; lines: +4 -1 +[tm ML（日本語版）:1031] での、小林 修平 + さんの指摘に従い、buffer local 変数 +を全て defvar するようにした。 +---------------------------- + + +* tm/mh-e + + Version 7.9 を添付した。 + +tm/mh-e/tm-mh-e.el +---------------------------- +revision 7.9 +date: 1995/10/26 09:26:23; author: morioka; state: Exp; lines: +20 -13 +tm-comp 用の設定をするのをやめて、代わりに tm-edit 用の設定をするよう +にした。 +---------------------------- diff --git a/Makefile b/Makefile index 6d74d23..8f6db0a 100644 --- a/Makefile +++ b/Makefile @@ -15,9 +15,9 @@ TM_FILES = tm/README.eng tm/rel-*.ol tm/Changes* \ tm/tm-ftp.el tm/tm-latex.el tm/tm-w3.el tm/tm-partial.el \ tm/tm-tar.el \ tm/tm-rich.el tm/richtext.el tm/tinyrich.el \ - tm/tm-comp.el \ + tm/tm-edit.el tm/signature.el \ tm/tm-setup.el tm/mime-setup.el \ - tm/signature.el tm/sc-setup.el tm/gnushook.el \ + tm/sc-setup.el tm/gnushook.el \ tm/*.c tm/methods/tm* \ tm/doc/Makefile tm/doc/*.pln tm/doc/*.ol tm/doc/*.tex \ tm/doc/*.texi @@ -34,7 +34,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.19.tar +TARFILE = tm7.20.tar nemacs: diff --git a/mh-e/Makefile b/mh-e/Makefile index d0fff22..7f31ccc 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.08.tar +TARFILE = tm-mh-e7.09.tar elc: diff --git a/mh-e/tm-mh-e.el b/mh-e/tm-mh-e.el index db58b37..c059ea3 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.8 1995/10/22 14:40:59 morioka Exp $") + "$Id: tm-mh-e.el,v 7.9 1995/10/26 09:26:23 morioka Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) @@ -263,7 +263,7 @@ With arg, turn MIME processing on if arg is positive." ))) -;;; @ for tm-comp +;;; @ for tm-edit ;;; (defun tm-mh-e::make-message (folder number) @@ -284,10 +284,17 @@ With arg, turn MIME processing on if arg is positive." (mh-expand-file-name (tm-mh-e::message/folder message)) )) -(defun tm-mh-e::prompt-for-message (prompt folder &optional default) +(defun tm-mh-e/prompt-for-message (prompt folder &optional default) (let ((files (directory-files (mh-expand-file-name folder) nil "^[0-9]+$") - )) + ) + (default mh-sent-from-msg) + ) + (setq default + (if default + (int-to-string default) + (car files) + )) (completing-read prompt (let ((i 0)) (mapcar (function @@ -296,30 +303,30 @@ With arg, turn MIME processing on if arg is positive." (list file i) )) files) - )) + ) nil nil default) )) - -(defun tm-mh-e::query-message () + +(defun tm-mh-e/query-message () (let* ((folder (mh-prompt-for-folder "Visit" "+inbox" nil)) - (number (tm-mh-e::prompt-for-message "Number?" folder)) + (number (tm-mh-e/prompt-for-message "Number: " folder)) ) (tm-mh-e::make-message folder number) )) -(defun tm-mh-e::insert-message (&optional message) +(defun tm-mh-e/insert-message (&optional message) (if (null message) - (setq message (tm-mh-e::query-message)) + (setq message (tm-mh-e/query-message)) ) (insert-file (tm-mh-e::message/file-name message)) ) (call-after-loaded - 'tm-comp + 'tm-edit (function (lambda () (set-alist - 'tm-comp/message-inserter-alist - 'mh-letter-mode (function tm-mh-e::insert-message)) + 'tm-edit/message-inserter-alist + 'mh-letter-mode (function tm-mh-e/insert-message)) ))) diff --git a/mime-setup.el b/mime-setup.el index 667e81a..f97680c 100644 --- a/mime-setup.el +++ b/mime-setup.el @@ -6,7 +6,7 @@ ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: mime-setup.el,v 7.4 1995/10/17 16:20:39 morioka Exp $ +;;; $Id: mime-setup.el,v 7.7 1995/10/26 11:12:49 morioka Exp $ ;;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). @@ -21,82 +21,13 @@ (defvar mime-setup-use-sc nil) (defvar mime-setup-use-signature t) (defvar mime-setup-default-signature-key "\C-c\C-s") -(defvar mime-setup-signature-key-alist - '((mail-mode . "\C-c\C-w"))) +(defvar mime-setup-signature-key-alist '((mail-mode . "\C-c\C-w"))) ;;; @ for Edit MIME mode ;;; -(autoload 'mime-mode "mime" "Edit MIME message." t) -(autoload 'mime-convert-buffer "mime" "convert to MIME." t) - -(setq mime-content-types - '(("text" - ;; Charset parameter need not to be specified, since it is - ;; defined automatically while translation. - ("plain" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("richtext" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("enriched" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("x-latex" - ("x-name") - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("html" - ("x-name") - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - )) - ("message" - ("external-body" - ("access-type" - ("anon-ftp" - ("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")) - ("tftp" - ("site") - ("name")) - ("afs" - ("site") - ("name")) - ("local-file" - ("site") - ("name")) - ("mail-server" - ("server")))) - ("rfc822")) - ("application" - ("octet-stream" - ("name") - ("type" "" "tar" "shar") - ("conversions")) - ("postscript") - ("x-kiss" - ("x-name") - ("x-cnf"))) - ("image" - ("gif" ("x-name")) - ("jpeg" ("x-name")) - ("x-pic" ("x-name")) - ("x-xwd") - ("x-xbm")) - ("audio" - ("basic")) - ("video" - ("mpeg"))) - ) +(autoload 'mime-mode "tm-edit" "Edit MIME message." t) ;;; @ for signature @@ -105,7 +36,6 @@ (if mime-setup-use-signature (progn (autoload 'insert-signature "signature" "Insert signature" t) - (add-hook 'mime-mode-hook (function (lambda () @@ -117,81 +47,10 @@ (define-key (current-local-map) key (function insert-signature)) )))) - (setq gnus-signature-file nil) )) -;;; @ for encoded-word -;;; - -(autoload 'mime/encode-message-header "tm-eword" - "convert message header to MIME style." t) - -(add-hook 'mime-translate-hook (function mime/encode-message-header)) - -(setq mime-header-charset-chooser - (function - (lambda (begin end) - ))) - - -;;; @ for tm-comp -;;; - -(call-after-loaded - 'tm-comp - (function - (lambda () - (setq mime-transfer-encoders - '(("base64" "mmencode") - ("quoted-printable" "mmencode" "-q") - ("7bit" nil) ;Default - ("8bit" nil) - ("binary" nil) - ("x-uue" "uuencode" "-") - )) - - (setq mime-file-types - '(("\\.rtf$" - "text" "richtext" nil nil) - ("\\.html$" - "text" "html" nil nil) - ("\\.ps$" - "application" "postscript" nil "quoted-printable") - ("\\.gif$" - "image" "gif" nil "base64") - ("\\.jpg$" - "image" "jpeg" nil "base64") - ("\\.xwd$" - "image" "x-xwd" nil "base64") - ("\\.xbm$" - "image" "x-xbm" nil "base64") - ("\\.pic$" - "image" "x-pic" nil "base64") - ("\\.tiff$" - "image" "tiff" nil "base64") - ("\\.au$" - "audio" "basic" nil "base64") - ("\\.mpg$" - "video" "mpeg" nil "base64") - ("\\.el$" - "application" "octet-stream" (("name" . file) - ("type" . "emacs-lisp")) "7bit") - ("\\.tar.gz$" - "application" "octet-stream" (("name" . file) - ("type" . "tar") - ("conversions" . "gzip")) nil) - ("\\.diff$" - "application" "octet-stream" (("name" . file) - ("type" . "patch")) nil) - ("\\.signature" - "text" "plain" nil nil) - (".*" nil nil nil nil)) - ) - ))) - - ;;; @ about SuperCite ;;; @@ -257,25 +116,19 @@ ;;; @@ In VM, the following definitions may be requried: ;;; -(if (boundp 'vm-visible-headers) - (progn - (setq vm-preview-lines nil) - (setq vm-invisible-header-regexp nil) - (setq vm-visible-headers - (append vm-visible-headers - '("Mime-Version:" - "Content-Type:" - "Content-Transfer-Encoding:"))) - )) +;;; (if (boundp 'vm-visible-headers) +;;; (progn +;;; (setq vm-preview-lines nil) +;;; (setq vm-invisible-header-regexp nil) +;;; (setq vm-visible-headers +;;; (append vm-visible-headers +;;; '("Mime-Version:" +;;; "Content-Type:" +;;; "Content-Transfer-Encoding:"))) +;;; )) ;;; @ end ;;; (provide 'mime-setup) - -;;; Local Variables: -;;; mode: emacs-lisp -;;; mode: outline-minor -;;; outline-regexp: ";;; @+\\|(......" -;;; End: diff --git a/mk-tm b/mk-tm index 54db890..162b252 100644 --- a/mk-tm +++ b/mk-tm @@ -1,6 +1,6 @@ ;;; -*-Emacs-Lisp-*- ;;; -;;; $Id: mk-tm,v 5.0 1995/10/03 05:13:18 morioka Exp morioka $ +;;; $Id: mk-tm,v 6.0 1995/10/26 09:32:03 morioka Exp morioka $ ;;; (setq load-path (append @@ -33,7 +33,7 @@ "tm-ew-d" "tm-ew-e" "tm-eword" "tm-parse" "tm-view" "tm-play" "tm-latex" "tm-w3" "tm-tar" "tm-partial" - "tm-rmail" "tm-comp" + "tm-rmail" "tm-edit" "tm-setup" "mime-setup" )) (cons @@ -45,7 +45,7 @@ ) )) -(setq tm-uncompile-el-files '("tm-partial.el")) +(setq tm-uncompile-el-files '("sc-setup.el")) (if (catch 'tag (let ((paths load-path) path) @@ -64,7 +64,7 @@ (if (catch 'tag (let ((paths load-path) path) (while paths - (setq path (expand-file-name "vm.el" (car paths))) + (setq path (expand-file-name "vm.elc" (car paths))) (if (file-exists-p path) (throw 'tag path) ) diff --git a/signature.el b/signature.el index 080468a..e577f90 100644 --- a/signature.el +++ b/signature.el @@ -8,7 +8,7 @@ ;;; Author: MORIOKA Tomohiko ;;; OKABE Yasuo (1994/08/01) ;;; Version: -;;; $Id: signature.el,v 2.0 1995/10/05 11:24:45 morioka Exp $ +;;; $Id: signature.el,v 4.0 1995/10/26 09:25:23 morioka Exp $ ;;; Keywords: mail, news, signature ;;; ;;; This file is part of tm (Tools for MIME). @@ -38,27 +38,39 @@ (defun signature/get-signature-file-name () (catch 'tag (let ((r signature-file-alist) cell b f) - (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) + (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 (cdr cell)) + ) + (setq r (cdr r)) + )) + ) + ((stringp (cdr b)) + (if (string-match (cdr b) f) (throw 'tag (cdr cell)) - ) - (setq r (cdr r)) - )) - ) - ((stringp (cdr b)) - (if (string-match (cdr b) f) - (throw 'tag (cdr cell)) - )) - )) - (setq r (cdr r)) - )) - signature-file-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." @@ -72,7 +84,8 @@ nil) (signature/get-signature-file-name))))) (insert-file-contents signature) - (set-buffer-modified-p (buffer-modified-p)))) ; force mode line update + (set-buffer-modified-p (buffer-modified-p)) ; force mode line update + signature)) (defun signature/insert-signature-at-eof (&optional arg) "Insert the file named by signature-file-name at the end of file." @@ -95,7 +108,8 @@ (insert-file-contents signature) (set-buffer-modified-p (buffer-modified-p)) ; force mode line update - ))))) + ))) + signature)) (defun insert-signature (&optional arg) "Insert the file named by signature-file-name. It is inserted at the diff --git a/tm-edit.el b/tm-edit.el new file mode 100644 index 0000000..0329458 --- /dev/null +++ b/tm-edit.el @@ -0,0 +1,2268 @@ +;;; +;;; tm-edit.el --- Simple MIME Composer for GNU Emacs +;;; + +;; Copyright (C) 1993 UMEDA Masanobu +;; Copyright (C) 1994,1995 MORIOKA Tomohiko + +;; Author: UMEDA Masanobu +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME, multimedia, multilingual + +;; This file is not part of GNU Emacs. + +;; GNU Emacs 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 (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This is an Emacs minor mode for editing Internet multimedia +;; messages formatted in MIME (RFC 1521 and RFC 1522). All messages in +;; this mode are composed in the tagged MIME format, that are +;; described in the following examples. The messages composed in the +;; tagged MIME format are automatically translated into a MIME +;; compliant message when exiting the mode. + +;; Mule (a multilingual extension to Emacs 18 and 19) has a capability +;; of handling multilingual text in limited ISO-2022 manner that is +;; based on early experiences in Japanese Internet community and +;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to +;; enable multilingual capability in single text message in MIME, +;; charset of multilingual text written in Mule is declared as either +;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required +;; for reading the such messages. + +;; This MIME composer can work with Mail mode, mh-e letter Mode, and +;; News mode. First of all, you need the following autoload +;; definition to load mime-mode automatically: +;; +;; (autoload 'mime-mode "mime" "Minor mode for editing MIME message." t) +;; +;; In case of Mail mode (includes VM mode), you need the following +;; hook definition: +;; +;; (setq mail-mode-hook +;; (list +;; (function +;; (lambda () +;; (mime-mode))))) +;; +;; In case of MH-E, you need the following hook definition: +;; +;; (setq mh-letter-mode-hook +;; (list +;; (function +;; (lambda () +;; (mime-mode) +;; (make-local-variable 'mail-header-separator) +;; (setq mail-header-separator "--------"))))) +;; +;; In case of News mode, you need the following hook definition: +;; +;; (setq news-reply-mode-hook +;; (list +;; (function +;; (lambda () +;; (mime-mode))))) +;; +;; Followings are for message forwarding as content-type +;; "message/rfc822". +;; +;; (setq rmail-mode-hook +;; (list +;; (function +;; (lambda () +;; ;; Forward mail using MIME. +;; (require 'mime) +;; (substitute-key-definition 'rmail-forward +;; 'mime-forward-from-rmail-using-mail +;; (current-local-map)) +;; )))) +;; +;; (setq gnus-mail-forward-method 'mime-forward-from-gnus-using-mail) +;; (setq gnus-summary-mode-hook +;; (list +;; (function +;; (lambda () +;; ;; Forward article using MIME. +;; (require 'mime) +;; )))) +;; +;; In case of Emacs 19, it is possible to emphasize the message tags +;; using font-lock mode as follows: +;; +;; (setq mime-mode-hook +;; (list +;; (function +;; (lambda () +;; (font-lock-mode 1) +;; (setq font-lock-keywords (list tm-edit/tag-regexp)))))) + +;; The message tag looks like: +;; +;; --[[TYPE/SUBTYPE;PARAMETERS][ENCODING]] +;; +;; The tagged MIME message examples: +;; +;; This is a conventional plain text. It should be translated into +;; text/plain. +;; +;;--[[text/plain]] +;; This is also a plain text. But, it is explicitly specified as is. +;; +;;--[[text/plain; charset=ISO-2022-JP]] +;; これは charset を ISO-2022-JP に指定した日本語の plain テキストです. +;; +;;--[[text/richtext]] +;;
This is a richtext.
+;; +;;--[[image/gif][base64]]^M...image encoded in base64 comes here... +;; +;;--[[audio/basic][base64]]^M...audio encoded in base64 comes here... + +;; LCD Archive Entry: +;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp| +;; Simple MIME Composer| +;; $Date: 1995/10/26 11:12:05 $|$Revision: 7.11 $|~/misc/mime.el.Z| + +;;; Code: + +(require 'sendmail) +(require 'mail-utils) +(require 'mel) +(require 'tl-822) +(require 'tl-list) +(require 'tm-view) +(require 'tm-ew-e) +(require 'signature) + + +;;; @ version +;;; + +(defconst tm-edit/RCS-ID + "$Id: tm-edit.el,v 7.11 1995/10/26 11:12:05 morioka Exp $") + +(defconst tm-edit/version (get-version-string tm-edit/RCS-ID)) + + +;;; @ variables +;;; + +(defvar mime-prefix "\C-c\C-x" + "*Keymap prefix for MIME commands.") + +(defvar mime-signature-file "~/.signature.rtf" + "*Signature file to be included as a part of a multipart message.") + +(defvar mime-ignore-preceding-spaces nil + "*Ignore preceding white spaces if non-nil.") + +(defvar mime-ignore-trailing-spaces nil + "*Ignore trailing white spaces if non-nil.") + +(defvar mime-ignore-same-text-tag t + "*Ignore preceding text content-type tag that is same with new one. +If non-nil, the text tag is not inserted unless something different.") + +(defvar mime-auto-hide-body t + "*Hide non-textual body encoded in base64 after insertion if non-nil.") + +(defvar mime-body-charset-chooser + (cond ((boundp 'NEMACS) + (function mime-body-charset-chooser-for-nemacs)) + ((featurep 'mule) + (function mime-body-charset-chooser-for-mule)) + ((string-match "^19\\." emacs-version) + (function mime-body-charset-chooser-for-emacs19)) + (t ;ASCII only emacs + (function mime-body-charset-chooser-for-emacs18))) + "*Function to identify charset and encoding of a text in a given region. +The value is a form of (CHARSET . ENCODING), where ENCODING must be a +full name, such as base64.") + +(defvar mime-string-encoder + (cond ((boundp 'NEMACS) + (function mime-string-encoder-for-nemacs)) + ((featurep 'mule) + (function mime-string-encoder-for-mule)) + ((string-match "^19\\." emacs-version) + (function mime-string-encoder-for-emacs19)) + (t ;ASCII only emacs + (function mime-string-encoder-for-emacs18))) + "*Function to encode a string for given encoding method. +The method is a form of (CHARSET . ENCODING).") + +(defvar mime-voice-recorder + (function mime-voice-recorder-for-sun) + "*Function to record a voice message and return a buffer that contains it.") + +(defvar mime-mode-hook nil + "*Hook called when enter MIME mode.") + +(defvar mime-translate-hook nil + "*Hook called before translating into a MIME compliant message. +To insert a signature file specified by mime-signature-file +(`.signature.rtf' by default) automatically, call the function +`tm-edit/insert-signature' from this hook.") + +(defvar mime-exit-hook nil + "*Hook called when exit MIME mode.") + +(defvar mime-content-types + '(("text" + ;; Charset parameter need not to be specified, since it is + ;; defined automatically while translation. + ("plain" + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + ) + ("richtext" + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + ) + ("enriched" + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + ) + ("x-latex" + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + ) + ("html" + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + )) + ("message" + ("external-body" + ("access-type" + ("anon-ftp" + ("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")) + ("tftp" ("site") ("name")) + ("afs" ("site") ("name")) + ("local-file" ("site") ("name")) + ("mail-server" ("server" "ftpmail@nic.karrn.ad.jp")) + )) + ("rfc822") + ) + ("application" + ("octet-stream" + ("name") + ("type" "" "tar" "shar") + ("conversions")) + ("postscript") + ("x-kiss" ("x-cnf"))) + ("image" + ("gif") + ("jpeg") + ("x-pic") + ("x-xwd") + ("x-xbm") + ) + ("audio" ("basic")) + ("video" ("mpeg")) + ) + "*Alist of content-type, subtype, parameters and its values.") + +(defvar mime-file-types + '(("\\.rtf$" + "text" "richtext" nil nil) + ("\\.html$" + "text" "html" nil nil) + ("\\.ps$" + "application" "postscript" nil "quoted-printable") + ("\\.gif$" + "image" "gif" nil "base64" + (("Content-Description" . file)) + ) + ("\\.jpg$" + "image" "jpeg" nil "base64") + ("\\.xwd$" + "image" "x-xwd" nil "base64") + ("\\.xbm$" + "image" "x-xbm" nil "base64") + ("\\.pic$" + "image" "x-pic" nil "base64" + (("Content-Description" . file)) + ) + ("\\.tiff$" + "image" "tiff" nil "base64") + ("\\.au$" + "audio" "basic" nil "base64") + ("\\.mpg$" + "video" "mpeg" nil "base64") + ("\\.el$" + "application" "octet-stream" (("name" . file) + ("type" . "emacs-lisp")) "7bit") + ("\\.tar.gz$" + "application" "octet-stream" (("name" . file) + ("type" . "tar") + ("conversions" . "gzip")) nil) + ("\\.diff$" + "application" "octet-stream" (("name" . file) + ("type" . "patch")) nil) + ("\\.signature" + "text" "plain" nil nil) + (".*" nil nil nil nil) + ) + "*Alist of file name, types, parameters, and default encoding. +If encoding is nil, it is determined from its contents.") + +(defvar tm-edit/split-message t) + +(defvar tm-edit/message-default-max-length 1000) + +(defvar tm-edit/message-max-length-alist + '((news-reply-mode . 500))) + +(defconst tm-edit/message-nuke-headers + "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)") + +(defvar tm-edit/message-blind-headers "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") + +(defvar tm-edit/message-default-sender-alist + '((mail-mode . mail-send-and-exit) + (mh-letter-mode . mh-send-letter) + (news-reply-mode . gnus-inews-news))) + +(defvar tm-edit/message-sender-alist + '((mail-mode + . (lambda () + (interactive) + (sendmail-send-it) + )) + (mh-letter-mode + . (lambda (&optional arg) + (interactive "P") + (write-region (point-min) (point-max) + tm-edit/draft-file-name) + (message + (format "Sending %d/%d..." (+ i 1) total)) + (cond (arg + (pop-to-buffer "MH mail delivery") + (erase-buffer) + (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" + "-nodraftfolder" + mh-send-args tm-edit/draft-file-name) + (goto-char (point-max)) ; show the interesting part + (recenter -1) + (sit-for 1)) + (t + (apply 'mh-exec-cmd-quiet t mh-send-prog + (mh-list-to-string + (list "-nopush" "-nodraftfolder" + "-noverbose" "-nowatch" + mh-send-args tm-edit/draft-file-name))))) + (message + (format "Sending %d/%d... done" (+ i 1) total)) + )) + )) + +(defvar tm-edit/window-config-alist + '((mail-mode . nil) + (mh-letter-mode . mh-previous-window-config) + (news-reply-mode . (cond ((boundp 'gnus-winconf-post-news) + (prog1 + gnus-winconf-post-news + (setq gnus-winconf-post-news nil) + )) + ((boundp 'gnus-prev-winconf) + (prog1 + gnus-prev-winconf + (setq gnus-prev-winconf nil) + )) + )) + )) + +(defvar tm-edit/news-reply-mode-server-running nil) + +(defvar tm-edit/message-before-send-hook-alist + '((mh-letter-mode . mh-before-send-letter-hook))) + +(defvar tm-edit/message-after-send-hook-alist + '((mh-letter-mode + . (lambda () + (if mh-annotate-char + (mh-annotate-msg mh-sent-from-msg + mh-sent-from-folder + mh-annotate-char + "-component" mh-annotate-field + "-text" + (format "\"%s %s\"" + (mh-get-field "To:") + (mh-get-field "Cc:")))))) + )) + +(defvar tm-edit/message-inserter-alist nil) + +(defvar mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]" + "*Specify MIME tspecials. +Tspecials means any character that matches with it in header must be quoted.") + +(defconst tm-edit/single-part-tag-regexp + "^--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]" + "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].") + +(defconst tm-edit/multipart-beginning-regexp "^--<<\\([^<>]+\\)>>-{\n") + +(defconst tm-edit/multipart-end-regexp "^--}-<<\\([^<>]+\\)>>\n") + +(defconst tm-edit/beginning-tag-regexp + (regexp-or tm-edit/single-part-tag-regexp + tm-edit/multipart-beginning-regexp)) + +(defconst tm-edit/end-tag-regexp + (regexp-or tm-edit/single-part-tag-regexp + tm-edit/multipart-end-regexp)) + +(defconst tm-edit/tag-regexp + (regexp-or tm-edit/single-part-tag-regexp + tm-edit/multipart-beginning-regexp + tm-edit/multipart-end-regexp)) + +(defvar mime-tag-format "--[[%s]]" + "*Control-string making a MIME tag.") + +(defvar mime-tag-format-with-encoding "--[[%s][%s]]" + "*Control-string making a MIME tag with encoding.") + +(defvar mime-multipart-boundary "Multipart" + "*Boundary of a multipart message.") + + +(defconst tm-edit/mime-version-value + (format "1.0 (generated by tm-edit %s)" tm-edit/version) + "MIME version number.") + +(defvar mime-mode-flag nil) +(make-variable-buffer-local 'mime-mode-flag) + +(or (assq 'mime-mode-flag minor-mode-alist) + (setq minor-mode-alist + (cons (list 'mime-mode-flag " MIME") minor-mode-alist))) + +(defun mime-define-keymap (keymap) + "Add MIME commands to KEYMAP." + (if (not (keymapp keymap)) + nil + (define-key keymap "\C-t" 'tm-edit/insert-text) + (define-key keymap "\C-i" 'tm-edit/insert-file) + (define-key keymap "\C-e" 'tm-edit/insert-external) + (define-key keymap "\C-v" 'tm-edit/insert-voice) + (define-key keymap "\C-y" 'tm-edit/insert-message) + (define-key keymap "\C-w" 'tm-edit/insert-signature) + (define-key keymap "\C-s" 'tm-edit/insert-signature) + (define-key keymap "\C-m" 'tm-edit/insert-tag) + (define-key keymap "a" 'tm-edit/enclose-alternative-region) + (define-key keymap "p" 'tm-edit/enclose-parallel-region) + (define-key keymap "m" 'tm-edit/enclose-mixed-region) + (define-key keymap "d" 'tm-edit/enclose-digest-region) + (define-key keymap "\C-p" 'tm-edit/preview-message) + (define-key keymap "\C-z" 'mime-mode-exit) + (define-key keymap "?" 'help-mime-mode) + )) + +(defconst tm-edit/menu + '("MIME" + ["Describe MIME Mode" help-mime-mode mime-mode-flag] + ["Insert File" tm-edit/insert-file mime-mode-flag] + ["Insert External" tm-edit/insert-external mime-mode-flag] + ["Insert Voice" tm-edit/insert-voice mime-mode-flag] + ["Insert Mail" tm-edit/insert-message mime-mode-flag] + ["Insert Signature" tm-edit/insert-signature mime-mode-flag] + ["Insert Text" tm-edit/insert-text mime-mode-flag] + ["Insert Tag" tm-edit/insert-tag mime-mode-flag] + ["Enclose as alternative" + tm-edit/enclose-alternative-region mime-mode-flag] + ["Enclose as parallel" + tm-edit/enclose-parallel-region mime-mode-flag] + ["Enclose as serial" + tm-edit/enclose-mixed-region mime-mode-flag] + ["Enclose as digest" + tm-edit/enclose-digest-region mime-mode-flag] + ["Preview Message" tm-edit/preview-message mime-mode-flag] + ) + "MIME menubar entry.") + +(defun tm-edit/define-menu-for-emacs19 () + "Define menu for Emacs 19." + (define-key (current-local-map) [menu-bar mime] + (cons "MIME" (make-sparse-keymap "MIME"))) + (mapcar (function + (lambda (item) + (define-key (current-local-map) + (vector 'menu-bar 'mime (aref item 1)) + (cons (aref item 0)(aref item 1)) + ) + )) + (reverse (cdr tm-edit/menu)) + )) + +;;; modified by Pekka Marjola +;;; 1995/9/5 (c.f. [tm-eng:69]) +(defun tm-edit/define-menu-for-xemacs () + "Define menu for Emacs 19." + (cond ((featurep 'menubar) + (make-local-variable 'current-menubar) + (set-buffer-menubar current-menubar) + (add-submenu nil mime-menu) + ))) + +(defvar mime-xemacs-old-bindings nil + "A list of commands to restore old bindings.") + +(defun mime-xemacs-save-old-bindings (keymap funct) + "Save key bindings to a list for setting it back." + (let* ((key-bindings (where-is-internal funct keymap)) + (key-binding nil)) + (while key-bindings + (setq key-binding (pop key-bindings)) + (setq mime-xemacs-old-bindings + (append mime-xemacs-old-bindings + (list (list 'define-key keymap key-binding + (list 'function funct)))))))) +;;; end + +;;;###autoload +(defun mime-mode () + "MIME minor mode for editing the tagged MIME message. + +In this mode, basically, the message is composed in the tagged MIME +format. The message tag looks like: + + `--[[text/plain; charset=ISO-2022-JP][7bit]]'. + +The tag specifies the MIME content type, subtype, optional parameters +and transfer encoding of the message following the tag. Messages +without any tag are treated as `text/plain' by default. Charset and +transfer encoding are automatically defined unless explicitly +specified. Binary messages such as audio and image are usually hidden +using selective-display facility. The messages in the tagged MIME +format are automatically translated into a MIME compliant message when +exiting this mode. + +Available charsets depend on Emacs version being used. The following +lists the available charsets of each emacs. + +Emacs18: US-ASCII is only available. +NEmacs: US-ASCII and ISO-2022-JP are available. +Emacs19: US-ASCII and ISO-8859-1 are available. +Mule: US-ASCII, ISO-8859-* (except for ISO-8859-6), + ISO-2022-JP, ISO-2022-JP-2 and ISO-2022-INT-1 are available. + +ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in Mule is expected to +be used to represent multilingual text in intermixed manner. Any +languages that has no registered charset are represented as either +ISO-2022-JP-2 or ISO-2022-INT-1 in Mule. + +Following commands are available in addition to major mode commands: +\\[tm-edit/insert-text] insert a text message. +\\[tm-edit/insert-file] insert a (binary) file. +\\[tm-edit/insert-external] insert a reference to external body. +\\[tm-edit/insert-voice] insert a voice message. +\\[tm-edit/insert-message] insert a mail or news message. +\\[tm-edit/insert-signature] insert a signature file at end. +\\[tm-edit/insert-tag] insert a new MIME tag. +\\[tm-edit/enclose-alternative-region] Enclose as multipart/alternative. +\\[tm-edit/enclose-parallel-region] Enclose as multipart/parallel. +\\[tm-edit/enclose-mixed-region] Enclose as multipart/mixed. +\\[tm-edit/enclose-digest-region] Enclose as multipart/digest. +\\[tm-edit/preview-message] preview editing MIME message. +\\[mime-mode-exit] exit and translate into a MIME compliant message. +\\[tm-edit/exit-and-run] exit, translate and run the original command. +\\[help-mime-mode] show this help. + +Additional commands are available in some major modes: +C-c C-c exit, translate and run the original command. +C-c C-s exit, translate and run the original command. + +The following is a message example written in the tagged MIME format. +TABs at the beginning of the line are not a part of the message: + + This is a conventional plain text. It should be translated + into text/plain. + --[[text/plain]] + This is also a plain text. But, it is explicitly specified as + is. + --[[text/plain; charset=ISO-2022-JP]] + これは charset を ISO-2022-JP に指定した日本語の plain テキス + トです. + --[[text/richtext]] +
This is a richtext.
+ --[[image/gif][base64]]^M...image encoded in base64 here... + --[[audio/basic][base64]]^M...audio encoded in base64 here... + +User customizable variables (not documented all of them): + mime-prefix + Specifies a key prefix for MIME minor mode commands. + + mime-signature-file + Specifies a signature file to be included as part of a multipart + message. + + mime-ignore-preceding-spaces + Preceding white spaces in a message body are ignored if non-nil. + + mime-ignore-trailing-spaces + Trailing white spaces in a message body are ignored if non-nil. + + mime-auto-fill-header + Fill header fields that contain encoded-words if non-nil. + + mime-auto-hide-body + Hide a non-textual body message encoded in base64 after insertion + if non-nil. + + mime-body-charset-chooser + Specifies a function to identify charset and encoding of a text in + a given region. The value is a form of (CHARSET . ENCODING), + where ENCODING must be a full name, such as base64. + + mime-string-encoder + Specifies a function to encode a string for given encoding method. + The method is a form of (CHARSET . ENCODING). + + mime-voice-recorder + Specifies a function to record a voice message and return a buffer + that contains it. The function mime-voice-recorder-for-sun is for + Sun SparcStations. + + mime-mode-hook + Turning on MIME mode calls the value of mime-mode-hook, if it is + non-nil. + + mime-translate-hook + The value of mime-translate-hook is called just before translating + the tagged MIME format into a MIME compliant message if it is + non-nil. If the hook call the function tm-edit/insert-signature, + the signature file will be inserted automatically. + + mime-exit-hook + Turning off MIME mode calls the value of mime-exit-hook, if it is + non-nil." + (interactive) + (if mime-mode-flag + (error "You are already editing a MIME message.") + (setq mime-mode-flag t) + ;; Remember old key bindings. + (make-local-variable 'mime-mode-old-local-map) + (setq mime-mode-old-local-map (current-local-map)) + ;; Add MIME commands to current local map. + ;; modified by Pekka Marjola + ;; 1995/9/5 (c.f. [tm-eng:69]) + (or (string-match "XEmacs\\|Lucid" emacs-version) ; can't use w/ XEmacs + (use-local-map (copy-keymap (current-local-map)))) + ;; end + + (if (not (lookup-key (current-local-map) mime-prefix)) + (define-key (current-local-map) mime-prefix (make-sparse-keymap))) + (mime-define-keymap (lookup-key (current-local-map) mime-prefix)) + ;; Replace key definitions to avoid sending a message without + ;; conversion into a MIME compliant message. + ;; modified by Pekka Marjola + ;; 1995/9/5 (c.f. [tm-eng:69]) + ;; copy-keymap behaves strangely in XEmacs + (cond ((string-match "XEmacs\\|Lucid" emacs-version) + (make-variable-buffer-local 'mime-xemacs-old-bindings) + (setq mime-xemacs-old-bindings nil) + (let ((keymap nil) + (keymaps (accessible-keymaps (current-local-map)))) + (while keymaps + (setq keymap (cdr (car keymaps))) + (setq keymaps (cdr keymaps)) + (if (not (keymapp keymap)) + nil + ;; Mail mode: + (mime-xemacs-save-old-bindings keymap 'mail-send) + (mime-xemacs-save-old-bindings keymap 'mail-send-and-exit) + ;; mh-e letter mode: + (mime-xemacs-save-old-bindings keymap 'mh-send-letter) + ;; Mail mode called from VM: + (mime-xemacs-save-old-bindings keymap 'vm-mail-send) + (mime-xemacs-save-old-bindings keymap 'vm-mail-send-and-exit) + ;; News mode: + (mime-xemacs-save-old-bindings keymap 'news-inews) + )) + ))) + ;; end + + (let ((keymap nil) + (keymaps (accessible-keymaps (current-local-map)))) + (while keymaps + (setq keymap (cdr (car keymaps))) + (setq keymaps (cdr keymaps)) + (if (not (keymapp keymap)) + nil + ;; Mail mode: + (substitute-key-definition + 'mail-send 'tm-edit/exit-and-run keymap) + (substitute-key-definition + 'mail-send-and-exit 'tm-edit/exit-and-run keymap) + ;; mh-e letter mode: + (substitute-key-definition + 'mh-send-letter 'tm-edit/exit-and-run keymap) + ;; Mail mode called from VM: + (substitute-key-definition + 'vm-mail-send 'tm-edit/exit-and-run keymap) + (substitute-key-definition + 'vm-mail-send-and-exit 'tm-edit/exit-and-run keymap) + ;; News mode: + (substitute-key-definition + 'news-inews 'tm-edit/exit-and-run keymap) + ))) + ;; Define menu. Menus for other emacs implementations are + ;; welcome. + ;; modified by Pekka Marjola + ;; 1995/9/5 (c.f. [tm-eng:69]) + (cond ((string-match "XEmacs\\|Lucid" emacs-version) + (tm-edit/define-menu-for-xemacs)) + ((string-match "^19\\." emacs-version) + (tm-edit/define-menu-for-emacs19) + )) + ;; end + + ;; Remember old selective-display. + (make-local-variable 'mime-mode-old-selective-display) + (setq mime-mode-old-selective-display selective-display) + (setq selective-display t) + ;; I don't care about saving these. + (setq paragraph-start + (concat tm-edit/single-part-tag-regexp "\\|" paragraph-start)) + (setq paragraph-separate + (concat tm-edit/single-part-tag-regexp "\\|" paragraph-separate)) + (run-hooks 'mime-mode-hook) + (message + (substitute-command-keys + "Type \\[mime-mode-exit] to exit MIME mode, and type \\[help-mime-mode] to get help.")) + )) + +;;;###autoload +(fset 'edit-mime 'mime-mode) ; for convenience + +(defun mime-mode-exit (&optional nomime) + "Translate the tagged MIME message into a MIME compliant message. +With no argument encode a message in the buffer into MIME, otherwise +just return to previous mode." + (interactive "P") + (if (not mime-mode-flag) + (error "You aren't editing a MIME message.") + (if (not nomime) + (progn + (run-hooks 'mime-translate-hook) + (tm-edit/translate-buffer))) + ;; Restore previous state. + (setq mime-mode-flag nil) + (use-local-map mime-mode-old-local-map) + + ;; modified by Pekka Marjola + ;; 1995/9/5 (c.f. [tm-eng:69]) + (if (string-match "XEmacs\\|Lucid" emacs-version) + (progn + (delete-menu-item '("MIME")) ; should rather be const + (while mime-xemacs-old-bindings + (eval (pop mime-xemacs-old-bindings))) + (local-unset-key mime-prefix))) + ;; end + + (setq selective-display mime-mode-old-selective-display) + (set-buffer-modified-p (buffer-modified-p)) + (run-hooks 'mime-exit-hook) + (message "Exit MIME mode.") + )) + +(defun tm-edit/exit-and-run () + (interactive) + (mime-mode-exit) + (call-interactively 'tm-edit/split-and-send) + ) + +(defun help-mime-mode () + "Show help message about MIME mode." + (interactive) + (with-output-to-temp-buffer "*Help*" + (princ "Edit MIME Mode:\n") + (princ (documentation 'mime-mode)) + (print-help-return-message))) + +(defun tm-edit/insert-text () + "Insert a text message. +Charset is automatically obtained from the mime-body-charset-chooser." + (interactive) + (if (and (tm-edit/insert-tag "text" nil nil) + (looking-at tm-edit/single-part-tag-regexp)) + (progn + ;; Make a space between the following message. + (insert "\n") + (forward-char -1) + ))) + +(defun tm-edit/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. + (fields (nth 4 guess)) + (encoding + (if (not (interactive-p)) + default + (completing-read + (concat "What transfer encoding" + (if default + (concat " (default " + (if (string-equal default "") "\"\"" default) + ")" + )) + ": ") + mime-encoding-method-alist nil t nil)))) + (if (string-equal encoding "") + (setq encoding default)) + (if (or (consp parameters) (consp fields)) + (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)) + ) + (setq rest fields) + (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 "\n" attribute ": " value)) + (setq rest (cdr rest)) + ) + )) + (tm-edit/insert-tag pritype subtype parameters) + (tm-edit/insert-binary-file file encoding) + )) + +(defun tm-edit/insert-external () + "Insert a reference to external body." + (interactive) + (tm-edit/insert-tag "message" "external-body" nil ";\n\t") + ;;(forward-char -1) + ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n") + ;;(forward-line 1) + (let* ((pritype (mime-prompt-for-type)) + (subtype (mime-prompt-for-subtype pritype)) + (parameters (mime-prompt-for-parameters pritype subtype ";\n\t"))) + (and pritype + subtype + (insert "Content-Type: " + pritype "/" subtype (or parameters "") "\n"))) + (if (and (not (eobp)) + (not (looking-at tm-edit/single-part-tag-regexp))) + (insert (mime-make-text-tag) "\n"))) + +(defun tm-edit/insert-voice () + "Insert a voice message." + (interactive) + (tm-edit/insert-tag "audio" "basic" nil) + (let ((buffer (funcall mime-voice-recorder))) + (unwind-protect + (tm-edit/insert-binary-buffer buffer "base64") + (kill-buffer buffer) + ))) + +(defun tm-edit/insert-signature () + "Insert a signature file specified by mime-signature-file." + (interactive) + (save-restriction + (apply (function tm-edit/insert-tag) + (prog1 + (mime-find-file-type (insert-signature)) + (narrow-to-region (point-min)(point)) + )) + )) + +;; Insert a new tag around a point. + +(defun tm-edit/insert-tag (&optional pritype subtype parameters delimiter) + "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS. +If nothing is inserted, return nil." + (interactive) + (let ((oldtag nil) + (newtag nil) + (current (point))) + (setq pritype + (or pritype + (mime-prompt-for-type))) + (setq subtype + (or subtype + (mime-prompt-for-subtype pritype))) + (setq parameters + (or parameters + (mime-prompt-for-parameters pritype subtype delimiter))) + ;; Make a new MIME tag. + (setq newtag (mime-make-tag pritype subtype parameters)) + ;; Find an current MIME tag. + (setq oldtag + (save-excursion + (if (tm-edit/goto-tag) + (buffer-substring (match-beginning 0) (match-end 0)) + ;; Assume content type is 'text/plan'. + (mime-make-tag "text" "plain") + ))) + ;; We are only interested in TEXT. + (if (and oldtag + (not (mime-test-content-type (tm-edit/get-contype oldtag) "text"))) + (setq oldtag nil)) + (beginning-of-line) + (cond ((and oldtag ;Text + (not (eobp)) + (save-excursion + (forward-line -1) + (looking-at tm-edit/beginning-tag-regexp) + ) + (or mime-ignore-same-text-tag + (not (string-equal oldtag newtag)))) + ;; If point is at the next of current tag, move to the + ;; beginning of the tag to disable insertion of extra tag. + (forward-line -1)) + ((and oldtag ;Text + (not (eobp)) + (not (looking-at tm-edit/tag-regexp)) + (or mime-ignore-same-text-tag + (not (string-equal oldtag newtag)))) + ;; Copy current tag to break a text into two. + (save-excursion + (insert oldtag "\n"))) + ((and (null oldtag) ;Not text + (not (looking-at tm-edit/tag-regexp))) + ;; Adjust insertion point. In the middle of text, it is + ;; okay to break the text into two. However, it should not + ;; be broken into two, if otherwise. + (goto-char (tm-edit/content-end)) + (if (eolp) + (forward-line 1)) + (if (not (bolp)) + (insert "\n")) + )) + ;; Make a new tag. + (if (or (not oldtag) ;Not text + (or mime-ignore-same-text-tag + (not (string-equal oldtag newtag)))) + (progn + ;; Mark the beginning of the tag for convenience. + (push-mark (point) 'nomsg) + (insert newtag "\n") + (list pritype subtype parameters) ;New tag is created. + ) + ;; Restore previous point. + (goto-char current) + nil ;Nothing is created. + ) + )) + +;; Insert the binary content after MIME tag. +;; modified by MORITA Masahiro +;; for x-uue +(defun tm-edit/insert-binary-file (file &optional encoding) + "Insert binary FILE at point. +Optional argument ENCODING specifies an encoding method such as base64." + (let ((tmpbuf (get-buffer-create " *MIME insert*"))) + (save-excursion + (set-buffer tmpbuf) + (erase-buffer) + (let ((mc-flag nil) ;Mule + (file-coding-system-for-read + (if (featurep 'mule) *noconv*)) + (kanji-flag nil) ;NEmacs + (emx-binary-mode t) ;Stop CRLF to LF conversion in OS/2 + ) + (let (jka-compr-compression-info-list + jam-zcat-filename-list) + (insert-file-contents file)))) + (prog1 + (if (and (stringp encoding) + (string-equal (downcase encoding) "x-uue")) + (progn + (require 'mel-u) + (let ((uuencode-external-encoder + (cons (car uuencode-external-encoder) + (list (file-name-nondirectory file)) + ))) + (tm-edit/insert-binary-buffer tmpbuf encoding) + )) + (tm-edit/insert-binary-buffer tmpbuf encoding)) + (kill-buffer tmpbuf)))) + +;; Insert the binary content after MIME tag. +;; modified by MORITA Masahiro +;; for x-uue +(defun tm-edit/insert-binary-buffer (buffer &optional encoding) + "Insert binary BUFFER at point. +Optional argument ENCODING specifies an encoding method such as base64." + (let* ((tagend (1- (point))) ;End of the tag + (hide-p (and mime-auto-hide-body + (stringp encoding) + (let ((en (downcase encoding))) + (or (string-equal en "base64") + (string-equal en "x-uue") + )))) + ) + (save-restriction + (narrow-to-region (1- (point)) (point)) + (let ((start (point)) + (emx-binary-mode t)) ;Stop LF to CRLF conversion in OS/2 + (insert-buffer-substring buffer) + ;; Encode binary message if necessary. + (if encoding + (mime-encode-region encoding start (point-max)))) + (if hide-p + (progn + (mime-flag-region (point-min) (1- (point-max)) ?\^M) + (goto-char (point-max))) + )) + ;; Define encoding even if it is 7bit. + (if (stringp encoding) + (save-excursion + (goto-char tagend) ;Make sure which line the tag is on. + (tm-edit/define-encoding encoding))) + )) + +;; Commands work on a current message flagment. + +(defun tm-edit/goto-tag () + "Search for the beginning of the tagged MIME message." + (let ((current (point)) multipart) + (if (looking-at tm-edit/tag-regexp) + t + ;; At first, go to the end. + (cond ((re-search-forward tm-edit/beginning-tag-regexp nil t) + (goto-char (match-beginning 0)) ;For multiline tag + (forward-line -1) + (end-of-line) + ) + (t + (goto-char (point-max)) + )) + ;; Then search for the beginning. + (re-search-backward tm-edit/end-tag-regexp nil t) + (beginning-of-line) + (or (looking-at tm-edit/beginning-tag-regexp) + ;; Restore previous point. + (progn + (goto-char current) + nil + )) + ))) + +(defun tm-edit/content-beginning () + "Return the point of the beginning of content." + (save-excursion + (let ((beg (save-excursion + (beginning-of-line) (point)))) + (if (tm-edit/goto-tag) + (let ((top (point))) + (goto-char (match-end 0)) + (if (and (= beg top) + (= (following-char) ?\^M)) + (point) + (forward-line 1) + (point))) + ;; Default text/plain tag. + (goto-char (point-min)) + (re-search-forward + (concat "\n" (regexp-quote mail-header-separator) + (if mime-ignore-preceding-spaces + "[ \t\n]*\n" "\n")) nil 'move) + (point)) + ))) + +(defun tm-edit/content-end () + "Return the point of the end of content." + (save-excursion + (let ((beg (save-excursion + (beginning-of-line) (point)))) + (if (tm-edit/goto-tag) + (let ((top (point))) + (goto-char (match-end 0)) + (if (and (= beg top) ;Must be on the same line. + (= (following-char) ?\^M)) + (progn + (end-of-line) + (point)) + ;; Move to the end of this text. + (if (re-search-forward tm-edit/tag-regexp nil 'move) + ;; Don't forget a multiline tag. + (goto-char (match-beginning 0))) + (point) + )) + ;; Assume the message begins with text/plain. + (goto-char (tm-edit/content-beginning)) + (if (re-search-forward tm-edit/tag-regexp nil 'move) + ;; Don't forget a multiline tag. + (goto-char (match-beginning 0))) + (point)) + ))) + +(defun tm-edit/define-charset (charset) + "Set charset of current tag to CHARSET." + (save-excursion + (if (tm-edit/goto-tag) + (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) + (delete-region (match-beginning 0) (match-end 0)) + (insert + (mime-create-tag (mime-set-parameter + (tm-edit/get-contype tag) "charset" charset) + (tm-edit/get-encoding tag)))) + ))) + +(defun tm-edit/define-encoding (encoding) + "Set encoding of current tag to ENCODING." + (save-excursion + (if (tm-edit/goto-tag) + (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) + (delete-region (match-beginning 0) (match-end 0)) + (insert (mime-create-tag (tm-edit/get-contype tag) encoding))) + ))) + +(defun tm-edit/choose-charset () + "Choose charset of a text following current point." + (save-excursion + (let* ((beg (point)) + (end (tm-edit/content-end))) + (car (funcall mime-body-charset-chooser beg end))))) + +(defun tm-edit/choose-encoding () + "Choose encoding of a text following current point." + (save-excursion + (let* ((beg (point)) + (end (tm-edit/content-end))) + (cdr (funcall mime-body-charset-chooser beg end))))) + +(defun mime-make-text-tag (&optional subtype) + "Make a tag for a text after current point. +Subtype of text type can be specified by an optional argument SUBTYPE. +Otherwise, it is obtained from mime-content-types." + (let* ((pritype "text") + (subtype (or subtype + (car (car (cdr (assoc pritype mime-content-types))))))) + ;; Charset should be defined later. + (mime-make-tag pritype subtype))) + + +;; Tag handling functions + +(defun mime-make-tag (pritype subtype &optional parameters encoding) + "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS." + (mime-create-tag (concat (or pritype "") "/" (or subtype "") + (or parameters "")) + encoding)) + +(defun mime-create-tag (contype &optional encoding) + "Make a tag with CONTENT-TYPE and optional ENCODING." + (format (if encoding mime-tag-format-with-encoding mime-tag-format) + contype encoding)) + +(defun tm-edit/get-contype (tag) + "Return Content-Type (including parameters) of TAG." + (and (stringp tag) + (or (string-match tm-edit/single-part-tag-regexp tag) + (string-match tm-edit/multipart-beginning-regexp tag) + (string-match tm-edit/multipart-end-regexp tag) + ) + (substring tag (match-beginning 1) (match-end 1)) + )) + +(defun tm-edit/get-encoding (tag) + "Return encoding of TAG." + (and (stringp tag) + (string-match tm-edit/single-part-tag-regexp tag) + (match-beginning 3) + (not (= (match-beginning 3) (match-end 3))) + (substring tag (match-beginning 3) (match-end 3)))) + +(defun mime-get-parameter (contype parameter) + "For given CONTYPE return value for PARAMETER. +Nil if no such parameter." + (if (string-match + (concat + ";[ \t\n]*" + (regexp-quote parameter) + "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)") + contype) + (substring contype (match-beginning 1) (match-end 1)) + nil ;No such parameter + )) + +(defun mime-set-parameter (contype parameter value) + "For given CONTYPE set PARAMETER to VALUE." + (if (string-match + (concat + ";[ \t\n]*\\(" + (regexp-quote parameter) + "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)") + contype) + ;; Change value + (concat (substring contype 0 (match-beginning 1)) + parameter "=" value + (substring contype (match-end 1))) + (concat contype "; " parameter "=" value))) + +(defun mime-strip-parameters (contype) + "Return primary content-type and subtype without parameters for CONTYPE." + (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype) + (substring contype (match-beginning 1) (match-end 1)) nil)) + +(defun mime-test-content-type (contype type &optional subtype) + "Test if CONTYPE is a TYPE and an optional SUBTYPE." + (and (stringp contype) + (stringp type) + (string-match + (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype ""))) + (downcase contype)))) + + +;; Basic functions + +(defun mime-find-file-type (file) + "Guess Content-Type, subtype, and parameters from FILE." + (let ((guess nil) + (guesses mime-file-types)) + (while (and (not guess) guesses) + (if (string-match (car (car guesses)) file) + (setq guess (cdr (car guesses)))) + (setq guesses (cdr guesses))) + guess + )) + +(defun mime-prompt-for-type () + "Ask for Content-type." + (let ((type "")) + ;; Repeat until primary content type is specified. + (while (string-equal type "") + (setq type + (completing-read "What content type: " + mime-content-types + nil + 'require-match ;Type must be specified. + nil + )) + (if (string-equal type "") + (progn + (message "Content type is required.") + (beep) + (sit-for 1) + )) + ) + type + )) + +(defun mime-prompt-for-subtype (pritype) + "Ask for Content-type subtype of Content-Type PRITYPE." + (let* ((default (car (car (cdr (assoc pritype mime-content-types))))) + (answer + (completing-read + (if default + (concat + "What content subtype: (default " default ") ") + "What content subtype: ") + (cdr (assoc pritype mime-content-types)) + nil + 'require-match ;Subtype must be specified. + nil + ))) + (if (string-equal answer "") default answer))) + +(defun mime-prompt-for-parameters (pritype subtype &optional delimiter) + "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE. +Optional DELIMITER specifies parameter delimiter (';' by default)." + (let* ((delimiter (or delimiter "; ")) + (parameters + (mapconcat + (function identity) + (delq nil + (mime-prompt-for-parameters-1 + (cdr (assoc subtype + (cdr (assoc pritype mime-content-types)))))) + delimiter + ))) + (if (and (stringp parameters) + (not (string-equal parameters ""))) + (concat delimiter parameters) + "" ;"" if no parameters + ))) + +(defun mime-prompt-for-parameters-1 (optlist) + (apply (function append) + (mapcar (function mime-prompt-for-parameter) optlist))) + +(defun mime-prompt-for-parameter (parameter) + "Ask for PARAMETER. +Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." + (let* ((prompt (car parameter)) + (choices (mapcar (function + (lambda (e) + (if (consp e) e (list e)))) + (cdr parameter))) + (default (car (car choices))) + (answer nil)) + (if choices + (progn + (setq answer + (completing-read + (concat "What " prompt + ": (default " + (if (string-equal default "") "\"\"" default) + ") ") + choices nil nil "")) + ;; If nothing is selected, use default. + (if (string-equal answer "") + (setq answer default))) + (setq answer + (read-string (concat "What " prompt ": ")))) + (cons (if (and answer + (not (string-equal answer ""))) + (concat prompt "=" + ;; Note: control characters ignored! + (if (string-match mime-tspecials-regexp answer) + (concat "\"" answer "\"") answer))) + (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-decode-string (encoding string) + "Using ENCODING decode a STRING." + (save-excursion + (set-buffer (get-buffer-create " *MIME decoding*")) + (erase-buffer) + (insert string) + (mime-decode-region encoding (point-min) (point-max)) + (prog1 + (buffer-substring (point-min) (point-max)) + (kill-buffer (current-buffer))))) + +(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, +while if FLAG is `\\^M' (control-M) the text is hidden." + (let ((buffer-read-only nil) ;Okay even if write protected. + (modp (buffer-modified-p))) + (unwind-protect + (subst-char-in-region from to + (if (= flag ?\n) ?\^M ?\n) + flag t) + (set-buffer-modified-p modp)))) + + +;; Translate the tagged MIME messages into a MIME compliant message. + +(defun tm-edit/translate-buffer () + "Encode the tagged MIME message in current buffer in MIME compliant message." + (interactive) + (mime/encode-message-header) + (tm-edit/translate-body) + ) + +(defun tm-edit/translate-body () + "Encode the tagged MIME body in current buffer in MIME compliant message." + (interactive) + (save-excursion + (let ((boundary + (concat mime-multipart-boundary " " (current-time-string))) + (i 1) + (time (current-time-string)) + ret) + (while (tm-edit/process-multipart-1 + (format "%s %s-%d" mime-multipart-boundary time i)) + (setq i (1+ i)) + ) + (save-restriction + ;; We are interested in message body. + (let* ((beg + (progn + (goto-char (point-min)) + (re-search-forward + (concat "\n" (regexp-quote mail-header-separator) + (if mime-ignore-preceding-spaces + "[ \t\n]*\n" "\n")) nil 'move) + (point))) + (end + (progn + (goto-char (point-max)) + (and mime-ignore-trailing-spaces + (re-search-backward "[^ \t\n]\n" beg t) + (forward-char 1)) + (point)))) + (setq ret (tm-edit/translate-region + beg end + (format "%s %s-%d" mime-multipart-boundary time i))) + )) + (let ((contype (car ret)) ;Content-Type + (encoding (nth 1 ret)) ;Content-Transfer-Encoding + ) + ;; Make primary MIME headers. + (or (mail-position-on-field "Mime-Version") + (insert tm-edit/mime-version-value)) + ;; Remove old Content-Type and other fields. + (save-restriction + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n") nil t) + (narrow-to-region (point-min) (point)) + (goto-char (point-min)) + (mime-delete-field "Content-Type") + (mime-delete-field "Content-Transfer-Encoding")) + ;; Then, insert Content-Type and Content-Transfer-Encoding fields. + (mail-position-on-field "Content-Type") + (insert contype) + (if encoding + (progn + (mail-position-on-field "Content-Transfer-Encoding") + (insert encoding))) + )))) + +(defun tm-edit/normalize-body () + "Normalize the body part by inserting appropriate message tags." + ;; Insert the first MIME tags if necessary. + (goto-char (point-min)) + (if (not (looking-at tm-edit/single-part-tag-regexp)) + (insert (mime-make-text-tag) "\n")) + ;; Check each tag, and add new tag or correct it if necessary. + (goto-char (point-min)) + (while (re-search-forward tm-edit/single-part-tag-regexp nil t) + (let* ((tag (buffer-substring (match-beginning 0) (match-end 0))) + (contype (tm-edit/get-contype tag)) + (charset (mime-get-parameter contype "charset")) + (encoding (tm-edit/get-encoding tag))) + ;; Remove extra whitespaces after the tag. + (if (looking-at "[ \t]+$") + (delete-region (match-beginning 0) (match-end 0))) + (cond ((= (following-char) ?\^M) + ;; It must be image, audio or video. + (let ((beg (point)) + (end (tm-edit/content-end))) + ;; Insert explicit MIME tags after hidden messages. + (forward-line 1) + (if (and (not (eobp)) + (not (looking-at tm-edit/single-part-tag-regexp))) + (progn + (insert (mime-make-text-tag) "\n") + (forward-line -1) ;Process it again as text. + )) + ;; Show a hidden message. The point is not altered + ;; after the conversion. + (mime-flag-region beg end ?\n))) + ((mime-test-content-type contype "message") + ;; Content-type "message" should be sent as is. + (forward-line 1)) + ((mime-test-content-type contype "text") + ;; Define charset for text if necessary. + (setq charset (or charset (tm-edit/choose-charset))) + (tm-edit/define-charset charset) + ;; Point is now on current tag. + ;; Define encoding and encode text if necessary. + (if (null encoding) ;Encoding is not specified. + (let* ((encoding (tm-edit/choose-encoding)) + (beg (tm-edit/content-beginning)) + (end (tm-edit/content-end)) + (body (buffer-substring beg end)) + (encoded (funcall mime-string-encoder + (cons charset encoding) body))) + (if (not (string-equal body encoded)) + (progn + (goto-char beg) + (delete-region beg end) + (insert encoded) + (goto-char beg))) + (tm-edit/define-encoding encoding))) + (forward-line 1)) + ((null encoding) ;Encoding is not specified. + ;; Application, image, audio, video, and any other + ;; unknown content-type without encoding should be + ;; encoded. + (let* ((encoding "base64") ;Encode in BASE64 by default. + (beg (tm-edit/content-beginning)) + (end (tm-edit/content-end)) + (body (buffer-substring beg end)) + (encoded (funcall mime-string-encoder + (cons nil encoding) body))) + (if (not (string-equal body encoded)) + (progn + (goto-char beg) + (delete-region beg end) + (insert encoded) + (goto-char beg))) + (tm-edit/define-encoding encoding)) + (forward-line 1)) + ) + ))) + +(defun mime-delete-field (field) + "Delete header FIELD." + (let ((regexp (format "^%s:[ \t]*" field))) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point))) + ))) + + +;;; +;;; Platform dependent functions +;;; + +;; Emacs 18 implementations + +(defun mime-body-charset-chooser-for-emacs18 (begin end) + "Return a cons of charset and encoding of a message in a given region. +Encoding name must be a canonical name, such as `base64'." + '("US-ASCII" . nil) ;Default charset of MIME. + ) + +(defun mime-string-encoder-for-emacs18 (method string) + "For given METHOD that is a cons of charset and encoding, encode a STRING." + (let ((charset (car method)) + (encoding (cdr method))) + (cond ((stringp encoding) + (mime-encode-string encoding string)) + ;; Return string without any encoding. + (t string) + ))) + + +;; Emacs 19 implementations + +(defun mime-body-charset-chooser-for-emacs19 (begin end) + "Return a cons of charset and encoding of a message in a given region. +Encoding name must be a canonical name, such as `base64'. +US-ASCII and ISO-8859-1 are supported on Emacs 19." + (cond ((save-excursion + (goto-char begin) + (re-search-forward "[\200-\377]" end t)) + '("ISO-8859-1" . "quoted-printable")) + (t + '("US-ASCII" . nil)) ;Default charset of MIME. + )) + +(defun mime-string-encoder-for-emacs19 (method string) + "For given METHOD that is a cons of charset and encoding, encode a STRING." + (let ((charset (car method)) + (encoding (cdr method))) + (cond ((stringp encoding) + (mime-encode-string encoding string)) + ;; Return string without any encoding. + (t string) + ))) + + +;; NEmacs implementations + +(defun mime-body-charset-chooser-for-nemacs (begin end) + "Return a cons of charset and encoding of a message in a given region. +Encoding name must be a canonical name, such as `base64'. +US-ASCII and ISO-2022-JP are supported on NEmacs." + (cond ((check-region-kanji-code begin end) + ;; The following are safe encoding methods for use in + ;; USENET News systems that strip off all ESCs. + ;; '("ISO-2022-JP" . "quoted-printable") + ;; '("ISO-2022-JP" . "base64") + ;; The following expects transport systems are all MIME + ;; compliants. For instance, ESCs are never stripped off. + '("ISO-2022-JP" . nil)) + (t + '("US-ASCII" . nil)) ;Default charset of MIME. + )) + +(defun mime-string-encoder-for-nemacs (method string) + "For given METHOD that is a cons of charset and encoding, encode a STRING. +US-ASCII and ISO-2022-JP are supported on NEmacs." + (let ((charset (car method)) + (encoding (cdr method))) + (cond ((stringp encoding) + (mime-encode-string encoding + ;; Convert internal (EUC) to JIS code. + (convert-string-kanji-code string 3 2) + )) + ;; NEmacs can convert into ISO-2022-JP automatically, + ;; but can do it myself as follows: + ;;(t (convert-string-kanji-code string 3 2)) + + ;; Return string without any encoding. + (t string) + ))) + + +;; Mule implementations +;; Thanks to contributions by wkenji@flab.fujitsu.co.jp (Kenji +;; WAKAMIYA) and handa@etl.go.jp (Kenichi Handa). + +(defun mime-body-charset-chooser-for-mule (begin end) + "Return a cons of charset and encoding of a message in a given +region. Encoding name must be a canonical name, such as `base64'. +US-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP, +ISO-2022-JP-2 and ISO-2022-INT-1 are supported on Mule. Either of +charset ISO-2022-JP-2 or ISO-2022-INT-1 is used for multilingual text +in Mule." + (let ((lclist (find-charset-region begin end))) + (cond ((null lclist) + '("US-ASCII" . nil)) ;Default charset of MIME. + ;; Multilingual capability requred. + ((and (> (length lclist) 1) + (boundp '*iso-2022-int-1*)) + '("ISO-2022-INT-1" . nil)) + ((> (length lclist) 1) + '("ISO-2022-JP-2" . nil)) + ;; Simple charset. + ((memq lc-ltn1 lclist) + '("ISO-8859-1" . "quoted-printable")) + ((memq lc-ltn2 lclist) + '("ISO-8859-2" . "quoted-printable")) + ((memq lc-ltn3 lclist) + '("ISO-8859-3" . "quoted-printable")) + ((memq lc-ltn4 lclist) + '("ISO-8859-4" . "quoted-printable")) + ((memq lc-crl lclist) + '("ISO-8859-5" . "quoted-printable")) + ;;((memq lc-arb lclist) + ;; '("ISO-8859-6" . "quoted-printable")) + ((memq lc-grk lclist) + '("ISO-8859-7" . "quoted-printable")) + ((memq lc-hbw lclist) + '("ISO-8859-8" . "quoted-printable")) + ((memq lc-ltn5 lclist) + '("ISO-8859-9" . "quoted-printable")) + ((memq lc-jp lclist) + '("ISO-2022-JP" . nil)) + ;; Unknown charset. + ((boundp '*iso-2022-int-1*) + '("ISO-2022-INT-1" . nil)) + (t + '("ISO-2022-JP-2" . nil)) + ))) + +(defun mime-string-encoder-for-mule (method string) + "For given METHOD that is a cons of charset and encoding, encode a +STRING. US-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP, +ISO-2022-JP-2 and ISO-2022-INT-1 are supported on Mule. Either of +charset ISO-2022-JP-2 or ISO-2022-INT-1 is used for multilingual +text." + (let* ((charset (car method)) + (encoding (cdr method)) + (coding-system + (cdr (assoc (and (stringp charset) (upcase charset)) + '(("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*) + ;;("ISO-8859-6" . *iso-8859-6*) + ("ISO-8859-7" . *iso-8859-7*) + ("ISO-8859-8" . *iso-8859-8*) + ("ISO-8859-9" . *iso-8859-9*) + ("ISO-2022-JP" . *junet*) + ("ISO-2022-JP-2" . *iso-2022-ss2-7*) + ("ISO-2022-INT-1" . *iso-2022-int-1*) + ))))) + ;; In bilingual environment it may be unnecessary to convert the + ;; coding system of the string unless transfer encoding is + ;; required since such conversion may be performed by mule + ;; automatically. + (if (not (null coding-system)) + (setq string (code-convert-string string *internal* coding-system))) + (if (stringp encoding) + (setq string (mime-encode-string encoding string))) + string + )) + + +;; Sun implementations + +(defun mime-voice-recorder-for-sun () + "Record voice in a buffer using Sun audio device, and return the buffer. +If the environment variable AUDIOHOST is defined, its value is used as +a recording host instead of local host." + (let ((buffer (get-buffer-create " *MIME audio*")) + (host (getenv "AUDIOHOST"))) + (message "Start the recording on %s. Type C-g to finish the recording..." + (or host (system-name))) + (save-excursion + (set-buffer buffer) + (erase-buffer) + (condition-case errorcode + (let ((selective-display nil) ;Disable ^M to nl translation. + (mc-flag nil) ;Mule + (kanji-flag nil)) ;NEmacs + ;; If AUDIOHOST is defined, use the value as recording host. + (cond ((not (null host)) + ;; Disable automatic conversion of coding system if Mule. + (if (featurep 'mule) + (define-program-coding-system nil "rsh" *noconv*)) + (call-process "rsh" + nil + buffer + nil + host + "cat" + "/dev/audio" + )) + (t + ;; Disable automatic conversion of coding system if Mule. + (if (featurep 'mule) + (define-program-coding-system nil "cat" *noconv*)) + (call-process "cat" + "/dev/audio" + buffer + nil + )))) + (quit (message "Type C-g to finish recording... done.") + buffer ;Return the buffer + ))))) + + +;;; +;;; Other useful commands. +;;; + +;; Message forwarding commands as content-type "message/rfc822". + +(defun tm-edit/insert-message (&optional message) + (interactive) + (let ((inserter (assoc-value major-mode tm-edit/message-inserter-alist))) + (if (and inserter (fboundp inserter)) + (progn + (tm-edit/insert-tag "message" "rfc822") + (funcall inserter message) + ) + (message "Sorry, I don't have message inserter for your MUA.") + ))) + +;;;###autoload +;;; (defun mime-forward-from-rmail-using-mail () +;;; "Forward current message in message/rfc822 content-type message from rmail. +;;; The message will be appended if being composed." +;;; (interactive) +;;; ;;>> this gets set even if we abort. Can't do anything about it, though. +;;; (rmail-set-attribute "forwarded" t) +;;; (let ((initialized nil) +;;; (beginning nil) +;;; (forwarding-buffer (current-buffer)) +;;; (subject (concat "[" +;;; (mail-strip-quoted-names (mail-fetch-field "From")) +;;; ": " (or (mail-fetch-field "Subject") "") "]"))) +;;; ;; If only one window, use it for the mail buffer. +;;; ;; Otherwise, use another window for the mail buffer +;;; ;; so that the Rmail buffer remains visible +;;; ;; and sending the mail will get back to it. +;;; (setq initialized +;;; (if (one-window-p t) +;;; (mail nil nil subject) +;;; (mail-other-window nil nil subject))) +;;; (save-excursion +;;; (goto-char (point-max)) +;;; (forward-line 1) +;;; (setq beginning (point)) +;;; (tm-edit/insert-tag "message" "rfc822") +;;; (insert-buffer forwarding-buffer)) +;;; (if (not initialized) +;;; (goto-char beginning)) +;;; )) + +;;;###autoload +;;; (defun mime-forward-from-gnus-using-mail () +;;; "Forward current article in message/rfc822 content-type message from GNUS. +;;; The message will be appended if being composed." +;;; (let ((initialized nil) +;;; (beginning nil) +;;; (forwarding-buffer (current-buffer)) +;;; (subject +;;; (concat "[" gnus-newsgroup-name "] " +;;; ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " +;;; (or (gnus-fetch-field "Subject") "")))) +;;; ;; If only one window, use it for the mail buffer. +;;; ;; Otherwise, use another window for the mail buffer +;;; ;; so that the Rmail buffer remains visible +;;; ;; and sending the mail will get back to it. +;;; (setq initialized +;;; (if (one-window-p t) +;;; (mail nil nil subject) +;;; (mail-other-window nil nil subject))) +;;; (save-excursion +;;; (goto-char (point-max)) +;;; (setq beginning (point)) +;;; (tm-edit/insert-tag "message" "rfc822") +;;; (insert-buffer forwarding-buffer) +;;; ;; You have a chance to arrange the message. +;;; (run-hooks 'gnus-mail-forward-hook) +;;; ) +;;; (if (not initialized) +;;; (goto-char beginning)) +;;; )) + +;;; mime.el ends here +(defun tm-edit/translate-region (beg end &optional boundary multipart) + (if (null boundary) + (setq boundary + (concat mime-multipart-boundary " " (current-time-string))) + ) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let ((tag nil) ;MIME tag + (contype nil) ;Content-Type + (encoding nil) ;Content-Transfer-Encoding + (nparts 0)) ;Number of body parts + ;; Normalize the body part by inserting appropriate message + ;; tags for every message contents. + (tm-edit/normalize-body) + ;; Counting the number of Content-Type. + (goto-char (point-min)) + (while (re-search-forward tm-edit/single-part-tag-regexp nil t) + (setq nparts (1+ nparts))) + ;; Begin translation. + (cond ((and (<= nparts 1)(not multipart)) + ;; It's a singular message. + (goto-char (point-min)) + (while (re-search-forward tm-edit/single-part-tag-regexp nil t) + (setq tag + (buffer-substring (match-beginning 0) (match-end 0))) + (delete-region (match-beginning 0) (1+ (match-end 0))) + (setq contype (tm-edit/get-contype tag)) + (setq encoding (tm-edit/get-encoding tag)) + )) + (t + ;; It's a multipart message. + (goto-char (point-min)) + (while (re-search-forward tm-edit/single-part-tag-regexp nil t) + (setq tag + (buffer-substring (match-beginning 0) (match-end 0))) + (delete-region (match-beginning 0) (match-end 0)) + (setq contype (tm-edit/get-contype tag)) + (setq encoding (tm-edit/get-encoding tag)) + (insert "--" boundary "\n") + (insert "Content-Type: " contype "\n") + (if encoding + (insert "Content-Transfer-Encoding: " encoding "\n")) + ) + ;; Define Content-Type as "multipart/mixed". + (setq contype + (concat "multipart/mixed; boundary=\"" boundary "\"")) + ;; Content-Transfer-Encoding must be "7bit". + ;; The following encoding can be `nil', but is + ;; specified as is since there is no way that a user + ;; specifies it. + (setq encoding "7bit") + ;; Insert the trailer. + (goto-char (point-max)) + (if (not (= (preceding-char) ?\n)) + ;; Boundary must start with a newline. + (insert "\n")) + (insert "--" boundary "--\n"))) + (list contype encoding boundary nparts) + )))) + + +(defun tm-edit/find-inmost () + (goto-char (point-min)) + (if (re-search-forward tm-edit/multipart-beginning-regexp nil t) + (let ((bb (match-beginning 0)) + (be (match-end 0)) + (type (buffer-substring (match-beginning 1)(match-end 1))) + end-exp eb ee) + (setq end-exp (format "^--}-<<%s>>\n" type)) + (widen) + (if (re-search-forward end-exp nil t) + (progn + (setq eb (match-beginning 0)) + (setq ee (match-end 0)) + ) + (setq eb (point-max)) + (setq ee (point-max)) + ) + (narrow-to-region be eb) + (goto-char be) + (if (re-search-forward tm-edit/multipart-beginning-regexp nil t) + (let (ret) + (narrow-to-region (match-beginning 0)(point-max)) + (tm-edit/find-inmost) + ) + (widen) + ;;(delete-region eb ee) + (list type bb be eb) + )))) + +(defun tm-edit/process-multipart-1 (boundary) + (let ((ret (tm-edit/find-inmost))) + (if ret + (let ((type (car ret)) + (bb (nth 1 ret))(be (nth 2 ret)) + (eb (nth 3 ret)) + ) + (narrow-to-region bb eb) + (delete-region bb be) + (setq bb (point-min)) + (setq eb (point-max)) + (widen) + (goto-char eb) + (if (looking-at tm-edit/multipart-end-regexp) + (let ((beg (match-beginning 0)) + (end (match-end 0)) + ) + (delete-region beg end) + (if (not (looking-at tm-edit/single-part-tag-regexp)) + (insert (concat (mime-make-text-tag) "\n")) + ))) + (setq boundary (nth 2 (tm-edit/translate-region bb eb boundary t))) + (goto-char bb) + (insert + (format "--[[multipart/%s; boundary=\"%s\"][7bit]]\n" + type boundary)) + boundary) + ))) + + +;;; @ multipart enclosure +;;; + +(defun tm-edit/enclose-region (type beg end) + (save-excursion + (goto-char beg) + (let ((f (bolp))) + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (if (not f) + (insert "\n") + ) + (insert (format "--<<%s>>-{\n" type)) + (goto-char (point-max)) + (setq f (bolp)) + (if (not f) + (insert (format "\n--}-<<%s>>" type)) + (insert (format "--}-<<%s>>\n" type)) + ) + (goto-char (point-max)) + ) + (if (not (eobp)) + (progn + (if (not f) + (if (not (eolp)) + (insert "\n") + (forward-char) + ) + ) + (if (not (looking-at tm-edit/single-part-tag-regexp)) + (insert (mime-make-text-tag) "\n") + ) + ) + (if (not f) + (insert "\n") + )) + ))) + +(defun tm-edit/enclose-mixed-region (beg end) + (interactive "*r") + (tm-edit/enclose-region "mixed" beg end) + ) + +(defun tm-edit/enclose-parallel-region (beg end) + (interactive "*r") + (tm-edit/enclose-region "parallel" beg end) + ) + +(defun tm-edit/enclose-digest-region (beg end) + (interactive "*r") + (tm-edit/enclose-region "digest" beg end) + ) + +(defun tm-edit/enclose-alternative-region (beg end) + (interactive "*r") + (tm-edit/enclose-region "alternative" beg end) + ) + + +;;; @ split +;;; + +(defun tm-edit/split-and-send (&optional cmd) + (interactive) + (let ((tm-edit/message-max-length + (or (cdr (assq major-mode tm-edit/message-max-length-alist)) + tm-edit/message-default-max-length)) + (lines (count-lines (point-min) (point-max))) + ) + (if (or (<= lines tm-edit/message-max-length) + (not tm-edit/split-message)) + (call-interactively + (or cmd + (cdr (assq major-mode tm-edit/message-default-sender-alist)) + )) + (let* ((tm-edit/draft-file-name + (or (buffer-file-name) + (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir)))) + (separator mail-header-separator) + (config + (eval (cdr (assq major-mode tm-edit/window-config-alist)))) + (id (concat "\"" + (replace-space-with-underline (current-time-string)) + "@" (system-name) "\""))) + + (let ((hook (cdr (assq major-mode + tm-edit/message-before-send-hook-alist)))) + (run-hooks hook)) + (let* ((header (rfc822/get-header-string-except + tm-edit/message-nuke-headers separator)) + (orig-header (rfc822/get-header-string-except + tm-edit/message-blind-headers separator)) + (subject (mail-fetch-field "subject")) + (total (+ (/ lines tm-edit/message-max-length) + (if (> (mod lines tm-edit/message-max-length) 0) + 1))) + (i 0) + (l tm-edit/message-max-length) + (the-buf (current-buffer)) + (buf (get-buffer "*tmp-send*")) + (command + (or cmd + (cdr (assq major-mode tm-edit/message-sender-alist)) + (cdr (assq major-mode tm-edit/message-default-sender-alist)))) + data) + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote separator) "$") + nil t) + (replace-match "") + ) + (if buf + (progn + (switch-to-buffer buf) + (erase-buffer) + (switch-to-buffer the-buf) + ) + (setq buf (get-buffer-create "*tmp-send*")) + ) + (switch-to-buffer buf) + (make-variable-buffer-local 'mail-header-separator) + (setq mail-header-separator separator) + (switch-to-buffer the-buf) + (goto-char (point-min)) + (re-search-forward "^$" nil t) + (while (< i total) + (setq buf (get-buffer "*tmp-send*")) + (setq data (buffer-substring + (point) + (progn + (goto-line l) + (point)) + )) + (switch-to-buffer buf) + (insert header) + (insert + (format "Subject: %s (%d/%d)\n" subject (+ i 1) total)) + (insert + (format "Mime-Version: 1.0 (split by tm-edit %s)\n" + tm-edit/version)) + (insert + (format + "Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" + id (+ i 1) total separator)) + (if (eq i 0) + (insert orig-header)) + (insert data) + (save-excursion + (call-interactively command)) + (erase-buffer) + (switch-to-buffer the-buf) + (setq l (+ l tm-edit/message-max-length)) + (setq i (+ i 1)) + ) + ) + (let ((hook + (cdr (assq major-mode tm-edit/message-after-send-hook-alist)))) + (run-hooks 'hook)) + (set-buffer-modified-p nil) + (cond ((y-or-n-p "Kill draft buffer? ") + (kill-buffer (current-buffer)) + (if config + (set-window-configuration config)))) + (message "") + )))) + + +;;; @ preview message +;;; + +(defun tm-edit/preview-message () + "preview editing MIME message. [tm-edit.el]" + (interactive) + (let* ((str (buffer-string)) + (separator mail-header-separator) + (the-buf (current-buffer)) + (buf-name (buffer-name)) + (temp-buf-name (concat "*temp-article:" buf-name "*")) + (buf (get-buffer temp-buf-name)) + ) + (if buf + (progn + (switch-to-buffer buf) + (erase-buffer) + ) + (setq buf (get-buffer-create temp-buf-name)) + (switch-to-buffer buf) + ) + (insert str) + (setq major-mode 'mime/temporary-message-mode) + (make-local-variable 'mail-header-separator) + (setq mail-header-separator separator) + (make-local-variable 'mime/editing-buffer) + (setq mime/editing-buffer the-buf) + + (run-hooks 'mime-translate-hook) + (tm-edit/translate-buffer) + (goto-char (point-min)) + (if (re-search-forward + (concat "^" (regexp-quote separator) "$")) + (replace-match "") + ) + (mime/viewer-mode) + )) + +(defun tm-edit/quitting-method () + (let ((temp mime::preview/article-buffer) + buf) + (mime-viewer/kill-buffer) + (set-buffer temp) + (setq buf mime/editing-buffer) + (kill-buffer temp) + (switch-to-buffer buf) + )) + +(set-alist 'mime-viewer/quitting-method-alist + 'mime/temporary-message-mode + (function tm-edit/quitting-method) + ) + + +;;; @ draft preview +;;; +;; by "OKABE Yasuo +;; Mon, 10 Apr 1995 20:03:07 +0900 + +(defvar tm-edit/draft-header-separator-alist + '((news-reply-mode . mail-header-separator) + (mh-letter-mode . mail-header-separator) + )) + +(defvar mime::article/draft-header-separator nil) + +(defun tm-edit/draft-preview () + (interactive) + (let ((sep (assoc-value major-mode tm-edit/draft-header-separator-alist))) + (or (stringp sep) (setq sep (eval sep))) + (make-variable-buffer-local 'mime::article/draft-header-separator) + (goto-char (point-min)) + (re-search-forward + (concat "^\\(" (regexp-quote sep) "\\)?$")) + (setq mime::article/draft-header-separator + (buffer-substring (match-beginning 0) (match-end 0))) + (replace-match "") + (mime/viewer-mode (current-buffer)) + (pop-to-buffer (current-buffer)) + )) + +(defun mime-viewer::quitting-method/draft-preview () + (let ((mother mime/mother-buffer)) + (save-excursion + (switch-to-buffer mother) + (goto-char (point-min)) + (if (and + (re-search-forward + (concat "^\\(" + (regexp-quote mime::article/draft-header-separator) + "\\)?$") nil t) + (bolp)) + (progn + (insert mime::article/draft-header-separator) + (set-buffer-modified-p (buffer-modified-p)) + ))) + (mime-viewer/kill-buffer) + (pop-to-buffer mother) + )) + +(set-alist 'mime-viewer/quitting-method-alist + 'mh-letter-mode + (function mime-viewer::quitting-method/draft-preview) + ) + +(set-alist 'mime-viewer/quitting-method-alist + 'news-reply-mode + (function mime-viewer::quitting-method/draft-preview) + ) + + +;;; @ etc +;;; + +(defun rfc822/get-header-string-except (pat boundary) + (let ((case-fold-search t)) + (save-excursion + (save-restriction + (narrow-to-region (goto-char (point-min)) + (progn + (re-search-forward + (concat "^\\(" (regexp-quote boundary) "\\)?$") + nil t) + (match-beginning 0) + )) + (goto-char (point-min)) + (let (field header) + (while (re-search-forward rfc822/field-top-regexp nil t) + (setq field (buffer-substring (match-beginning 0) + (rfc822/field-end) + )) + (if (not (string-match pat field)) + (setq header (concat header field "\n")) + )) + header) + )))) + +(defun replace-space-with-underline (str) + (mapconcat (function + (lambda (arg) + (char-to-string + (if (= arg 32) + ?_ + arg)))) str "") + ) + + +;;; @ end +;;; + +(provide 'tm-edit) + +(run-hooks 'tm-edit-load-hook) diff --git a/tm-ew-e.el b/tm-ew-e.el index 2abfd32..6bddae5 100644 --- a/tm-ew-e.el +++ b/tm-ew-e.el @@ -18,7 +18,7 @@ ;;; (defconst tm-ew-e/RCS-ID - "$Id: tm-ew-e.el,v 7.4 1995/10/18 08:54:59 morioka Exp $") + "$Id: tm-ew-e.el,v 7.5 1995/10/24 00:18:39 morioka Exp $") (defconst mime/eword-encoder-version (get-version-string tm-ew-e/RCS-ID)) @@ -486,8 +486,7 @@ (insert (concat "\nX-Nsubject: " - (mime/decode-encoded-words-string - (rfc822/unfolding-string str)) + (mime-eword/decode-string (rfc822/unfolding-string str)) ))))) ))) diff --git a/tm-partial.el b/tm-partial.el index 3cb2f87..755c017 100644 --- a/tm-partial.el +++ b/tm-partial.el @@ -1,17 +1,18 @@ ;;; -;;; tm-partial.el +;;; tm-partial.el --- Grabbing all MIME "message/partial"s. ;;; -;;; Grabbing all MIME "message/partial"s. -;;; by Yasuo OKABE @ Kyoto University 1994 -;;; modified by MORIOKA Tomohiko +;;; Copyright (C) 1995 Free Software Foundation, Inc. +;;; Copyright (C) 1994 OKABE Yasuo +;;; Copyright (C) 1995 MORIOKA Tomohiko ;;; -;;; original file is -;;; gif.el written by Art Mellor @ Cayman Systems, Inc. 1991 +;;; Author: OKABE Yasuo @ Kyoto University +;;; MORIOKA Tomohiko +;;; Version: +;;; $Id: tm-partial.el,v 7.10 1995/10/25 05:25:28 morioka Exp $ +;;; Keywords: mail, news, MIME, multimedia, message/partial ;;; ;;; This file is a part of tm (Tools for MIME). ;;; -;;; $Id: tm-partial.el,v 7.9 1995/10/23 09:27:29 morioka Exp $ -;;; (require 'tm-view) @@ -54,7 +55,7 @@ ) (let (cinfo the-id parameters) (setq subject-id (rfc822/get-field-body "Subject")) - (if (string-match "[0-9]+" subject-id) + (if (string-match "[0-9\n]+" subject-id) (setq subject-id (substring subject-id 0 (match-beginning 0))) ) (pop-to-buffer subject-buf) diff --git a/tm-rmail.el b/tm-rmail.el index 824ee3f..54c9b16 100644 --- a/tm-rmail.el +++ b/tm-rmail.el @@ -4,7 +4,7 @@ ;;; ;;; Author: MORIOKA Tomohiko ;;; Version: -;;; $Id: tm-rmail.el,v 7.3 1995/10/23 08:53:47 morioka Exp $ +;;; $Id: tm-rmail.el,v 7.4 1995/10/24 00:19:52 morioka Exp $ ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). @@ -12,6 +12,7 @@ (require 'tl-list) (require 'tl-misc) +(require 'rmail) (autoload 'mime/viewer-mode "tm-view" "View MIME message." t) (autoload 'mime/Content-Type "tm-view" "parse Content-Type field.") @@ -58,11 +59,7 @@ (defalias 'tm-rmail/quitting-method 'tm-rmail/quitting-method-to-article) -(add-hook 'rmail-mode-hook - (function - (lambda () - (local-set-key "v" (function tm-rmail/view-message)) - ))) +(define-key rmail-mode-map "v" (function tm-rmail/view-message)) (add-hook 'rmail-summary-mode-hook (function diff --git a/tm-setup.el b/tm-setup.el index 50b359b..f6e23bc 100644 --- a/tm-setup.el +++ b/tm-setup.el @@ -1,5 +1,5 @@ ;;; -;;; $Id: tm-setup.el,v 6.3 1995/09/10 15:45:42 morioka Exp $ +;;; $Id: tm-setup.el,v 6.4 1995/10/24 00:24:48 morioka Exp $ ;;; (require 'tl-misc) @@ -54,7 +54,12 @@ ;;; @ for RMAIL ;;; -(require 'tm-rmail) +(call-after-loaded 'rmail + (function + (lambda () + (require 'tm-rmail) + )) + 'rmail-mode-hook) ;;; @ for mh-e diff --git a/tm-view.el b/tm-view.el index c50f8d6..88dd0c6 100644 --- a/tm-view.el +++ b/tm-view.el @@ -25,7 +25,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.19 1995/10/23 09:27:13 morioka Exp $") + "$Id: tm-view.el,v 7.20 1995/10/24 00:21:02 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -237,6 +237,9 @@ ;;; @@ buffer local variables ;;; +(defvar mime/show-mode-old-window-configuration nil) +(defvar mime/mother-buffer nil) + (defvar mime::article/content-info nil) (defvar mime::article/preview-buffer nil) -- 1.7.10.4