X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-edit.el;h=0ab79adcad150537eb4babeff046e78f620f7849;hb=refs%2Fheads%2Fakemi;hp=7a9c28daea0b89500dcae0f87d3f63768f396fdf;hpb=a7d9e6b4951949e336100462c16f9022238abcd3;p=elisp%2Fsemi.git diff --git a/mime-edit.el b/mime-edit.el index 7a9c28d..0ab79ad 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -1,16 +1,14 @@ ;;; mime-edit.el --- Simple MIME Composer for GNU Emacs -;; Copyright (C) 1993,1994,1995,1996,1997 Free Software Foundation, Inc. +;; Copyright (C) 1993,94,95,96,97,98,99 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 -;; Version: $Revision: 0.69 $ ;; Keywords: MIME, multimedia, multilingual, mail, news -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). +;; 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 @@ -92,7 +90,7 @@ ;; ;; 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]] @@ -108,58 +106,77 @@ ;;; Code: -(require 'emu) (require 'sendmail) (require 'mail-utils) (require 'mel) (require 'mime-view) -(require 'eword-encode) (require 'signature) (require 'alist) +(require 'invisible) ;;; @ version ;;; -(defconst mime-edit-RCS-ID - "$Id: mime-edit.el,v 0.69 1997-03-07 13:52:44 morioka Exp $") - -(defconst mime-edit-version (get-version-string mime-edit-RCS-ID)) - -(defconst mime-edit-version-name - (concat "SEMI MIME-Edit " mime-edit-version)) +(eval-and-compile + (defconst mime-edit-version + (concat + (mime-product-name mime-user-interface-product) " " + (mapconcat #'number-to-string + (mime-product-version mime-user-interface-product) ".") + " - \"" (mime-product-code-name mime-user-interface-product) "\""))) ;;; @ variables ;;; -(defvar mime-ignore-preceding-spaces nil - "*Ignore preceding white spaces if non-nil.") +(defgroup mime-edit nil + "MIME edit mode" + :group 'mime) -(defvar mime-ignore-trailing-spaces nil - "*Ignore trailing 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-same-text-tag t +(defcustom mime-ignore-trailing-spaces nil + "*Ignore trailing white spaces if non-nil." + :group 'mime-edit + :type 'boolean) + +(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.") +If non-nil, the text tag is not inserted unless something different." + :group 'mime-edit + :type 'boolean) -(defvar mime-auto-hide-body t - "*Hide non-textual body encoded in base64 after insertion if non-nil.") +(defcustom mime-auto-hide-body t + "*Hide non-textual body encoded in base64 after insertion if non-nil." + :group 'mime-edit + :type 'boolean) -(defvar mime-edit-voice-recorder +(defcustom mime-edit-voice-recorder (function mime-edit-voice-recorder-for-sun) - "*Function to record a voice message and encode it. [mime-edit.el]") + "*Function to record a voice message and encode it." + :group 'mime-edit + :type 'function) -(defvar mime-edit-mode-hook nil - "*Hook called when enter MIME mode.") +(defcustom mime-edit-mode-hook nil + "*Hook called when enter MIME mode." + :group 'mime-edit + :type 'hook) -(defvar mime-edit-translate-hook nil +(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-edit-insert-signature' from this hook.") +`mime-edit-insert-signature' from this hook." + :group 'mime-edit + :type 'hook) -(defvar mime-edit-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" @@ -168,19 +185,12 @@ To insert a signature file automatically, call the function ("plain" ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") ) - ("richtext" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("enriched" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("x-latex" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("html" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("x-rot13-47") + ("enriched") + ("html") + ("css") ; rfc2318 + ("xml") ; rfc2376 + ("x-latex") + ("x-rot13-47-48") ) ("message" ("external-body" @@ -198,17 +208,23 @@ To insert a signature file automatically, call the function ("tftp" ("site") ("name")) ("afs" ("site") ("name")) ("local-file" ("site") ("name")) - ("mail-server" ("server" "ftpmail@nic.karrn.ad.jp")) + ("mail-server" + ("server" "ftpmail@nic.karrn.ad.jp") + ("subject")) + ("url" ("url")) )) ("rfc822") + ("news") ) ("application" ("octet-stream" ("type" "" "tar" "shar")) ("postscript") + ("vnd.ms-powerpoint") ("x-kiss" ("x-cnf"))) ("image" ("gif") ("jpeg") + ("png") ("tiff") ("x-pic") ("x-mag") @@ -220,20 +236,93 @@ To insert a signature file automatically, call the function ) "*Alist of content-type, subtype, parameters and its values.") -(defvar mime-file-types - '(("\\.rtf$" - "text" "richtext" nil +(defcustom mime-file-types + '( + + ;; Programming languages + + ("\\.cc$" + "application" "octet-stream" (("type" . "C++")) + "7bit" + "attachment" (("filename" . file)) + ) + + ("\\.el$" + "application" "octet-stream" (("type" . "emacs-lisp")) + "7bit" + "attachment" (("filename" . file)) + ) + + ("\\.lsp$" + "application" "octet-stream" (("type" . "common-lisp")) + "7bit" + "attachment" (("filename" . file)) + ) + + ("\\.pl$" + "application" "octet-stream" (("type" . "perl")) + "7bit" + "attachment" (("filename" . file)) + ) + + ;; Text or translated text + + ("\\.txt$" + "text" "plain" nil nil - nil nil) + "inline" (("filename" . file)) + ) + + ;; .rc : procmail modules pm-xxxx.rc + ;; *rc : other resource files + + ("\\.\\(rc\\|lst\\|log\\|sql\\|mak\\)$\\|\\..*rc$" + "text" "plain" nil + nil + "attachment" (("filename" . file)) + ) + ("\\.html$" "text" "html" nil nil nil nil) + + ("\\.diff$\\|\\.patch$" + "application" "octet-stream" (("type" . "patch")) + nil + "attachment" (("filename" . file)) + ) + + ("\\.signature" + "text" "plain" nil nil nil nil) + + + ;; Octect binary text + + ("\\.doc$" ;MS Word + "application" "winword" nil + "base64" + "attachment" (("filename" . file)) + ) + ("\\.ppt$" ; MS Power Point + "application" "vnd.ms-powerpoint" nil + "base64" + "attachment" (("filename" . file)) + ) + + ("\\.pln$" + "text" "plain" nil + nil + "inline" (("filename" . file)) + ) ("\\.ps$" "application" "postscript" nil "quoted-printable" "attachment" (("filename" . file)) ) + + ;; Pure binary + ("\\.jpg$" "image" "jpeg" nil "base64" @@ -244,6 +333,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" @@ -279,16 +373,6 @@ To insert a signature file automatically, call the function "base64" "attachment" (("filename" . file)) ) - ("\\.el$" - "application" "octet-stream" (("type" . "emacs-lisp")) - "7bit" - "attachment" (("filename" . file)) - ) - ("\\.lsp$" - "application" "octet-stream" (("type" . "common-lisp")) - "7bit" - "attachment" (("filename" . file)) - ) ("\\.tar\\.gz$" "application" "octet-stream" (("type" . "tar+gzip")) "base64" @@ -329,26 +413,58 @@ To insert a signature file automatically, call the function "base64" "attachment" (("filename" . file)) ) - ("\\.diff$" - "application" "octet-stream" (("type" . "patch")) - nil - "attachment" (("filename" . file)) - ) - ("\\.patch$" - "application" "octet-stream" (("type" . "patch")) - nil - "attachment" (("filename" . file)) - ) - ("\\.signature" - "text" "plain" nil nil) + + ;; Rest + (".*" "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 cell) + ) + (mime-encoding-list)))) + ;; 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 @@ -368,10 +484,12 @@ If encoding is nil, it is determined from its contents.") (iso-2022-jp 7 "base64") (iso-2022-kr 7 "base64") (euc-kr 8 "base64") - (cn-gb2312 8 "quoted-printable") + (cn-gb 8 "base64") + (gb2312 8 "base64") (cn-big5 8 "base64") - (gb2312 8 "quoted-printable") (big5 8 "base64") + (shift_jis 8 "base64") + (tis-620 8 "base64") (iso-2022-jp-2 7 "base64") (iso-2022-int-1 7 "base64") )) @@ -391,23 +509,16 @@ If encoding is nil, it is determined from its contents.") "A string formatted version of mime-transfer-level") (make-variable-buffer-local 'mime-transfer-level-string) -(defun mime-make-charset-default-encoding-alist (transfer-level) - (mapcar (function - (lambda (charset-type) - (let ((charset (car charset-type)) - (type (nth 1 charset-type)) - (encoding (nth 2 charset-type)) - ) - (if (<= type transfer-level) - (cons charset (mime-encoding-name type)) - (cons charset encoding) - )))) - mime-charset-type-list)) +(defvar mime-edit-use-long-mime-charset-comment t + "*Use charset comment") -(defvar mime-edit-charset-default-encoding-alist - (mime-make-charset-default-encoding-alist mime-transfer-level)) -(make-variable-buffer-local 'mime-edit-charset-default-encoding-alist) +(put 'iso-2022-jp-2 'mime-charset-comment "RFC1554") +(put 'iso-2022-jp 'mime-charset-comment "RFC1468 with trivial bugfix") +;;; @@ about content transfer encoding + +(defvar mime-content-transfer-encoding-priority-list + '(nil "8bit" "binary")) ;;; @@ about message inserting ;;; @@ -417,7 +528,7 @@ If encoding is nil, it is determined from its contents.") "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-edit-yank-ignored-field-regexp (concat "^" @@ -431,39 +542,38 @@ Each elements are regexp of field-name. [mime-edit.el]") ;;; @@ about message splitting ;;; -(defvar mime-edit-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-edit-message-default-max-lines 1000 - "*Default maximum lines 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-edit-message-max-lines-alist +(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. [mime-edit.el]") +`mime-edit-message-default-max-lines' is used." + :group 'mime-edit + :type 'list) (defconst mime-edit-split-ignored-field-regexp - "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)") + "\\(^Content-\\|^Subject:\\|^Mime-Version:\\|^Message-Id:\\)") -(defvar mime-edit-split-blind-field-regexp - "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") +(defcustom mime-edit-split-blind-field-regexp + "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)" + "*Regular expression to match field-name to be ignored when split sending." + :group 'mime-edit + :type 'regexp) (defvar mime-edit-split-message-sender-alist nil) (defvar mime-edit-news-reply-mode-server-running nil) -;;; @@ about PGP -;;; - -(defvar mime-edit-signing-type 'pgp-elkins - "*PGP signing type (pgp-elkins, pgp-kazu or nil). [mime-edit.el]") - -(defvar mime-edit-encrypting-type 'pgp-elkins - "*PGP encrypting type (pgp-elkins, pgp-kazu or nil). [mime-edit.el]") - - ;;; @@ about tag ;;; @@ -508,21 +618,63 @@ If it is not specified for a major-mode, ;;; @@ optional header fields ;;; -(defvar mime-edit-insert-x-emacs-field t - "*If non-nil, insert X-Emacs header field.") - -(defvar mime-edit-x-emacs-value - (if running-xemacs - (concat emacs-version +(defvar mime-edit-insert-user-agent-field t + "*If non-nil, insert User-Agent header field.") + +(defvar mime-edit-user-agent-value + (concat (mime-product-name mime-user-interface-product) + "/" + (mapconcat #'number-to-string + (mime-product-version mime-user-interface-product) ".") + " (" + (mime-product-code-name mime-user-interface-product) + ") " + (mime-product-name mime-library-product) + "/" + (mapconcat #'number-to-string + (mime-product-version mime-library-product) ".") + " (" + (mime-product-code-name mime-library-product) + ") " + (if (featurep 'xemacs) + (concat (if (featurep 'mule) "MULE") + " XEmacs" + (if (string-match "\\s +\\\"" emacs-version) + (concat "/" + (substring emacs-version 0 + (match-beginning 0)) + (if (and (boundp 'xemacs-betaname) + ;; It does not exist in XEmacs + ;; versions prior to 20.3. + xemacs-betaname) + (concat " " xemacs-betaname) + "") + " (" xemacs-codename ") (" + system-configuration ")") + " (" emacs-version ")")) + (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) + (substring emacs-version 0 (match-beginning 0)) + 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) - (concat "Emacs " ver ", MULE " mule-version) - ver)))) + (if (boundp 'enable-multibyte-characters) + (concat "Emacs/" ver + " (" system-configuration ")" + (if enable-multibyte-characters + (concat " MULE/" mule-version) + " (with unibyte mode)") + (if (featurep 'meadow) + (let ((mver (Meadow-version))) + (if (string-match "^Meadow-" mver) + (concat " Meadow/" + (substring mver + (match-end 0))) + )))) + (concat "MULE/" mule-version + " (based on Emacs " ver ")")) + (concat "Emacs/" ver " (" system-configuration ")"))))) + "Body of User-Agent field. +If variable `mime-edit-insert-user-agent-field' is not nil, it is +inserted into message header.") ;;; @ constants @@ -533,9 +685,15 @@ If it is not specified for a major-mode, Tspecials means any character that matches with it in header must be quoted.") (defconst mime-edit-mime-version-value - (concat "1.0 (generated by " mime-edit-version-name ")") + (eval-when-compile + (concat "1.0 (generated by " mime-edit-version ")")) "MIME version number.") +(defconst mime-edit-mime-version-field-for-message/partial + (eval-when-compile + (concat "MIME-Version: 1.0 (split by " mime-edit-version ")\n")) + "MIME version field for message/partial.") + ;;; @ keymap and menu ;;; @@ -543,37 +701,59 @@ Tspecials means any character that matches with it in header must be quoted.") (defvar mime-edit-mode-flag nil) (make-variable-buffer-local 'mime-edit-mode-flag) -(defvar mime-edit-prefix "\C-c\C-x" - "*Keymap prefix for MIME-Edit commands.") - -(defvar mime-edit-map (make-sparse-keymap) - "Keymap for MIME commands.") - -(define-key mime-edit-map "\C-t" 'mime-edit-insert-text) -(define-key mime-edit-map "\C-i" 'mime-edit-insert-file) -(define-key mime-edit-map "\C-e" 'mime-edit-insert-external) -(define-key mime-edit-map "\C-v" 'mime-edit-insert-voice) -(define-key mime-edit-map "\C-y" 'mime-edit-insert-message) -(define-key mime-edit-map "\C-m" 'mime-edit-insert-mail) -(define-key mime-edit-map "\C-w" 'mime-edit-insert-signature) -(define-key mime-edit-map "\C-s" 'mime-edit-insert-signature) -(define-key mime-edit-map "\C-k" 'mime-edit-insert-key) -(define-key mime-edit-map "t" 'mime-edit-insert-tag) -(define-key mime-edit-map "a" 'mime-edit-enclose-alternative-region) -(define-key mime-edit-map "p" 'mime-edit-enclose-parallel-region) -(define-key mime-edit-map "m" 'mime-edit-enclose-mixed-region) -(define-key mime-edit-map "d" 'mime-edit-enclose-digest-region) -(define-key mime-edit-map "s" 'mime-edit-enclose-signed-region) -(define-key mime-edit-map "e" 'mime-edit-enclose-encrypted-region) -(define-key mime-edit-map "q" 'mime-edit-enclose-quote-region) -(define-key mime-edit-map "7" 'mime-edit-set-transfer-level-7bit) -(define-key mime-edit-map "8" 'mime-edit-set-transfer-level-8bit) -(define-key mime-edit-map "/" 'mime-edit-set-split) -(define-key mime-edit-map "v" 'mime-edit-set-sign) -(define-key mime-edit-map "h" 'mime-edit-set-encrypt) -(define-key mime-edit-map "\C-p" 'mime-edit-preview-message) -(define-key mime-edit-map "\C-z" 'mime-edit-exit) -(define-key mime-edit-map "?" 'mime-edit-help) +(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") @@ -592,8 +772,8 @@ Tspecials means any character that matches with it in header must be quoted.") (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-signed-region) - (encrypted "Enclose as encrypted" mime-edit-enclose-encrypted-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) @@ -604,15 +784,11 @@ Tspecials means any character that matches with it in header must be quoted.") ) "MIME-edit menubar entry.") -(defvar mime-edit-mode-map (make-sparse-keymap) - "Keymap for MIME-Edit mode commands.") -(define-key mime-edit-mode-map mime-edit-prefix mime-edit-map) - -(cond (running-xemacs +(cond ((featurep '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." + "Define menu for XEmacs." (cond ((featurep 'menubar) (make-local-variable 'current-menubar) (set-buffer-menubar current-menubar) @@ -626,7 +802,7 @@ Tspecials means any character that matches with it in header must be quoted.") )) 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) @@ -654,26 +830,12 @@ Tspecials means any character that matches with it in header must be quoted.") ) )) -(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) - )) - ;;; @ functions ;;; +(defvar mime-edit-touched-flag nil) + ;;;###autoload (defun mime-edit-mode () "MIME minor mode for editing the tagged MIME message. @@ -729,24 +891,27 @@ Following commands are available in addition to major mode commands: \\[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-signed-region] enclose as PGP signed. -\\[mime-edit-enclose-encrypted-region] enclose as PGP encrypted. -\\[mime-edit-enclose-quote-region] enclose as verbose mode (to avoid to expand tags) +\\[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. +\\[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. @@ -809,14 +974,31 @@ User customizable variables (not documented all of them): (interactive) (if mime-edit-mode-flag (mime-edit-exit) - (if (and (boundp 'mime-edit-touched-flag) - mime-edit-touched-flag) + (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 ((featurep '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." @@ -824,20 +1006,20 @@ User customizable variables (not documented all of them): (if mime-edit-mode-flag (error "You are already editing a MIME message.") (setq mime-edit-mode-flag t) - + ;; Set transfer level into mode line ;; (setq mime-transfer-level-string (mime-encoding-name mime-transfer-level 'not-omit)) (force-mode-line-update) - + ;; Define menu for XEmacs. - (if running-xemacs + (if (featurep 'xemacs) (mime-edit-define-menu-for-xemacs) ) - + (enable-invisible) - + ;; I don't care about saving these. (setq paragraph-start (regexp-or mime-edit-single-part-tag-regexp @@ -854,6 +1036,7 @@ User customizable variables (not documented all of them): ;;;###autoload (defalias 'edit-mime 'turn-on-mime-edit) ; for convenience + (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 @@ -869,7 +1052,7 @@ just return to previous mode." (mime-edit-translate-buffer))) ;; Restore previous state. (setq mime-edit-mode-flag nil) - (if (and running-xemacs + (if (and (featurep 'xemacs) (featurep 'menubar)) (delete-menu-item (list mime-edit-menu-title)) ) @@ -893,26 +1076,26 @@ just return to previous mode." (princ (documentation 'mime-edit-mode)) (print-help-return-message))) -(defun mime-edit-insert-text () +(defun mime-edit-insert-text (&optional subtype) "Insert a text message. -Charset is automatically obtained from the `charsets-mime-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) - (let ((ret (mime-edit-insert-tag "text" nil nil))) - (if ret - (progn - (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 (second ret) '("enriched" "richtext")) - (fboundp 'enriched-mode) - ) - (enriched-mode t) - (if (boundp 'enriched-mode) - (enriched-mode nil) - )))))) + (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")) + (fboundp 'enriched-mode)) + (enriched-mode t) + (if (boundp 'enriched-mode) + (enriched-mode -1) + )) + ))) (defun mime-edit-insert-file (file &optional verbose) "Insert a message from a file." @@ -994,7 +1177,7 @@ Charset is automatically obtained from the `charsets-mime-charset-alist'." (let ((encoding (completing-read "What transfer encoding: " - mime-file-encoding-method-alist nil t nil))) + (mime-encoding-alist) nil t nil))) (mime-edit-insert-tag "audio" "basic" nil) (mime-edit-define-encoding encoding) (save-restriction @@ -1013,8 +1196,9 @@ Charset is automatically obtained from the `charsets-mime-charset-alist'." (let ((signature-insert-hook (function (lambda () - (apply (function mime-edit-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) @@ -1121,7 +1305,7 @@ Optional argument ENCODING specifies an encoding method such as base64." (defun mime-edit-goto-tag () "Search for the beginning of the tagged MIME message." - (let ((current (point)) multipart) + (let ((current (point))) (if (looking-at mime-edit-tag-regexp) t ;; At first, go to the end. @@ -1131,7 +1315,7 @@ Optional argument ENCODING specifies an encoding method such as base64." (t (goto-char (point-max)) )) - ;; Then search for the beginning. + ;; 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. @@ -1166,26 +1350,25 @@ Optional argument ENCODING specifies an encoding method such as base64." (defun mime-edit-content-end () "Return the point of the end of content." (save-excursion - (let ((beg (point))) - (if (mime-edit-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-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)) - ))) + (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-edit-define-charset (charset) "Set charset of current tag to CHARSET." @@ -1197,7 +1380,11 @@ Optional argument ENCODING specifies an encoding method such as base64." (mime-create-tag (mime-edit-set-parameter (mime-edit-get-contype tag) - "charset" (upcase (symbol-name charset))) + "charset" + (let ((comment (get charset 'mime-charset-comment))) + (if (and mime-edit-use-long-mime-charset-comment comment) + (concat (upcase (symbol-name charset)) " (" comment ")") + (upcase (symbol-name charset))))) (mime-edit-get-encoding tag))) )))) @@ -1417,13 +1604,13 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." )) (defun mime-prompt-for-encoding (default) - "Ask for Content-Transfer-Encoding. [mime-edit.el]" + "Ask for Content-Transfer-Encoding." (let (encoding) (while (string= (setq encoding (completing-read "What transfer encoding: " - mime-file-encoding-method-alist nil t default) + (mime-encoding-alist) nil t default) ) "")) encoding)) @@ -1461,21 +1648,17 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (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-edit-multipart-beginning-regexp nil t) - (let (ret) + (progn (narrow-to-region (match-beginning 0)(point-max)) (mime-edit-find-inmost) ) @@ -1508,21 +1691,18 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (cond ((string-equal type "quote") (mime-edit-enquote-region bb eb) ) - ((string-equal type "signed") - (cond ((eq mime-edit-signing-type 'pgp-elkins) - (mime-edit-sign-pgp-elkins bb eb boundary) - ) - ((eq mime-edit-signing-type 'pgp-kazu) - (mime-edit-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-edit-encrypting-type 'pgp-elkins) - (mime-edit-encrypt-pgp-elkins bb eb boundary) - ) - ((eq mime-edit-encrypting-type 'pgp-kazu) - (mime-edit-encrypt-pgp-kazu bb eb boundary) - ))) (t (setq boundary (nth 2 (mime-edit-translate-region bb eb @@ -1556,7 +1736,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (replace-match (concat "-" (substring tag 2))) ))))) -(defun mime-edit-sign-pgp-elkins (beg end boundary) +(defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction (narrow-to-region beg end) @@ -1564,17 +1744,16 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (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 (funcall (pgp-function 'mime-sign) - (point-min)(point-max) nil nil pgp-boundary) + (or (as-binary-process + (funcall (pgp-function 'mime-sign) + (point-min)(point-max) nil nil pgp-boundary)) (throw 'mime-edit-error 'pgp-error) ) )))) @@ -1613,7 +1792,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (vector from recipients header) )) -(defun mime-edit-encrypt-pgp-elkins (beg end boundary) +(defun mime-edit-encrypt-pgp-mime (beg end boundary) (save-excursion (save-restriction (let (from recipients header) @@ -1627,9 +1806,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (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) (insert header) (insert (format "Content-Type: %s\n" ctype)) @@ -1664,9 +1841,7 @@ Content-Transfer-Encoding: 7bit (let* ((ret (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 @@ -1686,10 +1861,9 @@ Content-Transfer-Encoding: 7bit (defun mime-edit-encrypt-pgp-kazu (beg end boundary) (save-excursion - (let (from recipients header) + (let (recipients header) (let ((ret (mime-edit-make-encrypt-recipient-header))) - (setq from (aref ret 0) - recipients (aref ret 1) + (setq recipients (aref ret 1) header (aref ret 2)) ) (save-restriction @@ -1697,9 +1871,7 @@ Content-Transfer-Encoding: 7bit (let* ((ret (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 header) (insert (format "Content-Type: %s\n" ctype)) @@ -1769,13 +1941,13 @@ Content-Transfer-Encoding: 7bit (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) + ;; Insert User-Agent field + (and mime-edit-insert-user-agent-field + (or (mail-position-on-field "User-Agent") + (insert mime-edit-user-agent-value) )) ;; Make primary MIME headers. - (or (mail-position-on-field "Mime-Version") + (or (mail-position-on-field "MIME-Version") (insert mime-edit-mime-version-value)) ;; Remove old Content-Type and other fields. (save-restriction @@ -1794,24 +1966,28 @@ Content-Transfer-Encoding: 7bit (insert encoding))) )))) -(defun mime-edit-translate-single-part-tag (&optional prefix) +(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-edit-get-contype tag)) - (setq 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))) + (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) + ) + (cons (and contype + (downcase contype)) + (and encoding + (downcase encoding)))) + ))) (defun mime-edit-translate-region (beg end &optional boundary multipart) (or boundary @@ -1847,23 +2023,26 @@ Content-Transfer-Encoding: 7bit (t ;; It's a multipart message. (goto-char (point-min)) - (and (mime-edit-translate-single-part-tag) - (while (mime-edit-translate-single-part-tag "\n")) - ) - ;; Define Content-Type as "multipart/mixed". - (setq contype - (concat "multipart/mixed;\n boundary=\"" boundary "\"")) - ;; Content-Transfer-Encoding must be "7bit". - ;; The following encoding can be `nil', but is - ;; specified as is since there is no way that a user - ;; specifies it. - (setq encoding "7bit") - ;; Insert the trailer. - (goto-char (point-max)) - (insert "\n--" boundary "--\n") - )) - (list contype encoding boundary nparts) - )))) + (let ((prio mime-content-transfer-encoding-priority-list) + part-info nprio) + (when (setq part-info + (mime-edit-translate-single-part-tag boundary)) + (and (setq nprio (member (cdr part-info) prio)) + (setq prio nprio)) + (while (setq part-info + (mime-edit-translate-single-part-tag boundary "\n")) + (and (setq nprio (member (cdr part-info) prio)) + (setq prio nprio)))) + ;; Define Content-Type as "multipart/mixed". + (setq contype + (concat "multipart/mixed;\n boundary=\"" boundary "\"")) + (setq encoding (car prio)) + ;; Insert the trailer. + (goto-char (point-max)) + (insert "\n--" boundary "--\n") + ))) + (list contype encoding boundary nparts) + )))) (defun mime-edit-normalize-body () "Normalize the body part by inserting appropriate message tags." @@ -1905,12 +2084,10 @@ Content-Transfer-Encoding: 7bit (intern (downcase charset)) (mime-edit-choose-charset))) (mime-edit-define-charset charset) - (cond ((string-equal contype "text/x-rot13-47") + (cond ((string-equal contype "text/x-rot13-47-48") (save-excursion (forward-line) - (set-mark (point)) - (goto-char (mime-edit-content-end)) - (tm:caesar-region) + (mule-caesar-region (point) (mime-edit-content-end)) )) ((string-equal contype "text/enriched") (save-excursion @@ -1927,7 +2104,7 @@ Content-Transfer-Encoding: 7bit ;; (point) ;; 'hard t))) ;; End patch for hard newlines - (enriched-encode beg end) + (enriched-encode beg end nil) (goto-char beg) (if (search-forward "\n\n") (delete-region beg (match-end 0)) @@ -1937,15 +2114,46 @@ Content-Transfer-Encoding: 7bit ;; Define encoding and encode text if necessary. (or encoding ;Encoding is not specified. (let* ((encoding - (cdr - (assq charset - mime-edit-charset-default-encoding-alist) - )) - (beg (mime-edit-content-beginning)) - ) + (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-edit-content-end) 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 "\\1\r\n")))) + (goto-char beg) + (mime-encode-region beg (mime-edit-content-end) + (or encoding "7bit")) (mime-edit-define-encoding encoding) )) (goto-char (mime-edit-content-end)) @@ -1956,9 +2164,7 @@ Content-Transfer-Encoding: 7bit ;; encoded. (let* ((encoding "base64") ;Encode in BASE64 by default. (beg (mime-edit-content-beginning)) - (end (mime-edit-content-end)) - (body (buffer-substring beg end)) - ) + (end (mime-edit-content-end))) (mime-encode-region beg end encoding) (mime-edit-define-encoding encoding)) (forward-line 1) @@ -1971,8 +2177,7 @@ Content-Transfer-Encoding: 7bit (goto-char (point-min)) (while (re-search-forward regexp nil t) (delete-region (match-beginning 0) - (progn (forward-line 1) (point))) - ))) + (1+ (std11-field-end)))))) ;;; @@ -1983,7 +2188,7 @@ Content-Transfer-Encoding: 7bit (defun mime-edit-voice-recorder-for-sun (encoding) "Record voice in a buffer using Sun audio device, -and insert data encoded as ENCODING. [mime-edit.el]" +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) @@ -2042,61 +2247,66 @@ and insert data encoded as ENCODING. [mime-edit.el]" ;;; @ multipart enclosure ;;; -(defun mime-edit-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-edit-beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - ) - ))) + )) (defun mime-edit-enclose-quote-region (beg end) (interactive "*r") - (mime-edit-enclose-region "quote" beg end) + (mime-edit-enclose-region-internal 'quote beg end) ) (defun mime-edit-enclose-mixed-region (beg end) (interactive "*r") - (mime-edit-enclose-region "mixed" beg end) + (mime-edit-enclose-region-internal 'mixed beg end) ) (defun mime-edit-enclose-parallel-region (beg end) (interactive "*r") - (mime-edit-enclose-region "parallel" beg end) + (mime-edit-enclose-region-internal 'parallel beg end) ) (defun mime-edit-enclose-digest-region (beg end) (interactive "*r") - (mime-edit-enclose-region "digest" beg end) + (mime-edit-enclose-region-internal 'digest beg end) ) (defun mime-edit-enclose-alternative-region (beg end) (interactive "*r") - (mime-edit-enclose-region "alternative" beg end) + (mime-edit-enclose-region-internal 'alternative beg end) ) -(defun mime-edit-enclose-signed-region (beg end) +(defun mime-edit-enclose-pgp-signed-region (beg end) (interactive "*r") - (if mime-edit-signing-type - (mime-edit-enclose-region "signed" beg end) - (message "Please specify signing type.") - )) + (mime-edit-enclose-region-internal 'pgp-signed beg end) + ) -(defun mime-edit-enclose-encrypted-region (beg end) +(defun mime-edit-enclose-pgp-encrypted-region (beg end) (interactive "*r") - (if mime-edit-signing-type - (mime-edit-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-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." @@ -2113,7 +2323,7 @@ and insert data encoded as ENCODING. [mime-edit.el]" (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-edit-split-message arg) (if arg @@ -2132,8 +2342,6 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (setq mime-transfer-level 8) (setq mime-transfer-level 7) )) - (setq mime-edit-charset-default-encoding-alist - (mime-make-charset-default-encoding-alist mime-transfer-level)) (message (format "Current transfer-level is %d bit" mime-transfer-level)) (setq mime-transfer-level-string @@ -2155,18 +2363,18 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." ;;; @ pgp ;;; +(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-edit-signing-type - (progn - (setq mime-edit-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-edit-pgp-processing 'sign) (setq mime-edit-pgp-processing nil) @@ -2177,15 +2385,12 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (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-edit-encrypting-type - (progn - (setq mime-edit-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-edit-pgp-processing 'encrypt) (setq mime-edit-pgp-processing nil) @@ -2193,9 +2398,6 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (message "This message will not be encrypt.") )) -(defvar mime-edit-pgp-processing nil) -(make-variable-buffer-local 'mime-edit-pgp-processing) - (defun mime-edit-pgp-enclose-buffer () (let ((beg (save-excursion (goto-char (point-min)) @@ -2206,10 +2408,10 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." ) (if beg (cond ((eq mime-edit-pgp-processing 'sign) - (mime-edit-enclose-signed-region beg end) + (mime-edit-enclose-pgp-signed-region beg end) ) ((eq mime-edit-pgp-processing 'encrypt) - (mime-edit-enclose-encrypted-region beg end) + (mime-edit-enclose-pgp-encrypted-region beg end) )) ))) @@ -2217,12 +2419,11 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." ;;; @ split ;;; -(defun mime-edit-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-edit-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)) @@ -2240,10 +2441,10 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) mime-edit-message-default-max-lines)) ) - (let* ((mime-edit-draft-file-name + (let* ((mime-edit-draft-file-name (or (buffer-file-name) (make-temp-name - (expand-file-name "mime-draft" mime-temp-directory)))) + (expand-file-name "mime-draft" temporary-file-directory)))) (separator mail-header-separator) (id (concat "\"" (replace-space-with-underline (current-time-string)) @@ -2348,7 +2549,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (defvar mime-edit-buffer nil) ; buffer local variable (defun mime-edit-preview-message () - "preview editing MIME message. [mime-edit.el]" + "preview editing MIME message." (interactive) (let* ((str (buffer-string)) (separator mail-header-separator) @@ -2371,7 +2572,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (setq mail-header-separator separator) (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)) @@ -2379,23 +2580,23 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (concat "^" (regexp-quote separator) "$")) (replace-match "") ) - (mime-view-mode) + (mime-view-buffer) )) (defun mime-edit-quitting-method () - (let ((temp mime::preview/article-buffer) + "Quitting method for mime-view." + (let ((temp mime-raw-buffer) buf) - (mime-view-kill-buffer) + (mime-preview-kill-buffer) (set-buffer temp) (setq buf mime-edit-buffer) (kill-buffer temp) (switch-to-buffer buf) )) -(set-alist 'mime-view-quitting-method-alist +(set-alist 'mime-preview-quitting-method-alist 'mime-temp-message-mode - (function mime-edit-quitting-method) - ) + #'mime-edit-quitting-method) ;;; @ edit again @@ -2403,148 +2604,181 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (defvar mime-edit-again-ignored-field-regexp (concat "^\\(" "Content-.*\\|Mime-Version" - (if mime-edit-insert-x-emacs-field "\\|X-Emacs") + (if mime-edit-insert-user-agent-field "\\|User-Agent") "\\):") "Regexp for deleted header fields when `mime-edit-again' is called.") -(defun mime-editor::edit-again (code-conversion) +(defsubst eliminate-top-spaces (string) + "Eliminate top sequence of space or tab in STRING." + (if (string-match "^[ \t]+" string) + (substring string (match-end 0)) + string)) + +(defun mime-edit-decode-multipart-in-buffer (content-type not-decode-text) + (let* ((subtype (mime-content-type-subtype content-type)) + (boundary (mime-content-type-parameter content-type "boundary")) + (boundary-pat (concat "\n--" (regexp-quote boundary) "[ \t]*\n"))) + (re-search-forward boundary-pat nil t) + (let ((bb (match-beginning 0)) eb tag) + (setq tag (format "\n--<<%s>>-{\n" subtype)) + (goto-char bb) + (insert tag) + (setq bb (+ bb (length tag))) + (re-search-forward + (concat "\n--" (regexp-quote boundary) "--[ \t]*\n") + nil t) + (setq eb (match-beginning 0)) + (replace-match (format "--}-<<%s>>\n" subtype)) + (save-restriction + (narrow-to-region bb eb) + (goto-char (point-min)) + (while (re-search-forward boundary-pat nil t) + (let ((beg (match-beginning 0)) + end) + (delete-region beg (match-end 0)) + (save-excursion + (if (re-search-forward boundary-pat nil t) + (setq end (match-beginning 0)) + (setq end (point-max)) + ) + (save-restriction + (narrow-to-region beg end) + (mime-edit-decode-message-in-buffer + (if (eq subtype 'digest) + (eval-when-compile + (make-mime-content-type 'message 'rfc822)) + ) + not-decode-text) + (goto-char (point-max)) + )))) + )) + (goto-char (point-min)) + (or (= (point-min) 1) + (delete-region (point-min) + (if (search-forward "\n\n" nil t) + (match-end 0) + (point-min) + ))) + )) + +(defun mime-edit-decode-single-part-in-buffer (content-type not-decode-text) + (let* ((type (mime-content-type-primary-type content-type)) + (subtype (mime-content-type-subtype content-type)) + (ctype (format "%s/%s" type subtype)) + charset + (pstr (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) + ) + )))) + (mime-content-type-parameters content-type) ""))) + encoding + encoded + (limit (save-excursion + (if (search-forward "\n\n" nil t) + (1- (point)))))) + (save-excursion + (if (re-search-forward + "^Content-Transfer-Encoding:" limit t) + (let ((beg (match-beginning 0)) + (hbeg (match-end 0)) + (end (std11-field-end limit))) + (setq encoding + (downcase + (eliminate-top-spaces + (std11-unfold-string + (buffer-substring hbeg end))))) + (if (or charset (eq type 'text)) + (progn + (delete-region beg (1+ end)) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (progn + (mime-decode-region + (match-end 0)(point-max) encoding) + (setq encoded t + encoding nil) + ))))))) + (if (or encoded (not not-decode-text)) + (progn + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\r\n" nil t) + (replace-match "\n") + )) + (decode-mime-charset-region (point-min)(point-max) + (or charset default-mime-charset)) + )) + (let ((he (if (re-search-forward "^$" nil t) + (match-end 0) + (point-min) + ))) + (if (and (eq type 'text) + (eq subtype 'x-rot13-47-48)) + (mule-caesar-region he (point-max)) + ) + (if (= (point-min) 1) + (progn + (goto-char he) + (insert + (concat "\n" + (mime-create-tag + (format "%s/%s%s" type subtype pstr) + encoding))) + ) + (delete-region (point-min) he) + (insert + (mime-create-tag (format "%s/%s%s" type subtype pstr) + encoding)) + )) + )) + +;;;###autoload +(defun mime-edit-decode-message-in-buffer (&optional default-content-type + not-decode-text) (save-excursion (goto-char (point-min)) - (let ((ctl (mime/Content-Type))) + (let ((ctl (or (mime-read-Content-Type) + default-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))) (cond - ((string= ctype "application/pgp-signature") + ((and (eq type 'application) + (eq (mime-content-type-subtype ctl) 'pgp-signature)) (delete-region (point-min)(point-max)) ) - ((string= type "multipart") - (let* ((boundary (cdr (assoc "boundary" params))) - (boundary-pat - (concat "\n--" (regexp-quote boundary) "[ \t]*\n")) - ) - (re-search-forward boundary-pat nil t) - (let ((bb (match-beginning 0)) eb tag) - (setq tag (format "\n--<<%s>>-{\n" stype)) - (goto-char bb) - (insert tag) - (setq bb (+ bb (length tag))) - (re-search-forward - (concat "\n--" (regexp-quote boundary) "--[ \t]*\n") - nil t) - (setq eb (match-beginning 0)) - (replace-match (format "--}-<<%s>>\n" stype)) - (save-restriction - (narrow-to-region bb eb) - (goto-char (point-min)) - (while (re-search-forward boundary-pat nil t) - (let ((beg (match-beginning 0)) - end) - (delete-region beg (match-end 0)) - (save-excursion - (if (re-search-forward boundary-pat nil t) - (setq end (match-beginning 0)) - (setq end (point-max)) - ) - (save-restriction - (narrow-to-region beg end) - (mime-editor::edit-again code-conversion) - (goto-char (point-max)) - )))) - )) - (goto-char (point-min)) - (or (= (point-min) 1) - (delete-region (point-min) - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-min) - ))) - )) + ((eq type 'multipart) + (mime-edit-decode-multipart-in-buffer ctl not-decode-text) + ) (t - (let* (charset - (pstr - (let ((bytes (+ 14 (length ctype)))) - (mapconcat (function - (lambda (attr) - (if (string-equal (car attr) "charset") - (progn - (setq charset (cdr attr)) - "") - (let* ((str - (concat (car attr) - "=" (cdr attr)) - ) - (bs (length str)) - ) - (setq bytes (+ bytes bs 2)) - (if (< bytes 76) - (concat "; " str) - (setq bytes (+ bs 1)) - (concat ";\n " str) - ) - )))) - params ""))) - encoding - encoded) - (save-excursion - (if (re-search-forward - "Content-Transfer-Encoding:" nil t) - (let ((beg (match-beginning 0)) - (hbeg (match-end 0)) - (end (std11-field-end))) - (setq encoding - (eliminate-top-spaces - (std11-unfold-string - (buffer-substring hbeg end)))) - (if (or charset (string-equal type "text")) - (progn - (delete-region beg (1+ end)) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (mime-decode-region - (match-end 0)(point-max) encoding) - (setq encoded t - encoding nil) - ))))))) - (if (or code-conversion encoded) - (decode-mime-charset-region - (point-min)(point-max) - (or charset default-mime-charset)) - ) - (let ((he - (if (re-search-forward "^$" nil t) - (match-end 0) - (point-min) - ))) - (if (= (point-min) 1) - (progn - (goto-char he) - (insert - (concat "\n" - (mime-create-tag - (concat type "/" stype pstr) encoding))) - ) - (delete-region (point-min) he) - (insert - (mime-create-tag - (concat type "/" stype pstr) encoding)) - )) - )))) - (if code-conversion + (mime-edit-decode-single-part-in-buffer ctl not-decode-text) + ))) + (or not-decode-text (decode-mime-charset-region (point-min) (point-max) - default-mime-charset) - ) - )))) + default-mime-charset)) + ) + (save-restriction + (std11-narrow-to-header) + (goto-char (point-min)) + (while (re-search-forward mime-edit-again-ignored-field-regexp nil t) + (delete-region (match-beginning 0) (1+ (std11-field-end))) + )) + (mime-decode-header-in-buffer (not not-decode-text)) + ))) +;;;###autoload (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 @@ -2556,14 +2790,8 @@ converted to MIME-Edit tags." nil t) (replace-match "\n\n") ) - (mime-editor::edit-again (not not-decode-text)) + (mime-edit-decode-message-in-buffer nil not-decode-text) (goto-char (point-min)) - (save-restriction - (std11-narrow-to-header) - (goto-char (point-min)) - (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)