X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-edit.el;h=4924c8d9cd0809fae1842eb363b60062ec0b2cf5;hb=dbae10fbd822fdee5adea0174cd09c387eae1d1d;hp=d2c304a34b0e2ae2709bd22e8b413dde2e7e2de9;hpb=7d97e838bc203bc60c581629ec38731ec976eb1e;p=elisp%2Fsemi.git diff --git a/mime-edit.el b/mime-edit.el index d2c304a..4924c8d 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -1,88 +1,86 @@ -;;; ;;; mime-edit.el --- Simple MIME Composer for GNU Emacs -;;; -;;; Copyright (C) 1993 UMEDA Masanobu -;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko -;;; -;;; Author: UMEDA Masanobu -;;; MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1994/08/21 renamed from mime.el by UMEDA Masanobu; -;;; 1996/05/24 renamed from tm-edit.el -;;; Version: $Revision: 0.23 $ -;;; Keywords: mail, news, MIME, multimedia, multilingual -;;; -;;; This file is part of SEMI (September, Emacs MIME Interface) -;;; -;;; 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. -;;; -;;; 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Copyright (C) 1993,1994,1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: UMEDA Masanobu +;; MORIOKA Tomohiko +;; Maintainer: MORIOKA Tomohiko +;; Created: 1994/08/21 renamed from mime.el +;; Renamed: 1997/2/21 from tm-edit.el +;; Keywords: MIME, multimedia, multilingual, mail, news + +;; This file is part of SEMI (Sophisticated Emacs MIME Interfaces). + +;; 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. + +;; 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, 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. - -;; Mule (a multilingual extension to Emacs 18 and 19) has a capability -;; of handling multilingual text in limited ISO-2022 manner that is -;; based on early experiences in Japanese Internet community and -;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to -;; enable multilingual capability in single text message in MIME, -;; charset of multilingual text written in Mule is declared as either -;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required -;; for reading the such messages. +;; 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 (multilingual feature of Emacs 20 and multilingual extension +;; for XEmacs 20) has a capability of handling multilingual text in +;; limited ISO-2022 manner that is based on early experiences in +;; Japanese Internet community and resulted in RFC 1468 (ISO-2022-JP +;; charset for MIME). In order to enable multilingual capability in +;; single text message in MIME, charset of multilingual text written +;; in Mule is declared as either `ISO-2022-JP-2' [RFC 1554]. 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/editor-mode automatically: +;; definition to load mime-edit-mode automatically: ;; -;; (autoload 'mime/editor-mode "mime-edit" +;; (autoload 'turn-on-mime-edit "mime-edit" ;; "Minor mode for editing MIME message." t) ;; ;; In case of Mail mode (includes VM mode), you need the following ;; hook definition: ;; -;; (add-hook 'mail-mode-hook 'mime/editor-mode) -;; (add-hook 'mail-send-hook 'mime-editor/maybe-translate) +;; (add-hook 'mail-mode-hook 'turn-on-mime-edit) +;; (add-hook 'mail-send-hook 'mime-edit-maybe-translate) ;; ;; In case of MH-E, you need the following hook definition: ;; ;; (add-hook 'mh-letter-mode-hook ;; (function ;; (lambda () -;; (mime/editor-mode) +;; (turn-on-mime-edit) ;; (make-local-variable 'mail-header-separator) ;; (setq mail-header-separator "--------") ;; )))) -;; (add-hook 'mh-before-send-letter-hook 'mime-editor/maybe-translate) +;; (add-hook 'mh-before-send-letter-hook 'mime-edit-maybe-translate) ;; ;; In case of News mode, you need the following hook definition: ;; -;; (add-hook 'news-reply-mode-hook 'mime/editor-mode) -;; (add-hook 'news-inews-hook 'mime-editor/maybe-translate) +;; (add-hook 'news-reply-mode-hook 'turn-on-mime-edit) +;; (add-hook 'news-inews-hook 'mime-edit-maybe-translate) ;; ;; In case of Emacs 19, it is possible to emphasize the message tags ;; using font-lock mode as follows: ;; -;; (add-hook 'mime/editor-mode-hook +;; (add-hook 'mime-edit-mode-hook ;; (function ;; (lambda () ;; (font-lock-mode 1) -;; (setq font-lock-keywords (list mime-editor/tag-regexp)) +;; (setq font-lock-keywords (list mime-edit-tag-regexp)) ;; )))) ;; The message tag looks like: @@ -93,14 +91,14 @@ ;; ;; This is a conventional plain text. It should be translated into ;; text/plain. -;; +;; ;;--[[text/plain]] ;; This is also a plain text. But, it is explicitly specified as is. +;;--[[text/plain; charset=ISO-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... @@ -109,61 +107,75 @@ ;;; Code: +(require 'emu) (require 'sendmail) (require 'mail-utils) (require 'mel) -(require 'tl-822) -(require 'tl-list) -(require 'tm-view) -(require 'tm-ew-e) +(require 'mime-view) +(require 'eword-encode) (require 'signature) +(require 'alist) ;;; @ version ;;; -(defconst mime-editor/RCS-ID - "$Id: mime-edit.el,v 0.23 1996-06-09 06:35:10 morioka Exp $") - -(defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) - -(defconst mime-editor/version-name - (concat "SEMI mime-edit " mime-editor/version)) +(defconst mime-edit-version-string + `,(concat (car mime-module-version) " " + (mapconcat #'number-to-string (cddr mime-module-version) ".") + " - \"" (cadr mime-module-version) "\"")) ;;; @ variables ;;; -(defvar mime-prefix "\C-c\C-x" - "*Keymap prefix for MIME commands.") +(defgroup mime-edit nil + "MIME edit mode" + :group 'mime) -(defvar mime-ignore-preceding-spaces nil - "*Ignore preceding white spaces if non-nil.") +(defcustom mime-ignore-preceding-spaces nil + "*Ignore preceding white spaces if non-nil." + :group 'mime-edit + :type 'boolean) -(defvar mime-ignore-trailing-spaces nil - "*Ignore trailing white spaces if non-nil.") +(defcustom mime-ignore-trailing-spaces nil + "*Ignore trailing white spaces if non-nil." + :group 'mime-edit + :type 'boolean) -(defvar mime-ignore-same-text-tag t +(defcustom mime-ignore-same-text-tag t "*Ignore preceding text content-type tag that is same with new one. -If non-nil, the text tag is not inserted unless something different.") - -(defvar mime-auto-hide-body t - "*Hide non-textual body encoded in base64 after insertion if non-nil.") - -(defvar mime-voice-recorder - (function mime-voice-recorder-for-sun) - "*Function to record a voice message and return a buffer that contains it.") - -(defvar mime/editor-mode-hook nil - "*Hook called when enter MIME mode.") - -(defvar mime-editor/translate-hook nil +If non-nil, the text tag is not inserted unless something different." + :group 'mime-edit + :type 'boolean) + +(defcustom mime-auto-hide-body t + "*Hide non-textual body encoded in base64 after insertion if non-nil." + :group 'mime-edit + :type 'boolean) + +(defcustom mime-edit-voice-recorder + (function mime-edit-voice-recorder-for-sun) + "*Function to record a voice message and encode it." + :group 'mime-edit + :type 'function) + +(defcustom mime-edit-mode-hook nil + "*Hook called when enter MIME mode." + :group 'mime-edit + :type 'hook) + +(defcustom mime-edit-translate-hook nil "*Hook called before translating into a MIME compliant message. To insert a signature file automatically, call the function -`mime-editor/insert-signature' from this hook.") +`mime-edit-insert-signature' from this hook." + :group 'mime-edit + :type 'hook) -(defvar mime-editor/exit-hook nil - "*Hook called when exit MIME mode.") +(defcustom mime-edit-exit-hook nil + "*Hook called when exit MIME mode." + :group 'mime-edit + :type 'hook) (defvar mime-content-types '(("text" @@ -184,7 +196,7 @@ To insert a signature file automatically, call the function ("html" ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") ) - ("x-rot13-47") + ("x-rot13-47-48") ) ("message" ("external-body" @@ -213,6 +225,7 @@ To insert a signature file automatically, call the function ("image" ("gif") ("jpeg") + ("png") ("tiff") ("x-pic") ("x-mag") @@ -224,8 +237,18 @@ To insert a signature file automatically, call the function ) "*Alist of content-type, subtype, parameters and its values.") -(defvar mime-file-types - '(("\\.rtf$" +(defcustom mime-file-types + '(("\\.txt$" + "text" "plain" nil + nil + "inline" (("filename" . file)) + ) + ("\\.pln$" + "text" "plain" nil + nil + "inline" (("filename" . file)) + ) + ("\\.rtf$" "text" "richtext" nil nil nil nil) @@ -248,6 +271,11 @@ To insert a signature file automatically, call the function "base64" "inline" (("filename" . file)) ) + ("\\.png$" + "image" "png" nil + "base64" + "inline" (("filename" . file)) + ) ("\\.tiff$" "image" "tiff" nil "base64" @@ -295,42 +323,42 @@ To insert a signature file automatically, call the function ) ("\\.tar\\.gz$" "application" "octet-stream" (("type" . "tar+gzip")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.tgz$" "application" "octet-stream" (("type" . "tar+gzip")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.tar\\.Z$" "application" "octet-stream" (("type" . "tar+compress")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.taz$" "application" "octet-stream" (("type" . "tar+compress")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.gz$" "application" "octet-stream" (("type" . "gzip")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.Z$" "application" "octet-stream" (("type" . "compress")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.lzh$" "application" "octet-stream" (("type" . "lha")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.zip$" "application" "zip" nil - nil + "base64" "attachment" (("filename" . file)) ) ("\\.diff$" @@ -338,162 +366,183 @@ To insert a signature file automatically, call the function nil "attachment" (("filename" . file)) ) + ("\\.patch$" + "application" "octet-stream" (("type" . "patch")) + nil + "attachment" (("filename" . file)) + ) ("\\.signature" - "text" "plain" nil nil) + "text" "plain" nil nil nil nil) (".*" "application" "octet-stream" nil nil - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ) "*Alist of file name, types, parameters, and default encoding. -If encoding is nil, it is determined from its contents.") +If encoding is nil, it is determined from its contents." + :type `(repeat + (list regexp + ;; primary-type + (choice :tag "Primary-Type" + ,@(nconc (mapcar (lambda (cell) + (list 'item (car cell)) + ) + mime-content-types) + '(string))) + ;; subtype + (choice :tag "Sub-Type" + ,@(nconc + (apply #'nconc + (mapcar (lambda (cell) + (mapcar (lambda (cell) + (list 'item (car cell)) + ) + (cdr cell))) + mime-content-types)) + '(string))) + ;; parameters + (repeat :tag "Parameters of Content-Type field" + (cons string (choice string symbol))) + ;; content-transfer-encoding + (choice :tag "Encoding" + ,@(cons + '(const nil) + (mapcar (lambda (cell) + (list 'item (car cell)) + ) + mime-file-encoding-method-alist))) + ;; disposition-type + (choice :tag "Disposition-Type" + (item nil) + (item "inline") + (item "attachment") + string) + ;; parameters + (repeat :tag "Parameters of Content-Disposition field" + (cons string (choice string symbol))) + )) + :group 'mime-edit) + ;;; @@ 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-charset-type-list + '((us-ascii 7 nil) + (iso-8859-1 8 "quoted-printable") + (iso-8859-2 8 "quoted-printable") + (iso-8859-3 8 "quoted-printable") + (iso-8859-4 8 "quoted-printable") + (iso-8859-5 8 "quoted-printable") + (koi8-r 8 "quoted-printable") + (iso-8859-7 8 "quoted-printable") + (iso-8859-8 8 "quoted-printable") + (iso-8859-9 8 "quoted-printable") + (iso-2022-jp 7 "base64") + (iso-2022-kr 7 "base64") + (euc-kr 8 "base64") + (cn-gb2312 8 "base64") + (gb2312 8 "base64") + (cn-big5 8 "base64") + (big5 8 "base64") + (shift_jis 8 "base64") + (iso-2022-jp-2 7 "base64") + (iso-2022-int-1 7 "base64") + )) + +(defvar mime-transfer-level 7 + "*A number of network transfer level. It should be bigger than 7.") +(make-variable-buffer-local 'mime-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) +(defsubst mime-encoding-name (transfer-level &optional not-omit) + (cond ((> transfer-level 8) "binary") + ((= transfer-level 8) "8bit") + (not-omit "7bit") + )) + +(defvar mime-transfer-level-string + (mime-encoding-name mime-transfer-level 'not-omit) + "A string formatted version of mime-transfer-level") +(make-variable-buffer-local 'mime-transfer-level-string) -(defvar mime-editor/charset-default-encoding-alist - (mime/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" "X-VM-.*" "X-UIDL") +(defvar mime-edit-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. [mime-edit.el]") +Each elements are regexp of field-name.") -(defvar mime-editor/yank-ignored-field-regexp +(defvar mime-edit-yank-ignored-field-regexp (concat "^" - (apply (function regexp-or) mime-editor/yank-ignored-field-list) + (apply (function regexp-or) mime-edit-yank-ignored-field-list) ":")) -(defvar mime-editor/message-inserter-alist nil) -(defvar mime-editor/mail-inserter-alist nil) +(defvar mime-edit-message-inserter-alist nil) +(defvar mime-edit-mail-inserter-alist nil) + ;;; @@ about message splitting ;;; -(defvar mime-editor/split-message t - "*Split large message if it is non-nil. [mime-edit.el]") +(defcustom mime-edit-split-message t + "*Split large message if it is non-nil." + :group 'mime-edit + :type 'boolean) -(defvar mime-editor/message-default-max-length 1000 - "*Default maximum size of a message. [mime-edit.el]") +(defcustom mime-edit-message-default-max-lines 1000 + "*Default maximum lines of a message." + :group 'mime-edit + :type 'integer) -(defvar mime-editor/message-max-length-alist - '((news-reply-mode . 500))) +(defcustom mime-edit-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-edit-message-default-max-lines' is used." + :group 'mime-edit + :type 'list) -(defconst mime-editor/split-ignored-field-regexp - "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)") +(defconst mime-edit-split-ignored-field-regexp + "\\(^Content-\\|^Subject:\\|^Mime-Version:\\|Message-Id:\\)") -(defvar mime-editor/split-blind-field-regexp +(defvar mime-edit-split-blind-field-regexp "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") -(defvar mime-editor/message-default-sender-alist - '((mail-mode . mail-send-and-exit) - (mh-letter-mode . mh-send-letter) - (news-reply-mode . gnus-inews-news) - )) - -(defvar mime-editor/split-message-sender-alist - '((mail-mode - . (lambda () - (interactive) - (sendmail-send-it) - )) - (mh-letter-mode - . (lambda (&optional arg) - (interactive "P") - (write-region (point-min) (point-max) - mime-editor/draft-file-name nil 'no-message) - (cond (arg - (pop-to-buffer "MH mail delivery") - (erase-buffer) - (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" - "-nodraftfolder" - mh-send-args mime-editor/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 mime-editor/draft-file-name))))) - )) - )) - -(defvar mime-editor/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/news-reply-mode-server-running nil) - - -;;; @@ about PGP -;;; +(defvar mime-edit-split-message-sender-alist nil) -(defvar mime-editor/signing-type nil - "*PGP signing type (pgp-elkins, pgp-kazu or nil). [mime-edit.el]") - -(defvar mime-editor/encrypting-type nil - "*PGP encrypting type (pgp-elkins, pgp-kazu or nil). [mime-edit.el]") - -(if (or mime-editor/signing-type mime-editor/encrypting-type) - (require 'mailcrypt) - ) +(defvar mime-edit-news-reply-mode-server-running nil) ;;; @@ about tag ;;; -(defconst mime-editor/single-part-tag-regexp +(defconst mime-edit-single-part-tag-regexp "--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]" "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].") -(defconst mime-editor/quoted-single-part-tag-regexp - (concat "- " (substring mime-editor/single-part-tag-regexp 1))) +(defconst mime-edit-quoted-single-part-tag-regexp + (concat "- " (substring mime-edit-single-part-tag-regexp 1))) -(defconst mime-editor/multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n") +(defconst mime-edit-multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n") -(defconst mime-editor/multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n") +(defconst mime-edit-multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n") -(defconst mime-editor/beginning-tag-regexp - (regexp-or mime-editor/single-part-tag-regexp - mime-editor/multipart-beginning-regexp)) +(defconst mime-edit-beginning-tag-regexp + (regexp-or mime-edit-single-part-tag-regexp + mime-edit-multipart-beginning-regexp)) -(defconst mime-editor/end-tag-regexp - (regexp-or mime-editor/single-part-tag-regexp - mime-editor/multipart-end-regexp)) +(defconst mime-edit-end-tag-regexp + (regexp-or mime-edit-single-part-tag-regexp + mime-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)) +(defconst mime-edit-tag-regexp + (regexp-or mime-edit-single-part-tag-regexp + mime-edit-multipart-beginning-regexp + mime-edit-multipart-end-regexp)) (defvar mime-tag-format "--[[%s]]" "*Control-string making a MIME tag.") @@ -501,6 +550,7 @@ Each elements are regexp of field-name. [mime-edit.el]") (defvar mime-tag-format-with-encoding "--[[%s][%s]]" "*Control-string making a MIME tag with encoding.") + ;;; @@ multipart boundary ;;; @@ -508,12 +558,34 @@ Each elements are regexp of field-name. [mime-edit.el]") "*Boundary of a multipart message.") -;;; @@ buffer local variables +;;; @@ optional header fields ;;; -(defvar mime/editor-mode-old-local-map nil) -(defvar mime/editor-mode-old-selective-display nil) -(defvar mime/editing-buffer nil) +(defvar mime-edit-insert-x-emacs-field t + "*If non-nil, insert X-Emacs header field.") + +(defvar mime-edit-x-emacs-value + (if (featurep 'xemacs) + (concat emacs-version (if (featurep 'mule) + " with mule" + " without mule")) + (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) + (substring emacs-version 0 (match-beginning 0)) + emacs-version))) + (if (featurep 'mule) + (if (boundp 'enable-multibyte-characters) + (concat "Emacs " ver + (if enable-multibyte-characters + (concat ", MULE " mule-version) + " (with raw setting)") + (if (featurep 'meadow) + (concat ", " (Meadow-version)) + )) + (concat "MULE " mule-version " based on Emacs " ver)) + ver))) + "Body of X-Emacs field. +If variable `mime-edit-insert-x-emacs-field' is not nil, it is +inserted into message header.") ;;; @ constants @@ -523,182 +595,232 @@ Each elements are regexp of field-name. [mime-edit.el]") "*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 (" mime-editor/version-name ")") +(defconst mime-edit-mime-version-value + (concat "1.0 (generated by " mime-edit-version-string ")") "MIME version number.") -(defconst mime-editor/mime-map (make-sparse-keymap) - "Keymap for MIME commands.") +(defconst mime-edit-mime-version-field-for-message/partial + (concat "MIME-Version: 1.0 (split by " mime-edit-version-string ")\n") + "MIME version field for message/partial.") ;;; @ keymap and menu ;;; -(defvar mime/editor-mode-flag nil) -(make-variable-buffer-local 'mime/editor-mode-flag) - -(set-alist 'minor-mode-alist - 'mime/editor-mode-flag - '((" MIME-Edit " mime-editor/transfer-level-string))) - -(defun mime-editor/define-keymap (keymap) - "Add mime-editor commands to KEYMAP." - (if (not (keymapp keymap)) - nil - (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 "\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) - -(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) +(defvar mime-edit-mode-flag nil) +(make-variable-buffer-local 'mime-edit-mode-flag) + +(defvar mime-edit-mode-entity-prefix "\C-c\C-x" + "Keymap prefix for MIME-Edit mode commands to insert entity or set status.") +(defvar mime-edit-mode-entity-map (make-sparse-keymap) + "Keymap for MIME-Edit mode commands to insert entity or set status.") + +(define-key mime-edit-mode-entity-map "\C-t" 'mime-edit-insert-text) +(define-key mime-edit-mode-entity-map "\C-i" 'mime-edit-insert-file) +(define-key mime-edit-mode-entity-map "\C-e" 'mime-edit-insert-external) +(define-key mime-edit-mode-entity-map "\C-v" 'mime-edit-insert-voice) +(define-key mime-edit-mode-entity-map "\C-y" 'mime-edit-insert-message) +(define-key mime-edit-mode-entity-map "\C-m" 'mime-edit-insert-mail) +(define-key mime-edit-mode-entity-map "\C-w" 'mime-edit-insert-signature) +(define-key mime-edit-mode-entity-map "\C-s" 'mime-edit-insert-signature) +(define-key mime-edit-mode-entity-map "\C-k" 'mime-edit-insert-key) +(define-key mime-edit-mode-entity-map "t" 'mime-edit-insert-tag) + +(define-key mime-edit-mode-entity-map "7" 'mime-edit-set-transfer-level-7bit) +(define-key mime-edit-mode-entity-map "8" 'mime-edit-set-transfer-level-8bit) +(define-key mime-edit-mode-entity-map "/" 'mime-edit-set-split) +(define-key mime-edit-mode-entity-map "s" 'mime-edit-set-sign) +(define-key mime-edit-mode-entity-map "v" 'mime-edit-set-sign) +(define-key mime-edit-mode-entity-map "e" 'mime-edit-set-encrypt) +(define-key mime-edit-mode-entity-map "h" 'mime-edit-set-encrypt) +(define-key mime-edit-mode-entity-map "p" 'mime-edit-preview-message) +(define-key mime-edit-mode-entity-map "\C-z" 'mime-edit-exit) +(define-key mime-edit-mode-entity-map "?" 'mime-edit-help) + +(defvar mime-edit-mode-enclosure-prefix "\C-c\C-m" + "Keymap prefix for MIME-Edit mode commands about enclosure.") +(defvar mime-edit-mode-enclosure-map (make-sparse-keymap) + "Keymap for MIME-Edit mode commands about enclosure.") + +(define-key mime-edit-mode-enclosure-map + "\C-a" 'mime-edit-enclose-alternative-region) +(define-key mime-edit-mode-enclosure-map + "\C-p" 'mime-edit-enclose-parallel-region) +(define-key mime-edit-mode-enclosure-map + "\C-m" 'mime-edit-enclose-mixed-region) +(define-key mime-edit-mode-enclosure-map + "\C-d" 'mime-edit-enclose-digest-region) +(define-key mime-edit-mode-enclosure-map + "\C-s" 'mime-edit-enclose-pgp-signed-region) +(define-key mime-edit-mode-enclosure-map + "\C-e" 'mime-edit-enclose-pgp-encrypted-region) +(define-key mime-edit-mode-enclosure-map + "\C-q" 'mime-edit-enclose-quote-region) + +(defvar mime-edit-mode-map (make-sparse-keymap) + "Keymap for MIME-Edit mode commands.") +(define-key mime-edit-mode-map + mime-edit-mode-entity-prefix mime-edit-mode-entity-map) +(define-key mime-edit-mode-map + mime-edit-mode-enclosure-prefix mime-edit-mode-enclosure-map) + +(defconst mime-edit-menu-title "MIME-Edit") + +(defconst mime-edit-menu-list + '((mime-help "Describe MIME editor mode" mime-edit-help) + (file "Insert File" mime-edit-insert-file) + (external "Insert External" mime-edit-insert-external) + (voice "Insert Voice" mime-edit-insert-voice) + (message "Insert Message" mime-edit-insert-message) + (mail "Insert Mail" mime-edit-insert-mail) + (signature "Insert Signature" mime-edit-insert-signature) + (text "Insert Text" mime-edit-insert-text) + (tag "Insert Tag" mime-edit-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-edit-enclose-alternative-region) + (parallel "Enclose as parallel" mime-edit-enclose-parallel-region) + (mixed "Enclose as serial" mime-edit-enclose-mixed-region) + (digest "Enclose as digest" mime-edit-enclose-digest-region) + (signed "Enclose as signed" mime-edit-enclose-pgp-signed-region) + (encrypted "Enclose as encrypted" mime-edit-enclose-pgp-encrypted-region) + (quote "Verbatim region" mime-edit-enclose-quote-region) + (key "Insert Public Key" mime-edit-insert-key) + (split "About split" mime-edit-set-split) + (sign "About sign" mime-edit-set-sign) + (encrypt "About encryption" mime-edit-set-encrypt) + (preview "Preview Message" mime-edit-preview-message) + (level "Toggle transfer-level" mime-edit-toggle-transfer-level) ) "MIME-edit menubar entry.") -(defun mime-editor/define-menu-for-emacs19 () - "Define menu for Emacs 19." - (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-edit (car item)) - (cons (nth 1 item)(nth 2 item)) +(cond (running-xemacs + ;; modified by Pekka Marjola + ;; 1995/9/5 (c.f. [tm-en:69]) + (defun mime-edit-define-menu-for-xemacs () + "Define menu for Emacs 19." + (cond ((featurep 'menubar) + (make-local-variable 'current-menubar) + (set-buffer-menubar current-menubar) + (add-submenu + nil + (cons mime-edit-menu-title + (mapcar (function + (lambda (item) + (vector (nth 1 item)(nth 2 item) + mime-edit-mode-flag) + )) + mime-edit-menu-list))) + ))) + + ;; modified by Steven L. Baur + ;; 1995/12/6 (c.f. [tm-en:209]) + (or (boundp 'mime-edit-popup-menu-for-xemacs) + (setq mime-edit-popup-menu-for-xemacs + (append '("MIME Commands" "---") + (mapcar (function (lambda (item) + (vector (nth 1 item) + (nth 2 item) + t))) + mime-edit-menu-list))) + ) + ) + ((>= emacs-major-version 19) + (define-key mime-edit-mode-map [menu-bar mime-edit] + (cons mime-edit-menu-title + (make-sparse-keymap mime-edit-menu-title))) + (mapcar (function + (lambda (item) + (define-key mime-edit-mode-map + (vector 'menu-bar 'mime-edit (car item)) + (cons (nth 1 item)(nth 2 item)) + ) + )) + (reverse mime-edit-menu-list) ) - )) - (reverse mime-editor/menu-list) - )) - -;;; 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 - (cons mime-editor/menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) - mime/editor-mode-flag) - )) - mime-editor/menu-list))) - ))) - -;;; 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 ;;; +(defvar mime-edit-touched-flag nil) + ;;;###autoload -(defun mime/editor-mode () +(defun mime-edit-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 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 lists the available charsets of each emacs. -Emacs18: US-ASCII is only available. -NEmacs: US-ASCII and ISO-2022-JP are available. -Emacs19: US-ASCII and ISO-8859-1 are available. -Mule: US-ASCII, ISO-8859-* (except for ISO-8859-6), - ISO-2022-JP, ISO-2022-JP-2 and ISO-2022-INT-1 are available. +Without mule: US-ASCII and ISO-8859-1 (or other charset) are available. +With mule: US-ASCII, ISO-8859-* (except for ISO-8859-5), KOI8-R, + ISO-2022-JP, ISO-2022-JP-2, EUC-KR, CN-GB-2312, + CN-BIG5 and ISO-2022-INT-1 are available. -ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in Mule is expected to +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 +without mule, 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 charset and value is symbol of MIME charset. 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: -\\[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-tag] insert a new MIME tag. -\\[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/insert-key] insert PGP public key. -\\[mime-editor/preview-message] preview editing MIME message. -\\[mime-editor/exit] exit and translate into a MIME compliant message. -\\[mime-editor/maybe-translate] exit and translate if in MIME mode, then split. -\\[mime-editor/help] show this help. + +\[make single part\] +\\[mime-edit-insert-text] insert a text message. +\\[mime-edit-insert-file] insert a (binary) file. +\\[mime-edit-insert-external] insert a reference to external body. +\\[mime-edit-insert-voice] insert a voice message. +\\[mime-edit-insert-message] insert a mail or news message. +\\[mime-edit-insert-mail] insert a mail message. +\\[mime-edit-insert-signature] insert a signature file at end. +\\[mime-edit-insert-key] insert PGP public key. +\\[mime-edit-insert-tag] insert a new MIME tag. + +\[make enclosure (maybe multipart)\] +\\[mime-edit-enclose-alternative-region] enclose as multipart/alternative. +\\[mime-edit-enclose-parallel-region] enclose as multipart/parallel. +\\[mime-edit-enclose-mixed-region] enclose as multipart/mixed. +\\[mime-edit-enclose-digest-region] enclose as multipart/digest. +\\[mime-edit-enclose-pgp-signed-region] enclose as PGP signed. +\\[mime-edit-enclose-pgp-encrypted-region] enclose as PGP encrypted. +\\[mime-edit-enclose-quote-region] enclose as verbose mode + (to avoid to expand tags) + +\[other commands\] +\\[mime-edit-set-transfer-level-7bit] set transfer-level as 7. +\\[mime-edit-set-transfer-level-8bit] set transfer-level as 8. +\\[mime-edit-set-split] set message splitting mode. +\\[mime-edit-set-sign] set PGP-sign mode. +\\[mime-edit-set-encrypt] set PGP-encryption mode. +\\[mime-edit-preview-message] preview editing MIME message. +\\[mime-edit-exit] exit and translate into a MIME + compliant message. +\\[mime-edit-help] show this help. +\\[mime-edit-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. @@ -712,16 +834,18 @@ 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 + mime-edit-prefix Specifies a key prefix for MIME minor mode commands. mime-ignore-preceding-spaces @@ -730,164 +854,177 @@ User customizable variables (not documented all of them): 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-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-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-edit-voice-recorder + Specifies a function to record a voice message and encode it. + The function `mime-edit-voice-recorder-for-sun' is for Sun + SparcStations. - mime/editor-mode-hook - Turning on MIME mode calls the value of mime/editor-mode-hook, if + mime-edit-mode-hook + Turning on MIME mode calls the value of mime-edit-mode-hook, if it is non-nil. - mime-editor/translate-hook - The value of mime-editor/translate-hook is called just before translating + mime-edit-translate-hook + The value of mime-edit-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 mime-editor/insert-signature, + non-nil. If the hook call the function mime-edit-insert-signature, the signature file will be inserted automatically. - mime-editor/exit-hook - Turning off MIME mode calls the value of mime-editor/exit-hook, if it is + mime-edit-exit-hook + Turning off MIME mode calls the value of mime-edit-exit-hook, if it is non-nil." (interactive) - (if mime/editor-mode-flag + (if mime-edit-mode-flag + (mime-edit-exit) + (if mime-edit-touched-flag + (mime-edit-again) + (make-local-variable 'mime-edit-touched-flag) + (setq mime-edit-touched-flag t) + (turn-on-mime-edit) + ))) + + +(cond (running-xemacs + (add-minor-mode 'mime-edit-mode-flag + '((" MIME-Edit " mime-transfer-level-string)) + mime-edit-mode-map + nil + 'mime-edit-mode) + ) + (t + (set-alist 'minor-mode-alist + 'mime-edit-mode-flag + '((" MIME-Edit " mime-transfer-level-string))) + (set-alist 'minor-mode-map-alist + 'mime-edit-mode-flag + mime-edit-mode-map) + )) + + +;;;###autoload +(defun turn-on-mime-edit () + "Unconditionally turn on MIME-Edit mode." + (interactive) + (if mime-edit-mode-flag (error "You are already editing a MIME message.") - (setq mime/editor-mode-flag t) - ;; Remember old key bindings. - (if running-xemacs - nil - (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 (current-local-map))) - ) - (if (not (lookup-key (current-local-map) mime-prefix)) - (define-key (current-local-map) mime-prefix mime-editor/mime-map)) + (setq mime-edit-mode-flag t) ;; Set transfer level into mode line ;; - (setq mime-editor/transfer-level-string - (mime/encoding-name mime-editor/transfer-level 'not-omit)) + (setq mime-transfer-level-string + (mime-encoding-name mime-transfer-level 'not-omit)) (force-mode-line-update) - - ;; Define menu. Menus for other emacs implementations are - ;; welcome. - (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/editor-mode-old-selective-display) - (setq mime/editor-mode-old-selective-display selective-display) - (setq selective-display t) + + ;; Define menu for XEmacs. + (if running-xemacs + (mime-edit-define-menu-for-xemacs) + ) + + (enable-invisible) + ;; I don't care about saving these. (setq paragraph-start - (regexp-or mime-editor/single-part-tag-regexp + (regexp-or mime-edit-single-part-tag-regexp paragraph-start)) (setq paragraph-separate - (regexp-or mime-editor/single-part-tag-regexp + (regexp-or mime-edit-single-part-tag-regexp paragraph-separate)) - (run-hooks 'mime/editor-mode-hook) + (run-hooks 'mime-edit-mode-hook) (message (substitute-command-keys - "Type \\[mime-editor/exit] to exit MIME mode, and type \\[mime-editor/help] to get help.")) + "Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help.")) )) ;;;###autoload -(defalias 'edit-mime 'mime/editor-mode) ; for convenience -(defalias 'mime-mode 'mime/editor-mode) ; for convenience +(defalias 'edit-mime 'turn-on-mime-edit) ; for convenience + -(defun mime-editor/exit (&optional nomime no-error) +(defun mime-edit-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/editor-mode-flag) + (if (not mime-edit-mode-flag) (if (null no-error) (error "You aren't editing a MIME message.") ) (if (not nomime) (progn - (run-hooks 'mime-editor/translate-hook) - (mime-editor/translate-buffer))) + (run-hooks 'mime-edit-translate-hook) + (mime-edit-translate-buffer))) ;; Restore previous state. - (setq mime/editor-mode-flag nil) - (cond (running-xemacs - ;; mime-prefix only defined if binding was nil - (if (eq (lookup-key (current-local-map) mime-prefix) - mime-editor/mime-map) - (define-key (current-local-map) mime-prefix nil)) - (delete-menu-item (list mime-editor/menu-title))) - (t - (use-local-map mime/editor-mode-old-local-map))) - - (setq selective-display mime/editor-mode-old-selective-display) + (setq mime-edit-mode-flag nil) + (if (and running-xemacs + (featurep 'menubar)) + (delete-menu-item (list mime-edit-menu-title)) + ) + (end-of-invisible) (set-buffer-modified-p (buffer-modified-p)) - (run-hooks 'mime-editor/exit-hook) + (run-hooks 'mime-edit-exit-hook) (message "Exit MIME editor mode.") )) -(defun mime-editor/maybe-translate () +(defun mime-edit-maybe-translate () (interactive) - (mime-editor/exit nil t) - (call-interactively 'mime-editor/maybe-split-and-send) + (mime-edit-exit nil t) + (call-interactively 'mime-edit-maybe-split-and-send) ) -(defun mime-editor/help () +(defun mime-edit-help () "Show help message about MIME mode." (interactive) (with-output-to-temp-buffer "*Help*" (princ "MIME editor mode:\n") - (princ (documentation 'mime/editor-mode)) + (princ (documentation 'mime-edit-mode)) (print-help-return-message))) -(defun mime-editor/insert-text () +(defun mime-edit-insert-text (&optional subtype) "Insert a text message. -Charset is automatically obtained from the `mime/lc-charset-alist'." +Charset is automatically obtained from the `charsets-mime-charset-alist'. +If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (interactive) - (if (and (mime-editor/insert-tag "text" nil nil) - (looking-at mime-editor/single-part-tag-regexp)) - (progn - ;; Make a space between the following message. - (insert "\n") - (forward-char -1) - ))) + (let ((ret (mime-edit-insert-tag "text" subtype nil))) + (when ret + (if (looking-at mime-edit-single-part-tag-regexp) + (progn + ;; Make a space between the following message. + (insert "\n") + (forward-char -1) + )) + (if (and (member (cadr ret) '("enriched" "richtext")) + (fboundp 'enriched-mode) + ) + (enriched-mode t) + (if (boundp 'enriched-mode) + (enriched-mode -1) + )) + ))) -(defun mime-editor/insert-file (file) +(defun mime-edit-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. + (encoding (nth 3 guess)) (disposition-type (nth 4 guess)) (disposition-params (nth 5 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 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 "") @@ -896,7 +1033,7 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." (setq attribute (car cell)) (setq value (cdr cell)) (if (eq value 'file) - (setq value (rfc822/wrap-as-quoted-string + (setq value (std11-wrap-as-quoted-string (file-name-nondirectory file))) ) (setq parameters (concat parameters "; " attribute "=" value)) @@ -913,7 +1050,7 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." (setq attribute (car cell)) (setq value (cdr cell)) (if (eq value 'file) - (setq value (rfc822/wrap-as-quoted-string + (setq value (std11-wrap-as-quoted-string (file-name-nondirectory file))) ) (setq parameters @@ -922,14 +1059,14 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." ) )) )) - (mime-editor/insert-tag pritype subtype parameters) - (mime-editor/insert-binary-file file encoding) + (mime-edit-insert-tag type subtype parameters) + (mime-edit-insert-binary-file file encoding) )) -(defun mime-editor/insert-external () +(defun mime-edit-insert-external () "Insert a reference to external body." (interactive) - (mime-editor/insert-tag "message" "external-body" nil ";\n\t") + (mime-edit-insert-tag "message" "external-body" nil ";\n\t") ;;(forward-char -1) ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n") ;;(forward-line 1) @@ -941,27 +1078,37 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." (insert "Content-Type: " pritype "/" subtype (or parameters "") "\n"))) (if (and (not (eobp)) - (not (looking-at mime-editor/single-part-tag-regexp))) + (not (looking-at mime-edit-single-part-tag-regexp))) (insert (mime-make-text-tag) "\n"))) -(defun mime-editor/insert-voice () +(defun mime-edit-insert-voice () "Insert a voice message." (interactive) - (mime-editor/insert-tag "audio" "basic" nil) - (let ((buffer (funcall mime-voice-recorder))) - (unwind-protect - (mime-editor/insert-binary-buffer buffer "base64") - (kill-buffer buffer) - ))) + (let ((encoding + (completing-read + "What transfer encoding: " + mime-file-encoding-method-alist nil t nil))) + (mime-edit-insert-tag "audio" "basic" nil) + (mime-edit-define-encoding encoding) + (save-restriction + (narrow-to-region (1- (point))(point)) + (unwind-protect + (funcall mime-edit-voice-recorder encoding) + (progn + (insert "\n") + (invisible-region (point-min)(point-max)) + (goto-char (point-max)) + ))))) -(defun mime-editor/insert-signature (&optional arg) +(defun mime-edit-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)) + (let ((items (mime-find-file-type signature-file-name))) + (apply (function mime-edit-insert-tag) + (car items) (cadr items) (list (caddr items)))) ))) ) (insert-signature arg) @@ -970,10 +1117,19 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." ;; Insert a new tag around a point. -(defun mime-editor/insert-tag (&optional pritype subtype parameters delimiter) +(defun mime-edit-insert-tag (&optional pritype subtype parameters delimiter) "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS. If nothing is inserted, return nil." (interactive) + (let ((p (point))) + (mime-edit-goto-tag) + (if (and (re-search-forward mime-edit-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)) @@ -992,7 +1148,7 @@ If nothing is inserted, return nil." ;; Find an current MIME tag. (setq oldtag (save-excursion - (if (mime-editor/goto-tag) + (if (mime-edit-goto-tag) (buffer-substring (match-beginning 0) (match-end 0)) ;; Assume content type is 'text/plan'. (mime-make-tag "text" "plain") @@ -1000,7 +1156,7 @@ If nothing is inserted, return nil." ;; We are only interested in TEXT. (if (and oldtag (not (mime-test-content-type - (mime-editor/get-contype oldtag) "text"))) + (mime-edit-get-contype oldtag) "text"))) (setq oldtag nil)) ;; Make a new tag. (if (or (not oldtag) ;Not text @@ -1018,93 +1174,60 @@ If nothing is inserted, return nil." ) )) -;; Insert the binary content after MIME tag. -;; modified by MORITA Masahiro -;; for x-uue -(defun mime-editor/insert-binary-file (file &optional encoding) +(defun mime-edit-insert-binary-file (file &optional encoding) "Insert binary FILE at point. Optional argument ENCODING specifies an encoding method such as base64." - (let ((tmpbuf (get-buffer-create " *MIME insert*"))) - (save-excursion - (set-buffer tmpbuf) - (erase-buffer) - (let ((mc-flag nil) ;Mule - (file-coding-system-for-read - (if (featurep 'mule) *noconv*)) - (kanji-flag nil) ;NEmacs - (emx-binary-mode t) ;Stop CRLF to LF conversion in OS/2 - ) - (let (jka-compr-compression-info-list - jam-zcat-filename-list) - (insert-file-contents file)))) - (prog1 - (if (and (stringp encoding) - (string-equal (downcase encoding) "x-uue")) - (progn - (require 'mel-u) - (let ((uuencode-external-encoder - (cons (car uuencode-external-encoder) - (list (file-name-nondirectory file)) - ))) - (mime-editor/insert-binary-buffer tmpbuf encoding) - )) - (mime-editor/insert-binary-buffer tmpbuf encoding)) - (kill-buffer tmpbuf)))) - -;; Insert the binary content after MIME tag. -;; modified by MORITA Masahiro -;; for x-uue -(defun mime-editor/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 start (point-max) encoding) - )) + (narrow-to-region tagend (point)) + (mime-insert-encoded-file file encoding) (if hide-p (progn (invisible-region (point-min) (point-max)) (goto-char (point-max)) ) + (goto-char (point-max)) )) + (or hide-p + (looking-at mime-edit-tag-regexp) + (= (point)(point-max)) + (mime-edit-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. - (mime-editor/define-encoding encoding))) + (goto-char tagend) ; Make sure which line the tag is on. + (mime-edit-define-encoding encoding) + )) )) ;; Commands work on a current message flagment. -(defun mime-editor/goto-tag () +(defun mime-edit-goto-tag () "Search for the beginning of the tagged MIME message." - (let ((current (point)) multipart) - (if (looking-at mime-editor/tag-regexp) + (let ((current (point))) + (if (looking-at mime-edit-tag-regexp) t ;; At first, go to the end. - (cond ((re-search-forward mime-editor/beginning-tag-regexp nil t) + (cond ((re-search-forward mime-edit-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 mime-editor/end-tag-regexp nil t) - (or (looking-at mime-editor/beginning-tag-regexp) + ;; Then search for the beginning. + (re-search-backward mime-edit-end-tag-regexp nil t) + (or (looking-at mime-edit-beginning-tag-regexp) ;; Restore previous point. (progn (goto-char current) @@ -1112,12 +1235,12 @@ Optional argument ENCODING specifies an encoding method such as base64." )) ))) -(defun mime-editor/content-beginning () +(defun mime-edit-content-beginning () "Return the point of the beginning of content." (save-excursion (let ((beg (save-excursion (beginning-of-line) (point)))) - (if (mime-editor/goto-tag) + (if (mime-edit-goto-tag) (let ((top (point))) (goto-char (match-end 0)) (if (and (= beg top) @@ -1134,55 +1257,55 @@ Optional argument ENCODING specifies an encoding method such as base64." (point)) ))) -(defun mime-editor/content-end () +(defun mime-edit-content-end () "Return the point of the end of content." (save-excursion - (let ((beg (point))) - (if (mime-editor/goto-tag) - (let ((top (point))) - (goto-char (match-end 0)) - (if (invisible-p (point)) - (next-visible-point (point)) - ;; Move to the end of this text. - (if (re-search-forward mime-editor/tag-regexp nil 'move) - ;; Don't forget a multiline tag. - (goto-char (match-beginning 0)) - ) - (point) - )) - ;; Assume the message begins with text/plain. - (goto-char (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)) - ))) + (if (mime-edit-goto-tag) + (progn + (goto-char (match-end 0)) + (if (invisible-p (point)) + (next-visible-point (point)) + ;; Move to the end of this text. + (if (re-search-forward mime-edit-tag-regexp nil 'move) + ;; Don't forget a multiline tag. + (goto-char (match-beginning 0)) + ) + (point) + )) + ;; Assume the message begins with text/plain. + (goto-char (mime-edit-content-beginning)) + (if (re-search-forward mime-edit-tag-regexp nil 'move) + ;; Don't forget a multiline tag. + (goto-char (match-beginning 0))) + (point)) + )) -(defun mime-editor/define-charset (charset) +(defun mime-edit-define-charset (charset) "Set charset of current tag to CHARSET." (save-excursion - (if (mime-editor/goto-tag) + (if (mime-edit-goto-tag) (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) (delete-region (match-beginning 0) (match-end 0)) (insert (mime-create-tag - (mime-editor/set-parameter - (mime-editor/get-contype tag) "charset" charset) - (mime-editor/get-encoding tag))) + (mime-edit-set-parameter + (mime-edit-get-contype tag) + "charset" (upcase (symbol-name charset))) + (mime-edit-get-encoding tag))) )))) -(defun mime-editor/define-encoding (encoding) +(defun mime-edit-define-encoding (encoding) "Set encoding of current tag to ENCODING." (save-excursion - (if (mime-editor/goto-tag) + (if (mime-edit-goto-tag) (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) (delete-region (match-beginning 0) (match-end 0)) - (insert (mime-create-tag (mime-editor/get-contype tag) encoding))) + (insert (mime-create-tag (mime-edit-get-contype tag) encoding))) ))) -(defun mime-editor/choose-charset () +(defun mime-edit-choose-charset () "Choose charset of a text following current point." - (mime/find-charset-region (point) (mime-editor/content-end)) + (detect-mime-charset-region (point) (mime-edit-content-end)) ) (defun mime-make-text-tag (&optional subtype) @@ -1209,20 +1332,20 @@ Otherwise, it is obtained from mime-content-types." (format (if encoding mime-tag-format-with-encoding mime-tag-format) contype encoding)) -(defun mime-editor/get-contype (tag) +(defun mime-edit-get-contype (tag) "Return Content-Type (including parameters) of TAG." (and (stringp 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) + (or (string-match mime-edit-single-part-tag-regexp tag) + (string-match mime-edit-multipart-beginning-regexp tag) + (string-match mime-edit-multipart-end-regexp tag) ) (substring tag (match-beginning 1) (match-end 1)) )) -(defun mime-editor/get-encoding (tag) +(defun mime-edit-get-encoding (tag) "Return encoding of TAG." (and (stringp tag) - (string-match mime-editor/single-part-tag-regexp tag) + (string-match mime-edit-single-part-tag-regexp tag) (match-beginning 3) (not (= (match-beginning 3) (match-end 3))) (substring tag (match-beginning 3) (match-end 3)))) @@ -1240,7 +1363,7 @@ Nil if no such parameter." nil ;No such parameter )) -(defun mime-editor/set-parameter (contype parameter value) +(defun mime-edit-set-parameter (contype parameter value) "For given CONTYPE set PARAMETER to VALUE." (let (ctype opt-fields) (if (string-match "\n[^ \t\n\r]+:" contype) @@ -1289,7 +1412,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. @@ -1299,7 +1422,7 @@ Nil if no such parameter." mime-content-types nil 'require-match ;Type must be specified. - nil + default )) (if (string-equal type "") (progn @@ -1308,19 +1431,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 @@ -1383,69 +1509,71 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter))))) )) -(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." + (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. ;;; -(defvar mime-editor/translate-buffer-hook - '(mime-editor/pgp-enclose-buffer - mime/encode-message-header - mime-editor/translate-body)) +(defvar mime-edit-translate-buffer-hook + '(mime-edit-pgp-enclose-buffer + mime-edit-translate-body + mime-edit-translate-header)) + +(defun mime-edit-translate-header () + "Encode the message header into network representation." + (eword-encode-header 'code-conversion) + (run-hooks 'mime-edit-translate-header-hook) + ) -(defun mime-editor/translate-buffer () +(defun mime-edit-translate-buffer () "Encode the tagged MIME message in current buffer in MIME compliant message." (interactive) - (if (catch 'mime-editor/error + (if (catch 'mime-edit-error (save-excursion - (run-hooks 'mime-editor/translate-buffer-hook) + (run-hooks 'mime-edit-translate-buffer-hook) )) (progn (undo) (error "Translation error!") ))) -(defun mime-editor/find-inmost () +(defun mime-edit-find-inmost () (goto-char (point-min)) - (if (re-search-forward mime-editor/multipart-beginning-regexp nil t) + (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) (let ((bb (match-beginning 0)) (be (match-end 0)) (type (buffer-substring (match-beginning 1)(match-end 1))) - end-exp eb ee) + end-exp eb) (setq end-exp (format "--}-<<%s>>\n" type)) (widen) (if (re-search-forward end-exp nil t) - (progn - (setq eb (match-beginning 0)) - (setq ee (match-end 0)) - ) + (setq eb (match-beginning 0)) (setq eb (point-max)) - (setq ee (point-max)) ) (narrow-to-region be eb) (goto-char be) - (if (re-search-forward mime-editor/multipart-beginning-regexp nil t) - (let (ret) + (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) + (progn (narrow-to-region (match-beginning 0)(point-max)) - (mime-editor/find-inmost) + (mime-edit-find-inmost) ) (widen) (list type bb be eb) )))) -(defun mime-editor/process-multipart-1 (boundary) - (let ((ret (mime-editor/find-inmost))) +(defun mime-edit-process-multipart-1 (boundary) + (let ((ret (mime-edit-find-inmost))) (if ret (let ((type (car ret)) (bb (nth 1 ret))(be (nth 2 ret)) @@ -1457,36 +1585,33 @@ while if FLAG is `\\^M' (control-M) the text is hidden." (setq eb (point-max)) (widen) (goto-char eb) - (if (looking-at mime-editor/multipart-end-regexp) + (if (looking-at mime-edit-multipart-end-regexp) (let ((beg (match-beginning 0)) (end (match-end 0)) ) (delete-region beg end) - (or (looking-at mime-editor/beginning-tag-regexp) + (or (looking-at mime-edit-beginning-tag-regexp) (eobp) (insert (concat (mime-make-text-tag) "\n")) ))) (cond ((string-equal type "quote") - (mime-editor/enquote-region bb eb) + (mime-edit-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 "pgp-signed") + (mime-edit-sign-pgp-mime bb eb boundary) + ) + ((string-equal type "pgp-encrypted") + (mime-edit-encrypt-pgp-mime bb eb boundary) + ) + ((string-equal type "kazu-signed") + (mime-edit-sign-pgp-kazu bb eb boundary) + ) + ((string-equal type "kazu-encrypted") + (mime-edit-encrypt-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 + (nth 2 (mime-edit-translate-region bb eb boundary t))) (goto-char bb) (insert @@ -1496,220 +1621,109 @@ while if FLAG is `\\^M' (control-M) the text is hidden." )) boundary)))) -(defun mime-editor/enquote-region (beg end) +(defun mime-edit-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) + (while (re-search-forward mime-edit-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) +(defun mime-edit-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) + mime-edit-quoted-single-part-tag-regexp nil t) (let ((tag (buffer-substring (match-beginning 0)(match-end 0)))) (replace-match (concat "-" (substring tag 2))) ))))) -(autoload 'mc-pgp-lookup-key "mc-pgp") -(autoload 'mc-pgp-sign-region "mc-pgp") -(autoload 'mc-pgp-encrypt-region "mc-pgp") - -(defun tm:mc-pgp-generic-parser (result) - (let ((ret (mc-pgp-generic-parser result))) - (if (consp ret) - (vector (car ret)(cdr ret)) - ))) - -(defun tm:mc-process-region - (beg end passwd program args parser &optional buffer boundary) - (let ((obuf (current-buffer)) - (process-connection-type nil) - mybuf result rgn proc) - (unwind-protect - (progn - (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp"))) - (set-buffer mybuf) - (erase-buffer) - (set-buffer obuf) - (buffer-disable-undo mybuf) - (setq proc - (apply 'start-process "*PGP*" mybuf program args)) - (if passwd - (progn - (process-send-string proc (concat passwd "\n")) - (or mc-passwd-timeout (mc-deactivate-passwd t)))) - (process-send-region proc beg end) - (process-send-eof proc) - (while (eq 'run (process-status proc)) - (accept-process-output proc 5)) - (setq result (process-exit-status proc)) - ;; Hack to force a status_notify() in Emacs 19.29 - (delete-process proc) - (set-buffer mybuf) - (goto-char (point-max)) - (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0))) - (goto-char (point-min)) - ;; CRNL -> NL - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - ;; Hurm. FIXME; must get better result codes. - (if (stringp result) - (error "%s exited abnormally: '%s'" program result) - (setq rgn (funcall parser result)) - ;; If the parser found something, migrate it - (if (consp rgn) - (progn - (set-buffer obuf) - (if boundary - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (insert (format "--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s -Content-Type: application/pgp-signature -Content-Transfer-Encoding: 7bit - -" boundary)) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - (goto-char (point-max)) - (insert (format "\n--%s--\n" boundary)) - ) - (delete-region beg end) - (goto-char beg) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - ) - (set-buffer mybuf) - (delete-region (car rgn) (cdr rgn))))) - ;; Return nil on failure and exit code on success - (if rgn result)) - ;; Cleanup even on nonlocal exit - (if (and proc (eq 'run (process-status proc))) - (interrupt-process proc)) - (set-buffer obuf) - (or buffer (null mybuf) (kill-buffer mybuf))))) - -(defun tm:mc-pgp-sign-region (start end &optional id unclear boundary) - (if (not (boundp 'mc-pgp-user-id)) - (load "mc-pgp") - ) - (let ((process-environment process-environment) - (buffer (get-buffer-create mc-buffer-name)) - passwd args key - (parser (function mc-pgp-generic-parser)) - (pgp-path mc-pgp-path) - ) - (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id))) - (setq passwd - (mc-activate-passwd - (cdr key) - (format "PGP passphrase for %s (%s): " (car key) (cdr key)))) - (setenv "PGPPASSFD" "0") - (setq args - (cons - (if boundary - "-fbast" - "-fast") - (list "+verbose=1" "+language=en" - (format "+clearsig=%s" (if unclear "off" "on")) - "+batchmode" "-u" (cdr key)))) - (if mc-pgp-comment - (setq args (cons (format "+comment=%s" mc-pgp-comment) args)) - ) - (message "Signing as %s ..." (car key)) - (if (tm:mc-process-region - start end passwd pgp-path args parser buffer boundary) - (progn - (if boundary - (progn - (goto-char (point-min)) - (insert - (format "\ ---[[multipart/signed; protocol=\"application/pgp-signature\"; - boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary)) - )) - (message "Signing as %s ... Done." (car key)) - t) - nil))) - -(defun mime-editor/sign-pgp-elkins (beg end boundary) +(defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction (narrow-to-region beg end) (let* ((ret - (mime-editor/translate-region beg end boundary)) + (mime-edit-translate-region beg end boundary)) (ctype (car ret)) (encoding (nth 1 ret)) - (parts (nth 3 ret)) - (pgp-boundary (concat "pgp-sign-" boundary)) - ) + (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 (tm:mc-pgp-sign-region (point-min)(point-max) - nil nil pgp-boundary) - (throw 'mime-editor/error 'pgp-error) + (or (as-binary-process + (funcall (pgp-function 'mime-sign) + (point-min)(point-max) nil nil pgp-boundary)) + (throw 'mime-edit-error 'pgp-error) ) )))) -(defun mime-editor/encrypt-pgp-elkins (beg end boundary) +(defvar mime-edit-encrypt-recipient-fields-list '("To" "cc")) + +(defun mime-edit-make-encrypt-recipient-header () + (let* ((names mime-edit-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-edit-encrypt-pgp-mime (beg end boundary) (save-excursion (save-restriction - (let ((from (rfc822/get-field-body "From")) - (to (rfc822/get-field-body "To")) - (cc (rfc822/get-field-body "cc")) - recipients) + (let (from recipients header) + (let ((ret (mime-edit-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)) + (mime-edit-translate-region beg end boundary)) (ctype (car ret)) (encoding (nth 1 ret)) - (parts (nth 3 ret)) - (pgp-boundary (concat "pgp-" boundary)) - ) + (pgp-boundary (concat "pgp-" boundary))) (goto-char beg) - (if (and (stringp from) - (not (string-equal from ""))) - (insert (format "From: %s\n" from)) - ) - (if (and (stringp to) - (not (string-equal to ""))) - (progn - (insert (format "To: %s\n" to)) - (setq recipients to) - )) - (if (and (stringp cc) - (not (string-equal cc ""))) - (progn - (insert (format "cc: %s\n" cc)) - (if recipients - (setq recipients (concat recipients "," cc)) - (setq recipients cc) - ))) + (insert header) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (if (null - (let ((mc-pgp-always-sign 'never)) - (mc-pgp-encrypt-region - (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients) - (point-min) (point-max) from nil) - )) - (throw 'mime-editor/error 'pgp-error) - ) + (or (funcall (pgp-function 'encrypt) + recipients (point-min) (point-max) from) + (throw 'mime-edit-error 'pgp-error) + ) (goto-char beg) (insert (format "--[[multipart/encrypted; boundary=\"%s\"; @@ -1726,30 +1740,24 @@ Content-Transfer-Encoding: 7bit (insert (format "\n--%s--\n" pgp-boundary)) ))))) -(defun mime-editor/sign-pgp-kazu (beg end boundary) +(defun mime-edit-sign-pgp-kazu (beg end boundary) (save-excursion (save-restriction (narrow-to-region beg end) (let* ((ret - (mime-editor/translate-region beg end boundary)) + (mime-edit-translate-region beg end boundary)) (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 ret)) - ) + (encoding (nth 1 ret))) (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (or (let ((program-coding-system-alist - (cons (cons (cons nil ".*pgp.*") - (cons *noconv* *noconv*)) - program-coding-system-alist)) - ) - (mc-pgp-sign-region beg (point-max)) - ) - (throw 'mime-editor/error 'pgp-error) + (or (as-binary-process + (funcall (pgp-function 'traditional-sign) + beg (point-max))) + (throw 'mime-edit-error 'pgp-error) ) (goto-char beg) (insert @@ -1757,54 +1765,31 @@ Content-Transfer-Encoding: 7bit )) )) -(defun mime-editor/encrypt-pgp-kazu (beg end boundary) +(defun mime-edit-encrypt-pgp-kazu (beg end boundary) (save-excursion - (let ((from (rfc822/get-field-body "From")) - (to (rfc822/get-field-body "To")) - (cc (rfc822/get-field-body "cc")) - recipients) + (let (recipients header) + (let ((ret (mime-edit-make-encrypt-recipient-header))) + (setq recipients (aref ret 1) + header (aref ret 2)) + ) (save-restriction (narrow-to-region beg end) (let* ((ret - (mime-editor/translate-region beg end boundary)) + (mime-edit-translate-region beg end boundary)) (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 ret)) - ) + (encoding (nth 1 ret))) (goto-char beg) - (if (and (stringp from) - (not (string-equal from ""))) - (insert (format "From: %s\n" from)) - ) - (if (and (stringp to) - (not (string-equal to ""))) - (progn - (insert (format "To: %s\n" to)) - (setq recipients to) - )) - (if (and (stringp cc) - (not (string-equal cc ""))) - (progn - (insert (format "cc: %s\n" cc)) - (if recipients - (setq recipients (concat recipients "," cc)) - (setq recipients cc) - ))) + (insert header) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (or (let ((program-coding-system-alist - (cons (cons (cons nil ".*pgp.*") - (cons *noconv* *noconv*)) - program-coding-system-alist)) - ) - (mc-pgp-encrypt-region - (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients) - beg (point-max)) - ) - (throw 'mime-editor/error 'pgp-error) + (or (as-binary-process + (funcall (pgp-function 'encrypt) + recipients beg (point-max) nil 'maybe) + ) + (throw 'mime-edit-error 'pgp-error) ) (goto-char beg) (insert @@ -1812,17 +1797,28 @@ Content-Transfer-Encoding: 7bit )) ))) -(defun mime-editor/translate-body () +(defsubst replace-space-with-underline (str) + (mapconcat (function + (lambda (arg) + (char-to-string + (if (eq arg ?\ ) + ?_ + arg)))) str "") + ) + +(defun mime-edit-make-boundary () + (concat mime-multipart-boundary "_" + (replace-space-with-underline (current-time-string)) + )) + +(defun mime-edit-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)) - )) + (let ((boundary (mime-edit-make-boundary)) (i 1) ret) - (while (mime-editor/process-multipart-1 + (while (mime-edit-process-multipart-1 (format "%s-%d" boundary i)) (setq i (1+ i)) ) @@ -1843,17 +1839,22 @@ Content-Transfer-Encoding: 7bit (re-search-backward "[^ \t\n]\n" beg t) (forward-char 1)) (point)))) - (setq ret (mime-editor/translate-region + (setq ret (mime-edit-translate-region beg end (format "%s-%d" boundary i))) )) - (mime-editor/dequote-region (point-min)(point-max)) + (mime-edit-dequote-region (point-min)(point-max)) (let ((contype (car ret)) ;Content-Type (encoding (nth 1 ret)) ;Content-Transfer-Encoding ) + ;; Insert X-Emacs field + (and mime-edit-insert-x-emacs-field + (or (mail-position-on-field "X-Emacs") + (insert mime-edit-x-emacs-value) + )) ;; Make primary MIME headers. - (or (mail-position-on-field "Mime-Version") - (insert mime-editor/mime-version-value)) + (or (mail-position-on-field "MIME-Version") + (insert mime-edit-mime-version-value)) ;; Remove old Content-Type and other fields. (save-restriction (goto-char (point-min)) @@ -1871,31 +1872,29 @@ Content-Transfer-Encoding: 7bit (insert encoding))) )))) -(defun mime-editor/translate-single-part-tag (&optional prefix) - (if (re-search-forward mime-editor/single-part-tag-regexp nil t) +(defun mime-edit-translate-single-part-tag (boundary &optional prefix) + "Translate single-part-tag to MIME header." + (if (re-search-forward mime-edit-single-part-tag-regexp nil t) (let* ((beg (match-beginning 0)) (end (match-end 0)) - (tag (buffer-substring beg end)) - ) + (tag (buffer-substring beg end))) (delete-region beg end) - (setq contype (mime-editor/get-contype tag)) - (setq 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) - ) + (let ((contype (mime-edit-get-contype tag)) + (encoding (mime-edit-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")) + (eword-encode-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)))) - ) +(defun mime-edit-translate-region (beg end &optional boundary multipart) + (or boundary + (setq boundary (mime-edit-make-boundary)) + ) (save-excursion (save-restriction (narrow-to-region beg end) @@ -1905,10 +1904,10 @@ Content-Transfer-Encoding: 7bit (nparts 0)) ;Number of body parts ;; Normalize the body part by inserting appropriate message ;; tags for every message contents. - (mime-editor/normalize-body) + (mime-edit-normalize-body) ;; Counting the number of Content-Type. (goto-char (point-min)) - (while (re-search-forward mime-editor/single-part-tag-regexp nil t) + (while (re-search-forward mime-edit-single-part-tag-regexp nil t) (setq nparts (1+ nparts))) ;; Begin translation. (cond @@ -1916,19 +1915,18 @@ Content-Transfer-Encoding: 7bit ;; It's a singular message. (goto-char (point-min)) (while (re-search-forward - mime-editor/single-part-tag-regexp nil t) + mime-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 (mime-editor/get-contype tag)) - (setq encoding (mime-editor/get-encoding tag)) + (setq contype (mime-edit-get-contype tag)) + (setq encoding (mime-edit-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")) - ) + (and (mime-edit-translate-single-part-tag boundary) + (while (mime-edit-translate-single-part-tag boundary "\n"))) ;; Define Content-Type as "multipart/mixed". (setq contype (concat "multipart/mixed;\n boundary=\"" boundary "\"")) @@ -1944,30 +1942,32 @@ Content-Transfer-Encoding: 7bit (list contype encoding boundary nparts) )))) -(defun mime-editor/normalize-body () +(defun mime-edit-normalize-body () "Normalize the body part by inserting appropriate message tags." ;; Insert the first MIME tags if necessary. (goto-char (point-min)) - (if (not (looking-at mime-editor/single-part-tag-regexp)) + (if (not (looking-at mime-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 mime-editor/single-part-tag-regexp nil t) + (while (re-search-forward mime-edit-single-part-tag-regexp nil t) (let* ((tag (buffer-substring (match-beginning 0) (match-end 0))) - (contype (mime-editor/get-contype tag)) + (contype (mime-edit-get-contype tag)) (charset (mime-get-parameter contype "charset")) - (encoding (mime-editor/get-encoding tag))) + (encoding (mime-edit-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)) - ) - (goto-char end) - (or (looking-at mime-editor/beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") + (end (mime-edit-content-end)) ) + (if (= end (point-max)) + nil + (goto-char end) + (or (looking-at mime-edit-beginning-tag-regexp) + (eobp) + (insert (mime-make-text-tag) "\n") + )) (visible-region beg end) (goto-char beg) ) @@ -1978,22 +1978,30 @@ Content-Transfer-Encoding: 7bit ) ((mime-test-content-type contype "text") ;; Define charset for text if necessary. - (setq charset (or charset (mime-editor/choose-charset))) - (mime-editor/define-charset charset) - (cond ((string-equal contype "text/x-rot13-47") + (setq charset (if charset + (intern (downcase charset)) + (mime-edit-choose-charset))) + (mime-edit-define-charset charset) + (cond ((string-equal contype "text/x-rot13-47-48") (save-excursion (forward-line) - (set-mark (point)) - (goto-char (mime-editor/content-end)) - (tm:caesar-region) + (mule-caesar-region (point) (mime-edit-content-end)) )) ((string-equal contype "text/enriched") (save-excursion (let ((beg (progn (forward-line) (point))) - (end (mime-editor/content-end)) + (end (mime-edit-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") @@ -2004,30 +2012,61 @@ Content-Transfer-Encoding: 7bit ;; Define encoding and encode text if necessary. (or encoding ;Encoding is not specified. (let* ((encoding - (cdr - (assoc charset - mime-editor/charset-default-encoding-alist) - )) - (beg (mime-editor/content-beginning)) - ) - (mime-charset-encode-region beg (mime-editor/content-end) + (let (bits conv) + (let ((ret (cdr (assq charset mime-charset-type-list)))) + (if ret + (setq bits (car ret) + conv (nth 1 ret)) + (setq bits 8 + conv "quoted-printable"))) + (if (<= bits mime-transfer-level) + (mime-encoding-name bits) + conv))) + (beg (mime-edit-content-beginning))) + (encode-mime-charset-region beg (mime-edit-content-end) charset) - (mime-encode-region beg (mime-editor/content-end) encoding) - (mime-editor/define-encoding encoding) + ;; Protect "From " in beginning of line + (save-restriction + (narrow-to-region beg (mime-edit-content-end)) + (goto-char beg) + (let (case-fold-search) + (if (re-search-forward "^From " nil t) + (unless encoding + (if (memq charset '(iso-2022-jp + iso-2022-jp-2 + iso-2022-int-1 + x-ctext)) + (while (progn + (replace-match "\e(BFrom ") + (re-search-forward "^From " nil t) + )) + (setq encoding "quoted-printable") + ))))) + ;; canonicalize line break code + (or (member encoding '(nil "7bit" "8bit" "quoted-printable")) + (save-restriction + (narrow-to-region beg (mime-edit-content-end)) + (goto-char beg) + (while (re-search-forward "\\([^\r]\\)\n" nil t) + (replace-match + (concat (buffer-substring (match-beginning 0) + (match-end 1)) "\r\n")) + ))) + (goto-char beg) + (mime-encode-region beg (mime-edit-content-end) encoding) + (mime-edit-define-encoding encoding) )) - (goto-char (mime-editor/content-end)) + (goto-char (mime-edit-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)) - ) + (beg (mime-edit-content-beginning)) + (end (mime-edit-content-end))) (mime-encode-region beg end encoding) - (mime-editor/define-encoding encoding)) + (mime-edit-define-encoding encoding)) (forward-line 1) )) ))) @@ -2048,46 +2087,13 @@ Content-Transfer-Encoding: 7bit ;; 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 - ))))) +(defun mime-edit-voice-recorder-for-sun (encoding) + "Record voice in a buffer using Sun audio device, +and insert data encoded as ENCODING." + (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. @@ -2095,29 +2101,29 @@ a recording host instead of local host." ;; Message forwarding commands as content-type "message/rfc822". -(defun mime-editor/insert-message (&optional message) +(defun mime-edit-insert-message (&optional message) (interactive) - (let ((inserter (assoc-value major-mode mime-editor/message-inserter-alist))) + (let ((inserter (cdr (assq major-mode mime-edit-message-inserter-alist)))) (if (and inserter (fboundp inserter)) (progn - (mime-editor/insert-tag "message" "rfc822") + (mime-edit-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) +(defun mime-edit-insert-mail (&optional message) (interactive) - (let ((inserter (assoc-value major-mode mime-editor/mail-inserter-alist))) + (let ((inserter (cdr (assq major-mode mime-edit-mail-inserter-alist)))) (if (and inserter (fboundp inserter)) (progn - (mime-editor/insert-tag "message" "rfc822") + (mime-edit-insert-tag "message" "rfc822") (funcall inserter message) ) (message "Sorry, I don't have mail inserter for your MUA.") ))) -(defun mime-editor/inserted-message-filter () +(defun mime-edit-inserted-message-filter () (save-excursion (save-restriction (let ((header-start (point)) @@ -2130,9 +2136,9 @@ a recording host instead of local host." ) (goto-char header-start) (while (and (re-search-forward - mime-editor/yank-ignored-field-regexp nil t) + mime-edit-yank-ignored-field-regexp nil t) (setq beg (match-beginning 0)) - (setq end (1+ (rfc822/field-end))) + (setq end (1+ (std11-field-end))) ) (delete-region beg end) ) @@ -2142,152 +2148,158 @@ a recording host instead of local host." ;;; @ multipart enclosure ;;; -(defun mime-editor/enclose-region (type beg end) +(defun mime-edit-enclose-region-internal (type beg end) (save-excursion (goto-char beg) - (let ((current (point))) - (save-restriction - (narrow-to-region beg end) - (insert (format "--<<%s>>-{\n" type)) - (goto-char (point-max)) - (insert (format "--}-<<%s>>\n" type)) - (goto-char (point-max)) + (save-restriction + (narrow-to-region beg end) + (insert (format "--<<%s>>-{\n" type)) + (goto-char (point-max)) + (insert (format "--}-<<%s>>\n" type)) + (goto-char (point-max)) + ) + (or (looking-at mime-edit-beginning-tag-regexp) + (eobp) + (insert (mime-make-text-tag) "\n") ) - (or (looking-at mime-editor/beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - ) - ))) + )) -(defun mime-editor/enclose-quote-region (beg end) +(defun mime-edit-enclose-quote-region (beg end) (interactive "*r") - (mime-editor/enclose-region "quote" beg end) + (mime-edit-enclose-region-internal 'quote beg end) ) -(defun mime-editor/enclose-mixed-region (beg end) +(defun mime-edit-enclose-mixed-region (beg end) (interactive "*r") - (mime-editor/enclose-region "mixed" beg end) + (mime-edit-enclose-region-internal 'mixed beg end) ) -(defun mime-editor/enclose-parallel-region (beg end) +(defun mime-edit-enclose-parallel-region (beg end) (interactive "*r") - (mime-editor/enclose-region "parallel" beg end) + (mime-edit-enclose-region-internal 'parallel beg end) ) -(defun mime-editor/enclose-digest-region (beg end) +(defun mime-edit-enclose-digest-region (beg end) (interactive "*r") - (mime-editor/enclose-region "digest" beg end) + (mime-edit-enclose-region-internal 'digest beg end) ) -(defun mime-editor/enclose-alternative-region (beg end) +(defun mime-edit-enclose-alternative-region (beg end) (interactive "*r") - (mime-editor/enclose-region "alternative" beg end) + (mime-edit-enclose-region-internal 'alternative beg end) ) -(defun mime-editor/enclose-signed-region (beg end) +(defun mime-edit-enclose-pgp-signed-region (beg end) (interactive "*r") - (if mime-editor/signing-type - (mime-editor/enclose-region "signed" beg end) - (message "Please specify signing type.") - )) + (mime-edit-enclose-region-internal 'pgp-signed beg end) + ) -(defun mime-editor/enclose-encrypted-region (beg end) +(defun mime-edit-enclose-pgp-encrypted-region (beg end) (interactive "*r") - (if mime-editor/signing-type - (mime-editor/enclose-region "encrypted" beg end) - (message "Please specify encrypting type.") - )) + (mime-edit-enclose-region-internal 'pgp-encrypted beg end) + ) + +(defun mime-edit-enclose-kazu-signed-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'kazu-signed beg end) + ) -(defun mime-editor/insert-key (&optional arg) +(defun mime-edit-enclose-kazu-encrypted-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'kazu-encrypted beg end) + ) + +(defun mime-edit-insert-key (&optional arg) "Insert a pgp public key." (interactive "P") - (mime-editor/insert-tag "application" "pgp-keys") - (mime-editor/define-encoding "7bit") - (mc-insert-public-key) + (mime-edit-insert-tag "application" "pgp-keys") + (mime-edit-define-encoding "7bit") + (funcall (pgp-function 'insert-key)) ) ;;; @ flag setting ;;; -(defun mime-editor/set-split (arg) +(defun mime-edit-set-split (arg) (interactive (list - (y-or-n-p "Do you want to enable split?") + (y-or-n-p "Do you want to enable split? ") )) - (setq mime-editor/split-message arg) + (setq mime-edit-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) +(defun mime-edit-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) (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-transfer-level transfer-level) + (if (< mime-transfer-level 8) + (setq mime-transfer-level 8) + (setq mime-transfer-level 7) )) - (setq mime-editor/charset-default-encoding-alist - (mime/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)) + mime-transfer-level)) + (setq mime-transfer-level-string + (mime-encoding-name mime-transfer-level 'not-omit)) (force-mode-line-update) ) +(defun mime-edit-set-transfer-level-7bit () + (interactive) + (mime-edit-toggle-transfer-level 7) + ) + +(defun mime-edit-set-transfer-level-8bit () + (interactive) + (mime-edit-toggle-transfer-level 8) + ) + ;;; @ pgp ;;; -(defun mime-editor/set-sign (arg) +(defvar mime-edit-pgp-processing nil) +(make-variable-buffer-local 'mime-edit-pgp-processing) + +(defun mime-edit-set-sign (arg) (interactive (list - (y-or-n-p "Do you want to sign?") + (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.") - ) - (message "Please specify signing type.") + (progn + (setq mime-edit-pgp-processing 'sign) + (message "This message will be signed.") ) - (if (eq mime-editor/pgp-processing 'sign) - (setq mime-editor/pgp-processing nil) + (if (eq mime-edit-pgp-processing 'sign) + (setq mime-edit-pgp-processing nil) ) (message "This message will not be signed.") )) -(defun mime-editor/set-encrypt (arg) +(defun mime-edit-set-encrypt (arg) (interactive (list - (y-or-n-p "Do you want to encrypt?") + (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.") - ) - (message "Please specify encrypting type.") + (progn + (setq mime-edit-pgp-processing 'encrypt) + (message "This message will be encrypt.") ) - (if (eq mime-editor/pgp-processing 'encrypt) - (setq mime-editor/pgp-processing nil) + (if (eq mime-edit-pgp-processing 'encrypt) + (setq mime-edit-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 () +(defun mime-edit-pgp-enclose-buffer () (let ((beg (save-excursion (goto-char (point-min)) (if (search-forward (concat "\n" mail-header-separator "\n")) @@ -2296,11 +2308,11 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (end (point-max)) ) (if beg - (cond ((eq mime-editor/pgp-processing 'sign) - (mime-editor/enclose-signed-region beg end) + (cond ((eq mime-edit-pgp-processing 'sign) + (mime-edit-enclose-pgp-signed-region beg end) ) - ((eq mime-editor/pgp-processing 'encrypt) - (mime-editor/enclose-encrypted-region beg end) + ((eq mime-edit-pgp-processing 'encrypt) + (mime-edit-enclose-pgp-encrypted-region beg end) )) ))) @@ -2308,58 +2320,57 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." ;;; @ split ;;; -(defun mime-editor/insert-partial-header - (fields subject id number total separator) +(defun mime-edit-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 mime-edit-mime-version-field-for-message/partial) (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) +(defun mime-edit-split-and-send + (&optional cmd lines mime-edit-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-length-alist)) - mime-editor/message-default-max-length)) + (or mime-edit-message-max-length + (setq mime-edit-message-max-length + (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) + mime-edit-message-default-max-lines)) ) - (let* ((mime-editor/draft-file-name + (let* ((mime-edit-draft-file-name (or (buffer-file-name) (make-temp-name - (expand-file-name "tm-draft" mime/tmp-dir)))) + (expand-file-name "mime-draft" mime-temp-directory)))) (separator mail-header-separator) - (config - (eval (cdr (assq major-mode mime-editor/window-config-alist)))) (id (concat "\"" (replace-space-with-underline (current-time-string)) "@" (system-name) "\""))) - (run-hooks 'mime-editor/before-split-hook) + (run-hooks 'mime-edit-before-split-hook) (let ((the-buf (current-buffer)) (copy-buf (get-buffer-create " *Original Message*")) - (header (rfc822/get-header-string-except - mime-editor/split-ignored-field-regexp separator)) + (header (std11-header-string-except + mime-edit-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) + (total (+ (/ lines mime-edit-message-max-length) + (if (> (mod lines mime-edit-message-max-length) 0) 1))) (command (or cmd (cdr (assq major-mode - mime-editor/split-message-sender-alist)) - (cdr - (assq major-mode - mime-editor/message-default-sender-alist)) + mime-edit-split-message-sender-alist)) + (function + (lambda () + (interactive) + (error "Split sender is not specified for `%s'." major-mode) + )) )) - (mime-editor/partial-number 1) + (mime-edit-partial-number 1) data) (save-excursion (set-buffer copy-buf) @@ -2373,34 +2384,34 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (narrow-to-region (point-min) he) )) (goto-char (point-min)) - (while (re-search-forward mime-editor/split-blind-field-regexp nil t) + (while (re-search-forward mime-edit-split-blind-field-regexp nil t) (delete-region (match-beginning 0) - (1+ (rfc822/field-end))) + (1+ (std11-field-end))) ))) - (while (< mime-editor/partial-number total) + (while (< mime-edit-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) + (goto-line mime-edit-message-max-length) (point)) )) (delete-region (point-min)(point)) ) - (mime-editor/insert-partial-header - header subject id mime-editor/partial-number total separator) + (mime-edit-insert-partial-header + header subject id mime-edit-partial-number total separator) (insert data) (save-excursion (message (format "Sending %d/%d..." - mime-editor/partial-number total)) + mime-edit-partial-number total)) (call-interactively command) (message (format "Sending %d/%d... done" - mime-editor/partial-number total)) + mime-edit-partial-number total)) ) - (setq mime-editor/partial-number - (1+ mime-editor/partial-number)) + (setq mime-edit-partial-number + (1+ mime-edit-partial-number)) ) (erase-buffer) (save-excursion @@ -2408,36 +2419,38 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (setq data (buffer-string)) (erase-buffer) ) - (mime-editor/insert-partial-header - header subject id mime-editor/partial-number total separator) + (mime-edit-insert-partial-header + header subject id mime-edit-partial-number total separator) (insert data) (save-excursion (message (format "Sending %d/%d..." - mime-editor/partial-number total)) + mime-edit-partial-number total)) (message (format "Sending %d/%d... done" - mime-editor/partial-number total)) + mime-edit-partial-number total)) ) ))) -(defun mime-editor/maybe-split-and-send (&optional cmd) +(defun mime-edit-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-length-alist)) - mime-editor/message-default-max-length)) + (run-hooks 'mime-edit-before-send-hook) + (let ((mime-edit-message-max-length + (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) + mime-edit-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) + (if (and (> lines mime-edit-message-max-length) + mime-edit-split-message) + (mime-edit-split-and-send cmd lines mime-edit-message-max-length) ))) ;;; @ preview message ;;; -(defun mime-editor/preview-message () - "preview editing MIME message. [mime-edit.el]" +(defvar mime-edit-buffer nil) ; buffer local variable + +(defun mime-edit-preview-message () + "preview editing MIME message." (interactive) (let* ((str (buffer-string)) (separator mail-header-separator) @@ -2455,116 +2468,61 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (switch-to-buffer buf) ) (insert str) - (setq major-mode 'mime/temporary-message-mode) + (setq major-mode 'mime-temp-message-mode) (make-local-variable 'mail-header-separator) (setq mail-header-separator separator) - (make-local-variable 'mime/editing-buffer) - (setq mime/editing-buffer the-buf) - - (run-hooks 'mime-editor/translate-hook) - (mime-editor/translate-buffer) + (make-local-variable 'mime-edit-buffer) + (setq mime-edit-buffer the-buf) + + (run-hooks 'mime-edit-translate-hook) + (mime-edit-translate-buffer) (goto-char (point-min)) (if (re-search-forward (concat "^" (regexp-quote separator) "$")) (replace-match "") ) - (mime/viewer-mode) + (mime-view-mode) )) -(defun mime-editor/quitting-method () - (let ((temp mime::preview/article-buffer) +(defun mime-edit-quitting-method () + "Quitting method for mime-view." + (let ((temp mime-raw-buffer) buf) - (mime-viewer/kill-buffer) + (mime-preview-kill-buffer) (set-buffer temp) - (setq buf mime/editing-buffer) + (setq buf mime-edit-buffer) (kill-buffer temp) (switch-to-buffer buf) )) -(set-alist 'mime-viewer/quitting-method-alist - 'mime/temporary-message-mode - (function mime-editor/quitting-method) - ) - - -;;; @ draft preview -;;; -;; by "OKABE Yasuo -;; Mon, 10 Apr 1995 20:03:07 +0900 - -(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 mime-editor/draft-preview () - (interactive) - (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)) - (re-search-forward - (concat "^\\(" (regexp-quote sep) "\\)?$")) - (setq mime::article/draft-header-separator - (buffer-substring (match-beginning 0) (match-end 0))) - (replace-match "") - (mime/viewer-mode (current-buffer)) - (pop-to-buffer (current-buffer)) - )) - -(defun mime-viewer::quitting-method/draft-preview () - (let ((mother mime::preview/mother-buffer)) - (save-excursion - (switch-to-buffer mother) - (goto-char (point-min)) - (if (and - (re-search-forward - (concat "^\\(" - (regexp-quote mime::article/draft-header-separator) - "\\)?$") nil t) - (bolp)) - (progn - (insert mime::article/draft-header-separator) - (set-buffer-modified-p (buffer-modified-p)) - ))) - (mime-viewer/kill-buffer) - (pop-to-buffer mother) - )) - -(set-alist 'mime-viewer/quitting-method-alist - 'mh-letter-mode - (function mime-viewer::quitting-method/draft-preview) - ) - -(set-alist 'mime-viewer/quitting-method-alist - 'news-reply-mode - (function mime-viewer::quitting-method/draft-preview) - ) +(set-alist 'mime-preview-quitting-method-alist + 'mime-temp-message-mode + #'mime-edit-quitting-method) ;;; @ edit again ;;; -(defun mime-editor::edit-again (code-conversion) +(defvar mime-edit-again-ignored-field-regexp + (concat "^\\(" "Content-.*\\|Mime-Version" + (if mime-edit-insert-x-emacs-field "\\|X-Emacs") + "\\):") + "Regexp for deleted header fields when `mime-edit-again' is called.") + +(defun mime-edit-decode-buffer (not-decode-text) (save-excursion (goto-char (point-min)) - (let ((ctl (mime/Content-Type))) + (let ((ctl (mime-read-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) - ) + (let ((type (mime-content-type-primary-type ctl)) + (stype (mime-content-type-subtype ctl)) + (params (mime-content-type-parameters ctl))) (cond - ((string-equal type "multipart") - (let* ((boundary (assoc-value "boundary" params)) + ((and (eq type 'application)(eq stype 'pgp-signature)) + (delete-region (point-min)(point-max)) + ) + ((eq type 'multipart) + (let* ((boundary (cdr (assoc "boundary" params))) (boundary-pat (concat "\n--" (regexp-quote boundary) "[ \t]*\n")) ) @@ -2593,7 +2551,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ) (save-restriction (narrow-to-region beg end) - (mime-editor::edit-again code-conversion) + (mime-edit-decode-buffer not-decode-text) (goto-char (point-max)) )))) )) @@ -2606,20 +2564,30 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ))) )) (t - (let* (charset + (let* ((ctype (format "%s/%s" type stype)) + charset (pstr - (mapconcat (function - (lambda (attr) - (if (string-equal (car attr) - "charset") - (progn - (setq charset (cdr attr)) - "") - (concat ";" (car attr) - "=" (cdr attr)) - ) - )) - params "")) + (let ((bytes (+ 14 (length ctype)))) + (mapconcat (function + (lambda (attr) + (if (string= (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 @@ -2627,12 +2595,12 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" "Content-Transfer-Encoding:" nil t) (let ((beg (match-beginning 0)) (hbeg (match-end 0)) - (end (rfc822/field-end))) + (end (std11-field-end))) (setq encoding (eliminate-top-spaces - (rfc822/unfolding-string + (std11-unfold-string (buffer-substring hbeg end)))) - (if (or charset (string-equal type "text")) + (if (or charset (eq type 'text)) (progn (delete-region beg (1+ end)) (goto-char (point-min)) @@ -2643,13 +2611,11 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (setq encoded t encoding nil) ))))))) - (if (or code-conversion encoded) - (if charset - (mime-charset-decode-region (point-min)(point-max) - charset) - (character-decode-region (point-min)(point-max) - mime/default-coding-system) - )) + (if (or encoded (not not-decode-text)) + (decode-mime-charset-region + (point-min)(point-max) + (or charset default-mime-charset)) + ) (let ((he (if (re-search-forward "^$" nil t) (match-end 0) @@ -2661,44 +2627,47 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (insert (concat "\n" (mime-create-tag - (concat type "/" stype pstr) encoding))) + (format "%s/%s%s" type stype pstr) + encoding))) ) (delete-region (point-min) he) (insert (mime-create-tag - (concat type "/" stype pstr) encoding)) + (format "%s/%s%s" type stype pstr) + encoding)) )) )))) - (if code-conversion - (character-decode-region (point-min) (point-max) - mime/default-coding-system) - ) + (or not-decode-text + (decode-mime-charset-region (point-min) (point-max) + default-mime-charset) + ) )))) -(defun mime/edit-again (&optional code-conversion no-separator no-mode) +(defun mime-edit-again (&optional not-decode-text no-separator not-turn-on) + "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode. +Content-Type and Content-Transfer-Encoding header fields will be +converted to MIME-Edit tags." (interactive) - (mime-editor::edit-again code-conversion) + (goto-char (point-min)) + (if (search-forward + (concat "\n" (regexp-quote mail-header-separator) "\n") + nil t) + (replace-match "\n\n") + ) + (mime-edit-decode-buffer not-decode-text) (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) - )) + (std11-narrow-to-header) (goto-char (point-min)) - (while (re-search-forward - "^\\(Content-.*\\|Mime-Version\\):" nil t) - (delete-region (match-beginning 0) (1+ (rfc822/field-end))) + (while (re-search-forward mime-edit-again-ignored-field-regexp 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) + (or not-turn-on + (turn-on-mime-edit) )) @@ -2706,11 +2675,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ;;; (provide 'mime-edit) -(provide 'tm-edit) -(if (boundp 'mime-edit-load-hook) - (run-hooks 'mime-edit-load-hook) - (run-hooks 'tm-edit-load-hook) - ) +(run-hooks 'mime-edit-load-hook) ;;; mime-edit.el ends here