X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-edit.el;h=873c5bf90658d362ebffbf28c4c886a8003dca6c;hb=d8d8ac12939199251a948289e342cd691f83e7bd;hp=bb48d9cdecafe78588520187de424b6101c66b94;hpb=7e73926d5aeae94ed2ee289ccce778646a8b6248;p=elisp%2Fsemi.git diff --git a/mime-edit.el b/mime-edit.el index bb48d9c..873c5bf 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -4,7 +4,6 @@ ;; Author: UMEDA Masanobu ;; MORIOKA Tomohiko -;; Maintainer: MORIOKA Tomohiko ;; Created: 1994/08/21 renamed from mime.el ;; Renamed: 1997/2/21 from tm-edit.el ;; Keywords: MIME, multimedia, multilingual, mail, news @@ -107,23 +106,27 @@ ;;; 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-version-string - `,(concat (car mime-module-version) " " - (mapconcat #'number-to-string (cddr mime-module-version) ".") - " - \"" (cadr mime-module-version) "\"")) +(eval-and-compile + (defconst mime-edit-version + (eval-when-compile + (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 @@ -184,18 +187,11 @@ 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") - ) + ("enriched") + ("html") + ("css") ; rfc2318 + ("xml") ; rfc2376 + ("x-latex") ("x-rot13-47-48") ) ("message" @@ -214,9 +210,13 @@ 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")) @@ -238,29 +238,87 @@ To insert a signature file automatically, call the function "*Alist of content-type, subtype, parameters and its values.") (defcustom mime-file-types - '(("\\.txt$" + '( + + ;; 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 "inline" (("filename" . file)) ) - ("\\.pln$" + + ;; .rc : procmail modules pm-xxxx.rc + ;; *rc : other resource files + + ("\\.\\(rc\\|lst\\|log\\|sql\\|mak\\)$\\|\\..*rc$" "text" "plain" nil nil - "inline" (("filename" . file)) + "attachment" (("filename" . file)) ) - ("\\.rtf$" - "text" "richtext" nil - nil - nil nil) + ("\\.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)) + ) + + ("\\.pln$" + "text" "plain" nil + nil + "inline" (("filename" . file)) + ) ("\\.ps$" "application" "postscript" nil "quoted-printable" "attachment" (("filename" . file)) ) + + ;; Pure binary + ("\\.jpg$" "image" "jpeg" nil "base64" @@ -311,16 +369,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" @@ -361,18 +409,9 @@ 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 nil nil) + + ;; Rest + (".*" "application" "octet-stream" nil nil @@ -408,9 +447,9 @@ If encoding is nil, it is determined from its contents." ,@(cons '(const nil) (mapcar (lambda (cell) - (list 'item (car cell)) + (list 'item cell) ) - mime-file-encoding-method-alist))) + (mime-encoding-list)))) ;; disposition-type (choice :tag "Disposition-Type" (item nil) @@ -441,10 +480,11 @@ 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") (iso-2022-jp-2 7 "base64") (iso-2022-int-1 7 "base64") )) @@ -464,23 +504,11 @@ 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-charset-default-encoding-alist - (mime-make-charset-default-encoding-alist mime-transfer-level)) -(make-variable-buffer-local 'mime-edit-charset-default-encoding-alist) +;;; @@ about content transfer encoding +(defvar mime-content-transfer-encoding-priority-list + '(nil "8bit" "binary")) ;;; @@ about message inserting ;;; @@ -523,26 +551,19 @@ If it is not specified for a major-mode, :type 'list) (defconst mime-edit-split-ignored-field-regexp - "\\(^Content-\\|^Subject:\\|^Mime-Version:\\|Message-Id:\\)") + "\\(^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-mime - "*PGP signing type (pgp-mime, pgp-kazu or nil).") - -(defvar mime-edit-encrypting-type 'pgp-mime - "*PGP encrypting type (pgp-mime, pgp-kazu or nil).") - - ;;; @@ about tag ;;; @@ -587,30 +608,56 @@ 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 (featurep 'xemacs) - (concat emacs-version (if (featurep 'mule) - " with mule" - " without mule")) - (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) - (substring emacs-version 0 (match-beginning 0)) - emacs-version))) - (if (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (concat "Emacs " ver - (if enable-multibyte-characters - (concat ", MULE " mule-version) - " (with raw setting)") - (if (featurep 'meadow) - (concat ", " (Meadow-version)) - )) - (concat "MULE " mule-version " based on Emacs " ver)) - ver))) - "Body of X-Emacs field. -If variable `mime-edit-insert-x-emacs-field' is not nil, it is +(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)) + " (" 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) + (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.") @@ -622,11 +669,13 @@ inserted into message header.") 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-string ")") + (eval-when-compile + (concat "1.0 (generated by " mime-edit-version ")")) "MIME version number.") (defconst mime-edit-mime-version-field-for-message/partial - (concat "MIME-Version: 1.0 (split by " mime-edit-version-string ")\n") + (eval-when-compile + (concat "MIME-Version: 1.0 (split by " mime-edit-version ")\n")) "MIME version field for message/partial.") @@ -677,9 +726,9 @@ Tspecials means any character that matches with it in header must be quoted.") (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-signed-region) + "\C-s" 'mime-edit-enclose-pgp-signed-region) (define-key mime-edit-mode-enclosure-map - "\C-e" 'mime-edit-enclose-encrypted-region) + "\C-e" 'mime-edit-enclose-pgp-encrypted-region) (define-key mime-edit-mode-enclosure-map "\C-q" 'mime-edit-enclose-quote-region) @@ -707,8 +756,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) @@ -719,11 +768,11 @@ Tspecials means any character that matches with it in header must be quoted.") ) "MIME-edit menubar entry.") -(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) @@ -826,24 +875,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. @@ -914,7 +966,7 @@ User customizable variables (not documented all of them): ))) -(cond (running-xemacs +(cond ((featurep 'xemacs) (add-minor-mode 'mime-edit-mode-flag '((" MIME-Edit " mime-transfer-level-string)) mime-edit-mode-map @@ -946,7 +998,7 @@ User customizable variables (not documented all of them): (force-mode-line-update) ;; Define menu for XEmacs. - (if running-xemacs + (if (featurep 'xemacs) (mime-edit-define-menu-for-xemacs) ) @@ -984,7 +1036,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)) ) @@ -1021,9 +1073,8 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (insert "\n") (forward-char -1) )) - (if (and (member (cadr ret) '("enriched" "richtext")) - (fboundp 'enriched-mode) - ) + (if (and (member (cadr ret) '("enriched")) + (fboundp 'enriched-mode)) (enriched-mode t) (if (boundp 'enriched-mode) (enriched-mode -1) @@ -1110,7 +1161,7 @@ If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." (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 @@ -1539,7 +1590,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (setq encoding (completing-read "What transfer encoding: " - mime-file-encoding-method-alist nil t default) + (mime-encoding-alist) nil t default) ) "")) encoding)) @@ -1620,21 +1671,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-mime) - (mime-edit-sign-pgp-mime 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-mime) - (mime-edit-encrypt-pgp-mime 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 @@ -1773,9 +1821,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 @@ -1795,10 +1841,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 @@ -1806,9 +1851,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)) @@ -1878,10 +1921,10 @@ 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") @@ -1919,8 +1962,12 @@ Content-Transfer-Encoding: 7bit (if encoding (insert "Content-Transfer-Encoding: " encoding "\n")) (eword-encode-header) - )) - t))) + ) + (cons (and contype + (downcase contype)) + (and encoding + (downcase encoding)))) + ))) (defun mime-edit-translate-region (beg end &optional boundary multipart) (or boundary @@ -1956,22 +2003,26 @@ Content-Transfer-Encoding: 7bit (t ;; It's a multipart message. (goto-char (point-min)) - (and (mime-edit-translate-single-part-tag boundary) - (while (mime-edit-translate-single-part-tag boundary "\n"))) - ;; Define Content-Type as "multipart/mixed". - (setq contype - (concat "multipart/mixed;\n boundary=\"" boundary "\"")) - ;; 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." @@ -2043,12 +2094,17 @@ 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) ;; Protect "From " in beginning of line @@ -2073,13 +2129,11 @@ Content-Transfer-Encoding: 7bit (save-restriction (narrow-to-region beg (mime-edit-content-end)) (goto-char beg) - (while (re-search-forward "\\([^\r]\\)\n" nil t) - (replace-match - (concat (buffer-substring (match-beginning 0) - (match-end 1)) "\r\n")) - ))) + (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) + (replace-match "\\1\r\n")))) (goto-char beg) - (mime-encode-region beg (mime-edit-content-end) encoding) + (mime-encode-region beg (mime-edit-content-end) + (or encoding "7bit")) (mime-edit-define-encoding encoding) )) (goto-char (mime-edit-content-end)) @@ -2215,19 +2269,25 @@ and insert data encoded as ENCODING." (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-internal '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-internal '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." @@ -2263,8 +2323,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 @@ -2286,18 +2344,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? ") )) (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) @@ -2311,12 +2369,9 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (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) @@ -2324,9 +2379,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)) @@ -2337,10 +2389,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) )) ))) @@ -2373,7 +2425,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (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)) @@ -2509,7 +2561,7 @@ 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 () @@ -2533,144 +2585,169 @@ 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-edit-decode-buffer (not-decode-text) +(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))) + (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)) + (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-read-Content-Type))) + (let ((ctl (or (mime-read-Content-Type) + default-content-type))) (if ctl - (let ((type (mime-content-type-primary-type ctl)) - (stype (mime-content-type-subtype ctl)) - (params (mime-content-type-parameters ctl))) + (let ((type (mime-content-type-primary-type ctl))) (cond - ((and (eq type 'application)(eq stype 'pgp-signature)) + ((and (eq type 'application) + (eq (mime-content-type-subtype ctl) 'pgp-signature)) (delete-region (point-min)(point-max)) ) ((eq type 'multipart) - (let* ((boundary (cdr (assoc "boundary" params))) - (boundary-pat - (concat "\n--" (regexp-quote boundary) "[ \t]*\n")) - ) - (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-edit-decode-buffer 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) - ))) - )) + (mime-edit-decode-multipart-in-buffer ctl not-decode-text) + ) (t - (let* ((ctype (format "%s/%s" type stype)) - 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) - ) - )))) - 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 (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)) - (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 - (format "%s/%s%s" type stype pstr) - encoding))) - ) - (delete-region (point-min) he) - (insert - (mime-create-tag - (format "%s/%s%s" type stype pstr) - encoding)) - )) - )))) + (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 @@ -2682,14 +2759,8 @@ converted to MIME-Edit tags." nil t) (replace-match "\n\n") ) - (mime-edit-decode-buffer 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)