X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-edit.el;h=fc4ceb71f4d20681ca6fe96f648b76c6ea92149c;hb=b77b17617ad6e2d752ffa07cc4232a54c6ebae81;hp=0329458b1db0ababe1cf1321239ced064fdd53ac;hpb=d76805c485e461fecda9a4a7ea7d6e237fe13436;p=elisp%2Ftm.git diff --git a/tm-edit.el b/tm-edit.el index 0329458..fc4ceb7 100644 --- a/tm-edit.el +++ b/tm-edit.el @@ -1,113 +1,87 @@ -;;; ;;; tm-edit.el --- Simple MIME Composer for GNU Emacs -;;; -;; Copyright (C) 1993 UMEDA Masanobu -;; Copyright (C) 1994,1995 MORIOKA Tomohiko +;; Copyright (C) 1993,1994,1995,1996,1997 Free Software Foundation, Inc. ;; Author: UMEDA Masanobu ;; MORIOKA Tomohiko +;; Maintainer: MORIOKA Tomohiko +;; Created: 1994/08/21 renamed from mime.el +;; Version: $Revision: 7.106 $ ;; Keywords: mail, news, MIME, multimedia, multilingual -;; This file is not part of GNU Emacs. +;; This file is part of tm (Tools for MIME). -;; 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. +;; 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 (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. +;; This program 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. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, 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. +;; messages formatted in MIME (RFC 2045, 2046, 2047, 2048 and 2049). +;; 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 +;; 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. +;; `ISO-2022-JP-2' [RFC 1554]. 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: +;; definition to load mime/editor-mode automatically: ;; -;; (autoload 'mime-mode "mime" "Minor mode for editing MIME message." t) +;; (autoload 'mime/editor-mode "tm-edit" +;; "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))))) +;; (add-hook 'mail-mode-hook 'mime/editor-mode) +;; (add-hook 'mail-send-hook 'mime-editor/maybe-translate) ;; ;; 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 "--------"))))) +;; (add-hook 'mh-letter-mode-hook +;; (function +;; (lambda () +;; (mime/editor-mode) +;; (make-local-variable 'mail-header-separator) +;; (setq mail-header-separator "--------") +;; )))) +;; (add-hook 'mh-before-send-letter-hook 'mime-editor/maybe-translate) ;; ;; 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) -;; )))) +;; (add-hook 'news-reply-mode-hook 'mime/editor-mode) +;; (add-hook 'news-inews-hook 'mime-editor/maybe-translate) ;; ;; 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)))))) +;; (add-hook 'mime/editor-mode-hook +;; (function +;; (lambda () +;; (font-lock-mode 1) +;; (setq font-lock-keywords (list mime-editor/tag-regexp)) +;; )))) ;; The message tag looks like: ;; @@ -120,28 +94,22 @@ ;; ;;--[[text/plain]] ;; This is also a plain text. But, it is explicitly specified as is. +;;--[[text/plain; charset=ISO-8859-1]] +;; This is also a plain text. But charset is specified as iso-8859-1. ;; -;;--[[text/plain; charset=ISO-2022-JP]] -;; $B$3$l$O(B charset $B$r(B ISO-2022-JP $B$K;XDj$7$?F|K\8l$N(B plain $B%F%-%9%H$G$9(B. -;; -;;--[[text/richtext]] +;; ¡Hola! Buenos días. ¿Cómo está usted? +;;--[[text/enriched]] ;;
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) @@ -151,10 +119,13 @@ ;;; @ version ;;; -(defconst tm-edit/RCS-ID - "$Id: tm-edit.el,v 7.11 1995/10/26 11:12:05 morioka Exp $") +(defconst mime-editor/RCS-ID + "$Id: tm-edit.el,v 7.106 1997/03/20 07:20:15 morioka Exp $") + +(defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) -(defconst tm-edit/version (get-version-string tm-edit/RCS-ID)) +(defconst mime-editor/version-name + (concat "tm-edit " mime-editor/version)) ;;; @ variables @@ -163,9 +134,6 @@ (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.") @@ -179,45 +147,19 @@ 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 +(defvar mime-editor/voice-recorder + (function mime-editor/voice-recorder-for-sun) + "*Function to record a voice message and encode it. [tm-edit.el]") + +(defvar mime/editor-mode-hook nil "*Hook called when enter MIME mode.") -(defvar mime-translate-hook nil +(defvar mime-editor/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.") +To insert a signature file automatically, call the function +`mime-editor/insert-signature' from this hook.") -(defvar mime-exit-hook nil +(defvar mime-editor/exit-hook nil "*Hook called when exit MIME mode.") (defvar mime-content-types @@ -238,7 +180,9 @@ To insert a signature file specified by mime-signature-file ) ("html" ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - )) + ) + ("x-rot13-47") + ) ("message" ("external-body" ("access-type" @@ -246,8 +190,12 @@ To insert a signature file specified by mime-signature-file ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp") ("directory" "/pub/GNU/elisp/mime") ("name") - ("mode" "binary" "ascii")) - ("ftp" ("site") ("directory") ("name") ("mode" "binary" "ascii")) + ("mode" "image" "ascii" "local8")) + ("ftp" + ("site") + ("directory") + ("name") + ("mode" "image" "ascii" "local8")) ("tftp" ("site") ("name")) ("afs" ("site") ("name")) ("local-file" ("site") ("name")) @@ -256,16 +204,15 @@ To insert a signature file specified by mime-signature-file ("rfc822") ) ("application" - ("octet-stream" - ("name") - ("type" "" "tar" "shar") - ("conversions")) + ("octet-stream" ("type" "" "tar" "shar")) ("postscript") ("x-kiss" ("x-cnf"))) ("image" ("gif") ("jpeg") + ("tiff") ("x-pic") + ("x-mag") ("x-xwd") ("x-xbm") ) @@ -276,159 +223,243 @@ To insert a signature file specified by mime-signature-file (defvar mime-file-types '(("\\.rtf$" - "text" "richtext" nil nil) + "text" "richtext" nil + nil + nil nil) ("\\.html$" - "text" "html" nil nil) + "text" "html" nil + nil + nil nil) ("\\.ps$" - "application" "postscript" nil "quoted-printable") - ("\\.gif$" - "image" "gif" nil "base64" - (("Content-Description" . file)) + "application" "postscript" nil + "quoted-printable" + "attachment" (("filename" . 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)) + "image" "jpeg" nil + "base64" + "inline" (("filename" . file)) + ) + ("\\.gif$" + "image" "gif" nil + "base64" + "inline" (("filename" . file)) ) ("\\.tiff$" - "image" "tiff" nil "base64") + "image" "tiff" nil + "base64" + "inline" (("filename" . file)) + ) + ("\\.pic$" + "image" "x-pic" nil + "base64" + "inline" (("filename" . file)) + ) + ("\\.mag$" + "image" "x-mag" nil + "base64" + "inline" (("filename" . file)) + ) + ("\\.xbm$" + "image" "x-xbm" nil + "base64" + "inline" (("filename" . file)) + ) + ("\\.xwd$" + "image" "x-xwd" nil + "base64" + "inline" (("filename" . file)) + ) ("\\.au$" - "audio" "basic" nil "base64") + "audio" "basic" nil + "base64" + "attachment" (("filename" . file)) + ) ("\\.mpg$" - "video" "mpeg" nil "base64") + "video" "mpeg" nil + "base64" + "attachment" (("filename" . file)) + ) ("\\.el$" - "application" "octet-stream" (("name" . file) - ("type" . "emacs-lisp")) "7bit") - ("\\.tar.gz$" - "application" "octet-stream" (("name" . file) - ("type" . "tar") - ("conversions" . "gzip")) nil) + "application" "octet-stream" (("type" . "emacs-lisp")) + "7bit" + "attachment" (("filename" . file)) + ) + ("\\.lsp$" + "application" "octet-stream" (("type" . "common-lisp")) + "7bit" + "attachment" (("filename" . file)) + ) + ("\\.tar\\.gz$" + "application" "octet-stream" (("type" . "tar+gzip")) + "base64" + "attachment" (("filename" . file)) + ) + ("\\.tgz$" + "application" "octet-stream" (("type" . "tar+gzip")) + "base64" + "attachment" (("filename" . file)) + ) + ("\\.tar\\.Z$" + "application" "octet-stream" (("type" . "tar+compress")) + "base64" + "attachment" (("filename" . file)) + ) + ("\\.taz$" + "application" "octet-stream" (("type" . "tar+compress")) + "base64" + "attachment" (("filename" . file)) + ) + ("\\.gz$" + "application" "octet-stream" (("type" . "gzip")) + "base64" + "attachment" (("filename" . file)) + ) + ("\\.Z$" + "application" "octet-stream" (("type" . "compress")) + "base64" + "attachment" (("filename" . file)) + ) + ("\\.lzh$" + "application" "octet-stream" (("type" . "lha")) + "base64" + "attachment" (("filename" . file)) + ) + ("\\.zip$" + "application" "zip" nil + "base64" + "attachment" (("filename" . file)) + ) ("\\.diff$" - "application" "octet-stream" (("name" . file) - ("type" . "patch")) nil) + "application" "octet-stream" (("type" . "patch")) + nil + "attachment" (("filename" . file)) + ) + ("\\.patch$" + "application" "octet-stream" (("type" . "patch")) + nil + "attachment" (("filename" . file)) + ) ("\\.signature" "text" "plain" nil nil) - (".*" nil nil nil nil) + (".*" + "application" "octet-stream" nil + nil + "attachment" (("filename" . file)) + ) ) "*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) +;;; @@ about charset, encoding and transfer-level +;;; + +(defvar mime-editor/transfer-level 7 + "*A number of network transfer level. It should be bigger than 7.") +(make-variable-buffer-local 'mime-editor/transfer-level) + +(defvar mime-editor/transfer-level-string + (mime/encoding-name mime-editor/transfer-level 'not-omit) + "*A string formatted version of mime/defaul-transfer-level") +(make-variable-buffer-local 'mime-editor/transfer-level-string) + +(defun mime-editor/make-charset-default-encoding-alist (transfer-level) + (mapcar (function + (lambda (charset-type) + (let ((charset (car charset-type)) + (type (nth 1 charset-type)) + (encoding (nth 2 charset-type)) + ) + (if (<= type transfer-level) + (cons charset (mime/encoding-name type)) + (cons charset encoding) + )))) + mime-charset-type-list)) + +(defvar mime-editor/charset-default-encoding-alist + (mime-editor/make-charset-default-encoding-alist mime-editor/transfer-level)) +(make-variable-buffer-local 'mime-editor/charset-default-encoding-alist) + +;;; @@ about message inserting +;;; + +(defvar mime-editor/yank-ignored-field-list + '("Received" "Approved" "Path" "Replied" "Status" + "Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*") + "Delete these fields from original message when it is inserted +as message/rfc822 part. +Each elements are regexp of field-name. [tm-edit.el]") + +(defvar mime-editor/yank-ignored-field-regexp + (concat "^" + (apply (function regexp-or) mime-editor/yank-ignored-field-list) + ":")) + +(defvar mime-editor/message-inserter-alist nil) +(defvar mime-editor/mail-inserter-alist nil) -(defvar tm-edit/message-default-max-length 1000) +;;; @@ about message splitting +;;; + +(defvar mime-editor/split-message t + "*Split large message if it is non-nil. [tm-edit.el]") -(defvar tm-edit/message-max-length-alist - '((news-reply-mode . 500))) +(defvar mime-editor/message-default-max-lines 1000 + "*Default maximum lines of a message. [tm-edit.el]") -(defconst tm-edit/message-nuke-headers +(defvar mime-editor/message-max-lines-alist + '((news-reply-mode . 500)) + "Alist of major-mode vs maximum lines of a message. +If it is not specified for a major-mode, +`mime-editor/message-default-max-lines' is used. [tm-edit.el]") + +(defconst mime-editor/split-ignored-field-regexp "\\(^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 mime-editor/split-blind-field-regexp + "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") -(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 mime-editor/split-message-sender-alist 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 mime-editor/news-reply-mode-server-running nil) -(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.") +;;; @@ about PGP +;;; + +(defvar mime-editor/signing-type 'pgp-elkins + "*PGP signing type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]") + +(defvar mime-editor/encrypting-type 'pgp-elkins + "*PGP encrypting type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]") -(defconst tm-edit/single-part-tag-regexp - "^--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]" + +;;; @@ about tag +;;; + +(defconst mime-editor/single-part-tag-regexp + "--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]" "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].") -(defconst tm-edit/multipart-beginning-regexp "^--<<\\([^<>]+\\)>>-{\n") +(defconst mime-editor/quoted-single-part-tag-regexp + (concat "- " (substring mime-editor/single-part-tag-regexp 1))) + +(defconst mime-editor/multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n") -(defconst tm-edit/multipart-end-regexp "^--}-<<\\([^<>]+\\)>>\n") +(defconst mime-editor/multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n") -(defconst tm-edit/beginning-tag-regexp - (regexp-or tm-edit/single-part-tag-regexp - tm-edit/multipart-beginning-regexp)) +(defconst mime-editor/beginning-tag-regexp + (regexp-or mime-editor/single-part-tag-regexp + mime-editor/multipart-beginning-regexp)) -(defconst tm-edit/end-tag-regexp - (regexp-or tm-edit/single-part-tag-regexp - tm-edit/multipart-end-regexp)) +(defconst mime-editor/end-tag-regexp + (regexp-or mime-editor/single-part-tag-regexp + mime-editor/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)) +(defconst mime-editor/tag-regexp + (regexp-or mime-editor/single-part-tag-regexp + mime-editor/multipart-beginning-regexp + mime-editor/multipart-end-regexp)) (defvar mime-tag-format "--[[%s]]" "*Control-string making a MIME tag.") @@ -436,151 +467,257 @@ Tspecials means any character that matches with it in header must be quoted.") (defvar mime-tag-format-with-encoding "--[[%s][%s]]" "*Control-string making a MIME tag with encoding.") +;;; @@ multipart boundary +;;; + (defvar mime-multipart-boundary "Multipart" "*Boundary of a multipart message.") + +;;; @@ buffer local variables +;;; + +(defvar mime/editor-mode-old-local-map nil) +(defvar mime/editing-buffer nil) + -(defconst tm-edit/mime-version-value - (format "1.0 (generated by tm-edit %s)" tm-edit/version) +;;; @ constants +;;; + +(defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]" + "*Specify MIME tspecials. +Tspecials means any character that matches with it in header must be quoted.") + +(defconst mime-editor/mime-version-value + (concat "1.0 (generated by " mime-editor/version-name ")") "MIME version number.") -(defvar mime-mode-flag nil) -(make-variable-buffer-local 'mime-mode-flag) +(defconst mime-editor/mime-map (make-sparse-keymap) + "Keymap for MIME commands.") + +;;; @ keymap and menu +;;; -(or (assq 'mime-mode-flag minor-mode-alist) - (setq minor-mode-alist - (cons (list 'mime-mode-flag " MIME") minor-mode-alist))) +(defvar mime/editor-mode-flag nil) +(make-variable-buffer-local 'mime/editor-mode-flag) -(defun mime-define-keymap (keymap) - "Add MIME commands to KEYMAP." +(defun mime-editor/define-keymap (keymap) + "Add mime-editor 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) + (define-key keymap "\C-t" 'mime-editor/insert-text) + (define-key keymap "\C-i" 'mime-editor/insert-file) + (define-key keymap "\C-e" 'mime-editor/insert-external) + (define-key keymap "\C-v" 'mime-editor/insert-voice) + (define-key keymap "\C-y" 'mime-editor/insert-message) + (define-key keymap "\C-m" 'mime-editor/insert-mail) + (define-key keymap "\C-w" 'mime-editor/insert-signature) + (define-key keymap "\C-s" 'mime-editor/insert-signature) + (define-key keymap "\C-k" 'mime-editor/insert-key) + (define-key keymap "t" 'mime-editor/insert-tag) + (define-key keymap "a" 'mime-editor/enclose-alternative-region) + (define-key keymap "p" 'mime-editor/enclose-parallel-region) + (define-key keymap "m" 'mime-editor/enclose-mixed-region) + (define-key keymap "d" 'mime-editor/enclose-digest-region) + (define-key keymap "s" 'mime-editor/enclose-signed-region) + (define-key keymap "e" 'mime-editor/enclose-encrypted-region) + (define-key keymap "q" 'mime-editor/enclose-quote-region) + (define-key keymap "7" 'mime-editor/set-transfer-level-7bit) + (define-key keymap "8" 'mime-editor/set-transfer-level-8bit) + (define-key keymap "/" 'mime-editor/set-split) + (define-key keymap "v" 'mime-editor/set-sign) + (define-key keymap "h" 'mime-editor/set-encrypt) + (define-key keymap "\C-p" 'mime-editor/preview-message) + (define-key keymap "\C-z" 'mime-editor/exit) + (define-key keymap "?" 'mime-editor/help) + )) + +(mime-editor/define-keymap mime-editor/mime-map) + +(defun mime-editor/toggle-mode () + (interactive) + (if mime/editor-mode-flag + (mime-editor/exit 'nomime) + (mime/editor-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] +(cond (running-xemacs + (defconst mime-editor/minor-mime-map nil "Keymap for MIME commands.") + (or mime-editor/minor-mime-map + (progn + (setq mime-editor/minor-mime-map + (make-sparse-keymap 'mime-editor/minor-mime-map)) + (define-key + mime-editor/minor-mime-map mime-prefix mime-editor/mime-map) + )) + (add-minor-mode 'mime/editor-mode-flag + '((" MIME-Edit " mime-editor/transfer-level-string)) + mime-editor/minor-mime-map + nil + 'mime-editor/toggle-mode) + ) + (t + (set-alist 'minor-mode-alist + 'mime/editor-mode-flag + '((" MIME-Edit " mime-editor/transfer-level-string)))) + ) + +(defconst mime-editor/menu-title "MIME-Edit") + +(defconst mime-editor/menu-list + '((mime-help "Describe MIME editor mode" mime-editor/help) + (file "Insert File" mime-editor/insert-file) + (external "Insert External" mime-editor/insert-external) + (voice "Insert Voice" mime-editor/insert-voice) + (message "Insert Message" mime-editor/insert-message) + (mail "Insert Mail" mime-editor/insert-mail) + (signature "Insert Signature" mime-editor/insert-signature) + (text "Insert Text" mime-editor/insert-text) + (tag "Insert Tag" mime-editor/insert-tag) + (alternative "Enclose as alternative" + mime-editor/enclose-alternative-region) + (parallel "Enclose as parallel" mime-editor/enclose-parallel-region) + (mixed "Enclose as serial" mime-editor/enclose-mixed-region) + (digest "Enclose as digest" mime-editor/enclose-digest-region) + (signed "Enclose as signed" mime-editor/enclose-signed-region) + (encrypted "Enclose as encrypted" mime-editor/enclose-encrypted-region) + (quote "Verbatim region" mime-editor/enclose-quote-region) + (key "Insert Public Key" mime-editor/insert-key) + (split "About split" mime-editor/set-split) + (sign "About sign" mime-editor/set-sign) + (encrypt "About encryption" mime-editor/set-encrypt) + (preview "Preview Message" mime-editor/preview-message) + (level "Toggle transfer-level" mime-editor/toggle-transfer-level) ) - "MIME menubar entry.") + "MIME-edit menubar entry.") -(defun tm-edit/define-menu-for-emacs19 () +(defun mime-editor/define-menu-for-emacs19 () "Define menu for Emacs 19." - (define-key (current-local-map) [menu-bar mime] - (cons "MIME" (make-sparse-keymap "MIME"))) + (define-key (current-local-map) [menu-bar mime-edit] + (cons mime-editor/menu-title + (make-sparse-keymap mime-editor/menu-title))) (mapcar (function (lambda (item) (define-key (current-local-map) - (vector 'menu-bar 'mime (aref item 1)) - (cons (aref item 0)(aref item 1)) + (vector 'menu-bar 'mime-edit (car item)) + (cons (nth 1 item)(nth 2 item)) ) )) - (reverse (cdr tm-edit/menu)) + (reverse mime-editor/menu-list) )) -;;; modified by Pekka Marjola -;;; 1995/9/5 (c.f. [tm-eng:69]) -(defun tm-edit/define-menu-for-xemacs () +;;; modified by Pekka Marjola +;;; 1995/9/5 (c.f. [tm-en:69]) +(defun mime-editor/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) + (add-submenu nil + (cons mime-editor/menu-title + (mapcar (function + (lambda (item) + (vector (nth 1 item)(nth 2 item) + mime/editor-mode-flag) + )) + mime-editor/menu-list))) ))) -(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)))))))) +;;; modified by Steven L. Baur +;;; 1995/12/6 (c.f. [tm-en:209]) +(if (and running-xemacs (not (boundp 'mime-editor/popup-menu-for-xemacs))) + (setq mime-editor/popup-menu-for-xemacs + (append '("MIME Commands" "---") + (mapcar (function (lambda (item) + (vector (nth 1 item) + (nth 2 item) + t))) + mime-editor/menu-list))) + ) ;;; end + +;;; @ functions +;;; + ;;;###autoload -(defun mime-mode () +(defun mime/editor-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: +format. The message tag looks like: - `--[[text/plain; charset=ISO-2022-JP][7bit]]'. + --[[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 +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. +specified. Binary messages such as audio and image are usually hidden. +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 +Available charsets depend on Emacs version being used. The following lists the available charsets of each emacs. -Emacs18: US-ASCII is only available. +EMACS 18: 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 +EMACS 19: US-ASCII and ISO-8859-1 (or other charset) are available. +XEmacs 19: US-ASCII and ISO-8859-1 (or other charset) are available. +Mule: US-ASCII, ISO-8859-* (except for ISO-8859-5), KOI8-R, + ISO-2022-JP, ISO-2022-JP-2, ISO-2022-KR, BIG5 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. +ISO-2022-JP-2 or ISO-2022-INT-1 in mule. + +If you want to use non-ISO-8859-1 charset in EMACS 19 or XEmacs 19, +please set variable `default-mime-charset'. This variable must be +symbol of which name is a MIME charset. + +If you want to add more charsets in mule, please set variable +`charsets-mime-charset-alist'. This variable must be alist of which +key is list of leading-char/charset and value is symbol of MIME +charset. (leading-char is a term of MULE 1.* and 2.*. charset is a +term of XEmacs/mule, mule merged EMACS and MULE 3.*) If name of +coding-system is different as MIME charset, please set variable +`mime-charset-coding-system-alist'. This variable must be alist of +which key is MIME charset and value is coding-system. 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. + +\[make single part\] +\\[mime-editor/insert-text] insert a text message. +\\[mime-editor/insert-file] insert a (binary) file. +\\[mime-editor/insert-external] insert a reference to external body. +\\[mime-editor/insert-voice] insert a voice message. +\\[mime-editor/insert-message] insert a mail or news message. +\\[mime-editor/insert-mail] insert a mail message. +\\[mime-editor/insert-signature] insert a signature file at end. +\\[mime-editor/insert-key] insert PGP public key. +\\[mime-editor/insert-tag] insert a new MIME tag. + +\[make enclosure (maybe multipart)\] +\\[mime-editor/enclose-alternative-region] enclose as multipart/alternative. +\\[mime-editor/enclose-parallel-region] enclose as multipart/parallel. +\\[mime-editor/enclose-mixed-region] enclose as multipart/mixed. +\\[mime-editor/enclose-digest-region] enclose as multipart/digest. +\\[mime-editor/enclose-signed-region] enclose as PGP signed. +\\[mime-editor/enclose-encrypted-region] enclose as PGP encrypted. +\\[mime-editor/enclose-quote-region] enclose as verbose mode (to avoid to expand tags) + +\[other commands\] +\\[mime-editor/set-transfer-level-7bit] set transfer-level as 7. +\\[mime-editor/set-transfer-level-8bit] set transfer-level as 8. +\\[mime-editor/set-split] set message splitting mode. +\\[mime-editor/set-sign] set PGP-sign mode. +\\[mime-editor/set-encrypt] set PGP-encryption mode. +\\[mime-editor/preview-message] preview editing MIME message. +\\[mime-editor/exit] exit and translate into a MIME compliant message. +\\[mime-editor/help] show this help. +\\[mime-editor/maybe-translate] exit and translate if in MIME mode, then split. Additional commands are available in some major modes: C-c C-c exit, translate and run the original command. @@ -594,242 +731,183 @@ TABs at the beginning of the line are not a part of the message: --[[text/plain]] This is also a plain text. But, it is explicitly specified as is. - --[[text/plain; charset=ISO-2022-JP]] - $B$3$l$O(B charset $B$r(B ISO-2022-JP $B$K;XDj$7$?F|K\8l$N(B plain $B%F%-%9(B - $B%H$G$9(B. - --[[text/richtext]] -
This is a richtext.
- --[[image/gif][base64]]^M...image encoded in base64 here... - --[[audio/basic][base64]]^M...audio encoded in base64 here... + --[[text/plain; charset=ISO-8859-1]] + This is also a plain text. But charset is specified as + iso-8859-1. + + ¡Hola! Buenos días. ¿Cómo está usted? + --[[text/enriched]] + This is a enriched text. + --[[image/gif][base64]]...image encoded in base64 here... + --[[audio/basic][base64]]...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-editor/transfer-level + A number of network transfer level. It should be bigger than 7. + If you are in 8bit-through environment, please set 8. - 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-editor/voice-recorder + Specifies a function to record a voice message and encode it. + The function `mime-editor/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/editor-mode-hook + Turning on MIME mode calls the value of mime/editor-mode-hook, if + it is non-nil. - mime-translate-hook - The value of mime-translate-hook is called just before translating + mime-editor/translate-hook + The value of mime-editor/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, + non-nil. If the hook call the function mime-editor/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 + mime-editor/exit-hook + Turning off MIME mode calls the value of mime-editor/exit-hook, if it is non-nil." (interactive) - (if mime-mode-flag + (if mime/editor-mode-flag (error "You are already editing a MIME message.") - (setq mime-mode-flag t) + (setq mime/editor-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 running-xemacs + (use-local-map (or (current-local-map) (make-sparse-keymap))) + (make-local-variable 'mime/editor-mode-old-local-map) + (setq mime/editor-mode-old-local-map (current-local-map)) + ;; Add MIME commands to current local map. + (use-local-map (copy-keymap (or (current-local-map) + (make-sparse-keymap)))) + ) (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 + (define-key (current-local-map) mime-prefix mime-editor/mime-map)) + + ;; Set transfer level into mode line + ;; + (setq mime-editor/transfer-level-string + (mime/encoding-name mime-editor/transfer-level 'not-omit)) + (force-mode-line-update) - (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) + (cond (running-xemacs + (mime-editor/define-menu-for-xemacs)) + ((>= emacs-major-version 19) + (mime-editor/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) + (enable-invisible) + ;; I don't care about saving these. (setq paragraph-start - (concat tm-edit/single-part-tag-regexp "\\|" paragraph-start)) + (regexp-or mime-editor/single-part-tag-regexp + paragraph-start)) (setq paragraph-separate - (concat tm-edit/single-part-tag-regexp "\\|" paragraph-separate)) - (run-hooks 'mime-mode-hook) + (regexp-or mime-editor/single-part-tag-regexp + paragraph-separate)) + (run-hooks 'mime/editor-mode-hook) (message (substitute-command-keys - "Type \\[mime-mode-exit] to exit MIME mode, and type \\[help-mime-mode] to get help.")) + "Type \\[mime-editor/exit] to exit MIME mode, and type \\[mime-editor/help] to get help.")) )) ;;;###autoload -(fset 'edit-mime 'mime-mode) ; for convenience +(defalias 'edit-mime 'mime/editor-mode) ; for convenience +(defalias 'mime-mode 'mime/editor-mode) ; for convenience -(defun mime-mode-exit (&optional nomime) +(defun mime-editor/exit (&optional nomime no-error) "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 mime/editor-mode-flag) + (if (null no-error) + (error "You aren't editing a MIME message.") + ) (if (not nomime) (progn - (run-hooks 'mime-translate-hook) - (tm-edit/translate-buffer))) + (run-hooks 'mime-editor/translate-hook) + (mime-editor/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 mime/editor-mode-flag nil) + (cond (running-xemacs + (if (featurep 'menubar) + (delete-menu-item (list mime-editor/menu-title)))) + (t + (use-local-map mime/editor-mode-old-local-map))) - (setq selective-display mime-mode-old-selective-display) + (end-of-invisible) (set-buffer-modified-p (buffer-modified-p)) - (run-hooks 'mime-exit-hook) - (message "Exit MIME mode.") + (run-hooks 'mime-editor/exit-hook) + (message "Exit MIME editor mode.") )) -(defun tm-edit/exit-and-run () +(defun mime-editor/maybe-translate () (interactive) - (mime-mode-exit) - (call-interactively 'tm-edit/split-and-send) + (mime-editor/exit nil t) + (call-interactively 'mime-editor/maybe-split-and-send) ) -(defun help-mime-mode () +(defun mime-editor/help () "Show help message about MIME mode." (interactive) (with-output-to-temp-buffer "*Help*" - (princ "Edit MIME Mode:\n") - (princ (documentation 'mime-mode)) + (princ "MIME editor mode:\n") + (princ (documentation 'mime/editor-mode)) (print-help-return-message))) -(defun tm-edit/insert-text () +(defun mime-editor/insert-text () "Insert a text message. -Charset is automatically obtained from the mime-body-charset-chooser." +Charset is automatically obtained from the `charsets-mime-charset-alist'." (interactive) - (if (and (tm-edit/insert-tag "text" nil nil) - (looking-at tm-edit/single-part-tag-regexp)) + (let ((ret (mime-editor/insert-tag "text" nil nil))) + (if ret (progn - ;; Make a space between the following message. - (insert "\n") - (forward-char -1) - ))) + (if (looking-at mime-editor/single-part-tag-regexp) + (progn + ;; Make a space between the following message. + (insert "\n") + (forward-char -1) + )) + (if (and (member (second ret) '("enriched" "richtext")) + (fboundp 'enriched-mode) + ) + (enriched-mode t) + (if (boundp 'enriched-mode) + (enriched-mode nil) + )))))) -(defun tm-edit/insert-file (file) +(defun mime-editor/insert-file (file &optional verbose) "Insert a message from a file." - (interactive "fInsert file as MIME message: ") + (interactive "fInsert file as MIME message: \nP") (let* ((guess (mime-find-file-type file)) - (pritype (nth 0 guess)) + (type (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)) + (encoding (nth 3 guess)) + (disposition-type (nth 4 guess)) + (disposition-params (nth 5 guess)) + ) + (if verbose + (setq type (mime-prompt-for-type type) + subtype (mime-prompt-for-subtype type subtype) + )) + (if (or (interactive-p) verbose) + (setq encoding (mime-prompt-for-encoding encoding)) + ) + (if (or (consp parameters) (stringp disposition-type)) (let ((rest parameters) cell attribute value) (setq parameters "") (while rest @@ -837,31 +915,40 @@ Charset is automatically obtained from the mime-body-charset-chooser." (setq attribute (car cell)) (setq value (cdr cell)) (if (eq value 'file) - (setq value (file-name-nondirectory file)) + (setq value (std11-wrap-as-quoted-string + (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)) - ) + (if disposition-type + (progn + (setq parameters + (concat parameters "\n" + "Content-Disposition: " disposition-type)) + (setq rest disposition-params) + (while rest + (setq cell (car rest)) + (setq attribute (car cell)) + (setq value (cdr cell)) + (if (eq value 'file) + (setq value (std11-wrap-as-quoted-string + (file-name-nondirectory file))) + ) + (setq parameters + (concat parameters "; " attribute "=" value)) + (setq rest (cdr rest)) + ) + )) )) - (tm-edit/insert-tag pritype subtype parameters) - (tm-edit/insert-binary-file file encoding) + (mime-editor/insert-tag type subtype parameters) + (mime-editor/insert-binary-file file encoding) )) -(defun tm-edit/insert-external () +(defun mime-editor/insert-external () "Insert a reference to external body." (interactive) - (tm-edit/insert-tag "message" "external-body" nil ";\n\t") + (mime-editor/insert-tag "message" "external-body" nil ";\n\t") ;;(forward-char -1) ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n") ;;(forward-line 1) @@ -873,39 +960,61 @@ Charset is automatically obtained from the mime-body-charset-chooser." (insert "Content-Type: " pritype "/" subtype (or parameters "") "\n"))) (if (and (not (eobp)) - (not (looking-at tm-edit/single-part-tag-regexp))) + (not (looking-at mime-editor/single-part-tag-regexp))) (insert (mime-make-text-tag) "\n"))) -(defun tm-edit/insert-voice () +(defun mime-editor/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) - ))) + (let ((encoding + (completing-read + "What transfer encoding: " + mime-file-encoding-method-alist nil t nil))) + (mime-editor/insert-tag "audio" "basic" nil) + (mime-editor/define-encoding encoding) + (save-restriction + (narrow-to-region (1- (point))(point)) + (unwind-protect + (funcall mime-editor/voice-recorder encoding) + (progn + (insert "\n") + (invisible-region (point-min)(point-max)) + (goto-char (point-max)) + ))))) -(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)) - )) +(defun mime-editor/insert-signature (&optional arg) + "Insert a signature file." + (interactive "P") + (let ((signature-insert-hook + (function + (lambda () + (apply (function mime-editor/insert-tag) + (mime-find-file-type signature-file-name)) + ))) + ) + (insert-signature arg) )) + ;; Insert a new tag around a point. -(defun tm-edit/insert-tag (&optional pritype subtype parameters delimiter) +(defun mime-editor/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 ((p (point))) + (mime-editor/goto-tag) + (if (and (re-search-forward mime-editor/tag-regexp nil t) + (< (match-beginning 0) p) + (< p (match-end 0)) + ) + (goto-char (match-beginning 0)) + (goto-char p) + )) (let ((oldtag nil) (newtag nil) - (current (point))) + (current (point)) + ) (setq pritype (or pritype (mime-prompt-for-type))) @@ -920,46 +1029,16 @@ If nothing is inserted, return nil." ;; Find an current MIME tag. (setq oldtag (save-excursion - (if (tm-edit/goto-tag) + (if (mime-editor/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"))) + (not (mime-test-content-type + (mime-editor/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 @@ -976,93 +1055,60 @@ If nothing is inserted, return nil." ) )) -;; Insert the binary content after MIME tag. -;; modified by MORITA Masahiro -;; for x-uue -(defun tm-edit/insert-binary-file (file &optional encoding) +(defun mime-editor/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") - )))) + (not + (let ((en (downcase encoding))) + (or (string-equal en "7bit") + (string-equal en "8bit") + (string-equal en "binary") + ))))) ) (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)))) + (narrow-to-region tagend (point)) + (mime-insert-encoded-file file encoding) (if hide-p (progn - (mime-flag-region (point-min) (1- (point-max)) ?\^M) - (goto-char (point-max))) + (invisible-region (point-min) (point-max)) + (goto-char (point-max)) + ) + (goto-char (point-max)) )) + (or hide-p + (looking-at mime-editor/tag-regexp) + (= (point)(point-max)) + (mime-editor/insert-tag "text" "plain") + ) ;; 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))) + (goto-char tagend) ; Make sure which line the tag is on. + (mime-editor/define-encoding encoding) + )) )) + ;; Commands work on a current message flagment. -(defun tm-edit/goto-tag () +(defun mime-editor/goto-tag () "Search for the beginning of the tagged MIME message." (let ((current (point)) multipart) - (if (looking-at tm-edit/tag-regexp) + (if (looking-at mime-editor/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) + (cond ((re-search-forward mime-editor/beginning-tag-regexp nil t) + (goto-char (1- (match-beginning 0))) ;For multiline tag ) (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) + (re-search-backward mime-editor/end-tag-regexp nil t) + (or (looking-at mime-editor/beginning-tag-regexp) ;; Restore previous point. (progn (goto-char current) @@ -1070,12 +1116,12 @@ Optional argument ENCODING specifies an encoding method such as base64." )) ))) -(defun tm-edit/content-beginning () +(defun mime-editor/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) + (if (mime-editor/goto-tag) (let ((top (point))) (goto-char (match-end 0)) (if (and (= beg top) @@ -1092,67 +1138,57 @@ Optional argument ENCODING specifies an encoding method such as base64." (point)) ))) -(defun tm-edit/content-end () +(defun mime-editor/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 ((beg (point))) + (if (mime-editor/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)) + (if (invisible-p (point)) + (next-visible-point (point)) ;; Move to the end of this text. - (if (re-search-forward tm-edit/tag-regexp nil 'move) + (if (re-search-forward mime-editor/tag-regexp nil 'move) ;; Don't forget a multiline tag. - (goto-char (match-beginning 0))) + (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) + (goto-char (mime-editor/content-beginning)) + (if (re-search-forward mime-editor/tag-regexp nil 'move) ;; Don't forget a multiline tag. (goto-char (match-beginning 0))) (point)) ))) -(defun tm-edit/define-charset (charset) +(defun mime-editor/define-charset (charset) "Set charset of current tag to CHARSET." (save-excursion - (if (tm-edit/goto-tag) + (if (mime-editor/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)))) - ))) + (mime-create-tag + (mime-editor/set-parameter + (mime-editor/get-contype tag) + "charset" (upcase (symbol-name charset))) + (mime-editor/get-encoding tag))) + )))) -(defun tm-edit/define-encoding (encoding) +(defun mime-editor/define-encoding (encoding) "Set encoding of current tag to ENCODING." (save-excursion - (if (tm-edit/goto-tag) + (if (mime-editor/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))) + (insert (mime-create-tag (mime-editor/get-contype tag) encoding))) ))) -(defun tm-edit/choose-charset () +(defun mime-editor/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))))) + (detect-mime-charset-region (point) (mime-editor/content-end)) + ) (defun mime-make-text-tag (&optional subtype) "Make a tag for a text after current point. @@ -1178,20 +1214,20 @@ Otherwise, it is obtained from mime-content-types." (format (if encoding mime-tag-format-with-encoding mime-tag-format) contype encoding)) -(defun tm-edit/get-contype (tag) +(defun mime-editor/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) + (or (string-match mime-editor/single-part-tag-regexp tag) + (string-match mime-editor/multipart-beginning-regexp tag) + (string-match mime-editor/multipart-end-regexp tag) ) (substring tag (match-beginning 1) (match-end 1)) )) -(defun tm-edit/get-encoding (tag) +(defun mime-editor/get-encoding (tag) "Return encoding of TAG." (and (stringp tag) - (string-match tm-edit/single-part-tag-regexp tag) + (string-match mime-editor/single-part-tag-regexp tag) (match-beginning 3) (not (= (match-beginning 3) (match-end 3))) (substring tag (match-beginning 3) (match-end 3)))) @@ -1209,19 +1245,27 @@ Nil if no such parameter." nil ;No such parameter )) -(defun mime-set-parameter (contype parameter value) +(defun mime-editor/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))) + (let (ctype opt-fields) + (if (string-match "\n[^ \t\n\r]+:" contype) + (setq ctype (substring contype 0 (match-beginning 0)) + opt-fields (substring contype (match-beginning 0))) + (setq ctype contype) + ) + (if (string-match + (concat + ";[ \t\n]*\\(" + (regexp-quote parameter) + "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)") + ctype) + ;; Change value + (concat (substring ctype 0 (match-beginning 1)) + parameter "=" value + (substring contype (match-end 1)) + opt-fields) + (concat ctype "; " parameter "=" value opt-fields) + ))) (defun mime-strip-parameters (contype) "Return primary content-type and subtype without parameters for CONTYPE." @@ -1250,7 +1294,7 @@ Nil if no such parameter." guess )) -(defun mime-prompt-for-type () +(defun mime-prompt-for-type (&optional default) "Ask for Content-type." (let ((type "")) ;; Repeat until primary content type is specified. @@ -1260,7 +1304,7 @@ Nil if no such parameter." mime-content-types nil 'require-match ;Type must be specified. - nil + default )) (if (string-equal type "") (progn @@ -1269,19 +1313,22 @@ Nil if no such parameter." (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 + type)) + +(defun mime-prompt-for-subtype (type &optional default) + "Ask for subtype of media-type TYPE." + (let ((subtypes (cdr (assoc type mime-content-types)))) + (or (and default + (assoc default subtypes)) + (setq default (car (car subtypes))) + )) + (let* ((answer (completing-read (if default (concat "What content subtype: (default " default ") ") "What content subtype: ") - (cdr (assoc pritype mime-content-types)) + (cdr (assoc type mime-content-types)) nil 'require-match ;Subtype must be specified. nil @@ -1344,557 +1391,53 @@ 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-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)))) +(defun mime-prompt-for-encoding (default) + "Ask for Content-Transfer-Encoding. [tm-edit.el]" + (let (encoding) + (while (string= + (setq encoding + (completing-read + "What transfer encoding: " + mime-file-encoding-method-alist nil t default) + ) + "")) + encoding)) -;; Translate the tagged MIME messages into a MIME compliant message. +;;; @ 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) +(defvar mime-editor/translate-buffer-hook + '(mime-editor/pgp-enclose-buffer + mime-editor/translate-header + mime-editor/translate-body)) + +(defun mime-editor/translate-header () + "Encode the message header into network representation." + (mime/encode-message-header 'code-conversion) + (run-hooks 'mime-editor/translate-header-hook) ) -(defun tm-edit/translate-body () - "Encode the tagged MIME body in current buffer in MIME compliant message." +(defun mime-editor/translate-buffer () + "Encode the tagged MIME message 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))) + (if (catch 'mime-editor/error + (save-excursion + (run-hooks 'mime-editor/translate-buffer-hook) )) - (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))) - )))) + (progn + (undo) + (error "Translation error!") + ))) -(defun tm-edit/normalize-body () - "Normalize the body part by inserting appropriate message tags." - ;; Insert the first MIME tags if necessary. +(defun mime-editor/find-inmost () (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) + (if (re-search-forward mime-editor/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)) + (setq end-exp (format "--}-<<%s>>\n" type)) (widen) (if (re-search-forward end-exp nil t) (progn @@ -1906,18 +1449,17 @@ a recording host instead of local host." ) (narrow-to-region be eb) (goto-char be) - (if (re-search-forward tm-edit/multipart-beginning-regexp nil t) + (if (re-search-forward mime-editor/multipart-beginning-regexp nil t) (let (ret) (narrow-to-region (match-beginning 0)(point-max)) - (tm-edit/find-inmost) + (mime-editor/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))) +(defun mime-editor/process-multipart-1 (boundary) + (let ((ret (mime-editor/find-inmost))) (if ret (let ((type (car ret)) (bb (nth 1 ret))(be (nth 2 ret)) @@ -1929,194 +1471,844 @@ a recording host instead of local host." (setq eb (point-max)) (widen) (goto-char eb) - (if (looking-at tm-edit/multipart-end-regexp) + (if (looking-at mime-editor/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)) + (or (looking-at mime-editor/beginning-tag-regexp) + (eobp) (insert (concat (mime-make-text-tag) "\n")) - ))) - (setq boundary (nth 2 (tm-edit/translate-region bb eb boundary t))) - (goto-char bb) + ))) + (cond ((string-equal type "quote") + (mime-editor/enquote-region bb eb) + ) + ((string-equal type "signed") + (cond ((eq mime-editor/signing-type 'pgp-elkins) + (mime-editor/sign-pgp-elkins bb eb boundary) + ) + ((eq mime-editor/signing-type 'pgp-kazu) + (mime-editor/sign-pgp-kazu bb eb boundary) + )) + ) + ((string-equal type "encrypted") + (cond ((eq mime-editor/encrypting-type 'pgp-elkins) + (mime-editor/encrypt-pgp-elkins bb eb boundary) + ) + ((eq mime-editor/encrypting-type 'pgp-kazu) + (mime-editor/encrypt-pgp-kazu bb eb boundary) + ))) + (t + (setq boundary + (nth 2 (mime-editor/translate-region bb eb + boundary t))) + (goto-char bb) + (insert + (format "--[[multipart/%s; + boundary=\"%s\"][7bit]]\n" + type boundary)) + )) + boundary)))) + +(defun mime-editor/enquote-region (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (while (re-search-forward mime-editor/single-part-tag-regexp nil t) + (let ((tag (buffer-substring (match-beginning 0)(match-end 0)))) + (replace-match (concat "- " (substring tag 1))) + ))))) + +(defun mime-editor/dequote-region (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (while (re-search-forward + mime-editor/quoted-single-part-tag-regexp nil t) + (let ((tag (buffer-substring (match-beginning 0)(match-end 0)))) + (replace-match (concat "-" (substring tag 2))) + ))))) + +(defun mime-editor/sign-pgp-elkins (beg end boundary) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let* ((ret + (mime-editor/translate-region beg end boundary)) + (ctype (car ret)) + (encoding (nth 1 ret)) + (parts (nth 3 ret)) + (pgp-boundary (concat "pgp-sign-" boundary)) + ) + (goto-char beg) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (or (funcall (pgp-function 'mime-sign) + (point-min)(point-max) nil nil pgp-boundary) + (throw 'mime-editor/error 'pgp-error) + ) + )))) + +(defvar mime-editor/encrypt-recipient-fields-list '("To" "cc")) + +(defun mime-editor/make-encrypt-recipient-header () + (let* ((names mime-editor/encrypt-recipient-fields-list) + (values + (std11-field-bodies (cons "From" names) + nil mail-header-separator)) + (from (prog1 + (car values) + (setq values (cdr values)))) + (header (and (stringp from) + (if (string-equal from "") + "" + (format "From: %s\n" from) + ))) + recipients) + (while (and names values) + (let ((name (car names)) + (value (car values)) + ) + (and (stringp value) + (or (string-equal value "") + (progn + (setq header (concat header name ": " value "\n") + recipients (if recipients + (concat recipients " ," value) + value)) + )))) + (setq names (cdr names) + values (cdr values)) + ) + (vector from recipients header) + )) + +(defun mime-editor/encrypt-pgp-elkins (beg end boundary) + (save-excursion + (save-restriction + (let (from recipients header) + (let ((ret (mime-editor/make-encrypt-recipient-header))) + (setq from (aref ret 0) + recipients (aref ret 1) + header (aref ret 2)) + ) + (narrow-to-region beg end) + (let* ((ret + (mime-editor/translate-region beg end boundary)) + (ctype (car ret)) + (encoding (nth 1 ret)) + (parts (nth 3 ret)) + (pgp-boundary (concat "pgp-" boundary)) + ) + (goto-char beg) + (insert header) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (or (funcall (pgp-function 'encrypt) + recipients (point-min) (point-max) from) + (throw 'mime-editor/error 'pgp-error) + ) + (goto-char beg) + (insert (format "--[[multipart/encrypted; + boundary=\"%s\"; + protocol=\"application/pgp-encrypted\"][7bit]] +--%s +Content-Type: application/pgp-encrypted + +--%s +Content-Type: application/octet-stream +Content-Transfer-Encoding: 7bit + +" pgp-boundary pgp-boundary pgp-boundary)) + (goto-char (point-max)) + (insert (format "\n--%s--\n" pgp-boundary)) + ))))) + +(defun mime-editor/sign-pgp-kazu (beg end boundary) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let* ((ret + (mime-editor/translate-region beg end boundary)) + (ctype (car ret)) + (encoding (nth 1 ret)) + (parts (nth 3 ret)) + ) + (goto-char beg) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (or (as-binary-process + (funcall (pgp-function 'traditional-sign) + beg (point-max))) + (throw 'mime-editor/error 'pgp-error) + ) + (goto-char beg) + (insert + "--[[application/pgp; format=mime][7bit]]\n") + )) + )) + +(defun mime-editor/encrypt-pgp-kazu (beg end boundary) + (save-excursion + (let (from recipients header) + (let ((ret (mime-editor/make-encrypt-recipient-header))) + (setq from (aref ret 0) + recipients (aref ret 1) + header (aref ret 2)) + ) + (save-restriction + (narrow-to-region beg end) + (let* ((ret + (mime-editor/translate-region beg end boundary)) + (ctype (car ret)) + (encoding (nth 1 ret)) + (parts (nth 3 ret)) + ) + (goto-char beg) + (insert header) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (or (as-binary-process + (funcall (pgp-function 'encrypt) + recipients beg (point-max) nil 'maybe) + ) + (throw 'mime-editor/error 'pgp-error) + ) + (goto-char beg) (insert - (format "--[[multipart/%s; boundary=\"%s\"][7bit]]\n" - type boundary)) - boundary) + "--[[application/pgp; format=mime][7bit]]\n") + )) + ))) + +(defun mime-editor/translate-body () + "Encode the tagged MIME body in current buffer in MIME compliant message." + (interactive) + (save-excursion + (let ((boundary + (concat mime-multipart-boundary "_" + (replace-space-with-underline (current-time-string)) + )) + (i 1) + ret) + (while (mime-editor/process-multipart-1 + (format "%s-%d" boundary 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 (mime-editor/translate-region + beg end + (format "%s-%d" boundary i))) + )) + (mime-editor/dequote-region (point-min)(point-max)) + (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 mime-editor/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 mime-editor/translate-single-part-tag (&optional prefix) + (if (re-search-forward mime-editor/single-part-tag-regexp nil t) + (let* ((beg (match-beginning 0)) + (end (match-end 0)) + (tag (buffer-substring beg end)) + ) + (delete-region beg end) + (let ((contype (mime-editor/get-contype tag)) + (encoding (mime-editor/get-encoding tag)) + ) + (insert (concat prefix "--" boundary "\n")) + (save-restriction + (narrow-to-region (point)(point)) + (insert "Content-Type: " contype "\n") + (if encoding + (insert "Content-Transfer-Encoding: " encoding "\n")) + (mime/encode-message-header) + )) + t))) + +(defun mime-editor/translate-region (beg end &optional boundary multipart) + (if (null boundary) + (setq boundary + (concat mime-multipart-boundary "_" + (replace-space-with-underline (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. + (mime-editor/normalize-body) + ;; Counting the number of Content-Type. + (goto-char (point-min)) + (while (re-search-forward mime-editor/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 + mime-editor/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 (mime-editor/get-contype tag)) + (setq encoding (mime-editor/get-encoding tag)) + )) + (t + ;; It's a multipart message. + (goto-char (point-min)) + (and (mime-editor/translate-single-part-tag) + (while (mime-editor/translate-single-part-tag "\n")) + ) + ;; Define Content-Type as "multipart/mixed". + (setq contype + (concat "multipart/mixed;\n 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)) + (insert "\n--" boundary "--\n") + )) + (list contype encoding boundary nparts) + )))) + +(defun mime-editor/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 mime-editor/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 mime-editor/single-part-tag-regexp nil t) + (let* ((tag (buffer-substring (match-beginning 0) (match-end 0))) + (contype (mime-editor/get-contype tag)) + (charset (mime-get-parameter contype "charset")) + (encoding (mime-editor/get-encoding tag))) + ;; Remove extra whitespaces after the tag. + (if (looking-at "[ \t]+$") + (delete-region (match-beginning 0) (match-end 0))) + (let ((beg (point)) + (end (mime-editor/content-end)) + ) + (if (= end (point-max)) + nil + (goto-char end) + (or (looking-at mime-editor/beginning-tag-regexp) + (eobp) + (insert (mime-make-text-tag) "\n") + )) + (visible-region beg end) + (goto-char beg) + ) + (cond + ((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 (if charset + (intern (downcase charset)) + (mime-editor/choose-charset))) + (mime-editor/define-charset charset) + (cond ((string-equal contype "text/x-rot13-47") + (save-excursion + (forward-line) + (set-mark (point)) + (goto-char (mime-editor/content-end)) + (tm:caesar-region) + )) + ((string-equal contype "text/enriched") + (save-excursion + (let ((beg (progn + (forward-line) + (point))) + (end (mime-editor/content-end)) + ) + ;; Patch for hard newlines + ;; (save-excursion + ;; (goto-char beg) + ;; (while (search-forward "\n" end t) + ;; (put-text-property (match-beginning 0) + ;; (point) + ;; 'hard t))) + ;; End patch for hard newlines + (enriched-encode beg end) + (goto-char beg) + (if (search-forward "\n\n") + (delete-region beg (match-end 0)) + ) + )))) + ;; Point is now on current tag. + ;; Define encoding and encode text if necessary. + (or encoding ;Encoding is not specified. + (let* ((encoding + (cdr + (assq charset + mime-editor/charset-default-encoding-alist) + )) + (beg (mime-editor/content-beginning)) + ) + (encode-mime-charset-region beg (mime-editor/content-end) + charset) + (mime-encode-region beg (mime-editor/content-end) encoding) + (mime-editor/define-encoding encoding) + )) + (goto-char (mime-editor/content-end)) + ) + ((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 (mime-editor/content-beginning)) + (end (mime-editor/content-end)) + (body (buffer-substring beg end)) + ) + (mime-encode-region beg end encoding) + (mime-editor/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 +;;; + +;; Sun implementations + +(defun mime-editor/voice-recorder-for-sun (encoding) + "Record voice in a buffer using Sun audio device, +and insert data encoded as ENCODING. [tm-edit.el]" + (message "Start the recording on %s. Type C-g to finish the recording..." + (system-name)) + (mime-insert-encoded-file "/dev/audio" encoding) + ) + + +;;; @ Other useful commands. +;;; + +;; Message forwarding commands as content-type "message/rfc822". + +(defun mime-editor/insert-message (&optional message) + (interactive) + (let ((inserter (assoc-value major-mode mime-editor/message-inserter-alist))) + (if (and inserter (fboundp inserter)) + (progn + (mime-editor/insert-tag "message" "rfc822") + (funcall inserter message) + ) + (message "Sorry, I don't have message inserter for your MUA.") + ))) + +(defun mime-editor/insert-mail (&optional message) + (interactive) + (let ((inserter (assoc-value major-mode mime-editor/mail-inserter-alist))) + (if (and inserter (fboundp inserter)) + (progn + (mime-editor/insert-tag "message" "rfc822") + (funcall inserter message) + ) + (message "Sorry, I don't have mail inserter for your MUA.") + ))) + +(defun mime-editor/inserted-message-filter () + (save-excursion + (save-restriction + (let ((header-start (point)) + (case-fold-search t) + beg end) + ;; for Emacs 18 + ;; (if (re-search-forward "^$" (marker-position (mark-marker))) + (if (re-search-forward "^$" (mark t)) + (narrow-to-region header-start (match-beginning 0)) + ) + (goto-char header-start) + (while (and (re-search-forward + mime-editor/yank-ignored-field-regexp nil t) + (setq beg (match-beginning 0)) + (setq end (1+ (std11-field-end))) + ) + (delete-region beg end) + ) + )))) + ;;; @ multipart enclosure ;;; -(defun tm-edit/enclose-region (type beg end) +(defun mime-editor/enclose-region (type beg end) (save-excursion (goto-char beg) - (let ((f (bolp))) + (let ((current (point))) (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)) - ) + (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") - )) + (or (looking-at mime-editor/beginning-tag-regexp) + (eobp) + (insert (mime-make-text-tag) "\n") + ) ))) -(defun tm-edit/enclose-mixed-region (beg end) +(defun mime-editor/enclose-quote-region (beg end) (interactive "*r") - (tm-edit/enclose-region "mixed" beg end) + (mime-editor/enclose-region "quote" beg end) ) -(defun tm-edit/enclose-parallel-region (beg end) +(defun mime-editor/enclose-mixed-region (beg end) (interactive "*r") - (tm-edit/enclose-region "parallel" beg end) + (mime-editor/enclose-region "mixed" beg end) ) -(defun tm-edit/enclose-digest-region (beg end) +(defun mime-editor/enclose-parallel-region (beg end) (interactive "*r") - (tm-edit/enclose-region "digest" beg end) + (mime-editor/enclose-region "parallel" beg end) ) -(defun tm-edit/enclose-alternative-region (beg end) +(defun mime-editor/enclose-digest-region (beg end) (interactive "*r") - (tm-edit/enclose-region "alternative" beg end) + (mime-editor/enclose-region "digest" beg end) ) +(defun mime-editor/enclose-alternative-region (beg end) + (interactive "*r") + (mime-editor/enclose-region "alternative" beg end) + ) -;;; @ split +(defun mime-editor/enclose-signed-region (beg end) + (interactive "*r") + (if mime-editor/signing-type + (mime-editor/enclose-region "signed" beg end) + (message "Please specify signing type.") + )) + +(defun mime-editor/enclose-encrypted-region (beg end) + (interactive "*r") + (if mime-editor/signing-type + (mime-editor/enclose-region "encrypted" beg end) + (message "Please specify encrypting type.") + )) + +(defun mime-editor/insert-key (&optional arg) + "Insert a pgp public key." + (interactive "P") + (mime-editor/insert-tag "application" "pgp-keys") + (mime-editor/define-encoding "7bit") + (funcall (pgp-function 'insert-key)) + ) + + +;;; @ flag setting ;;; -(defun tm-edit/split-and-send (&optional cmd) +(defun mime-editor/set-split (arg) + (interactive + (list + (y-or-n-p "Do you want to enable split?") + )) + (setq mime-editor/split-message arg) + (if arg + (message "This message is enabled to split.") + (message "This message is not enabled to split.") + )) + +(defun mime-editor/toggle-transfer-level (&optional transfer-level) + "Toggle transfer-level is 7bit or 8bit through. + +Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (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 (numberp transfer-level) + (setq mime-editor/transfer-level transfer-level) + (if (< mime-editor/transfer-level 8) + (setq mime-editor/transfer-level 8) + (setq mime-editor/transfer-level 7) + )) + (setq mime-editor/charset-default-encoding-alist + (mime-editor/make-charset-default-encoding-alist + mime-editor/transfer-level)) + (message (format "Current transfer-level is %d bit" + mime-editor/transfer-level)) + (setq mime-editor/transfer-level-string + (mime/encoding-name mime-editor/transfer-level 'not-omit)) + (force-mode-line-update) + ) + +(defun mime-editor/set-transfer-level-7bit () + (interactive) + (mime-editor/toggle-transfer-level 7) + ) + +(defun mime-editor/set-transfer-level-8bit () + (interactive) + (mime-editor/toggle-transfer-level 8) + ) + + +;;; @ pgp +;;; + +(defun mime-editor/set-sign (arg) + (interactive + (list + (y-or-n-p "Do you want to sign?") + )) + (if arg + (if mime-editor/signing-type + (progn + (setq mime-editor/pgp-processing 'sign) + (message "This message will be signed.") ) - (if buf - (progn - (switch-to-buffer buf) - (erase-buffer) - (switch-to-buffer the-buf) - ) - (setq buf (get-buffer-create "*tmp-send*")) + (message "Please specify signing type.") + ) + (if (eq mime-editor/pgp-processing 'sign) + (setq mime-editor/pgp-processing nil) + ) + (message "This message will not be signed.") + )) + +(defun mime-editor/set-encrypt (arg) + (interactive + (list + (y-or-n-p "Do you want to encrypt?") + )) + (if arg + (if mime-editor/encrypting-type + (progn + (setq mime-editor/pgp-processing 'encrypt) + (message "This message will be encrypt.") ) - (switch-to-buffer buf) - (make-variable-buffer-local 'mail-header-separator) - (setq mail-header-separator separator) - (switch-to-buffer the-buf) + (message "Please specify encrypting type.") + ) + (if (eq mime-editor/pgp-processing 'encrypt) + (setq mime-editor/pgp-processing nil) + ) + (message "This message will not be encrypt.") + )) + +(defvar mime-editor/pgp-processing nil) +(make-variable-buffer-local 'mime-editor/pgp-processing) + +(defun mime-editor/pgp-enclose-buffer () + (let ((beg (save-excursion + (goto-char (point-min)) + (if (search-forward (concat "\n" mail-header-separator "\n")) + (match-end 0) + ))) + (end (point-max)) + ) + (if beg + (cond ((eq mime-editor/pgp-processing 'sign) + (mime-editor/enclose-signed-region beg end) + ) + ((eq mime-editor/pgp-processing 'encrypt) + (mime-editor/enclose-encrypted-region beg end) + )) + ))) + + +;;; @ split +;;; + +(defun mime-editor/insert-partial-header + (fields subject id number total separator) + (insert fields) + (insert (format "Subject: %s (%d/%d)\n" subject number total)) + (insert (format "Mime-Version: 1.0 (split by %s)\n" + mime-editor/version-name)) + (insert (format "\ +Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" + id number total separator)) + ) + +(defun mime-editor/split-and-send + (&optional cmd lines mime-editor/message-max-length) + (interactive) + (or lines + (setq lines + (count-lines (point-min) (point-max))) + ) + (or mime-editor/message-max-length + (setq mime-editor/message-max-length + (or (cdr (assq major-mode mime-editor/message-max-lines-alist)) + mime-editor/message-default-max-lines)) + ) + (let* ((mime-editor/draft-file-name + (or (buffer-file-name) + (make-temp-name + (expand-file-name "tm-draft" mime/tmp-dir)))) + (separator mail-header-separator) + (id (concat "\"" + (replace-space-with-underline (current-time-string)) + "@" (system-name) "\""))) + (run-hooks 'mime-editor/before-split-hook) + (let ((the-buf (current-buffer)) + (copy-buf (get-buffer-create " *Original Message*")) + (header (std11-header-string-except + mime-editor/split-ignored-field-regexp separator)) + (subject (mail-fetch-field "subject")) + (total (+ (/ lines mime-editor/message-max-length) + (if (> (mod lines mime-editor/message-max-length) 0) + 1))) + (command + (or cmd + (cdr + (assq major-mode + mime-editor/split-message-sender-alist)) + (function + (lambda () + (interactive) + (error "Split sender is not specified for `%s'." major-mode) + )) + )) + (mime-editor/partial-number 1) + data) + (save-excursion + (set-buffer copy-buf) + (erase-buffer) + (insert-buffer the-buf) + (save-restriction + (if (re-search-forward + (concat "^" (regexp-quote separator) "$") nil t) + (let ((he (match-beginning 0))) + (replace-match "") + (narrow-to-region (point-min) he) + )) (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)) - ) + (while (re-search-forward mime-editor/split-blind-field-regexp nil t) + (delete-region (match-beginning 0) + (1+ (std11-field-end))) + ))) + (while (< mime-editor/partial-number total) + (erase-buffer) + (save-excursion + (set-buffer copy-buf) + (setq data (buffer-substring + (point-min) + (progn + (goto-line mime-editor/message-max-length) + (point)) + )) + (delete-region (point-min)(point)) ) - (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 "") - )))) + (mime-editor/insert-partial-header + header subject id mime-editor/partial-number total separator) + (insert data) + (save-excursion + (message (format "Sending %d/%d..." + mime-editor/partial-number total)) + (call-interactively command) + (message (format "Sending %d/%d... done" + mime-editor/partial-number total)) + ) + (setq mime-editor/partial-number + (1+ mime-editor/partial-number)) + ) + (erase-buffer) + (save-excursion + (set-buffer copy-buf) + (setq data (buffer-string)) + (erase-buffer) + ) + (mime-editor/insert-partial-header + header subject id mime-editor/partial-number total separator) + (insert data) + (save-excursion + (message (format "Sending %d/%d..." + mime-editor/partial-number total)) + (message (format "Sending %d/%d... done" + mime-editor/partial-number total)) + ) + ))) + +(defun mime-editor/maybe-split-and-send (&optional cmd) + (interactive) + (run-hooks 'mime-editor/before-send-hook) + (let ((mime-editor/message-max-length + (or (cdr (assq major-mode mime-editor/message-max-lines-alist)) + mime-editor/message-default-max-lines)) + (lines (count-lines (point-min) (point-max))) + ) + (if (and (> lines mime-editor/message-max-length) + mime-editor/split-message) + (mime-editor/split-and-send cmd lines mime-editor/message-max-length) + ))) ;;; @ preview message ;;; -(defun tm-edit/preview-message () +(defun mime-editor/preview-message () "preview editing MIME message. [tm-edit.el]" (interactive) (let* ((str (buffer-string)) @@ -2141,8 +2333,8 @@ a recording host instead of local host." (make-local-variable 'mime/editing-buffer) (setq mime/editing-buffer the-buf) - (run-hooks 'mime-translate-hook) - (tm-edit/translate-buffer) + (run-hooks 'mime-editor/translate-hook) + (mime-editor/translate-buffer) (goto-char (point-min)) (if (re-search-forward (concat "^" (regexp-quote separator) "$")) @@ -2151,7 +2343,7 @@ a recording host instead of local host." (mime/viewer-mode) )) -(defun tm-edit/quitting-method () +(defun mime-editor/quitting-method () (let ((temp mime::preview/article-buffer) buf) (mime-viewer/kill-buffer) @@ -2163,7 +2355,7 @@ a recording host instead of local host." (set-alist 'mime-viewer/quitting-method-alist 'mime/temporary-message-mode - (function tm-edit/quitting-method) + (function mime-editor/quitting-method) ) @@ -2172,16 +2364,16 @@ a recording host instead of local host." ;; by "OKABE Yasuo ;; Mon, 10 Apr 1995 20:03:07 +0900 -(defvar tm-edit/draft-header-separator-alist +(defvar mime-editor/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 () +(defun mime-editor/draft-preview () (interactive) - (let ((sep (assoc-value major-mode tm-edit/draft-header-separator-alist))) + (let ((sep (cdr (assq major-mode mime-editor/draft-header-separator-alist)))) (or (stringp sep) (setq sep (eval sep))) (make-variable-buffer-local 'mime::article/draft-header-separator) (goto-char (point-min)) @@ -2195,7 +2387,7 @@ a recording host instead of local host." )) (defun mime-viewer::quitting-method/draft-preview () - (let ((mother mime/mother-buffer)) + (let ((mother mime::preview/mother-buffer)) (save-excursion (switch-to-buffer mother) (goto-char (point-min)) @@ -2224,40 +2416,172 @@ a recording host instead of local host." ) -;;; @ etc +;;; @ edit again ;;; -(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 mime-editor::edit-again (code-conversion) + (save-excursion + (goto-char (point-min)) + (let ((ctl (mime/Content-Type))) + (if ctl + (let ((ctype (car ctl)) + (params (cdr ctl)) + type stype) + (if (string-match "/" ctype) + (progn + (setq type (substring ctype 0 (match-beginning 0))) + (setq stype (substring ctype (match-end 0))) + ) + (setq type ctype) + ) + (cond + ((string= ctype "application/pgp-signature") + (delete-region (point-min)(point-max)) + ) + ((string= type "multipart") + (let* ((boundary (assoc-value "boundary" params)) + (boundary-pat + (concat "\n--" (regexp-quote boundary) "[ \t]*\n")) + ) + (re-search-forward boundary-pat nil t) + (let ((bb (match-beginning 0)) eb tag) + (setq tag (format "\n--<<%s>>-{\n" stype)) + (goto-char bb) + (insert tag) + (setq bb (+ bb (length tag))) + (re-search-forward + (concat "\n--" (regexp-quote boundary) "--[ \t]*\n") + nil t) + (setq eb (match-beginning 0)) + (replace-match (format "--}-<<%s>>\n" stype)) + (save-restriction + (narrow-to-region bb eb) + (goto-char (point-min)) + (while (re-search-forward boundary-pat nil t) + (let ((beg (match-beginning 0)) + end) + (delete-region beg (match-end 0)) + (save-excursion + (if (re-search-forward boundary-pat nil t) + (setq end (match-beginning 0)) + (setq end (point-max)) + ) + (save-restriction + (narrow-to-region beg end) + (mime-editor::edit-again code-conversion) + (goto-char (point-max)) + )))) + )) + (goto-char (point-min)) + (or (= (point-min) 1) + (delete-region (point-min) + (if (search-forward "\n\n" nil t) + (match-end 0) + (point-min) + ))) + )) + (t + (let* (charset + (pstr + (let ((bytes (+ 14 (length ctype)))) + (mapconcat (function + (lambda (attr) + (if (string-equal (car attr) "charset") + (progn + (setq charset (cdr attr)) + "") + (let* ((str + (concat (car attr) + "=" (cdr attr)) + ) + (bs (length str)) + ) + (setq bytes (+ bytes bs 2)) + (if (< bytes 76) + (concat "; " str) + (setq bytes (+ bs 1)) + (concat ";\n " str) + ) + )))) + params ""))) + encoding + encoded) + (save-excursion + (if (re-search-forward + "Content-Transfer-Encoding:" nil t) + (let ((beg (match-beginning 0)) + (hbeg (match-end 0)) + (end (std11-field-end))) + (setq encoding + (eliminate-top-spaces + (std11-unfold-string + (buffer-substring hbeg end)))) + (if (or charset (string-equal type "text")) + (progn + (delete-region beg (1+ end)) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (progn + (mime-decode-region + (match-end 0)(point-max) encoding) + (setq encoded t + encoding nil) + ))))))) + (if (or code-conversion encoded) + (decode-mime-charset-region + (point-min)(point-max) + (or charset default-mime-charset)) + ) + (let ((he + (if (re-search-forward "^$" nil t) + (match-end 0) + (point-min) + ))) + (if (= (point-min) 1) + (progn + (goto-char he) + (insert + (concat "\n" + (mime-create-tag + (concat type "/" stype pstr) encoding))) + ) + (delete-region (point-min) he) + (insert + (mime-create-tag + (concat type "/" stype pstr) encoding)) + )) + )))) + (if code-conversion + (decode-mime-charset-region (point-min) (point-max) + default-mime-charset) + ) )))) -(defun replace-space-with-underline (str) - (mapconcat (function - (lambda (arg) - (char-to-string - (if (= arg 32) - ?_ - arg)))) str "") - ) +(defun mime/edit-again (&optional code-conversion no-separator no-mode) + (interactive) + (mime-editor::edit-again code-conversion) + (goto-char (point-min)) + (save-restriction + (narrow-to-region + (point-min) + (if (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)?$") + nil t) + (match-end 0) + (point-max) + )) + (goto-char (point-min)) + (while (re-search-forward + "^\\(Content-.*\\|Mime-Version\\):" nil t) + (delete-region (match-beginning 0) (1+ (std11-field-end))) + )) + (or no-separator + (and (re-search-forward "^$") + (replace-match mail-header-separator) + )) + (or no-mode + (mime/editor-mode) + )) ;;; @ end @@ -2266,3 +2590,5 @@ a recording host instead of local host." (provide 'tm-edit) (run-hooks 'tm-edit-load-hook) + +;;; tm-edit.el ends here