X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-edit.el;h=e97a483dd3badfb51e702b5554e8083f22c7abb4;hb=refs%2Fheads%2Femy-1_13;hp=57c1de97aebb2778b452ecd7d4395c6d79fc33a1;hpb=80db5c51a4f6fa0d7f14e11f2060a06342ecd00c;p=elisp%2Fsemi.git diff --git a/mime-edit.el b/mime-edit.el index 57c1de9..e97a483 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1993,94,95,96,97,98,99 Free Software Foundation, Inc. ;; Author: UMEDA Masanobu -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko +;; Daiki Ueno ;; Created: 1994/08/21 renamed from mime.el ;; Renamed: 1997/2/21 from tm-edit.el ;; Keywords: MIME, multimedia, multilingual, mail, news @@ -106,13 +107,31 @@ ;;; Code: +(eval-when-compile (require 'static)) + (require 'sendmail) (require 'mail-utils) (require 'mel) +(require 'eword-encode) ; eword-encode-field-body (require 'mime-view) (require 'signature) (require 'alist) (require 'invisible) +(require 'pgg-def) +(require 'pgg-parse) + +(autoload 'pgg-encrypt-region "pgg" + "PGP encryption of current region." t) +(autoload 'pgg-sign-region "pgg" + "PGP signature of current region." t) +(autoload 'pgg-insert-key "pgg" + "Insert PGP public key at point." t) +(autoload 'smime-encrypt-region "smime" + "S/MIME encryption of current region.") +(autoload 'smime-sign-region "smime" + "S/MIME signature of current region.") +(defvar smime-output-buffer) +(defvar smime-errors-buffer) ;;; @ version @@ -190,7 +209,7 @@ To insert a signature file automatically, call the function ("css") ; rfc2318 ("xml") ; rfc2376 ("x-latex") - ("x-rot13-47-48") + ;; ("x-rot13-47-48") ) ("message" ("external-body" @@ -211,14 +230,13 @@ To insert a signature file automatically, call the function ("mail-server" ("server" "ftpmail@nic.karrn.ad.jp") ("subject")) - ("url" ("url")) - )) + ("url" ("url")))) ("rfc822") - ("news") - ) + ("news")) ("application" ("octet-stream" ("type" "" "tar" "shar")) ("postscript") + ("vnd.ms-powerpoint") ("x-kiss" ("x-cnf"))) ("image" ("gif") @@ -228,11 +246,9 @@ To insert a signature file automatically, call the function ("x-pic") ("x-mag") ("x-xwd") - ("x-xbm") - ) + ("x-xbm")) ("audio" ("basic")) - ("video" ("mpeg")) - ) + ("video" ("mpeg"))) "*Alist of content-type, subtype, parameters and its values.") (defcustom mime-file-types @@ -243,34 +259,29 @@ To insert a signature file automatically, call the function ("\\.cc$" "application" "octet-stream" (("type" . "C++")) "7bit" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.el$" "application" "octet-stream" (("type" . "emacs-lisp")) "7bit" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.lsp$" "application" "octet-stream" (("type" . "common-lisp")) "7bit" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.pl$" "application" "octet-stream" (("type" . "perl")) "7bit" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ;; Text or translated text ("\\.txt$" "text" "plain" nil nil - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ;; .rc : procmail modules pm-xxxx.rc ;; *rc : other resource files @@ -278,19 +289,17 @@ To insert a signature file automatically, call the function ("\\.\\(rc\\|lst\\|log\\|sql\\|mak\\)$\\|\\..*rc$" "text" "plain" nil nil - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) - ("\\.html$" + ("\\.html?$" "text" "html" nil nil nil nil) ("\\.diff$\\|\\.patch$" - "application" "octet-stream" (("type" . "patch")) + "text" "plain" (("type" . "patch")) nil - "attachment" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.signature" "text" "plain" nil nil nil nil) @@ -299,122 +308,104 @@ To insert a signature file automatically, call the function ;; Octect binary text ("\\.doc$" ;MS Word - "application" "winword" nil + "application" "msword" nil "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) + ("\\.ppt$" ; MS Power Point + "application" "vnd.ms-powerpoint" nil + "base64" + "attachment" (("filename" . file))) ("\\.pln$" "text" "plain" nil nil - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.ps$" "application" "postscript" nil "quoted-printable" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ;; Pure binary - ("\\.jpg$" + ("\\.jpg$\\|\\.jpeg$" "image" "jpeg" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.gif$" "image" "gif" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.png$" "image" "png" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.tiff$" "image" "tiff" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.pic$" "image" "x-pic" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.mag$" "image" "x-mag" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.xbm$" "image" "x-xbm" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.xwd$" "image" "x-xwd" nil "base64" - "inline" (("filename" . file)) - ) + "inline" (("filename" . file))) ("\\.au$" "audio" "basic" nil "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.mpg$" "video" "mpeg" nil "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.tar\\.gz$" "application" "octet-stream" (("type" . "tar+gzip")) "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.tgz$" "application" "octet-stream" (("type" . "tar+gzip")) "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.tar\\.Z$" "application" "octet-stream" (("type" . "tar+compress")) "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.taz$" "application" "octet-stream" (("type" . "tar+compress")) "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.gz$" "application" "octet-stream" (("type" . "gzip")) "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.Z$" "application" "octet-stream" (("type" . "compress")) "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.lzh$" "application" "octet-stream" (("type" . "lha")) "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ("\\.zip$" "application" "zip" nil "base64" - "attachment" (("filename" . file)) - ) + "attachment" (("filename" . file))) ;; 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." :type `(repeat @@ -422,8 +413,7 @@ If encoding is nil, it is determined from its contents." ;; primary-type (choice :tag "Primary-Type" ,@(nconc (mapcar (lambda (cell) - (list 'item (car cell)) - ) + (list 'item (car cell))) mime-content-types) '(string))) ;; subtype @@ -432,8 +422,7 @@ If encoding is nil, it is determined from its contents." (apply #'nconc (mapcar (lambda (cell) (mapcar (lambda (cell) - (list 'item (car cell)) - ) + (list 'item (car cell))) (cdr cell))) mime-content-types)) '(string))) @@ -445,8 +434,7 @@ If encoding is nil, it is determined from its contents." ,@(cons '(const nil) (mapcar (lambda (cell) - (list 'item cell) - ) + (list 'item cell)) (mime-encoding-list)))) ;; disposition-type (choice :tag "Disposition-Type" @@ -456,10 +444,19 @@ If encoding is nil, it is determined from its contents." string) ;; parameters (repeat :tag "Parameters of Content-Disposition field" - (cons string (choice string symbol))) - )) + (cons string (choice string symbol))))) :group 'mime-edit) +(defvar mime-content-disposition-types + '(("attachment") ("inline"))) + +(defcustom mime-edit-attach-at-end-type nil + "*List of MIME types to be attached at the end of a message. +Values must be strings indicates MIME types. You can specify +either type/subtype or type only." + :group 'mime-edit + :type '(choice (const :tag "Nothing" nil) + (list (repeat symbol)))) ;;; @@ about charset, encoding and transfer-level ;;; @@ -483,26 +480,29 @@ If encoding is nil, it is determined from its contents." (cn-big5 8 "base64") (big5 8 "base64") (shift_jis 8 "base64") + (tis-620 8 "base64") (iso-2022-jp-2 7 "base64") - (iso-2022-int-1 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.") +(defcustom mime-transfer-level 7 + "*A number of network transfer level. It should be bigger than 7. +Currently it has no effect except mode-line display." + :group 'mime-edit + :type '(choice (const 7) + (const 8) + (const :tag "Binary" 9))) (make-variable-buffer-local 'mime-transfer-level) (defsubst mime-encoding-name (transfer-level &optional not-omit) (cond ((> transfer-level 8) "binary") ((= transfer-level 8) "8bit") - (not-omit "7bit") - )) + (not-omit "7bit"))) (defvar mime-transfer-level-string (mime-encoding-name mime-transfer-level 'not-omit) - "A string formatted version of mime-transfer-level") + "A string formatted version of `mime-transfer-level'.") (make-variable-buffer-local 'mime-transfer-level-string) - ;;; @@ about content transfer encoding (defvar mime-content-transfer-encoding-priority-list @@ -511,17 +511,13 @@ If encoding is nil, it is determined from its contents." ;;; @@ about message inserting ;;; -(defvar mime-edit-yank-ignored-field-list +(defcustom 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.") - -(defvar mime-edit-yank-ignored-field-regexp - (concat "^" - (apply (function regexp-or) mime-edit-yank-ignored-field-list) - ":")) + "List of ignored header fields when inserting message/rfc822. +Each elements are regexp of field-name." + :group 'mime-edit + :type '(repeat regexp)) (defvar mime-edit-message-inserter-alist nil) (defvar mime-edit-mail-inserter-alist nil) @@ -535,15 +531,15 @@ Each elements are regexp of field-name.") :group 'mime-edit :type 'boolean) -(defcustom mime-edit-message-default-max-lines 1000 +(defcustom mime-edit-message-default-max-lines 5000 "*Default maximum lines of a message." :group 'mime-edit :type 'integer) (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, + "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) @@ -589,11 +585,11 @@ If it is not specified for a major-mode, mime-edit-multipart-beginning-regexp mime-edit-multipart-end-regexp)) -(defvar mime-tag-format "--[[%s]]" - "*Control-string making a MIME tag.") +(defconst mime-tag-format "--[[%s]]" + "Control-string making a MIME tag.") -(defvar mime-tag-format-with-encoding "--[[%s][%s]]" - "*Control-string making a MIME tag with encoding.") +(defconst mime-tag-format-with-encoding "--[[%s][%s]]" + "Control-string making a MIME tag with encoding.") ;;; @@ multipart boundary @@ -606,8 +602,10 @@ If it is not specified for a major-mode, ;;; @@ optional header fields ;;; -(defvar mime-edit-insert-user-agent-field t - "*If non-nil, insert User-Agent header field.") +(defcustom mime-edit-insert-user-agent-field nil + "*If non-nil, insert User-Agent header field." + :group 'mime-edit + :type 'boolean) (defvar mime-edit-user-agent-value (concat (mime-product-name mime-user-interface-product) @@ -624,21 +622,37 @@ If it is not specified for a major-mode, " (" (mime-product-code-name mime-library-product) ") " + (if (fboundp 'apel-version) + (concat (apel-version) " ")) (if (featurep 'xemacs) - (concat (if (featurep 'mule) "MULE") + (concat (cond ((featurep 'utf-2000) + (concat "UTF-2000-MULE/" utf-2000-version)) + ((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 ")") + (if (string-match "^[0-9]+\\(\\.[0-9]+\\)" emacs-version) + (concat + "/" + (substring emacs-version 0 (match-end 0)) + (cond ((and (boundp 'xemacs-betaname) + xemacs-betaname) + ;; It does not exist in XEmacs + ;; versions prior to 20.3. + (concat " " xemacs-betaname)) + ((and (boundp 'emacs-patch-level) + emacs-patch-level) + ;; It does not exist in FSF Emacs or in + ;; XEmacs versions earlier than 21.1.1. + (format " (patch %d)" emacs-patch-level)) + (t "")) + " (" xemacs-codename ")" + ;; `xemacs-extra-name' has appeared in the + ;; development version of XEmacs 21.5-b8. + (if (and (boundp 'xemacs-extra-name) + (symbol-value 'xemacs-extra-name)) + (concat " " (symbol-value 'xemacs-extra-name)) + "") + " (" + system-configuration ")") " (" emacs-version ")")) (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) (substring emacs-version 0 (match-beginning 0)) @@ -655,8 +669,7 @@ If it is not specified for a major-mode, (if (string-match "^Meadow-" mver) (concat " Meadow/" (substring mver - (match-end 0))) - )))) + (match-end 0))))))) (concat "MULE/" mule-version " (based on Emacs " ver ")")) (concat "Emacs/" ver " (" system-configuration ")"))))) @@ -669,20 +682,14 @@ inserted into message header.") ;;; (defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]" - "*Specify MIME tspecials. + "Specify MIME tspecials. Tspecials means any character that matches with it in header must be quoted.") (defconst mime-edit-mime-version-value - (eval-when-compile - (concat "1.0 (generated by " mime-edit-version ")")) +; (concat "1.0 (generated by " mime-edit-version ")") + "1.0" "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 ;;; @@ -696,6 +703,7 @@ Tspecials means any character that matches with it in header must be quoted.") (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 "i" 'mime-edit-insert-text-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) @@ -764,60 +772,71 @@ Tspecials means any character that matches with it in header must be quoted.") (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) + (split "Set splitting" mime-edit-set-split) + (sign "PGP sign" mime-edit-set-sign) + (encrypt "PGP encrypt" mime-edit-set-encrypt) (preview "Preview Message" mime-edit-preview-message) - (level "Toggle transfer-level" mime-edit-toggle-transfer-level) - ) + (level "Toggle transfer-level" mime-edit-toggle-transfer-level)) "MIME-edit menubar entry.") -(cond ((featurep 'xemacs) +(static-if (featurep 'xemacs) ;; modified by Pekka Marjola ;; 1995/9/5 (c.f. [tm-en:69]) - (defun mime-edit-define-menu-for-xemacs () - "Define menu for XEmacs." - (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) - ) - )) + (progn + (defun mime-edit-define-menu-for-xemacs () + "Define menu for XEmacs." + (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))))) + ;; Bogus check. Nemacs is not supported. + ;;(>= 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))) + +;;; @ macros +;;; +(defmacro mime-edit-insert-place (type-list &rest body) + `(save-excursion + (if (get-text-property (point) 'invisible) + (error "Can't split invisible region")) + (if (or (member (intern (concat (car ,type-list) "/" (cadr ,type-list))) + mime-edit-attach-at-end-type) + (member (intern (car ,type-list)) + mime-edit-attach-at-end-type)) + (goto-char (point-max))) + ,@ body)) + +(defmacro mime-edit-force-text-tag (regexp) + `(cond ((looking-at (concat "\n*\\(" ,regexp "\\)")) + (replace-match "\\1")) + ((not (eobp)) + (insert (mime-make-text-tag) "\n")))) ;;; @ functions ;;; @@ -841,23 +860,18 @@ 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. +Available charsets depend on Emacs. -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. +These charsets are available in all emacsen (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 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. -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 @@ -870,6 +884,7 @@ Following commands are available in addition to major mode commands: \[make single part\] \\[mime-edit-insert-text] insert a text message. \\[mime-edit-insert-file] insert a (binary) file. +\\[mime-eidt-insert-text-file] insert a text 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. @@ -923,8 +938,9 @@ TABs at the beginning of the line are not a part of the message: --[[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-edit-prefix +User customizable variables (not all of them are documented): +mime-edit-mode-entity-prefix +mime-edit-mode-enclosure-prefix Specifies a key prefix for MIME minor mode commands. mime-ignore-preceding-spaces @@ -939,10 +955,10 @@ User customizable variables (not documented all of them): 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. + If you are in 8bit-through environment, please set to 8. mime-edit-voice-recorder - Specifies a function to record a voice message and encode it. + Specifies a function to record and encode a voice message. The function `mime-edit-voice-recorder-for-sun' is for Sun SparcStations. @@ -966,25 +982,21 @@ User customizable variables (not documented all of them): (mime-edit-again) (make-local-variable 'mime-edit-touched-flag) (setq mime-edit-touched-flag t) - (turn-on-mime-edit) - ))) + (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) - )) +(static-if (featurep 'xemacs) + (add-minor-mode 'mime-edit-mode-flag + '((" MIME-Edit " mime-transfer-level-string)) + mime-edit-mode-map + nil + 'mime-edit-mode) + (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 @@ -992,7 +1004,7 @@ User customizable variables (not documented all of them): "Unconditionally turn on MIME-Edit mode." (interactive) (if mime-edit-mode-flag - (error "You are already editing a MIME message.") + (error "You are already editing a MIME message") (setq mime-edit-mode-flag t) ;; Set transfer level into mode line @@ -1003,8 +1015,7 @@ User customizable variables (not documented all of them): ;; Define menu for XEmacs. (if (featurep 'xemacs) - (mime-edit-define-menu-for-xemacs) - ) + (mime-edit-define-menu-for-xemacs)) (enable-invisible) @@ -1018,8 +1029,7 @@ User customizable variables (not documented all of them): (run-hooks 'mime-edit-mode-hook) (message (substitute-command-keys - "Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help.")) - )) + "Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help.")))) ;;;###autoload (defalias 'edit-mime 'turn-on-mime-edit) ; for convenience @@ -1027,13 +1037,13 @@ User customizable variables (not documented all of them): (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." +When NOMIME is nil, encode a message in the buffer into MIME. +Otherwise, just returns to previous mode. If NO-ERROR is non-nil, +no errors will be signaled even if it is not MIME-Edit mode." (interactive "P") (if (not mime-edit-mode-flag) (if (null no-error) - (error "You aren't editing a MIME message.") - ) + (error "You aren't editing a MIME message")) (if (not nomime) (progn (run-hooks 'mime-edit-translate-hook) @@ -1042,19 +1052,16 @@ just return to previous mode." (setq mime-edit-mode-flag nil) (if (and (featurep 'xemacs) (featurep 'menubar)) - (delete-menu-item (list mime-edit-menu-title)) - ) - (end-of-invisible) + (delete-menu-item (list mime-edit-menu-title))) + (disable-invisible) (set-buffer-modified-p (buffer-modified-p)) (run-hooks 'mime-edit-exit-hook) - (message "Exit MIME editor mode.") - )) + (message "Exit MIME editor mode."))) (defun mime-edit-maybe-translate () (interactive) (mime-edit-exit nil t) - (call-interactively 'mime-edit-maybe-split-and-send) - ) + (call-interactively 'mime-edit-maybe-split-and-send)) (defun mime-edit-help () "Show help message about MIME mode." @@ -1075,18 +1082,110 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (progn ;; Make a space between the following message. (insert "\n") - (forward-char -1) - )) + (forward-char -1))) (if (and (member (cadr ret) '("enriched")) (fboundp 'enriched-mode)) (enriched-mode t) (if (boundp 'enriched-mode) - (enriched-mode -1) - )) - ))) + (enriched-mode -1)))))) + +(defun mime-edit-insert-text-file (file &optional verbose) + "Insert a text message from a FILE. +Charset is automatically obtained from the `charsets-mime-charset-alist'. +If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." + (interactive "fInsert file as a MIME text: \nP") + (let* ((guess (mime-find-file-type file)) + (type "text") + (subtype nil) + (parameters (nth 2 guess)) +;; (encoding (nth 3 guess)) + (disposition-type (nth 4 guess)) + (disposition-params (nth 5 guess)) + string) + (setq subtype (mime-prompt-for-subtype type subtype)) +;; (if (or (interactive-p) verbose) +;; (setq encoding (mime-prompt-for-encoding encoding))) + (if verbose + (setq disposition-type (mime-prompt-for-disposition disposition-type))) + (if (or (consp parameters) (stringp disposition-type)) + (let ((rest parameters) cell attribute value) + (setq parameters "") + (while rest + (setq cell (car rest)) + (setq attribute (car cell)) + (setq value (cdr cell)) + (if (eq value 'file) + (setq value (std11-wrap-as-quoted-string + (file-name-nondirectory file)))) + (setq parameters (concat parameters "; " attribute "=" value)) + (setq rest (cdr rest))) + (if disposition-type + (progn + (setq parameters + (concat parameters "\n" + "Content-Disposition: " disposition-type)) + (setq rest disposition-params) + (while rest + (setq cell (car rest)) + (setq attribute (car cell)) + (setq value (cdr cell)) + (if (eq value 'file) + (setq value (std11-wrap-as-quoted-string + (file-name-nondirectory file)))) + (setq parameters + (concat parameters "; " attribute "=" value)) + (setq rest (cdr rest))))))) + (mime-edit-insert-place + (list type subtype) + (mime-edit-insert-tag type subtype parameters) +;; (if (stringp encoding) +;; (mime-edit-define-encoding encoding)) + (save-excursion + (let ((ret (insert-file-contents file))) + (forward-char (cadr ret)) + (mime-edit-force-text-tag mime-edit-single-part-regexp)))))) + +(defun mime-edit-guess-charset (file) + (with-temp-buffer + (let (candidates candidate eol eol-string) + (set-buffer-multibyte nil) + (insert-file-contents-as-binary file) + (setq candidates (detect-coding-region (point-min) (point-max))) + (setq candidate (if (listp candidates) + (car candidates) + candidates)) + (setq eol (coding-system-eol-type candidate)) + (cond ((eq eol + (static-if (featurep 'xemacs) + 'lf + 0)) + (setq eol-string "\n")) + ((eq eol + (static-if (featurep 'xemacs) + 'cr + 2)) + (setq eol-string "\r"))) + (goto-char (point-min)) + (when eol-string + (while (search-forward eol-string nil t) + (replace-match "\r\n"))) + (static-if (featurep 'xemacs) + (setq candidate (coding-system-name (coding-system-base candidate))) + (setq candidate (coding-system-base candidate))) + ;; #### FIXME + (cond ((eq candidate 'undecided) + (setq candidate "us-ascii")) + ((eq candidate 'iso-2022-7bit) + (setq candidate "iso-2022-jp")) + (t + (setq candidate + (symbol-name (coding-system-to-mime-charset candidate))))) + (cons candidate (buffer-string))))) (defun mime-edit-insert-file (file &optional verbose) - "Insert a message from a file." + "Insert a message from a FILE. +If VERBOSE is non-nil, it will prompt for Content-Type, +Content-Transfer-Encoding and Content-Disposition headers." (interactive "fInsert file as MIME message: \nP") (let* ((guess (mime-find-file-type file)) (type (nth 0 guess)) @@ -1095,28 +1194,31 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (encoding (nth 3 guess)) (disposition-type (nth 4 guess)) (disposition-params (nth 5 guess)) - ) + charset-and-string) (if verbose (setq type (mime-prompt-for-type type) - subtype (mime-prompt-for-subtype type subtype) - )) + subtype (mime-prompt-for-subtype type subtype))) (if (or (interactive-p) verbose) - (setq encoding (mime-prompt-for-encoding encoding)) - ) + (setq encoding (mime-prompt-for-encoding encoding))) + (if verbose + (setq disposition-type (mime-prompt-for-disposition disposition-type))) (if (or (consp parameters) (stringp disposition-type)) (let ((rest parameters) cell attribute value) (setq parameters "") + (when (string= type "text") + (setq charset-and-string (mime-edit-guess-charset file)) + (setq parameters + (concat parameters "; charset=" + (car charset-and-string)))) (while rest (setq cell (car rest)) (setq attribute (car cell)) (setq value (cdr cell)) (if (eq value 'file) (setq value (std11-wrap-as-quoted-string - (file-name-nondirectory file))) - ) + (file-name-nondirectory file)))) (setq parameters (concat parameters "; " attribute "=" value)) - (setq rest (cdr rest)) - ) + (setq rest (cdr rest))) (if disposition-type (progn (setq parameters @@ -1129,35 +1231,34 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (setq value (cdr cell)) (if (eq value 'file) (setq value (std11-wrap-as-quoted-string - (file-name-nondirectory file))) - ) + (file-name-nondirectory file)))) (setq parameters (concat parameters "; " attribute "=" value)) - (setq rest (cdr rest)) - ) - )) - )) - (mime-edit-insert-tag type subtype parameters) - (mime-edit-insert-binary-file file encoding) - )) + (setq rest (cdr rest))))))) + (mime-edit-insert-place + (list type subtype) + (mime-edit-insert-tag type subtype parameters) + (if charset-and-string + (mime-edit-insert-binary-string (cdr charset-and-string) encoding) + (mime-edit-insert-binary-file file encoding))))) (defun mime-edit-insert-external () "Insert a reference to external body." (interactive) - (mime-edit-insert-tag "message" "external-body" nil ";\n\t") - ;;(forward-char -1) - ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n") - ;;(forward-line 1) (let* ((pritype (mime-prompt-for-type)) (subtype (mime-prompt-for-subtype pritype)) (parameters (mime-prompt-for-parameters pritype subtype ";\n\t"))) - (and pritype - subtype - (insert "Content-Type: " - pritype "/" subtype (or parameters "") "\n"))) - (if (and (not (eobp)) - (not (looking-at mime-edit-single-part-tag-regexp))) - (insert (mime-make-text-tag) "\n"))) + (mime-edit-insert-place + '("message" "external-body") + (mime-edit-insert-tag "message" "external-body" nil ";\n\t") + ;;(forward-char -1) + ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n") + ;;(forward-line 1) + (and pritype + subtype + (insert "Content-Type: " + pritype "/" subtype (or parameters "") "\n")) + (mime-edit-force-text-tag mime-edit-single-part-tag-regexp)))) (defun mime-edit-insert-voice () "Insert a voice message." @@ -1166,17 +1267,18 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (completing-read "What transfer encoding: " (mime-encoding-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)) - ))))) + (mime-edit-insert-place + '("audio" "basic") + (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-edit-insert-signature (&optional arg) "Insert a signature file." @@ -1186,11 +1288,8 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (lambda () (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) - )) + (car items) (cadr items) (list (caddr items)))))))) + (insert-signature arg))) ;; Insert a new tag around a point. @@ -1199,19 +1298,18 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS. If nothing is inserted, return nil." (interactive) + (if (get-text-property (point) 'invisible) + (error "Can't split invisible region")) (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)) - ) + (< p (match-end 0))) (goto-char (match-beginning 0)) - (goto-char p) - )) + (goto-char p))) (let ((oldtag nil) (newtag nil) - (current (point)) - ) + (current (point))) (setq pritype (or pritype (mime-prompt-for-type))) @@ -1229,8 +1327,7 @@ If nothing is inserted, return nil." (if (mime-edit-goto-tag) (buffer-substring (match-beginning 0) (match-end 0)) ;; Assume content type is 'text/plan'. - (mime-make-tag "text" "plain") - ))) + (mime-make-tag "text" "plain")))) ;; We are only interested in TEXT. (if (and oldtag (not (mime-test-content-type @@ -1249,8 +1346,43 @@ If nothing is inserted, return nil." ;; Restore previous point. (goto-char current) nil ;Nothing is created. - ) - )) + ))) + +;; #### This should be merged into the function below but for now, +;; don't change APIs. +(defun mime-edit-insert-binary-string (string &optional encoding) + "Insert binary STRING 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) + (not + (let ((en (downcase encoding))) + (or (string-equal en "7bit") + (string-equal en "8bit") + (string-equal en "binary"))))))) + (save-restriction + (narrow-to-region tagend (point)) + (insert + (with-temp-buffer + ;; #### @!#$%@!${$@} + (set-buffer-multibyte nil) + (insert string) + ;; #### Why mime-encode-string doesn't exist? + (mime-encode-region (point-min) (point-max) + (or encoding "7bit")) + (buffer-string))) + (if hide-p + (progn + (invisible-region (point-min) (point-max)) + (goto-char (point-max))) + (goto-char (point-max)))) + (mime-edit-force-text-tag mime-edit-tag-regexp) + ;; Define encoding even if it is 7bit. + (if (stringp encoding) + (save-excursion + (goto-char tagend) ; Make sure which line the tag is on. + (mime-edit-define-encoding encoding))))) (defun mime-edit-insert-binary-file (file &optional encoding) "Insert binary FILE at point. @@ -1262,31 +1394,21 @@ Optional argument ENCODING specifies an encoding method such as base64." (let ((en (downcase encoding))) (or (string-equal en "7bit") (string-equal en "8bit") - (string-equal en "binary") - ))))) - ) + (string-equal en "binary"))))))) (save-restriction (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") - ) + (goto-char (point-max))) + (goto-char (point-max)))) + (mime-edit-force-text-tag mime-edit-tag-regexp) ;; Define encoding even if it is 7bit. (if (stringp encoding) (save-excursion (goto-char tagend) ; Make sure which line the tag is on. - (mime-edit-define-encoding encoding) - )) - )) + (mime-edit-define-encoding encoding))))) ;; Commands work on a current message flagment. @@ -1301,17 +1423,14 @@ Optional argument ENCODING specifies an encoding method such as base64." (goto-char (1- (match-beginning 0))) ;For multiline tag ) (t - (goto-char (point-max)) - )) + (goto-char (point-max)))) ;; 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) - nil - )) - ))) + nil))))) (defun mime-edit-content-beginning () "Return the point of the beginning of content." @@ -1332,8 +1451,7 @@ Optional argument ENCODING specifies an encoding method such as base64." (concat "\n" (regexp-quote mail-header-separator) (if mime-ignore-preceding-spaces "[ \t\n]*\n" "\n")) nil 'move) - (point)) - ))) + (point))))) (defun mime-edit-content-end () "Return the point of the end of content." @@ -1346,17 +1464,14 @@ Optional argument ENCODING specifies an encoding method such as base64." ;; 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) - )) + (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)) - )) + (point)))) (defun mime-edit-define-charset (charset) "Set charset of current tag to CHARSET." @@ -1368,9 +1483,12 @@ 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))) - (mime-edit-get-encoding tag))) - )))) + "charset" + (let ((comment (get charset 'mime-charset-comment))) + (if comment + (concat (upcase (symbol-name charset)) " (" comment ")") + (upcase (symbol-name charset))))) + (mime-edit-get-encoding tag))))))) (defun mime-edit-define-encoding (encoding) "Set encoding of current tag to ENCODING." @@ -1378,18 +1496,16 @@ Optional argument ENCODING specifies an encoding method such as base64." (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-edit-get-contype tag) encoding))) - ))) + (insert (mime-create-tag (mime-edit-get-contype tag) encoding)))))) (defun mime-edit-choose-charset () "Choose charset of a text following current point." - (detect-mime-charset-region (point) (mime-edit-content-end)) - ) + (detect-mime-charset-region (point) (mime-edit-content-end))) (defun mime-make-text-tag (&optional subtype) "Make a tag for a text after current point. Subtype of text type can be specified by an optional argument SUBTYPE. -Otherwise, it is obtained from mime-content-types." +Otherwise, it is obtained from `mime-content-types'." (let* ((pritype "text") (subtype (or subtype (car (car (cdr (assoc pritype mime-content-types))))))) @@ -1415,10 +1531,8 @@ Otherwise, it is obtained from mime-content-types." (and (stringp 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)) - )) + (string-match mime-edit-multipart-end-regexp tag)) + (substring tag (match-beginning 1) (match-end 1)))) (defun mime-edit-get-encoding (tag) "Return encoding of TAG." @@ -1447,8 +1561,7 @@ Nil if no such parameter." (if (string-match "\n[^ \t\n\r]+:" contype) (setq ctype (substring contype 0 (match-beginning 0)) opt-fields (substring contype (match-beginning 0))) - (setq ctype contype) - ) + (setq ctype contype)) (if (string-match (concat ";[ \t\n]*\\(" @@ -1458,10 +1571,10 @@ Nil if no such parameter." ;; Change value (concat (substring ctype 0 (match-beginning 1)) parameter "=" value - (substring contype (match-end 1)) - opt-fields) - (concat ctype "; " parameter "=" value opt-fields) - ))) + (substring contype (match-end 1))) + ;; This field makes two CDP header when charset parameter is present. +;; opt-fields) + (concat ctype "; " parameter "=" value opt-fields)))) (defun mime-strip-parameters (contype) "Return primary content-type and subtype without parameters for CONTYPE." @@ -1487,8 +1600,7 @@ Nil if no such parameter." (if (string-match (car (car guesses)) file) (setq guess (cdr (car guesses)))) (setq guesses (cdr guesses))) - guess - )) + guess)) (defun mime-prompt-for-type (&optional default) "Ask for Content-type." @@ -1500,15 +1612,12 @@ Nil if no such parameter." mime-content-types nil 'require-match ;Type must be specified. - default - )) + default)) (if (string-equal type "") (progn (message "Content type is required.") (beep) - (sit-for 1) - )) - ) + (sit-for 1)))) type)) (defun mime-prompt-for-subtype (type &optional default) @@ -1516,8 +1625,7 @@ Nil if no such parameter." (let ((subtypes (cdr (assoc type mime-content-types)))) (or (and default (assoc default subtypes)) - (setq default (car (car subtypes))) - )) + (setq default (car (car subtypes))))) (let* ((answer (completing-read (if default @@ -1527,8 +1635,7 @@ Nil if no such parameter." (cdr (assoc type mime-content-types)) nil 'require-match ;Subtype must be specified. - nil - ))) + nil))) (if (string-equal answer "") default answer))) (defun mime-prompt-for-parameters (pritype subtype &optional delimiter) @@ -1542,8 +1649,7 @@ Optional DELIMITER specifies parameter delimiter (';' by default)." (mime-prompt-for-parameters-1 (cdr (assoc subtype (cdr (assoc pritype mime-content-types)))))) - delimiter - ))) + delimiter))) (if (and (stringp parameters) (not (string-equal parameters ""))) (concat delimiter parameters) @@ -1556,7 +1662,7 @@ Optional DELIMITER specifies parameter delimiter (';' by default)." (defun mime-prompt-for-parameter (parameter) "Ask for PARAMETER. -Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." +Parameter must be '(PROMPT CHOICE1 (CHOICE2...))." (let* ((prompt (car parameter)) (choices (mapcar (function (lambda (e) @@ -1584,8 +1690,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." ;; Note: control characters ignored! (if (string-match mime-tspecials-regexp answer) (concat "\"" answer "\"") answer))) - (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter))))) - )) + (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter))))))) (defun mime-prompt-for-encoding (default) "Ask for Content-Transfer-Encoding." @@ -1594,11 +1699,18 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (setq encoding (completing-read "What transfer encoding: " - (mime-encoding-alist) nil t default) - ) + (mime-encoding-alist) nil t default)) "")) encoding)) +(defun mime-prompt-for-disposition (default) + "Prompt Content-Disposition" + (completing-read (concat "What disposition type (default " + default "): ") + mime-content-disposition-types + nil t nil nil + default)) + ;;; @ Translate the tagged MIME messages into a MIME compliant message. ;;; @@ -1611,20 +1723,18 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (defun mime-edit-translate-header () "Encode the message header into network representation." (eword-encode-header 'code-conversion) - (run-hooks 'mime-edit-translate-header-hook) - ) + (run-hooks 'mime-edit-translate-header-hook)) (defun mime-edit-translate-buffer () "Encode the tagged MIME message in current buffer in MIME compliant message." (interactive) + (undo-boundary) (if (catch 'mime-edit-error (save-excursion - (run-hooks 'mime-edit-translate-buffer-hook) - )) + (run-hooks 'mime-edit-translate-buffer-hook))) (progn (undo) - (error "Translation error!") - ))) + (error "Translation error!")))) (defun mime-edit-find-inmost () (goto-char (point-min)) @@ -1637,26 +1747,22 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (widen) (if (re-search-forward end-exp nil t) (setq eb (match-beginning 0)) - (setq eb (point-max)) - ) + (setq eb (point-max))) (narrow-to-region be eb) (goto-char be) (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) (progn (narrow-to-region (match-beginning 0)(point-max)) - (mime-edit-find-inmost) - ) + (mime-edit-find-inmost)) (widen) - (list type bb be eb) - )))) + (list type bb be eb))))) (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)) - (eb (nth 3 ret)) - ) + (eb (nth 3 ret))) (narrow-to-region bb eb) (delete-region bb be) (setq bb (point-min)) @@ -1665,28 +1771,23 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (goto-char eb) (if (looking-at mime-edit-multipart-end-regexp) (let ((beg (match-beginning 0)) - (end (match-end 0)) - ) + (end (match-end 0))) (delete-region beg end) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (concat (mime-make-text-tag) "\n")) - ))) + (mime-edit-force-text-tag mime-edit-beginning-tag-regexp))) (cond ((string-equal type "quote") - (mime-edit-enquote-region bb eb) - ) + (mime-edit-enquote-region bb eb)) ((string-equal type "pgp-signed") - (mime-edit-sign-pgp-mime bb eb boundary) - ) + (mime-edit-sign-pgp-mime bb eb boundary)) ((string-equal type "pgp-encrypted") - (mime-edit-encrypt-pgp-mime bb eb boundary) - ) + (mime-edit-encrypt-pgp-mime bb eb boundary)) ((string-equal type "kazu-signed") - (mime-edit-sign-pgp-kazu bb eb boundary) - ) + (mime-edit-sign-pgp-kazu bb eb boundary)) ((string-equal type "kazu-encrypted") - (mime-edit-encrypt-pgp-kazu bb eb boundary) - ) + (mime-edit-encrypt-pgp-kazu bb eb boundary)) + ((string-equal type "smime-signed") + (mime-edit-sign-smime bb eb boundary)) + ((string-equal type "smime-encrypted") + (mime-edit-encrypt-smime bb eb boundary)) (t (setq boundary (nth 2 (mime-edit-translate-region bb eb @@ -1695,8 +1796,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (insert (format "--[[multipart/%s; boundary=\"%s\"][7bit]]\n" - type boundary)) - )) + type boundary)))) boundary)))) (defun mime-edit-enquote-region (beg end) @@ -1706,8 +1806,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (goto-char beg) (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))) - ))))) + (replace-match (concat "- " (substring tag 1)))))))) (defun mime-edit-dequote-region (beg end) (save-excursion @@ -1717,30 +1816,57 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (while (re-search-forward 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))) - ))))) + (replace-match (concat "-" (substring tag 2)))))))) + +(defvar mime-edit-pgp-user-id nil) (defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) + (let* ((from (std11-field-body "From" mail-header-separator)) + (ret (progn + (narrow-to-region beg end) + (mime-edit-translate-region beg end boundary))) (ctype (car ret)) (encoding (nth 1 ret)) - (pgp-boundary (concat "pgp-sign-" boundary))) + (pgp-boundary (concat "pgp-sign-" boundary)) + micalg) (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) + (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'mime-sign) - (point-min)(point-max) nil nil pgp-boundary)) - (throw 'mime-edit-error 'pgp-error) - ) - )))) + (or (let ((pgg-default-user-id + (or mime-edit-pgp-user-id + (if from + (nth 1 (std11-extract-address-components from)) + pgg-default-user-id)))) + (pgg-sign-region (point-min)(point-max))) + (throw 'mime-edit-error 'pgp-error)) + (setq micalg + (cdr (assq 'hash-algorithm + (cdar (with-current-buffer pgg-output-buffer + (pgg-parse-armor-region + (point-min)(point-max)))))) + micalg + (if micalg + (concat "; micalg=pgp-" (downcase (symbol-name micalg))) + "")) + (goto-char beg) + (insert (format "--[[multipart/signed; + boundary=\"%s\"%s; + protocol=\"application/pgp-signature\"][7bit]] +--%s +" pgp-boundary micalg pgp-boundary)) + (goto-char (point-max)) + (insert (format "\n--%s +Content-Type: application/pgp-signature +Content-Transfer-Encoding: 7bit + +" pgp-boundary)) + (insert-buffer-substring pgg-output-buffer) + (goto-char (point-max)) + (insert (format "\n--%s--\n" pgp-boundary)))))) (defvar mime-edit-encrypt-recipient-fields-list '("To" "cc")) @@ -1755,26 +1881,21 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (header (and (stringp from) (if (string-equal from "") "" - (format "From: %s\n" from) - ))) + (format "From: %s\n" from)))) recipients) (while (and names values) (let ((name (car names)) - (value (car values)) - ) + (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)) - )))) + value)))))) (setq names (cdr names) - values (cdr values)) - ) - (vector from recipients header) - )) + values (cdr values))) + (vector from recipients header))) (defun mime-edit-encrypt-pgp-mime (beg end boundary) (save-excursion @@ -1783,25 +1904,34 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (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-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (pgp-boundary (concat "pgp-" boundary))) - (goto-char beg) - (insert header) - (insert (format "Content-Type: %s\n" ctype)) - (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) - (insert "\n") - (or (funcall (pgp-function 'encrypt) - recipients (point-min) (point-max) from) - (throw 'mime-edit-error 'pgp-error) - ) + header (aref ret 2))) + (narrow-to-region beg end) + (let* ((ret + (mime-edit-translate-region beg end boundary)) + (ctype (car ret)) + (encoding (nth 1 ret)) + (pgp-boundary (concat "pgp-" boundary))) + (goto-char beg) + (insert header) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding))) + (insert "\n") + (eword-encode-header) + (or (let ((pgg-default-user-id + (or mime-edit-pgp-user-id + (if from + (nth 1 (std11-extract-address-components from)) + pgg-default-user-id)))) + (pgg-encrypt-region + (point-min) (point-max) + (mapcar (lambda (recipient) + (nth 1 (std11-extract-address-components + recipient))) + (split-string recipients + "\\([ \t\n]*,[ \t\n]*\\)+")))) + (throw 'mime-edit-error 'pgp-error)) + (delete-region (point-min)(point-max)) (goto-char beg) (insert (format "--[[multipart/encrypted; boundary=\"%s\"; @@ -1814,9 +1944,9 @@ Content-Type: application/octet-stream Content-Transfer-Encoding: 7bit " pgp-boundary pgp-boundary pgp-boundary)) + (insert-buffer-substring pgg-output-buffer) (goto-char (point-max)) - (insert (format "\n--%s--\n" pgp-boundary)) - ))))) + (insert (format "\n--%s--\n" pgp-boundary))))))) (defun mime-edit-sign-pgp-kazu (beg end boundary) (save-excursion @@ -1829,27 +1959,21 @@ Content-Transfer-Encoding: 7bit (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) + (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'traditional-sign) - beg (point-max))) - (throw 'mime-edit-error 'pgp-error) - ) + (or (pgg-sign-region beg (point-max) 'clearsign) + (throw 'mime-edit-error 'pgp-error)) (goto-char beg) (insert "--[[application/pgp; format=mime][7bit]]\n") - )) - )) + )))) (defun mime-edit-encrypt-pgp-kazu (beg end boundary) (save-excursion (let (recipients header) (let ((ret (mime-edit-make-encrypt-recipient-header))) (setq recipients (aref ret 1) - header (aref ret 2)) - ) + header (aref ret 2))) (save-restriction (narrow-to-region beg end) (let* ((ret @@ -1860,20 +1984,80 @@ Content-Transfer-Encoding: 7bit (insert header) (insert (format "Content-Type: %s\n" ctype)) (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) + (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'encrypt) - recipients beg (point-max) nil 'maybe) - ) - (throw 'mime-edit-error 'pgp-error) - ) + (or (pgg-encrypt-region beg (point-max) recipients) + (throw 'mime-edit-error 'pgp-error)) (goto-char beg) (insert "--[[application/pgp; format=mime][7bit]]\n") - )) - ))) + ))))) + +(defun mime-edit-sign-smime (beg end boundary) + (save-excursion + (save-restriction + (let* ((ret (progn + (narrow-to-region beg end) + (mime-edit-translate-region beg end boundary))) + (ctype (car ret)) + (encoding (nth 1 ret)) + (smime-boundary (concat "smime-sign-" boundary))) + (goto-char beg) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding))) + (insert "\n") + (let (buffer-undo-list) + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + (or (prog1 (smime-sign-region (point-min)(point-max)) + (push nil buffer-undo-list) + (ignore-errors (undo))) + (throw 'mime-edit-error 'pgp-error))) + (goto-char beg) + (insert (format "--[[multipart/signed; + boundary=\"%s\"; micalg=sha1; + protocol=\"application/pkcs7-signature\"][7bit]] +--%s +" smime-boundary smime-boundary)) + (goto-char (point-max)) + (insert (format "\n--%s +Content-Type: application/pkcs7-signature; name=\"smime.p7s\" +Content-Transfer-Encoding: base64 +Content-Disposition: attachment; filename=\"smime.p7s\" +Content-Description: S/MIME Cryptographic Signature + +" smime-boundary)) + (insert-buffer-substring smime-output-buffer) + (goto-char (point-max)) + (insert (format "\n--%s--\n" smime-boundary)))))) + +(defun mime-edit-encrypt-smime (beg end boundary) + (save-excursion + (save-restriction + (let* ((ret (progn + (narrow-to-region beg end) + (mime-edit-translate-region beg end boundary))) + (ctype (car 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") + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + (or (smime-encrypt-region (point-min)(point-max)) + (throw 'mime-edit-error 'pgp-error)) + (delete-region (point-min)(point-max)) + (insert "--[[application/pkcs7-mime; name=\"smime.p7m\" +Content-Disposition: attachment; filename=\"smime.p7m\" +Content-Description: S/MIME Encrypted Message][base64]]\n") + (insert-buffer-substring smime-output-buffer))))) (defsubst replace-space-with-underline (str) (mapconcat (function @@ -1881,13 +2065,11 @@ Content-Transfer-Encoding: 7bit (char-to-string (if (eq arg ?\ ) ?_ - arg)))) str "") - ) + arg)))) str "")) (defun mime-edit-make-boundary () (concat mime-multipart-boundary "_" - (replace-space-with-underline (current-time-string)) - )) + (replace-space-with-underline (current-time-string)))) (defun mime-edit-translate-body () "Encode the tagged MIME body in current buffer in MIME compliant message." @@ -1898,8 +2080,7 @@ Content-Transfer-Encoding: 7bit ret) (while (mime-edit-process-multipart-1 (format "%s-%d" boundary i)) - (setq i (1+ i)) - ) + (setq i (1+ i))) (save-restriction ;; We are interested in message body. (let* ((beg @@ -1919,8 +2100,7 @@ Content-Transfer-Encoding: 7bit (point)))) (setq ret (mime-edit-translate-region beg end - (format "%s-%d" boundary i))) - )) + (format "%s-%d" boundary i))))) (mime-edit-dequote-region (point-min)(point-max)) (let ((contype (car ret)) ;Content-Type (encoding (nth 1 ret)) ;Content-Transfer-Encoding @@ -1928,8 +2108,7 @@ Content-Transfer-Encoding: 7bit ;; Insert User-Agent field (and mime-edit-insert-user-agent-field (or (mail-position-on-field "User-Agent") - (insert mime-edit-user-agent-value) - )) + (insert mime-edit-user-agent-value))) ;; Make primary MIME headers. (or (mail-position-on-field "MIME-Version") (insert mime-edit-mime-version-value)) @@ -1947,8 +2126,7 @@ Content-Transfer-Encoding: 7bit (if encoding (progn (mail-position-on-field "Content-Transfer-Encoding") - (insert encoding))) - )))) + (insert encoding))))))) (defun mime-edit-translate-single-part-tag (boundary &optional prefix) "Translate single-part-tag to MIME header." @@ -1965,18 +2143,15 @@ Content-Transfer-Encoding: 7bit (insert "Content-Type: " contype "\n") (if encoding (insert "Content-Transfer-Encoding: " encoding "\n")) - (eword-encode-header) - ) + (eword-encode-header)) (cons (and contype (downcase contype)) (and encoding - (downcase encoding)))) - ))) + (downcase encoding))))))) (defun mime-edit-translate-region (beg end &optional boundary multipart) (or boundary - (setq boundary (mime-edit-make-boundary)) - ) + (setq boundary (mime-edit-make-boundary))) (save-excursion (save-restriction (narrow-to-region beg end) @@ -2002,8 +2177,7 @@ Content-Transfer-Encoding: 7bit (buffer-substring (match-beginning 0) (match-end 0))) (delete-region (match-beginning 0) (1+ (match-end 0))) (setq contype (mime-edit-get-contype tag)) - (setq encoding (mime-edit-get-encoding tag)) - )) + (setq encoding (mime-edit-get-encoding tag)))) (t ;; It's a multipart message. (goto-char (point-min)) @@ -2023,10 +2197,8 @@ Content-Transfer-Encoding: 7bit (setq encoding (car prio)) ;; Insert the trailer. (goto-char (point-max)) - (insert "\n--" boundary "--\n") - ))) - (list contype encoding boundary nparts) - )))) + (insert "\n--" boundary "--\n")))) + (list contype encoding boundary nparts))))) (defun mime-edit-normalize-body () "Normalize the body part by inserting appropriate message tags." @@ -2045,23 +2217,17 @@ Content-Transfer-Encoding: 7bit (if (looking-at "[ \t]+$") (delete-region (match-beginning 0) (match-end 0))) (let ((beg (point)) - (end (mime-edit-content-end)) - ) + (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") - )) + (mime-edit-force-text-tag mime-edit-beginning-tag-regexp)) (visible-region beg end) - (goto-char beg) - ) + (goto-char beg)) (cond ((mime-test-content-type contype "message") ;; Content-type "message" should be sent as is. - (forward-line 1) - ) + (forward-line 1)) ((mime-test-content-type contype "text") ;; Define charset for text if necessary. (setq charset (if charset @@ -2071,15 +2237,13 @@ Content-Transfer-Encoding: 7bit (cond ((string-equal contype "text/x-rot13-47-48") (save-excursion (forward-line) - (mule-caesar-region (point) (mime-edit-content-end)) - )) + (mule-caesar-region (point) (mime-edit-content-end)))) ((string-equal contype "text/enriched") (save-excursion (let ((beg (progn (forward-line) (point))) - (end (mime-edit-content-end)) - ) + (end (mime-edit-content-end))) ;; Patch for hard newlines ;; (save-excursion ;; (goto-char beg) @@ -2088,12 +2252,10 @@ 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)) - ) - )))) + (delete-region beg (match-end 0))))))) ;; Point is now on current tag. ;; Define encoding and encode text if necessary. (or encoding ;Encoding is not specified. @@ -2124,10 +2286,8 @@ Content-Transfer-Encoding: 7bit x-ctext)) (while (progn (replace-match "\e(BFrom ") - (re-search-forward "^From " nil t) - )) - (setq encoding "quoted-printable") - ))))) + (re-search-forward "^From " nil t))) + (setq encoding "quoted-printable")))))) ;; canonicalize line break code (or (member encoding '(nil "7bit" "8bit" "quoted-printable")) (save-restriction @@ -2138,10 +2298,8 @@ Content-Transfer-Encoding: 7bit (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)) - ) + (mime-edit-define-encoding encoding))) + (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 @@ -2151,9 +2309,7 @@ Content-Transfer-Encoding: 7bit (end (mime-edit-content-end))) (mime-encode-region beg end encoding) (mime-edit-define-encoding encoding)) - (forward-line 1) - )) - ))) + (forward-line 1)))))) (defun mime-delete-field (field) "Delete header FIELD." @@ -2161,8 +2317,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)))))) ;;; @@ -2176,8 +2331,7 @@ Content-Transfer-Encoding: 7bit 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) - ) + (mime-insert-encoded-file "/dev/audio" encoding)) ;;; @ Other useful commands. @@ -2190,22 +2344,22 @@ and insert data encoded as ENCODING." (let ((inserter (cdr (assq major-mode mime-edit-message-inserter-alist)))) (if (and inserter (fboundp inserter)) (progn - (mime-edit-insert-tag "message" "rfc822") - (funcall inserter message) - ) - (message "Sorry, I don't have message inserter for your MUA.") - ))) + (mime-edit-insert-place + '("message" "rfc822") + (mime-edit-insert-tag "message" "rfc822") + (funcall inserter message))) + (message "Sorry, I don't have message inserter for your MUA.")))) (defun mime-edit-insert-mail (&optional message) (interactive) (let ((inserter (cdr (assq major-mode mime-edit-mail-inserter-alist)))) (if (and inserter (fboundp inserter)) (progn - (mime-edit-insert-tag "message" "rfc822") - (funcall inserter message) - ) - (message "Sorry, I don't have mail inserter for your MUA.") - ))) + (mime-edit-insert-place + '("message" "rfc822") + (mime-edit-insert-tag "message" "rfc822") + (funcall inserter message))) + (message "Sorry, I don't have mail inserter for your MUA.")))) (defun mime-edit-inserted-message-filter () (save-excursion @@ -2216,17 +2370,16 @@ and insert data encoded as ENCODING." ;; for Emacs 18 ;; (if (re-search-forward "^$" (marker-position (mark-marker))) (if (re-search-forward "^$" (mark t)) - (narrow-to-region header-start (match-beginning 0)) - ) + (narrow-to-region header-start (match-beginning 0))) (goto-char header-start) (while (and (re-search-forward - mime-edit-yank-ignored-field-regexp nil t) + (concat "^" + (apply (function regexp-or) + mime-edit-yank-ignored-field-list) + ":") nil t) (setq beg (match-beginning 0)) - (setq end (1+ (std11-field-end))) - ) - (delete-region beg end) - ) - )))) + (setq end (1+ (std11-field-end)))) + (delete-region beg end)))))) ;;; @ multipart enclosure @@ -2240,66 +2393,60 @@ and insert data encoded as ENCODING." (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") - ) - )) + (goto-char (point-max))) + (mime-edit-force-text-tag mime-edit-beginning-tag-regexp))) (defun mime-edit-enclose-quote-region (beg end) (interactive "*r") - (mime-edit-enclose-region-internal '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-internal '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-internal '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-internal '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-internal 'alternative beg end) - ) + (mime-edit-enclose-region-internal 'alternative beg end)) (defun mime-edit-enclose-pgp-signed-region (beg end) (interactive "*r") - (mime-edit-enclose-region-internal 'pgp-signed beg end) - ) + (mime-edit-enclose-region-internal 'pgp-signed beg end)) (defun mime-edit-enclose-pgp-encrypted-region (beg end) (interactive "*r") - (mime-edit-enclose-region-internal 'pgp-encrypted beg end) - ) + (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) - ) + (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) - ) + (mime-edit-enclose-region-internal 'kazu-encrypted beg end)) + +(defun mime-edit-enclose-smime-signed-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'smime-signed beg end)) + +(defun mime-edit-enclose-smime-encrypted-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'smime-encrypted beg end)) (defun mime-edit-insert-key (&optional arg) "Insert a pgp public key." (interactive "P") (mime-edit-insert-tag "application" "pgp-keys") (mime-edit-define-encoding "7bit") - (funcall (pgp-function 'insert-key)) - ) + (pgg-insert-key) + (mime-edit-force-text-tag mime-edit-single-part-tag-regexp)) ;;; @ flag setting @@ -2308,13 +2455,11 @@ and insert data encoded as ENCODING." (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 (message "This message is enabled to split.") - (message "This message is not enabled to split.") - )) + (message "This message is not enabled to split."))) (defun mime-edit-toggle-transfer-level (&optional transfer-level) "Toggle transfer-level is 7bit or 8bit through. @@ -2325,24 +2470,20 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (setq mime-transfer-level transfer-level) (if (< mime-transfer-level 8) (setq mime-transfer-level 8) - (setq mime-transfer-level 7) - )) + (setq mime-transfer-level 7))) (message (format "Current transfer-level is %d bit" mime-transfer-level)) (setq mime-transfer-level-string (mime-encoding-name mime-transfer-level 'not-omit)) - (force-mode-line-update) - ) + (force-mode-line-update)) (defun mime-edit-set-transfer-level-7bit () (interactive) - (mime-edit-toggle-transfer-level 7) - ) + (mime-edit-toggle-transfer-level 7)) (defun mime-edit-set-transfer-level-8bit () (interactive) - (mime-edit-toggle-transfer-level 8) - ) + (mime-edit-toggle-transfer-level 8)) ;;; @ pgp @@ -2354,51 +2495,47 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (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 (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) - ) - (message "This message will not be signed.") - )) + (or (memq 'sign mime-edit-pgp-processing) + (setq mime-edit-pgp-processing + (nconc mime-edit-pgp-processing + (copy-sequence '(sign))))) + (message "This message will be signed.")) + (setq mime-edit-pgp-processing + (delq 'sign mime-edit-pgp-processing)) + (message "This message will not be signed."))) (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 (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) - ) - (message "This message will not be encrypt.") - )) + (or (memq 'encrypt mime-edit-pgp-processing) + (setq mime-edit-pgp-processing + (nconc mime-edit-pgp-processing + (copy-sequence '(encrypt))))) + (message "This message will be encrypt.")) + (setq mime-edit-pgp-processing + (delq 'encrypt mime-edit-pgp-processing)) + (message "This message will not be encrypt."))) (defun mime-edit-pgp-enclose-buffer () (let ((beg (save-excursion (goto-char (point-min)) (if (search-forward (concat "\n" mail-header-separator "\n")) - (match-end 0) - ))) - (end (point-max)) - ) + (match-end 0))))) (if beg - (cond ((eq mime-edit-pgp-processing 'sign) - (mime-edit-enclose-pgp-signed-region beg end) - ) - ((eq mime-edit-pgp-processing 'encrypt) - (mime-edit-enclose-pgp-encrypted-region beg end) - )) - ))) + (dolist (pgp-processing mime-edit-pgp-processing) + (case pgp-processing + (sign + (mime-edit-enclose-pgp-signed-region + beg (point-max))) + (encrypt + (mime-edit-enclose-pgp-encrypted-region + beg (point-max)))))))) ;;; @ split @@ -2408,28 +2545,26 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." id number total separator) (insert fields) (insert (format "Subject: %s (%d/%d)\n" subject number total)) - (insert mime-edit-mime-version-field-for-message/partial) + (insert (format "Mime-Version: %s\n" mime-edit-mime-version-value)) (insert (format "\ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" - id number total separator)) - ) + id number total separator))) (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))) - ) + (count-lines (point-min) (point-max)))) (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-edit-draft-file-name - (or (buffer-file-name) - (make-temp-name - (expand-file-name "mime-draft" temporary-file-directory)))) + mime-edit-message-default-max-lines))) + (let* ( +;; (mime-edit-draft-file-name +;; (or (buffer-file-name) +;; (make-temp-name +;; (expand-file-name "mime-draft" temporary-file-directory)))) (separator mail-header-separator) (id (concat "\"" (replace-space-with-underline (current-time-string)) @@ -2451,9 +2586,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (function (lambda () (interactive) - (error "Split sender is not specified for `%s'." major-mode) - )) - )) + (error "Split sender is not specified for `%s'." major-mode))))) (mime-edit-partial-number 1) data) (save-excursion @@ -2465,13 +2598,11 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (concat "^" (regexp-quote separator) "$") nil t) (let ((he (match-beginning 0))) (replace-match "") - (narrow-to-region (point-min) he) - )) + (narrow-to-region (point-min) he))) (goto-char (point-min)) (while (re-search-forward mime-edit-split-blind-field-regexp nil t) (delete-region (match-beginning 0) - (1+ (std11-field-end))) - ))) + (1+ (std11-field-end)))))) (while (< mime-edit-partial-number total) (erase-buffer) (save-excursion @@ -2480,10 +2611,8 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (point-min) (progn (goto-line mime-edit-message-max-length) - (point)) - )) - (delete-region (point-min)(point)) - ) + (point)))) + (delete-region (point-min)(point))) (mime-edit-insert-partial-header header subject id mime-edit-partial-number total separator) (insert data) @@ -2491,28 +2620,23 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (message (format "Sending %d/%d..." mime-edit-partial-number total)) (call-interactively command) - (message (format "Sending %d/%d... done" - mime-edit-partial-number total)) - ) + (message (format "Sending %d/%d...done" + mime-edit-partial-number total))) (setq mime-edit-partial-number - (1+ mime-edit-partial-number)) - ) + (1+ mime-edit-partial-number))) (erase-buffer) (save-excursion (set-buffer copy-buf) (setq data (buffer-string)) - (erase-buffer) - ) + (erase-buffer)) (mime-edit-insert-partial-header header subject id mime-edit-partial-number total separator) (insert data) (save-excursion (message (format "Sending %d/%d..." mime-edit-partial-number total)) - (message (format "Sending %d/%d... done" - mime-edit-partial-number total)) - ) - ))) + (message (format "Sending %d/%d...done" + mime-edit-partial-number total)))))) (defun mime-edit-maybe-split-and-send (&optional cmd) (interactive) @@ -2520,18 +2644,17 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (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))) - ) + (lines (count-lines (point-min) (point-max)))) (if (and (> lines mime-edit-message-max-length) mime-edit-split-message) - (mime-edit-split-and-send cmd lines mime-edit-message-max-length) - ))) + (mime-edit-split-and-send cmd lines mime-edit-message-max-length)))) ;;; @ preview message ;;; (defvar mime-edit-buffer nil) ; buffer local variable +(defvar mime-edit-temp-message-buffer nil) (defun mime-edit-preview-message () "preview editing MIME message." @@ -2542,42 +2665,40 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (buf-name (buffer-name)) (temp-buf-name (concat "*temp-article:" buf-name "*")) (buf (get-buffer temp-buf-name)) - ) + (pgp-processing mime-edit-pgp-processing)) (if buf (progn (switch-to-buffer buf) - (erase-buffer) - ) + (erase-buffer)) (setq buf (get-buffer-create temp-buf-name)) - (switch-to-buffer buf) - ) + (switch-to-buffer buf)) (insert str) (setq major-mode 'mime-temp-message-mode) (make-local-variable 'mail-header-separator) (setq mail-header-separator separator) (make-local-variable 'mime-edit-buffer) (setq mime-edit-buffer the-buf) + (setq mime-edit-pgp-processing pgp-processing) (run-hooks 'mime-edit-translate-hook) (mime-edit-translate-buffer) (goto-char (point-min)) (if (re-search-forward (concat "^" (regexp-quote separator) "$")) - (replace-match "") - ) + (replace-match "")) (mime-view-buffer) - )) + (make-local-variable 'mime-edit-temp-message-buffer) + (setq mime-edit-temp-message-buffer buf))) (defun mime-edit-quitting-method () "Quitting method for mime-view." - (let ((temp mime-raw-buffer) - buf) + (let* ((temp mime-edit-temp-message-buffer) + buf) (mime-preview-kill-buffer) (set-buffer temp) (setq buf mime-edit-buffer) (kill-buffer temp) - (switch-to-buffer buf) - )) + (switch-to-buffer buf))) (set-alist 'mime-preview-quitting-method-alist 'mime-temp-message-mode @@ -2600,7 +2721,12 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" string)) (defun mime-edit-decode-multipart-in-buffer (content-type not-decode-text) - (let* ((subtype (mime-content-type-subtype content-type)) + (let* ((subtype + (or + (cdr (assoc (mime-content-type-parameter content-type "protocol") + '(("application/pgp-encrypted" . pgp-encrypted) + ("application/pgp-signature" . pgp-signed)))) + (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) @@ -2624,29 +2750,45 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (save-excursion (if (re-search-forward boundary-pat nil t) (setq end (match-beginning 0)) - (setq end (point-max)) - ) + (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)) - )))) - )) + (cond + ((eq subtype 'pgp-encrypted) + (when (and + (progn + (goto-char (point-min)) + (re-search-forward "^-+BEGIN PGP MESSAGE-+$" + nil t)) + (prog1 + (save-window-excursion + (pgg-decrypt-region (match-beginning 0) + (point-max))) + (delete-region (point-min)(point-max)))) + (insert-buffer-substring pgg-output-buffer) + (mime-edit-decode-message-in-buffer + nil not-decode-text) + (delete-region (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (match-end 0) + (point-min))) + (goto-char (point-max)))) + (t + (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) - ))) - )) + (point-min)))))) -(defun mime-edit-decode-single-part-in-buffer (content-type not-decode-text) +(defun mime-edit-decode-single-part-in-buffer + (content-type not-decode-text &optional content-disposition) (let* ((type (mime-content-type-primary-type content-type)) (subtype (mime-content-type-subtype content-type)) (ctype (format "%s/%s" type subtype)) @@ -2666,14 +2808,41 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (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)))))) + (1- (point))))) + (disposition-type + (mime-content-disposition-type content-disposition)) + (disposition-str + (if disposition-type + (let ((bytes (+ 21 (length (format "%s" disposition-type))))) + (mapconcat (function + (lambda (attr) + (let* ((str (concat + (car attr) + "=" + (if (string-equal "filename" + (car attr)) + (std11-wrap-as-quoted-string + (cdr 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-disposition-parameters + content-disposition) + ""))))) + (if disposition-type + (setq pstr (format "%s\nContent-Disposition: %s%s" + pstr disposition-type disposition-str))) (save-excursion (if (re-search-forward "^Content-Transfer-Encoding:" limit t) @@ -2694,20 +2863,22 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (mime-decode-region (match-end 0)(point-max) encoding) (setq encoded t - encoding nil) - ))))))) - (if (or encoded (not not-decode-text)) - (decode-mime-charset-region (point-min)(point-max) - (or charset default-mime-charset)) - ) + encoding nil)))))))) + (if (and (eq type 'text) + (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) - ))) + (point-min)))) (if (and (eq type 'text) (eq subtype 'x-rot13-47-48)) - (mule-caesar-region he (point-max)) - ) + (mule-caesar-region he (point-max))) (if (= (point-min) 1) (progn (goto-char he) @@ -2715,14 +2886,11 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (concat "\n" (mime-create-tag (format "%s/%s%s" type subtype pstr) - encoding))) - ) + encoding)))) (delete-region (point-min) he) (insert (mime-create-tag (format "%s/%s%s" type subtype pstr) - encoding)) - )) - )) + encoding)))))) ;;;###autoload (defun mime-edit-decode-message-in-buffer (&optional default-content-type @@ -2736,26 +2904,24 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (cond ((and (eq type 'application) (eq (mime-content-type-subtype ctl) 'pgp-signature)) - (delete-region (point-min)(point-max)) - ) + (delete-region (point-min)(point-max))) ((eq type 'multipart) - (mime-edit-decode-multipart-in-buffer ctl not-decode-text) - ) + (mime-edit-decode-multipart-in-buffer ctl not-decode-text)) (t - (mime-edit-decode-single-part-in-buffer ctl not-decode-text) - ))) + (mime-edit-decode-single-part-in-buffer + ctl not-decode-text (mime-read-Content-Disposition))))) (or not-decode-text (decode-mime-charset-region (point-min) (point-max) - 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)) - ))) + default-mime-charset))) + (if (= (point-min) 1) + (progn + (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) @@ -2767,17 +2933,14 @@ converted to MIME-Edit tags." (if (search-forward (concat "\n" (regexp-quote mail-header-separator) "\n") nil t) - (replace-match "\n\n") - ) + (replace-match "\n\n")) (mime-edit-decode-message-in-buffer nil not-decode-text) (goto-char (point-min)) (or no-separator (and (re-search-forward "^$") - (replace-match mail-header-separator) - )) + (replace-match mail-header-separator))) (or not-turn-on - (turn-on-mime-edit) - )) + (turn-on-mime-edit))) ;;; @ end