mime-edit の拡張
Hiroya Murata <[email protected]> Tue, 25 Oct 2005 00:40:46 +0900
| Newsgroups | gmane.mail.emacs.mime.japanese |
|---|---|
| Message-ID | <uvezmorcx.wl%[email protected]> |
mime-edit.el を mime-edit-insert-file, -voice, -mail, -message で 挿入される各パートについて, 別バッファにエンコード済みのデータを置 いて mime-edit バッファに mime-view を用いて表現形式を挿入する様に 拡張してみました. ;; 現在の実装では, -insert-file で挿入されるパートのメディアタイプ ;; が text だった場合は, 選んだ encoding に限らず, 編集バッファに ;; そのまま挿入されてしまいます. 又これを使って, mime-edit-again では, mime 解析した各 entity から 編集バッファを構成する様にもしてあります. 未だ完全ではありませんが, 取り敢えず叩き台にでもなればと思い, 公開 します. 添付のパッチは, emiko-1_14 枝の先端からの差分です. 尚, Wanderlust から使用する為には, 次のパッチを Wanderlust へ当て る必要があります. -- Hiroya Murata (村田 浩也) <[email protected]> PGP fingerprint: 53B6 1B4A 8193 A2D4 1526 BC9E 9AEF 2F6D 249D 5F17
mime-edit.el.patch
(application/octet-stream, 30 KB)
Index: mime-edit.el
===================================================================
RCS file: /cvs/root/semi/mime-edit.el,v
retrieving revision 1.36.2.8.2.28
diff -u -r1.36.2.8.2.28 mime-edit.el
--- mime-edit.el 6 Jul 2005 02:09:28 -0000 1.36.2.8.2.28
+++ mime-edit.el 24 Oct 2005 15:06:05 -0000
@@ -717,6 +717,7 @@
(define-key mime-edit-mode-entity-map "\C-k" 'mime-edit-insert-key)
(define-key mime-edit-mode-entity-map "t" 'mime-edit-insert-tag)
+(define-key mime-edit-mode-entity-map "d" 'mime-edit-delete-current-part)
(define-key mime-edit-mode-entity-map "7" 'mime-edit-set-transfer-level-7bit)
(define-key mime-edit-mode-entity-map "8" 'mime-edit-set-transfer-level-8bit)
(define-key mime-edit-mode-entity-map "/" 'mime-edit-set-split)
@@ -994,11 +995,13 @@
(if mime-edit-mode-flag
(error "You are already editing a MIME message.")
(setq mime-edit-mode-flag t)
+ (make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'mime-edit-clear-attached-buffer 'local)
;; Set transfer level into mode line
;;
(setq mime-transfer-level-string
- (mime-encoding-name mime-transfer-level 'not-omit))
+ (mime-encoding-name mime-transfer-level 'not-omit))
(force-mode-line-update)
;; Define menu for XEmacs.
@@ -1117,8 +1120,20 @@
(setq parameters
(concat parameters "; " attribute "=" value))
(setq rest (cdr rest)))))))
- (mime-edit-insert-tag type subtype parameters)
- (mime-edit-insert-binary-file file encoding)))
+ (cond
+ ((string-equal type "text")
+ (mime-edit-insert-tag type subtype parameters)
+ (insert-file-contents file))
+ (t
+ (mime-edit-insert-single-part-entity
+ (with-current-buffer (mime-edit-create-attached-entity-buffer)
+ (insert "Content-Type: " type "/" subtype parameters "\n")
+ (when encoding
+ (insert "Content-Transfer-Encoding: " encoding "\n"))
+ (insert "\n")
+ (mime-insert-encoded-file file encoding)
+ (mime-encode-header-in-buffer)
+ (mime-open-entity 'buffer (current-buffer))))))))
(defun mime-edit-insert-external ()
"Insert a reference to external body."
@@ -1145,29 +1160,39 @@
(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 (point)(point))
- (unwind-protect
- (funcall mime-edit-voice-recorder encoding)
- (progn
- (insert "\n")
- (add-text-properties
- (point-min)(point-max) '(invisible t mime-edit-invisible t))
- (goto-char (point-max)))))))
+ (mime-edit-insert-single-part-entity
+ (with-current-buffer (mime-edit-create-attached-entity-buffer)
+ (insert "Content-Type: audio/basic\n")
+ (when encoding
+ (insert "Content-Transfer-Encoding: " encoding "\n"))
+ (insert "\n")
+ (unwind-protect
+ (funcall mime-edit-voice-recorder encoding)
+ (progn
+ (insert "\n")
+ (mime-encode-header-in-buffer)
+ (mime-open-entity 'buffer (current-buffer))))))))
(defun mime-edit-insert-signature (&optional arg)
"Insert a signature file."
(interactive "P")
(let ((signature-insert-hook
- (function
- (lambda ()
+ (function
+ (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)))
+(defun mime-edit-delete-current-part ()
+ "Delete current part."
+ (interactive)
+ (when (mime-edit-goto-tag)
+ (let ((beg (match-beginning 0))
+ (end (mime-edit-content-end))
+ (inhibit-read-only t))
+ (delete-region beg end))))
+
;; Insert a new tag around a point.
@@ -1223,33 +1248,59 @@
nil ;Nothing is created.
)))
-(defun mime-edit-insert-binary-file (file &optional encoding)
- "Insert binary FILE at point.
-Optional argument ENCODING specifies an encoding method such as base64."
- (let* ((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")))))))
+
+;; Attachement part support
+
+(defvar mime-edit-attached-entity-buffers nil)
+(make-variable-buffer-local 'mime-edit-attached-entity-buffers)
+
+(defun mime-edit-clear-attached-buffer ()
+ (dolist (buffer mime-edit-attached-entity-buffers)
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer))))
+
+(defun mime-edit-create-attached-entity-buffer (&optional edit-buffer)
+ (let ((buffer (generate-new-buffer
+ (concat (buffer-name edit-buffer) "*attached*"))))
+ (setq mime-edit-attached-entity-buffers
+ (cons buffer mime-edit-attached-entity-buffers))
+ buffer))
+
+(defun mime-edit-insert-attached-part (type subtype entity
+ &optional parameters encoding)
+ (let ((tag-beg (point))
+ (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"))))))
+ (inhibit-read-only t))
(save-restriction
- (narrow-to-region (point)(point))
- (mime-insert-encoded-file file encoding)
- (if hide-p
- (add-text-properties
- (point-min)(point-max) '(invisible t mime-edit-invisible t)))
+ (narrow-to-region (point) (point))
+ (insert (mime-make-tag type subtype parameters encoding) "\n")
+ (unless hide-p
+ (save-restriction
+ (mime-display-entity entity nil '((entity-button . invisible)
+ (header . invisible)
+ (body . visible)))))
+ (add-text-properties (point-min) (point-max)
+ (list 'mime-edit-attached-entity entity
+ 'mime-edit-attached-visible (not hide-p)
+ 'read-only t))
+ (put-text-property (1- (point-max)) (point-max) 'rear-nonsticky t)
(goto-char (point-max)))
- (or hide-p
- (looking-at mime-edit-tag-regexp)
- (= (point)(point-max))
- (mime-edit-insert-tag "text" "plain"))
+ (or (looking-at mime-edit-tag-regexp)
+ (= (point) (point-max))
+ (insert (mime-make-tag "text" "plain") "\n"))
;; 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)))))
+ (goto-char tag-beg) ; Make sure which line the tag is on.
+ (mime-edit-define-encoding encoding)))
+ entity))
+
;; Commands work on a current message flagment.
@@ -1260,7 +1311,7 @@
(if (looking-at mime-edit-tag-regexp)
t
;; At first, go to the end.
- (cond ((re-search-forward mime-edit-beginning-tag-regexp nil t)
+ (cond ((re-search-forward mime-edit-tag-regexp nil t)
(goto-char (1- (match-beginning 0))) ;For multiline tag
)
(t
@@ -1300,14 +1351,20 @@
(if (mime-edit-goto-tag)
(progn
(goto-char (1+ (match-end 0)))
- (if (get-text-property (point) 'mime-edit-invisible)
- (or (next-single-property-change (point) 'mime-edit-invisible)
- (point-max))
+ (cond
+ ((get-text-property (point) 'mime-edit-invisible)
+ (or (next-single-property-change (point) 'mime-edit-invisible)
+ (point-max)))
+ ((get-text-property (point) 'mime-edit-attached-entity)
+ (or (next-single-property-change (point)
+ 'mime-edit-attached-entity)
+ (point-max)))
+ (t
;; 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)))
+ (point))))
;; Assume the message begins with text/plain.
(goto-char (mime-edit-content-beginning))
(if (re-search-forward mime-edit-tag-regexp nil 'move)
@@ -1319,26 +1376,34 @@
"Set charset of current tag to CHARSET."
(save-excursion
(if (mime-edit-goto-tag)
- (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
+ (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))
+ (props (text-properties-at (match-beginning 0))))
(delete-region (match-beginning 0) (match-end 0))
- (insert
- (mime-create-tag
- (mime-edit-set-parameter
- (mime-edit-get-contype 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)))))))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert
+ (mime-create-tag
+ (mime-edit-set-parameter
+ (mime-edit-get-contype 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)))
+ (set-text-properties (point-min) (point-max) props))))))
(defun mime-edit-define-encoding (encoding)
"Set encoding of current tag to ENCODING."
(save-excursion
(if (mime-edit-goto-tag)
- (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
+ (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))
+ (props (text-properties-at (match-beginning 0))))
(delete-region (match-beginning 0) (match-end 0))
- (insert (mime-create-tag (mime-edit-get-contype tag) encoding))))))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (mime-create-tag (mime-edit-get-contype tag) encoding))
+ (set-text-properties (point-min) (point-max) props))))))
(defun mime-edit-choose-charset ()
"Choose charset of a text following current point."
@@ -1565,7 +1630,8 @@
(undo-boundary)
(if (catch 'mime-edit-error
(save-excursion
- (run-hooks 'mime-edit-translate-buffer-hook)))
+ (let ((inhibit-read-only t))
+ (run-hooks 'mime-edit-translate-buffer-hook))))
(progn
(undo)
(error "Translation error!"))))
@@ -1660,7 +1726,7 @@
(save-excursion
(save-restriction
(let* ((from (std11-field-body "From" mail-header-separator))
- (ret (progn
+ (ret (progn
(narrow-to-region beg end)
(mime-edit-translate-region beg end boundary)))
(ctype (car ret))
@@ -1672,9 +1738,9 @@
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
- (or (let ((pgg-default-user-id
+ (or (let ((pgg-default-user-id
(or mime-edit-pgp-user-id
- (if from
+ (if from
(nth 1 (std11-extract-address-components from))
pgg-default-user-id))))
(pgg-sign-region (point-min)(point-max)))
@@ -1682,9 +1748,9 @@
(setq micalg
(cdr (assq 'hash-algorithm
(cdar (with-current-buffer pgg-output-buffer
- (pgg-parse-armor-region
+ (pgg-parse-armor-region
(point-min)(point-max))))))
- micalg
+ micalg
(if micalg
(concat "; micalg=pgp-" (downcase (symbol-name micalg)))
""))
@@ -1737,34 +1803,34 @@
(save-excursion
(save-restriction
(let (from recipients header)
- (let ((ret (mime-edit-make-encrypt-recipient-header)))
- (setq from (aref ret 0)
- recipients (aref ret 1)
- header (aref ret 2)))
- (narrow-to-region beg end)
- (let* ((ret
- (mime-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")
+ (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")
(mime-encode-header-in-buffer)
- (or (let ((pgg-default-user-id
+ (or (let ((pgg-default-user-id
(or mime-edit-pgp-user-id
- (if from
+ (if from
(nth 1 (std11-extract-address-components from))
- pgg-default-user-id))))
- (pgg-encrypt-region
- (point-min) (point-max)
+ pgg-default-user-id))))
+ (pgg-encrypt-region
+ (point-min) (point-max)
(mapcar (lambda (recipient)
(nth 1 (std11-extract-address-components
recipient)))
- (split-string recipients
+ (split-string recipients
"\\([ \t\n]*,[ \t\n]*\\)+"))))
(throw 'mime-edit-error 'pgp-error))
(delete-region (point-min)(point-max))
@@ -1832,7 +1898,7 @@
(defun mime-edit-sign-smime (beg end boundary)
(save-excursion
(save-restriction
- (let* ((ret (progn
+ (let* ((ret (progn
(narrow-to-region beg end)
(mime-edit-translate-region beg end boundary)))
(ctype (car ret))
@@ -1861,7 +1927,7 @@
(defun mime-edit-encrypt-smime (beg end boundary)
(save-excursion
(save-restriction
- (let* ((ret (progn
+ (let* ((ret (progn
(narrow-to-region beg end)
(mime-edit-translate-region beg end boundary)))
(ctype (car ret))
@@ -1954,26 +2020,43 @@
(mail-position-on-field "Content-Transfer-Encoding")
(insert encoding)))))))
+(defun mime-edit-translate-attached-part (tag-beg tag-end)
+ (let ((entity (get-text-property tag-beg 'mime-edit-attached-entity)))
+ (when entity
+ (save-excursion
+ (let ((body-beg (1+ tag-end))
+ (body-end (or (next-single-property-change
+ tag-beg
+ 'mime-edit-attached-entity)
+ (point-max)))
+ (inhibit-read-only t))
+ (remove-text-properties tag-beg body-end
+ '(mime-edit-attached-entity))
+ (delete-region body-beg body-end)
+ (goto-char body-beg)
+ (mime-insert-entity-body entity))))))
+
(defun mime-edit-translate-single-part-tag (boundary &optional prefix)
"Translate single-part-tag to MIME header."
(if (re-search-forward mime-edit-single-part-tag-regexp nil t)
(let* ((beg (match-beginning 0))
(end (match-end 0))
- (tag (buffer-substring beg end)))
+ (tag (buffer-substring beg end))
+ (contype (mime-edit-get-contype tag))
+ (encoding (mime-edit-get-encoding tag)))
+ (mime-edit-translate-attached-part beg end)
(delete-region beg end)
- (let ((contype (mime-edit-get-contype tag))
- (encoding (mime-edit-get-encoding tag)))
- (insert (concat prefix "--" boundary "\n"))
- (save-restriction
- (narrow-to-region (point)(point))
- (insert "Content-Type: " contype "\n")
- (if encoding
- (insert "Content-Transfer-Encoding: " encoding "\n"))
- (mime-encode-header-in-buffer))
- (cons (and contype
- (downcase contype))
- (and encoding
- (downcase encoding)))))))
+ (insert (concat prefix "--" boundary "\n"))
+ (save-restriction
+ (narrow-to-region (point)(point))
+ (insert "Content-Type: " contype "\n")
+ (if encoding
+ (insert "Content-Transfer-Encoding: " encoding "\n"))
+ (mime-encode-header-in-buffer))
+ (cons (and contype
+ (downcase contype))
+ (and encoding
+ (downcase encoding))))))
(defun mime-edit-translate-region (beg end &optional boundary multipart)
(or boundary
@@ -1999,11 +2082,13 @@
(goto-char (point-min))
(while (re-search-forward
mime-edit-single-part-tag-regexp nil t)
- (setq tag
- (buffer-substring (match-beginning 0) (match-end 0)))
- (delete-region (match-beginning 0) (1+ (match-end 0)))
- (setq contype (mime-edit-get-contype tag))
- (setq encoding (mime-edit-get-encoding tag))))
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (setq tag (buffer-substring beg end))
+ (mime-edit-translate-attached-part beg end)
+ (delete-region beg (1+ end))
+ (setq contype (mime-edit-get-contype tag))
+ (setq encoding (mime-edit-get-encoding tag)))))
(t
;; It's a multipart message.
(goto-char (point-min))
@@ -2073,12 +2158,12 @@
(point)))
(end (mime-edit-content-end)))
;; Patch for hard newlines
- ;; (save-excursion
- ;; (goto-char beg)
- ;; (while (search-forward "\n" end t)
- ;; (put-text-property (match-beginning 0)
- ;; (point)
- ;; 'hard t)))
+ ;; (save-excursion
+ ;; (goto-char beg)
+ ;; (while (search-forward "\n" end t)
+ ;; (put-text-property (match-beginning 0)
+ ;; (point)
+ ;; 'hard t)))
;; End patch for hard newlines
(enriched-encode beg end nil)
(goto-char beg)
@@ -2173,22 +2258,27 @@
;; Message forwarding commands as content-type "message/rfc822".
+(defun mime-edit-insert-message-1 (inserter &optional message)
+ (mime-edit-insert-attached-part
+ "message" "rfc822"
+ (with-current-buffer (mime-edit-create-attached-entity-buffer)
+ (funcall inserter message)
+ (goto-char (point-min))
+ (insert "Content-Type: message/rfc822\n\n")
+ (mime-open-entity 'buffer (current-buffer)))))
+
(defun mime-edit-insert-message (&optional message)
(interactive)
(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))
+ (mime-edit-insert-message-1 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))
+ (mime-edit-insert-message-1 inserter message)
(message "Sorry, I don't have mail inserter for your MUA."))))
(defun mime-edit-inserted-message-filter ()
@@ -2330,11 +2420,11 @@
(if arg
(progn
(or (memq 'sign mime-edit-pgp-processing)
- (setq mime-edit-pgp-processing
- (nconc 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
+ (setq mime-edit-pgp-processing
(delq 'sign mime-edit-pgp-processing))
(message "This message will not be signed.")))
@@ -2345,8 +2435,8 @@
(if arg
(progn
(or (memq 'encrypt mime-edit-pgp-processing)
- (setq mime-edit-pgp-processing
- (nconc 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
@@ -2362,10 +2452,10 @@
(dolist (pgp-processing mime-edit-pgp-processing)
(case pgp-processing
(sign
- (mime-edit-enclose-pgp-signed-region
+ (mime-edit-enclose-pgp-signed-region
beg (point-max)))
(encrypt
- (mime-edit-enclose-pgp-encrypted-region
+ (mime-edit-enclose-pgp-encrypted-region
beg (point-max))))))))
@@ -2540,214 +2630,130 @@
"\\):")
"Regexp for deleted header fields when `mime-edit-again' is called.")
-(defsubst eliminate-top-spaces (string)
- "Eliminate top sequence of space or tab in STRING."
- (if (string-match "^[ \t]+" string)
- (substring string (match-end 0))
- string))
-
-(defun mime-edit-decode-multipart-in-buffer (content-type not-decode-text)
- (let* ((subtype
+(defun mime-edit-insert-multipart-entity (entity)
+ (let* ((content-type (mime-entity-content-type entity))
+ (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)
- (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)
- (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))))))
-
-(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))
+ (mime-content-type-subtype content-type))))
+ (insert (format "--<<%s>>-{\n" subtype))
+ (cond
+ ((eq subtype 'pgp-encrypted)
+ (when (with-temp-buffer
+ (mime-insert-entity-body entity)
+ (goto-char (point-min))
+ (and
+ (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)
+ (save-window-excursion
+ (pgg-decrypt-region (match-beginning 0) (point-max)))))
+ (let ((decrypted (with-current-buffer
+ (mime-edit-create-attached-entity-buffer)
+ (insert-buffer-substring pgg-output-buffer)
+ (mime-open-entity 'buffer (current-buffer)))))
+ (mime-edit-insert-mime-entity decrypted))))
+ (t
+ (dolist (child (mime-entity-children entity))
+ (mime-edit-insert-mime-entity child))))
+ (insert (format "--}-<<%s>>\n" subtype))))
+
+(defun mime-edit-insert-single-part-entity (entity)
+ (let* ((content-type (mime-entity-content-type entity))
+ (content-disposition (mime-entity-content-disposition entity))
+ (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)))))
+ (parameters (let ((bytes (+ 14 (length ctype))))
+ (mapconcat (lambda (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 (mime-entity-encoding entity))
(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)
- ))))
+ (mapconcat (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)
- (let ((beg (match-beginning 0))
- (hbeg (match-end 0))
- (end (std11-field-end limit)))
- (setq encoding
- (downcase
- (eliminate-top-spaces
- (std11-unfold-string
- (buffer-substring hbeg end)))))
- (if (or charset (eq type 'text))
- (progn
- (delete-region beg (1+ end))
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (progn
- (mime-decode-region
- (match-end 0)(point-max) encoding)
- (setq encoded t
- encoding nil))))))))
- (if (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))))
- (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))))))
+ (when disposition-type
+ (setq parameters (format "%s\nContent-Disposition: %s%s"
+ parameters disposition-type disposition-str)))
+ (cond
+ ((eq type 'text)
+ (insert
+ (mime-make-tag (symbol-name type) (symbol-name subtype) parameters)
+ "\n")
+ (if (eq subtype 'x-rot13-47-48)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mime-insert-text-content entity)
+ (mule-caesar-region (point-min) (point-max))
+ (goto-char (point-max)))
+ (mime-insert-text-content entity)))
+ (t
+ (mime-edit-insert-attached-part (symbol-name type)
+ (symbol-name subtype)
+ entity
+ parameters
+ encoding)))))
+
+(defun mime-edit-insert-mime-entity (entity)
+ (let ((ct (mime-entity-content-type entity)))
+ (when ct
+ (let ((type (mime-content-type-primary-type ct)))
+ (cond
+ ((and (eq type 'application)
+ (eq (mime-content-type-subtype ct) 'pgp-signature)))
+ ((eq type 'multipart)
+ (mime-edit-insert-multipart-entity entity))
+ (t
+ (mime-edit-insert-single-part-entity entity)))))))
;;;###autoload
(defun mime-edit-decode-message-in-buffer (&optional default-content-type
not-decode-text)
(save-excursion
- (goto-char (point-min))
- (let ((ctl (or (mime-read-Content-Type)
- default-content-type)))
- (if ctl
- (let ((type (mime-content-type-primary-type ctl)))
- (cond
- ((and (eq type 'application)
- (eq (mime-content-type-subtype ctl) 'pgp-signature))
- (delete-region (point-min)(point-max)))
- ((eq type 'multipart)
- (mime-edit-decode-multipart-in-buffer ctl not-decode-text))
- (t
- (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)))
- (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)))))))
+ (let* ((edit-buffer (current-buffer))
+ (message (with-current-buffer
+ (mime-edit-create-attached-entity-buffer)
+ (insert-buffer-substring edit-buffer)
+ (mime-open-entity 'buffer (current-buffer)))))
+ (goto-char (point-min))
+ (when (re-search-forward "^$")
+ (delete-region (1+ (match-end 0)) (point-max)))
+ (goto-char (point-max))
+ (mime-edit-insert-mime-entity message)
+ (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)
wl.patch
(application/octet-stream, 2.7 KB)
Index: elmo/elmo-mime.el
===================================================================
RCS file: /cvs/root/wanderlust/elmo/elmo-mime.el,v
retrieving revision 1.25
diff -u -r1.25 elmo-mime.el
--- elmo/elmo-mime.el 20 Mar 2005 09:19:39 -0000 1.25
+++ elmo/elmo-mime.el 24 Oct 2005 15:39:51 -0000
@@ -29,6 +29,7 @@
;;; Code:
;;
(require 'elmo-vars)
+(require 'elmo)
(require 'mmbuffer)
(require 'mmimap)
(require 'mime-view)
@@ -196,7 +197,7 @@
"Insert sorted header fields of the ENTITY.")
(luna-define-method elmo-mime-insert-sorted-header ((entity
- mime-elmo-buffer-entity)
+ mime-buffer-entity)
&optional invisible-fields
visible-fields
sorted-fields)
Index: wl/wl-draft.el
===================================================================
RCS file: /cvs/root/wanderlust/wl/wl-draft.el,v
retrieving revision 1.254
diff -u -r1.254 wl-draft.el
--- wl/wl-draft.el 16 Mar 2005 09:10:22 -0000 1.254
+++ wl/wl-draft.el 24 Oct 2005 15:40:03 -0000
@@ -66,6 +66,7 @@
(defvar wl-draft-config-exec-flag t)
(defvar wl-draft-buffer-cur-summary-buffer nil)
(defvar wl-draft-clone-local-variable-regexp "^\\(wl\\|mime\\)")
+(defvar wl-draft-ignore-clone-variables '(mime-edit-attached-entity-buffers))
(defvar wl-draft-sendlog-filename "sendlog")
(defvar wl-draft-queue-save-filename "qinfo")
(defvar wl-draft-config-save-filename "config")
@@ -575,7 +576,7 @@
body-beg)
(set-buffer tmp-buf)
(erase-buffer)
- (insert string)
+ (insert (string-to-multibyte string))
(setq to (std11-field-body "To"))
(setq to (and to
(eword-decode-string
@@ -1263,15 +1264,14 @@
(wl-draft-send kill-when-done mes-string))))
(defun wl-draft-clone-local-variables ()
- (let ((locals (buffer-local-variables))
- result)
- (while locals
- (when (and (consp (car locals))
- (car (car locals))
+ (let (symbol result)
+ (dolist (local (buffer-local-variables))
+ (when (and (consp local)
+ (setq symbol (car local))
+ (not (memq symbol wl-draft-ignore-clone-variables))
(string-match wl-draft-clone-local-variable-regexp
- (symbol-name (car (car locals)))))
- (wl-append result (list (car (car locals)))))
- (setq locals (cdr locals)))
+ (symbol-name symbol)))
+ (setq result (cons symbol result))))
result))
(defcustom wl-draft-send-confirm-with-preview t
@@ -1325,7 +1325,8 @@
;; Don't call this explicitly.
;; Added to 'wl-draft-send-hook (by teranisi)
;; (wl-draft-config-exec)
- (run-hooks 'wl-draft-send-hook)
+ (let ((inhibit-read-only t))
+ (run-hooks 'wl-draft-send-hook))
(when (or (not wl-interactive-send)
(wl-draft-send-confirm))
(let ((send-mail-function 'wl-draft-raw-send)