[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/mml.el [lexbind]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/mml.el [lexbind] |
Date: |
Wed, 15 Sep 2004 20:36:35 -0400 |
Index: emacs/lisp/gnus/mml.el
diff -c emacs/lisp/gnus/mml.el:1.14.4.2 emacs/lisp/gnus/mml.el:1.14.4.3
*** emacs/lisp/gnus/mml.el:1.14.4.2 Tue Oct 14 23:34:51 2003
--- emacs/lisp/gnus/mml.el Thu Sep 16 00:12:16 2004
***************
*** 1,5 ****
! ;;; mml.el --- package for parsing and validating MML documents
! ;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; This file is part of GNU Emacs.
--- 1,6 ----
! ;;; mml.el --- A package for parsing and validating MML documents
! ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
! ;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; This file is part of GNU Emacs.
***************
*** 27,41 ****
--- 28,88 ----
(require 'mm-bodies)
(require 'mm-encode)
(require 'mm-decode)
+ (require 'mml-sec)
(eval-when-compile (require 'cl))
(eval-and-compile
(autoload 'message-make-message-id "message")
(autoload 'gnus-setup-posting-charset "gnus-msg")
(autoload 'gnus-add-minor-mode "gnus-ems")
+ (autoload 'gnus-make-local-hook "gnus-util")
(autoload 'message-fetch-field "message")
+ (autoload 'fill-flowed-encode "flow-fill")
(autoload 'message-posting-charset "message"))
+ (defcustom mml-content-type-parameters
+ '(name access-type expiration size permission format)
+ "*A list of acceptable parameters in MML tag.
+ These parameters are generated in Content-Type header if exists."
+ :type '(repeat (symbol :tag "Parameter"))
+ :group 'message)
+
+ (defcustom mml-content-disposition-parameters
+ '(filename creation-date modification-date read-date)
+ "*A list of acceptable parameters in MML tag.
+ These parameters are generated in Content-Disposition header if exists."
+ :type '(repeat (symbol :tag "Parameter"))
+ :group 'message)
+
+ (defcustom mml-insert-mime-headers-always nil
+ "If non-nil, always put Content-Type: text/plain at top of empty parts.
+ It is necessary to work against a bug in certain clients."
+ :type 'boolean
+ :group 'message)
+
+ (defvar mml-tweak-type-alist nil
+ "A list of (TYPE . FUNCTION) for tweaking MML parts.
+ TYPE is a string containing a regexp to match the MIME type. FUNCTION
+ is a Lisp function which is called with the MML handle to tweak the
+ part. This variable is used only when no TWEAK parameter exists in
+ the MML handle.")
+
+ (defvar mml-tweak-function-alist nil
+ "A list of (NAME . FUNCTION) for tweaking MML parts.
+ NAME is a string containing the name of the TWEAK parameter in the MML
+ handle. FUNCTION is a Lisp function which is called with the MML
+ handle to tweak the part.")
+
+ (defvar mml-tweak-sexp-alist
+ '((mml-externalize-attachments . mml-tweak-externalize-attachments))
+ "A list of (SEXP . FUNCTION) for tweaking MML parts.
+ SEXP is an s-expression. If the evaluation of SEXP is non-nil, FUNCTION
+ is called. FUNCTION is a Lisp function which is called with the MML
+ handle to tweak the part.")
+
+ (defvar mml-externalize-attachments nil
+ "*If non-nil, local-file attachments are generated as external parts.")
+
(defvar mml-generate-multipart-alist nil
"*Alist of multipart generation functions.
Each entry has the form (NAME . FUNCTION), where
***************
*** 73,87 ****
with unknown encoding; `multipart': always send messages with more than
one charsets.")
- (defvar mml-generate-mime-preprocess-function nil
- "A function called before generating a mime part.
- The function is called with one parameter, which is the part to be
- generated.")
-
- (defvar mml-generate-mime-postprocess-function nil
- "A function called after generating a mime part.
- The function is called with one parameter, which is the generated part.")
-
(defvar mml-generate-default-type "text/plain")
(defvar mml-buffer-list nil)
--- 120,125 ----
***************
*** 98,110 ****
(defun mml-parse ()
"Parse the current buffer as an MML document."
! (goto-char (point-min))
! (let ((table (syntax-table)))
! (unwind-protect
! (progn
! (set-syntax-table mml-syntax-table)
! (mml-parse-1))
! (set-syntax-table table))))
(defun mml-parse-1 ()
"Parse the current buffer as an MML document."
--- 136,149 ----
(defun mml-parse ()
"Parse the current buffer as an MML document."
! (save-excursion
! (goto-char (point-min))
! (let ((table (syntax-table)))
! (unwind-protect
! (progn
! (set-syntax-table mml-syntax-table)
! (mml-parse-1))
! (set-syntax-table table)))))
(defun mml-parse-1 ()
"Parse the current buffer as an MML document."
***************
*** 112,117 ****
--- 151,193 ----
(while (and (not (eobp))
(not (looking-at "<#/multipart")))
(cond
+ ((looking-at "<#secure")
+ ;; The secure part is essentially a meta-meta tag, which
+ ;; expands to either a part tag if there are no other parts in
+ ;; the document or a multipart tag if there are other parts
+ ;; included in the message
+ (let* (secure-mode
+ (taginfo (mml-read-tag))
+ (recipients (cdr (assq 'recipients taginfo)))
+ (sender (cdr (assq 'sender taginfo)))
+ (location (cdr (assq 'tag-location taginfo)))
+ (mode (cdr (assq 'mode taginfo)))
+ (method (cdr (assq 'method taginfo)))
+ tags)
+ (save-excursion
+ (if
+ (re-search-forward
+ "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
+ (setq secure-mode "multipart")
+ (setq secure-mode "part")))
+ (save-excursion
+ (goto-char location)
+ (re-search-forward "<#secure[^\n]*>\n"))
+ (delete-region (match-beginning 0) (match-end 0))
+ (cond ((string= mode "sign")
+ (setq tags (list "sign" method)))
+ ((string= mode "encrypt")
+ (setq tags (list "encrypt" method)))
+ ((string= mode "signencrypt")
+ (setq tags (list "sign" method "encrypt" method))))
+ (eval `(mml-insert-tag ,secure-mode
+ ,@tags
+ ,(if recipients "recipients")
+ ,recipients
+ ,(if sender "sender")
+ ,sender))
+ ;; restart the parse
+ (goto-char location)))
((looking-at "<#multipart")
(push (nconc (mml-read-tag) (mml-parse-1)) struct))
((looking-at "<#external")
***************
*** 128,145 ****
(setq raw (cdr (assq 'raw tag))
point (point)
contents (mml-read-part (eq 'mml (car tag)))
! charsets (if raw nil
! (mm-find-mime-charset-region point (point))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
! (prog1 (y-or-n-p
! "\
! Message contains characters with unknown encoding. Really send?")
! (set (make-local-variable 'mml-confirmation-set)
! (push 'unknown-encoding mml-confirmation-set))))
(if (setq use-ascii
(or (memq 'use-ascii mml-confirmation-set)
! (y-or-n-p "Use ASCII as charset?")))
(setq charsets (delq nil charsets))
(setq warn nil))
(error "Edit your message to remove those characters")))
--- 204,228 ----
(setq raw (cdr (assq 'raw tag))
point (point)
contents (mml-read-part (eq 'mml (car tag)))
! charsets (cond
! (raw nil)
! ((assq 'charset tag)
! (list
! (intern (downcase (cdr (assq 'charset tag))))))
! (t
! (mm-find-mime-charset-region point (point)
! mm-hack-charsets))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
! (message-options-get 'unknown-encoding)
! (and (y-or-n-p "\
! Message contains characters with unknown encoding. Really send? ")
! (message-options-set 'unknown-encoding t)))
(if (setq use-ascii
(or (memq 'use-ascii mml-confirmation-set)
! (message-options-get 'use-ascii)
! (and (y-or-n-p "Use ASCII as charset? ")
! (message-options-set 'use-ascii t))))
(setq charsets (delq nil charsets))
(setq warn nil))
(error "Edit your message to remove those characters")))
***************
*** 155,168 ****
tag point (point) use-ascii)))
(when (and warn
(not (memq 'multipart mml-confirmation-set))
! (not
! (prog1 (y-or-n-p
! (format
! "\
A message part needs to be split into %d charset parts. Really send? "
! (length nstruct)))
! (set (make-local-variable 'mml-confirmation-set)
! (push 'multipart mml-confirmation-set)))))
(error "Edit your message to use only one charset"))
(setq struct (nconc nstruct struct)))))))
(unless (eobp)
--- 238,248 ----
tag point (point) use-ascii)))
(when (and warn
(not (memq 'multipart mml-confirmation-set))
! (not (message-options-get 'multipart))
! (not (and (y-or-n-p (format "\
A message part needs to be split into %d charset parts. Really send? "
! (length nstruct)))
! (message-options-set 'multipart t))))
(error "Edit your message to use only one charset"))
(setq struct (nconc nstruct struct)))))))
(unless (eobp)
***************
*** 229,240 ****
(defun mml-read-tag ()
"Read a tag and return the contents."
! (let (contents name elem val)
(forward-char 2)
(setq name (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
(skip-chars-forward " \t\n")
! (while (not (looking-at ">"))
(setq elem (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
(skip-chars-forward "= \t\n")
--- 309,321 ----
(defun mml-read-tag ()
"Read a tag and return the contents."
! (let ((orig-point (point))
! contents name elem val)
(forward-char 2)
(setq name (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
(skip-chars-forward " \t\n")
! (while (not (looking-at ">[ \t]*\n?"))
(setq elem (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
(skip-chars-forward "= \t\n")
***************
*** 244,258 ****
(setq val (match-string 1 val)))
(push (cons (intern elem) val) contents)
(skip-chars-forward " \t\n"))
! (forward-char 1)
! (skip-chars-forward " \t\n")
(cons (intern name) (nreverse contents))))
(defun mml-read-part (&optional mml)
"Return the buffer up till the next part, multipart or closing part or
multipart.
If MML is non-nil, return the buffer up till the correspondent mml tag."
(let ((beg (point)) (count 1))
! ;; If the tag ended at the end of the line, we go to the next line.
(when (looking-at "[ \t]*\n")
(forward-line 1))
(if mml
--- 325,351 ----
(setq val (match-string 1 val)))
(push (cons (intern elem) val) contents)
(skip-chars-forward " \t\n"))
! (goto-char (match-end 0))
! ;; Don't skip the leading space.
! ;;(skip-chars-forward " \t\n")
! ;; Put the tag location into the returned contents
! (setq contents (append (list (cons 'tag-location orig-point)) contents))
(cons (intern name) (nreverse contents))))
+ (defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
+ (let ((str (buffer-substring-no-properties start end))
+ (bufstart start) tmp)
+ (while (setq tmp (text-property-any start end 'hard 't))
+ (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
+ '(hard t) str)
+ (setq start (1+ tmp)))
+ str))
+
(defun mml-read-part (&optional mml)
"Return the buffer up till the next part, multipart or closing part or
multipart.
If MML is non-nil, return the buffer up till the correspondent mml tag."
(let ((beg (point)) (count 1))
! ;; If the tag ended at the end of the line, we go to the next line.
(when (looking-at "[ \t]*\n")
(forward-line 1))
(if mml
***************
*** 261,279 ****
(if (re-search-forward "<#\\(/\\)?mml." nil t)
(setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max))))
! (buffer-substring-no-properties beg (if (> count 0)
! (point)
! (match-beginning 0))))
(if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1
! (buffer-substring-no-properties beg (match-beginning 0))
(if (or (not (match-beginning 1))
(equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
! (buffer-substring-no-properties beg (goto-char (point-max)))))))
(defvar mml-boundary nil)
(defvar mml-base-boundary "-=-=")
--- 354,375 ----
(if (re-search-forward "<#\\(/\\)?mml." nil t)
(setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max))))
! (mml-buffer-substring-no-properties-except-hard-newlines
! beg (if (> count 0)
! (point)
! (match-beginning 0))))
(if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1
! (mml-buffer-substring-no-properties-except-hard-newlines
! beg (match-beginning 0))
(if (or (not (match-beginning 1))
(equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
! (mml-buffer-substring-no-properties-except-hard-newlines
! beg (goto-char (point-max)))))))
(defvar mml-boundary nil)
(defvar mml-base-boundary "-=-=")
***************
*** 294,422 ****
(buffer-string)))))
(defun mml-generate-mime-1 (cont)
! (save-restriction
! (narrow-to-region (point) (point))
! (if mml-generate-mime-preprocess-function
! (funcall mml-generate-mime-preprocess-function cont))
! (cond
! ((or (eq (car cont) 'part) (eq (car cont) 'mml))
! (let ((raw (cdr (assq 'raw cont)))
! coded encoding charset filename type)
! (setq type (or (cdr (assq 'type cont)) "text/plain"))
! (if (and (not raw)
! (member (car (split-string type "/")) '("text" "message")))
! (progn
! (with-temp-buffer
! (cond
! ((cdr (assq 'buffer cont))
! (insert-buffer-substring (cdr (assq 'buffer cont))))
! ((and (setq filename (cdr (assq 'filename cont)))
! (not (equal (cdr (assq 'nofile cont)) "yes")))
! (mm-insert-file-contents filename))
! ((eq 'mml (car cont))
! (insert (cdr (assq 'contents cont))))
! (t
! (save-restriction
! (narrow-to-region (point) (point))
! (insert (cdr (assq 'contents cont)))
! ;; Remove quotes from quoted tags.
! (goto-char (point-min))
! (while (re-search-forward
! "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil
t)
! (delete-region (+ (match-beginning 0) 2)
! (+ (match-beginning 0) 3))))))
! (cond
! ((eq (car cont) 'mml)
! (let ((mml-boundary (funcall mml-boundary-function
! (incf mml-multipart-number)))
! (mml-generate-default-type "text/plain"))
! (mml-to-mime))
! (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
! ;; ignore 0x1b, it is part of iso-2022-jp
! (setq encoding (mm-body-7-or-8))))
! ((string= (car (split-string type "/")) "message")
! (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
! ;; ignore 0x1b, it is part of iso-2022-jp
! (setq encoding (mm-body-7-or-8))))
! (t
! (setq charset (mm-encode-body))
! (setq encoding (mm-body-encoding
! charset (cdr (assq 'encoding cont))))))
! (setq coded (buffer-string)))
! (mml-insert-mime-headers cont type charset encoding)
! (insert "\n")
! (insert coded))
! (mm-with-unibyte-buffer
! (cond
! ((cdr (assq 'buffer cont))
! (insert-buffer-substring (cdr (assq 'buffer cont))))
! ((and (setq filename (cdr (assq 'filename cont)))
! (not (equal (cdr (assq 'nofile cont)) "yes")))
! (let ((coding-system-for-read mm-binary-coding-system))
! (mm-insert-file-contents filename nil nil nil nil t)))
! (t
! (insert (cdr (assq 'contents cont)))))
! (setq encoding (mm-encode-buffer type)
! coded (buffer-string)))
! (mml-insert-mime-headers cont type charset encoding)
! (insert "\n")
! (mm-with-unibyte-current-buffer
! (insert coded)))))
! ((eq (car cont) 'external)
! (insert "Content-Type: message/external-body")
! (let ((parameters (mml-parameter-string
! cont '(expiration size permission)))
! (name (cdr (assq 'name cont))))
! (when name
! (setq name (mml-parse-file-name name))
! (if (stringp name)
(mml-insert-parameter
! (mail-header-encode-parameter "name" name)
! "access-type=local-file")
! (mml-insert-parameter
! (mail-header-encode-parameter
! "name" (file-name-nondirectory (nth 2 name)))
! (mail-header-encode-parameter "site" (nth 1 name))
! (mail-header-encode-parameter
! "directory" (file-name-directory (nth 2 name))))
(mml-insert-parameter
! (concat "access-type="
! (if (member (nth 0 name) '("ftp@" "anonymous@"))
! "anon-ftp"
! "ftp")))))
! (when parameters
! (mml-insert-parameter-string
! cont '(expiration size permission))))
! (insert "\n\n")
! (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
! (insert "Content-ID: " (message-make-message-id) "\n")
! (insert "Content-Transfer-Encoding: "
! (or (cdr (assq 'encoding cont)) "binary"))
! (insert "\n\n")
! (insert (or (cdr (assq 'contents cont))))
! (insert "\n"))
! ((eq (car cont) 'multipart)
! (let* ((type (or (cdr (assq 'type cont)) "mixed"))
! (mml-generate-default-type (if (equal type "digest")
! "message/rfc822"
! "text/plain"))
! (handler (assoc type mml-generate-multipart-alist)))
! (if handler
! (funcall (cdr handler) cont)
! ;; No specific handler. Use default one.
! (let ((mml-boundary (mml-compute-boundary cont)))
! (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
! type mml-boundary))
! ;; Skip `multipart' and `type' elements.
! (setq cont (cddr cont))
! (while cont
! (insert "\n--" mml-boundary "\n")
! (mml-generate-mime-1 (pop cont)))
! (insert "\n--" mml-boundary "--\n")))))
! (t
! (error "Invalid element: %S" cont)))
! (if mml-generate-mime-postprocess-function
! (funcall mml-generate-mime-postprocess-function cont))))
(defun mml-compute-boundary (cont)
"Return a unique boundary that does not exist in CONT."
--- 390,572 ----
(buffer-string)))))
(defun mml-generate-mime-1 (cont)
! (let ((mm-use-ultra-safe-encoding
! (or mm-use-ultra-safe-encoding (assq 'sign cont))))
! (save-restriction
! (narrow-to-region (point) (point))
! (mml-tweak-part cont)
! (cond
! ((or (eq (car cont) 'part) (eq (car cont) 'mml))
! (let ((raw (cdr (assq 'raw cont)))
! coded encoding charset filename type flowed)
! (setq type (or (cdr (assq 'type cont)) "text/plain"))
! (if (and (not raw)
! (member (car (split-string type "/")) '("text" "message")))
! (progn
! (with-temp-buffer
! (setq charset (mm-charset-to-coding-system
! (cdr (assq 'charset cont))))
! (when (eq charset 'ascii)
! (setq charset nil))
! (cond
! ((cdr (assq 'buffer cont))
! (insert-buffer-substring (cdr (assq 'buffer cont))))
! ((and (setq filename (cdr (assq 'filename cont)))
! (not (equal (cdr (assq 'nofile cont)) "yes")))
! (let ((coding-system-for-read charset))
! (mm-insert-file-contents filename)))
! ((eq 'mml (car cont))
! (insert (cdr (assq 'contents cont))))
! (t
! (save-restriction
! (narrow-to-region (point) (point))
! (insert (cdr (assq 'contents cont)))
! ;; Remove quotes from quoted tags.
! (goto-char (point-min))
! (while (re-search-forward
! "<#!+/?\\(part\\|multipart\\|external\\|mml\\)"
! nil t)
! (delete-region (+ (match-beginning 0) 2)
! (+ (match-beginning 0) 3))))))
! (cond
! ((eq (car cont) 'mml)
! (let ((mml-boundary (mml-compute-boundary cont))
! (mml-generate-default-type "text/plain"))
! (mml-to-mime))
! (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
! ;; ignore 0x1b, it is part of iso-2022-jp
! (setq encoding (mm-body-7-or-8))))
! ((string= (car (split-string type "/")) "message")
! (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
! ;; ignore 0x1b, it is part of iso-2022-jp
! (setq encoding (mm-body-7-or-8))))
! (t
! ;; Only perform format=flowed filling on text/plain
! ;; parts where there either isn't a format parameter
! ;; in the mml tag or it says "flowed" and there
! ;; actually are hard newlines in the text.
! (let (use-hard-newlines)
! (when (and (string= type "text/plain")
! (or (null (assq 'format cont))
! (string= (cdr (assq 'format cont))
! "flowed"))
! (setq use-hard-newlines
! (text-property-any
! (point-min) (point-max) 'hard 't)))
! (fill-flowed-encode)
! ;; Indicate that `mml-insert-mime-headers' should
! ;; insert a "; format=flowed" string unless the
! ;; user has already specified it.
! (setq flowed (null (assq 'format cont)))))
! (setq charset (mm-encode-body charset))
! (setq encoding (mm-body-encoding
! charset (cdr (assq 'encoding cont))))))
! (setq coded (buffer-string)))
! (mml-insert-mime-headers cont type charset encoding flowed)
! (insert "\n")
! (insert coded))
! (mm-with-unibyte-buffer
! (cond
! ((cdr (assq 'buffer cont))
! (insert-buffer-substring (cdr (assq 'buffer cont))))
! ((and (setq filename (cdr (assq 'filename cont)))
! (not (equal (cdr (assq 'nofile cont)) "yes")))
! (let ((coding-system-for-read mm-binary-coding-system))
! (mm-insert-file-contents filename nil nil nil nil t)))
! (t
! (insert (cdr (assq 'contents cont)))))
! (setq encoding (mm-encode-buffer type)
! coded (mm-string-as-multibyte (buffer-string))))
! (mml-insert-mime-headers cont type charset encoding nil)
! (insert "\n")
! (mm-with-unibyte-current-buffer
! (insert coded)))))
! ((eq (car cont) 'external)
! (insert "Content-Type: message/external-body")
! (let ((parameters (mml-parameter-string
! cont '(expiration size permission)))
! (name (cdr (assq 'name cont)))
! (url (cdr (assq 'url cont))))
! (when name
! (setq name (mml-parse-file-name name))
! (if (stringp name)
! (mml-insert-parameter
! (mail-header-encode-parameter "name" name)
! "access-type=local-file")
(mml-insert-parameter
! (mail-header-encode-parameter
! "name" (file-name-nondirectory (nth 2 name)))
! (mail-header-encode-parameter "site" (nth 1 name))
! (mail-header-encode-parameter
! "directory" (file-name-directory (nth 2 name))))
! (mml-insert-parameter
! (concat "access-type="
! (if (member (nth 0 name) '("ftp@" "anonymous@"))
! "anon-ftp"
! "ftp")))))
! (when url
(mml-insert-parameter
! (mail-header-encode-parameter "url" url)
! "access-type=url"))
! (when parameters
! (mml-insert-parameter-string
! cont '(expiration size permission))))
! (insert "\n\n")
! (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
! (insert "Content-ID: " (message-make-message-id) "\n")
! (insert "Content-Transfer-Encoding: "
! (or (cdr (assq 'encoding cont)) "binary"))
! (insert "\n\n")
! (insert (or (cdr (assq 'contents cont))))
! (insert "\n"))
! ((eq (car cont) 'multipart)
! (let* ((type (or (cdr (assq 'type cont)) "mixed"))
! (mml-generate-default-type (if (equal type "digest")
! "message/rfc822"
! "text/plain"))
! (handler (assoc type mml-generate-multipart-alist)))
! (if handler
! (funcall (cdr handler) cont)
! ;; No specific handler. Use default one.
! (let ((mml-boundary (mml-compute-boundary cont)))
! (insert (format "Content-Type: multipart/%s; boundary=\"%s\""
! type mml-boundary)
! (if (cdr (assq 'start cont))
! (format "; start=\"%s\"\n" (cdr (assq 'start cont)))
! "\n"))
! (let ((cont cont) part)
! (while (setq part (pop cont))
! ;; Skip `multipart' and attributes.
! (when (and (consp part) (consp (cdr part)))
! (insert "\n--" mml-boundary "\n")
! (mml-generate-mime-1 part))))
! (insert "\n--" mml-boundary "--\n")))))
! (t
! (error "Invalid element: %S" cont)))
! ;; handle sign & encrypt tags in a semi-smart way.
! (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist))
! (encrypt-item (assoc (cdr (assq 'encrypt cont))
! mml-encrypt-alist))
! sender recipients)
! (when (or sign-item encrypt-item)
! (when (setq sender (cdr (assq 'sender cont)))
! (message-options-set 'mml-sender sender)
! (message-options-set 'message-sender sender))
! (if (setq recipients (cdr (assq 'recipients cont)))
! (message-options-set 'message-recipients recipients))
! (let ((style (mml-signencrypt-style (first (or sign-item
encrypt-item)))))
! ;; check if: we're both signing & encrypting, both methods
! ;; are the same (why would they be different?!), and that
! ;; the signencrypt style allows for combined operation.
! (if (and sign-item encrypt-item (equal (first sign-item)
! (first encrypt-item))
! (equal style 'combined))
! (funcall (nth 1 encrypt-item) cont t)
! ;; otherwise, revert to the old behavior.
! (when sign-item
! (funcall (nth 1 sign-item) cont))
! (when encrypt-item
! (funcall (nth 1 encrypt-item) cont)))))))))
(defun mml-compute-boundary (cont)
"Return a unique boundary that does not exist in CONT."
***************
*** 458,491 ****
"")
mml-base-boundary))
! (defun mml-insert-mime-headers (cont type charset encoding)
! (let (parameters disposition description)
(setq parameters
(mml-parameter-string
! cont '(name access-type expiration size permission)))
(when (or charset
parameters
! (not (equal type mml-generate-default-type)))
(when (consp charset)
(error
! "Can't encode a part with several charsets."))
(insert "Content-Type: " type)
(when charset
(insert "; " (mail-header-encode-parameter
"charset" (symbol-name charset))))
(when parameters
(mml-insert-parameter-string
! cont '(name access-type expiration size permission)))
(insert "\n"))
(setq parameters
(mml-parameter-string
! cont '(filename creation-date modification-date read-date)))
(when (or (setq disposition (cdr (assq 'disposition cont)))
parameters)
(insert "Content-Disposition: " (or disposition "inline"))
(when parameters
(mml-insert-parameter-string
! cont '(filename creation-date modification-date read-date)))
(insert "\n"))
(unless (eq encoding '7bit)
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
--- 608,647 ----
"")
mml-base-boundary))
! (defun mml-insert-mime-headers (cont type charset encoding flowed)
! (let (parameters id disposition description)
(setq parameters
(mml-parameter-string
! cont mml-content-type-parameters))
(when (or charset
parameters
! flowed
! (not (equal type mml-generate-default-type))
! mml-insert-mime-headers-always)
(when (consp charset)
(error
! "Can't encode a part with several charsets"))
(insert "Content-Type: " type)
(when charset
(insert "; " (mail-header-encode-parameter
"charset" (symbol-name charset))))
+ (when flowed
+ (insert "; format=flowed"))
(when parameters
(mml-insert-parameter-string
! cont mml-content-type-parameters))
(insert "\n"))
+ (when (setq id (cdr (assq 'id cont)))
+ (insert "Content-ID: " id "\n"))
(setq parameters
(mml-parameter-string
! cont mml-content-disposition-parameters))
(when (or (setq disposition (cdr (assq 'disposition cont)))
parameters)
(insert "Content-Disposition: " (or disposition "inline"))
(when parameters
(mml-insert-parameter-string
! cont mml-content-disposition-parameters))
(insert "\n"))
(unless (eq encoding '7bit)
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
***************
*** 542,566 ****
;;; Transforming MIME to MML
;;;
! (defun mime-to-mml ()
! "Translate the current buffer (which should be a message) into MML."
;; First decode the head.
(save-restriction
(message-narrow-to-head)
(mail-decode-encoded-word-region (point-min) (point-max)))
! (let ((handles (mm-dissect-buffer t)))
! (goto-char (point-min))
! (search-forward "\n\n" nil t)
! (delete-region (point) (point-max))
! (if (stringp (car handles))
! (mml-insert-mime handles)
! (mml-insert-mime handles t))
! (mm-destroy-parts handles))
(save-restriction
(message-narrow-to-head)
;; Remove them, they are confusing.
(message-remove-header "Content-Type")
(message-remove-header "MIME-Version")
(message-remove-header "Content-Transfer-Encoding")))
(defun mml-to-mime ()
--- 698,725 ----
;;; Transforming MIME to MML
;;;
! (defun mime-to-mml (&optional handles)
! "Translate the current buffer (which should be a message) into MML.
! If HANDLES is non-nil, use it instead reparsing the buffer."
;; First decode the head.
(save-restriction
(message-narrow-to-head)
(mail-decode-encoded-word-region (point-min) (point-max)))
! (unless handles
! (setq handles (mm-dissect-buffer t)))
! (goto-char (point-min))
! (search-forward "\n\n" nil t)
! (delete-region (point) (point-max))
! (if (stringp (car handles))
! (mml-insert-mime handles)
! (mml-insert-mime handles t))
! (mm-destroy-parts handles)
(save-restriction
(message-narrow-to-head)
;; Remove them, they are confusing.
(message-remove-header "Content-Type")
(message-remove-header "MIME-Version")
+ (message-remove-header "Content-Disposition")
(message-remove-header "Content-Transfer-Encoding")))
(defun mml-to-mime ()
***************
*** 568,573 ****
--- 727,735 ----
(message-encode-message-body)
(save-restriction
(message-narrow-to-headers-or-head)
+ ;; Skip past any From_ headers.
+ (while (looking-at "From ")
+ (forward-line 1))
(let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer))))
***************
*** 589,605 ****
(mml-insert-mml-markup handle buffer textp)))
(cond
(mmlp
! (insert-buffer buffer)
(goto-char (point-max))
(insert "<#/mml>\n"))
((stringp (car handle))
(mapcar 'mml-insert-mime (cdr handle))
(insert "<#/multipart>\n"))
(textp
! (let ((text (mm-get-part handle))
! (charset (mail-content-type-get
! (mm-handle-type handle) 'charset)))
! (insert (mm-decode-string text charset)))
(goto-char (point-max)))
(t
(insert "<#/part>\n")))))
--- 751,770 ----
(mml-insert-mml-markup handle buffer textp)))
(cond
(mmlp
! (insert-buffer-substring buffer)
(goto-char (point-max))
(insert "<#/mml>\n"))
((stringp (car handle))
(mapcar 'mml-insert-mime (cdr handle))
(insert "<#/multipart>\n"))
(textp
! (let ((charset (mail-content-type-get
! (mm-handle-type handle) 'charset))
! (start (point)))
! (if (eq charset 'gnus-decoded)
! (mm-insert-part handle)
! (insert (mm-decode-string (mm-get-part handle) charset)))
! (mml-quote-region start (point)))
(goto-char (point-max)))
(t
(insert "<#/part>\n")))))
***************
*** 607,620 ****
(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
"Take a MIME handle and insert an MML tag."
(if (stringp (car handle))
! (insert "<#multipart type=" (mm-handle-media-subtype handle)
! ">\n")
(if mmlp
(insert "<#mml type=" (mm-handle-media-type handle))
(insert "<#part type=" (mm-handle-media-type handle)))
(dolist (elem (append (cdr (mm-handle-type handle))
(cdr (mm-handle-disposition handle))))
! (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))
(when (mm-handle-disposition handle)
(insert " disposition=" (car (mm-handle-disposition handle))))
(when buffer
--- 772,792 ----
(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
"Take a MIME handle and insert an MML tag."
(if (stringp (car handle))
! (progn
! (insert "<#multipart type=" (mm-handle-media-subtype handle))
! (let ((start (mm-handle-multipart-ctl-parameter handle 'start)))
! (when start
! (insert " start=\"" start "\"")))
! (insert ">\n"))
(if mmlp
(insert "<#mml type=" (mm-handle-media-type handle))
(insert "<#part type=" (mm-handle-media-type handle)))
(dolist (elem (append (cdr (mm-handle-type handle))
(cdr (mm-handle-disposition handle))))
! (unless (symbolp (cdr elem))
! (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
! (when (mm-handle-id handle)
! (insert " id=\"" (mm-handle-id handle) "\""))
(when (mm-handle-disposition handle)
(insert " disposition=" (car (mm-handle-disposition handle))))
(when buffer
***************
*** 641,648 ****
;;;
(defvar mml-mode-map
! (let ((map (make-sparse-keymap))
(main (make-sparse-keymap)))
(define-key map "f" 'mml-attach-file)
(define-key map "b" 'mml-attach-buffer)
(define-key map "e" 'mml-attach-external)
--- 813,837 ----
;;;
(defvar mml-mode-map
! (let ((sign (make-sparse-keymap))
! (encrypt (make-sparse-keymap))
! (signpart (make-sparse-keymap))
! (encryptpart (make-sparse-keymap))
! (map (make-sparse-keymap))
(main (make-sparse-keymap)))
+ (define-key sign "p" 'mml-secure-message-sign-pgpmime)
+ (define-key sign "o" 'mml-secure-message-sign-pgp)
+ (define-key sign "s" 'mml-secure-message-sign-smime)
+ (define-key signpart "p" 'mml-secure-sign-pgpmime)
+ (define-key signpart "o" 'mml-secure-sign-pgp)
+ (define-key signpart "s" 'mml-secure-sign-smime)
+ (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
+ (define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
+ (define-key encrypt "s" 'mml-secure-message-encrypt-smime)
+ (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime)
+ (define-key encryptpart "o" 'mml-secure-encrypt-pgp)
+ (define-key encryptpart "s" 'mml-secure-encrypt-smime)
+ (define-key map "\C-n" 'mml-unsecure-message)
(define-key map "f" 'mml-attach-file)
(define-key map "b" 'mml-attach-buffer)
(define-key map "e" 'mml-attach-external)
***************
*** 651,673 ****
(define-key map "p" 'mml-insert-part)
(define-key map "v" 'mml-validate)
(define-key map "P" 'mml-preview)
;;(define-key map "n" 'mml-narrow-to-part)
! (define-key main "\M-m" map)
main))
(easy-menu-define
mml-menu mml-mode-map ""
! '("MML"
! ("Attach"
! ["File" mml-attach-file t]
! ["Buffer" mml-attach-buffer t]
! ["External" mml-attach-external t])
! ("Insert"
! ["Multipart" mml-insert-multipart t]
! ["Part" mml-insert-part t])
;;["Narrow" mml-narrow-to-part t]
! ["Quote" mml-quote-region t]
! ["Validate" mml-validate t]
["Preview" mml-preview t]))
(defvar mml-mode nil
--- 840,882 ----
(define-key map "p" 'mml-insert-part)
(define-key map "v" 'mml-validate)
(define-key map "P" 'mml-preview)
+ (define-key map "s" sign)
+ (define-key map "S" signpart)
+ (define-key map "c" encrypt)
+ (define-key map "C" encryptpart)
;;(define-key map "n" 'mml-narrow-to-part)
! ;; `M-m' conflicts with `back-to-indentation'.
! ;; (define-key main "\M-m" map)
! (define-key main "\C-c\C-m" map)
main))
(easy-menu-define
mml-menu mml-mode-map ""
! `("Attachments"
! ["Attach File..." mml-attach-file
! ,@(if (featurep 'xemacs) '(t)
! '(:help "Attach a file at point"))]
! ["Attach Buffer..." mml-attach-buffer t]
! ["Attach External..." mml-attach-external t]
! ["Insert Part..." mml-insert-part t]
! ["Insert Multipart..." mml-insert-multipart t]
! ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t]
! ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t]
! ["PGP Sign" mml-secure-message-sign-pgp t]
! ["PGP Encrypt" mml-secure-message-encrypt-pgp t]
! ["S/MIME Sign" mml-secure-message-sign-smime t]
! ["S/MIME Encrypt" mml-secure-message-encrypt-smime t]
! ("Secure MIME part"
! ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t]
! ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t]
! ["PGP Sign Part" mml-secure-sign-pgp t]
! ["PGP Encrypt Part" mml-secure-encrypt-pgp t]
! ["S/MIME Sign Part" mml-secure-sign-smime t]
! ["S/MIME Encrypt Part" mml-secure-encrypt-smime t])
! ["Encrypt/Sign off" mml-unsecure-message t]
;;["Narrow" mml-narrow-to-part t]
! ["Quote MML" mml-quote-region t]
! ["Validate MML" mml-validate t]
["Preview" mml-preview t]))
(defvar mml-mode nil
***************
*** 675,694 ****
(defun mml-mode (&optional arg)
"Minor mode for editing MML.
\\{mml-mode-map}"
(interactive "P")
! (if (not (set (make-local-variable 'mml-mode)
! (if (null arg) (not mml-mode)
! (> (prefix-numeric-value arg) 0))))
! nil
! (set (make-local-variable 'mml-mode) t)
! (unless (assq 'mml-mode minor-mode-alist)
! (push `(mml-mode " MML") minor-mode-alist))
! (unless (assq 'mml-mode minor-mode-map-alist)
! (push (cons 'mml-mode mml-mode-map)
! minor-mode-map-alist)))
! (run-hooks 'mml-mode-hook))
;;;
;;; Helper functions for reading MIME stuff from the minibuffer and
--- 884,900 ----
(defun mml-mode (&optional arg)
"Minor mode for editing MML.
+ MML is the MIME Meta Language, a minor mode for composing MIME articles.
+ See Info node `(emacs-mime)Composing'.
\\{mml-mode-map}"
(interactive "P")
! (when (set (make-local-variable 'mml-mode)
! (if (null arg) (not mml-mode)
! (> (prefix-numeric-value arg) 0)))
! (gnus-add-minor-mode 'mml-mode " MML" mml-mode-map)
! (easy-menu-add mml-menu mml-mode-map)
! (run-hooks 'mml-mode-hook)))
;;;
;;; Helper functions for reading MIME stuff from the minibuffer and
***************
*** 696,703 ****
;;;
(defun mml-minibuffer-read-file (prompt)
! (let ((file (read-file-name prompt nil nil t)))
! ;; Prevent some common errors. This is inspired by similar code in
;; VM.
(when (file-directory-p file)
(error "%s is a directory, cannot attach" file))
--- 902,910 ----
;;;
(defun mml-minibuffer-read-file (prompt)
! (let* ((completion-ignored-extensions nil)
! (file (read-file-name prompt nil nil t)))
! ;; Prevent some common errors. This is inspired by similar code in
;; VM.
(when (file-directory-p file)
(error "%s is a directory, cannot attach" file))
***************
*** 728,733 ****
--- 935,953 ----
(setq description nil))
description))
+ (defun mml-minibuffer-read-disposition (type &optional default)
+ (let* ((default (or default
+ (if (string-match "^text/.*" type)
+ "inline"
+ "attachment")))
+ (disposition (completing-read "Disposition: "
+ '(("attachment") ("inline") (""))
+ nil
+ nil)))
+ (if (not (equal disposition ""))
+ disposition
+ default)))
+
(defun mml-quote-region (beg end)
"Quote the MML tags in the region."
(interactive "r")
***************
*** 755,761 ****
(when value
;; Quote VALUE if it contains suspicious characters.
(when (string-match "[\"'\\~/*;() \t\n]" value)
! (setq value (prin1-to-string value)))
(insert (format " %s=%s" key value)))))
(insert ">\n"))
--- 975,983 ----
(when value
;; Quote VALUE if it contains suspicious characters.
(when (string-match "[\"'\\~/*;() \t\n]" value)
! (setq value (with-output-to-string
! (let (print-escape-nonascii)
! (prin1 value)))))
(insert (format " %s=%s" key value)))))
(insert ">\n"))
***************
*** 768,774 ****
;;; Attachment functions.
! (defun mml-attach-file (file &optional type description)
"Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
`\\[message-send-and-exit]' or `\\[message-send]'.
--- 990,996 ----
;;; Attachment functions.
! (defun mml-attach-file (file &optional type description disposition)
"Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
`\\[message-send-and-exit]' or `\\[message-send]'.
***************
*** 779,788 ****
(interactive
(let* ((file (mml-minibuffer-read-file "Attach file: "))
(type (mml-minibuffer-read-type file))
! (description (mml-minibuffer-read-description)))
! (list file type description)))
! (mml-insert-empty-tag 'part 'type type 'filename file
! 'disposition "attachment" 'description description))
(defun mml-attach-buffer (buffer &optional type description)
"Attach a buffer to the outgoing MIME message.
--- 1001,1014 ----
(interactive
(let* ((file (mml-minibuffer-read-file "Attach file: "))
(type (mml-minibuffer-read-type file))
! (description (mml-minibuffer-read-description))
! (disposition (mml-minibuffer-read-disposition type)))
! (list file type description disposition)))
! (mml-insert-empty-tag 'part
! 'type type
! 'filename file
! 'disposition (or disposition "attachment")
! 'description description))
(defun mml-attach-buffer (buffer &optional type description)
"Attach a buffer to the outgoing MIME message.
***************
*** 823,870 ****
(mml-insert-tag 'part 'type type 'disposition "inline")
(forward-line -1))
(defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer.
If RAW, don't highlight the article."
(interactive "P")
! (let ((buf (current-buffer))
! (message-posting-charset (or (gnus-setup-posting-charset
! (save-restriction
! (message-narrow-to-headers-or-head)
! (message-fetch-field "Newsgroups")))
! message-posting-charset)))
! (switch-to-buffer (get-buffer-create
! (concat (if raw "*Raw MIME preview of "
! "*MIME preview of ") (buffer-name))))
! (erase-buffer)
! (insert-buffer buf)
! (if (re-search-forward
! (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
! (replace-match "\n"))
! (let ((mail-header-separator "")) ;; mail-header-separator is removed.
! (mml-to-mime))
! (if raw
! (when (fboundp 'set-buffer-multibyte)
! (let ((s (buffer-string)))
! ;; Insert the content into unibyte buffer.
! (erase-buffer)
! (mm-disable-multibyte)
! (insert s)))
! (let ((gnus-newsgroup-charset (car message-posting-charset)))
! (run-hooks 'gnus-article-decode-hook)
! (let ((gnus-newsgroup-name "dummy"))
! (gnus-article-prepare-display))))
! ;; Disable article-mode-map.
! (use-local-map nil)
! (setq buffer-read-only t)
! (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
! (goto-char (point-min))))
(defun mml-validate ()
"Validate the current MML document."
(interactive)
(mml-parse))
(provide 'mml)
;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
--- 1049,1174 ----
(mml-insert-tag 'part 'type type 'disposition "inline")
(forward-line -1))
+ (defun mml-preview-insert-mail-followup-to ()
+ "Insert a Mail-Followup-To header before previewing an article.
+ Should be adopted if code in `message-send-mail' is changed."
+ (when (and (message-mail-p)
+ (message-subscribed-p)
+ (not (mail-fetch-field "mail-followup-to"))
+ (message-make-mail-followup-to))
+ (message-position-on-field "Mail-Followup-To" "X-Draft-From")
+ (insert (message-make-mail-followup-to))))
+
(defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer.
If RAW, don't highlight the article."
(interactive "P")
! (save-excursion
! (let* ((buf (current-buffer))
! (message-options message-options)
! (message-this-is-mail (message-mail-p))
! (message-this-is-news (message-news-p))
! (message-posting-charset (or (gnus-setup-posting-charset
! (save-restriction
! (message-narrow-to-headers-or-head)
! (message-fetch-field "Newsgroups")))
! message-posting-charset)))
! (message-options-set-recipient)
! (switch-to-buffer (generate-new-buffer
! (concat (if raw "*Raw MIME preview of "
! "*MIME preview of ") (buffer-name))))
! (when (boundp 'gnus-buffers)
! (push (current-buffer) gnus-buffers))
! (erase-buffer)
! (insert-buffer-substring buf)
! (mml-preview-insert-mail-followup-to)
! (let ((message-deletable-headers (if (message-news-p)
! nil
! message-deletable-headers)))
! (message-generate-headers
! (copy-sequence (if (message-news-p)
! message-required-news-headers
! message-required-mail-headers))))
! (if (re-search-forward
! (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
! (replace-match "\n"))
! (let ((mail-header-separator ""));; mail-header-separator is removed.
! (mml-to-mime))
! (if raw
! (when (fboundp 'set-buffer-multibyte)
! (let ((s (buffer-string)))
! ;; Insert the content into unibyte buffer.
! (erase-buffer)
! (mm-disable-multibyte)
! (insert s)))
! (let ((gnus-newsgroup-charset (car message-posting-charset))
! gnus-article-prepare-hook gnus-original-article-buffer)
! (run-hooks 'gnus-article-decode-hook)
! (let ((gnus-newsgroup-name "dummy")
! (gnus-newsrc-hashtb (or gnus-newsrc-hashtb
! (gnus-make-hashtable 5))))
! (gnus-article-prepare-display))))
! ;; Disable article-mode-map.
! (use-local-map nil)
! (gnus-make-local-hook 'kill-buffer-hook)
! (add-hook 'kill-buffer-hook
! (lambda ()
! (mm-destroy-parts gnus-article-mime-handles)) nil t)
! (setq buffer-read-only t)
! (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
! (local-set-key "=" (lambda () (interactive) (delete-other-windows)))
! (local-set-key "\r"
! (lambda ()
! (interactive)
! (widget-button-press (point))))
! (local-set-key gnus-mouse-2
! (lambda (event)
! (interactive "@e")
! (widget-button-press (widget-event-point event) event)))
! (goto-char (point-min)))))
(defun mml-validate ()
"Validate the current MML document."
(interactive)
(mml-parse))
+ (defun mml-tweak-part (cont)
+ "Tweak a MML part."
+ (let ((tweak (cdr (assq 'tweak cont)))
+ func)
+ (cond
+ (tweak
+ (setq func
+ (or (cdr (assoc tweak mml-tweak-function-alist))
+ (intern tweak))))
+ (mml-tweak-type-alist
+ (let ((alist mml-tweak-type-alist)
+ (type (or (cdr (assq 'type cont)) "text/plain")))
+ (while alist
+ (if (string-match (caar alist) type)
+ (setq func (cdar alist)
+ alist nil)
+ (setq alist (cdr alist)))))))
+ (if func
+ (funcall func cont)
+ cont)
+ (let ((alist mml-tweak-sexp-alist))
+ (while alist
+ (if (eval (caar alist))
+ (funcall (cdar alist) cont))
+ (setq alist (cdr alist)))))
+ cont)
+
+ (defun mml-tweak-externalize-attachments (cont)
+ "Tweak attached files as external parts."
+ (let (filename-cons)
+ (when (and (eq (car cont) 'part)
+ (not (cdr (assq 'buffer cont)))
+ (and (setq filename-cons (assq 'filename cont))
+ (not (equal (cdr (assq 'nofile cont)) "yes"))))
+ (setcar cont 'external)
+ (setcar filename-cons 'name))))
+
(provide 'mml)
;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/gnus/mml.el [lexbind],
Miles Bader <=