Debugger entered: nil (progn (debug nil)) (if (eq cell mml-text/plain-tag-literal-constant) (progn (debug nil))) check-setcdr(# (type . "text/plain") "multipart/alternative; boundary=\"====-=-=\"") apply(check-setcdr # ((type . "text/plain") "multipart/alternative; boundary=\"====-=-=\"")) setcdr((type . "text/plain") "multipart/alternative; boundary=\"====-=-=\"") (progn (setcdr (assq 'type (cdr (car cont))) content-type)) (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond (... ...) (... ...) (t ...)) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options))) (let ((cont (mml-parse)) (mml-multipart-number mml-multipart-number) (options message-options)) (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ... ... ...) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options)))) mml-generate-mime(nil "multipart/alternative; boundary=\"====-=-=\"") message-encode-message-body() mml-to-mime() (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (assoc 'contents cont) (buffer-string)))) (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (assoc 'contents cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed (string= type "text/plain") (not (string= (cdr ...) "pgp")) (or (null (assq ... cont)) (string= (cdr ...) "flowed")) (setq use-hard-newlines (text-property-any (point-min) (point-max) 'hard 't))) (progn (fill-flowed-encode) (setq flowed (null (assq ... cont)))))) (if (or charset (not (string= type "text/calendar"))) (setq charset (mm-encode-body charset)) (let ((mm-coding-system-priorities (cons 'utf-8 mm-coding-system-priorities))) (setq charset (mm-encode-body)))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr (assq ... cont)) "yes"))) (let ((coding-system-for-read coding)) (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))) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" 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) (if mml-inhibit-compute-boundary nil (setcdr (assoc 'contents cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed (string= type "text/plain") (not (string= ... "pgp")) (or (null ...) (string= ... "flowed")) (setq use-hard-newlines (text-property-any ... ... ... ...))) (progn (fill-flowed-encode) (setq flowed (null ...))))) (if (or charset (not (string= type "text/calendar"))) (setq charset (mm-encode-body charset)) (let ((mm-coding-system-priorities (cons ... mm-coding-system-priorities))) (setq charset (mm-encode-body)))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string))) (unwind-protect (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr ...) "yes"))) (let ((coding-system-for-read coding)) (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 ... cont))) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" nil t) (delete-region (+ ... 2) (+ ... 3)))))) (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (assoc ... cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed (string= type "text/plain") (not ...) (or ... ...) (setq use-hard-newlines ...)) (progn (fill-flowed-encode) (setq flowed ...)))) (if (or charset (not (string= type "text/calendar"))) (setq charset (mm-encode-body charset)) (let ((mm-coding-system-priorities ...)) (setq charset (mm-encode-body)))) (setq encoding (mm-body-encoding charset (cdr (assq ... cont)))))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq ... cont)))) ((and filename (not (equal ... "yes"))) (let ((coding-system-for-read coding)) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (cdr (assq ... cont)))) (t (save-restriction (narrow-to-region (point) (point)) (insert (cdr ...)) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" nil t) (delete-region ... ...))))) (cond ((eq (car cont) 'mml) (let ((mml-boundary ...) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr ... ...))) (let ((mm-7bit-chars ...)) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars ...)) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed ... ... ... ...) (progn ... ...))) (if (or charset (not ...)) (setq charset (mm-encode-body charset)) (let (...) (setq charset ...))) (setq encoding (mm-body-encoding charset (cdr ...))))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ((cdr (assq ... cont)) (insert-buffer-substring (cdr ...))) ((and filename (not ...)) (let (...) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (cdr ...))) (t (save-restriction (narrow-to-region ... ...) (insert ...) (goto-char ...) (while ... ...)))) (cond ((eq (car cont) 'mml) (let (... ...) (mml-to-mime) (if mml-inhibit-compute-boundary nil ...)) (let (...) (setq encoding ...))) ((string= (car ...) "message") (let (...) (setq encoding ...))) (t (let (use-hard-newlines) (if ... ...)) (if (or charset ...) (setq charset ...) (let ... ...)) (setq encoding (mm-body-encoding charset ...)))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (progn (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ((cdr ...) (insert-buffer-substring ...)) ((and filename ...) (let ... ...)) ((eq ... ...) (insert ...)) (t (save-restriction ... ... ... ...))) (cond ((eq ... ...) (let ... ... ...) (let ... ...)) ((string= ... "message") (let ... ...)) (t (let ... ...) (if ... ... ...) (setq encoding ...))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond (... ...) (... ...) (... ...) (t ...)) (cond (... ... ...) (... ...) (t ... ... ...)) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (cond ((cdr ...) (insert ...)) ((and filename ...) (let ... ...) (if charset nil ...)) (t (let ... ...))) (if (setq encoding (cdr ...)) (setq encoding (intern ...))) (setq encoding (mm-encode-buffer type encoding)) (setq coded (decode-coding-string (buffer-string) 'us-ascii))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)) (let* ((raw (cdr (assq 'raw cont))) (filename (cdr (assq 'filename cont))) (type (or (cdr (assq 'type cont)) (if filename (or (mm-default-file-encoding filename) "application/octet-stream") "text/plain"))) (charset (cdr (assq 'charset cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or (mm-coding-system-to-mime-charset coding) (intern (downcase charset)))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ... ... ... ...) (cond ... ... ...) (setq coded ...)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (cond (... ...) (... ... ...) (t ...)) (if (setq encoding ...) (setq encoding ...)) (setq encoding (mm-encode-buffer type encoding)) (setq coded (decode-coding-string ... ...))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded))) (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let* ((raw (cdr (assq 'raw cont))) (filename (cdr (assq 'filename cont))) (type (or (cdr (assq ... cont)) (if filename (or ... "application/octet-stream") "text/plain"))) (charset (cdr (assq 'charset cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or (mm-coding-system-to-mime-charset coding) (intern ...))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn (let ((temp-buffer ...)) (save-current-buffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn ... ... ... ... ...) (and ... ...)))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" 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)))) (if name (progn (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" ...) (mail-header-encode-parameter "site" ...) (mail-header-encode-parameter "directory" ...)) (mml-insert-parameter (concat "access-type=" ...))))) (if url (progn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont '(expiration size permission)))) (insert "\n\n") (insert "Content-Type: " (or (cdr (assq 'type cont)) (if name (or (mm-default-file-encoding name) "application/octet-stream") "text/plain")) "\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 ... 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) (let ((mml-boundary (mml-compute-boundary cont))) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" type mml-boundary) (if (cdr ...) (format "; start=\"%s\"\n" ...) "\n")) (let ((cont cont) part) (while (setq part ...) (if ... ...))) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" 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 ... cont))) (filename (cdr (assq ... cont))) (type (or (cdr ...) (if filename ... "text/plain"))) (charset (cdr (assq ... cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or ... ...)))) (if (and (not raw) (member (car ...) '...)) (progn (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer ...)) (save-current-buffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont '...)) (name (cdr (assq ... cont))) (url (cdr (assq ... cont)))) (if name (progn (setq name (mml-parse-file-name name)) (if (stringp name) (mml-insert-parameter ... "access-type=local-file") (mml-insert-parameter ... ... ...) (mml-insert-parameter ...)))) (if url (progn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont '...))) (insert "\n\n") (insert "Content-Type: " (or (cdr (assq ... cont)) (if name (or ... "application/octet-stream") "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr (assq ... cont)) "binary")) (insert "\n\n") (insert (or (cdr (assq ... cont)))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or (cdr ...) "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) (let ((mml-boundary ...)) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" type mml-boundary) (if ... ... "\n")) (let (... part) (while ... ...)) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq ... cont))) (progn (message-options-set 'mml-sender sender) (message-options-set 'message-sender sender))) (if (setq recipients (cdr (assq ... cont))) (message-options-set 'message-recipients recipients)) (let ((style (mml-signencrypt-style ...))) (if (and sign-item encrypt-item (equal ... ...) (equal style ...)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn ...)) (if encrypt-item (progn ...)))))))) (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 ...)) (filename (cdr ...)) (type (or ... ...)) (charset (cdr ...)) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding ...) (setq charset nil coding nil)) (charset (setq charset ...))) (if (and (not raw) (member ... ...)) (progn (let ... ...) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont ...)) (name (cdr ...)) (url (cdr ...))) (if name (progn (setq name ...) (if ... ... ... ...))) (if url (progn (mml-insert-parameter ... "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont ...))) (insert "\n\n") (insert "Content-Type: " (or (cdr ...) (if name ... "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr ...) "binary")) (insert "\n\n") (insert (or (cdr ...))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or ... "mixed")) (mml-generate-default-type (if ... "message/rfc822" "text/plain")) (handler (assoc type mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont) (let (...) (insert ... ...) (let ... ...) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq ... cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq ... cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr ...)) (progn (message-options-set ... sender) (message-options-set ... sender))) (if (setq recipients (cdr ...)) (message-options-set 'message-recipients recipients)) (let ((style ...)) (if (and sign-item encrypt-item ... ...) (funcall ... cont t) (if sign-item ...) (if encrypt-item ...)))))))) mml-generate-mime-1((mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function (setq mml-multipart-number (1+ mml-multipart-number)))) (throw 'not-unique nil)))) (unwind-protect (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function (setq mml-multipart-number (1+ mml-multipart-number)))) (throw 'not-unique nil)))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function (setq mml-multipart-number ...))) (throw 'not-unique nil)))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function ...)) (throw 'not-unique nil)))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (cond ((member (car cont) '(part mml)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let (... ... mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward ... nil t) (progn ... ...))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))) ((eq (car cont) 'multipart) (mapc 'mml-compute-boundary-1 (cdr (cdr cont))))) mml-compute-boundary-1((mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))) mapc(mml-compute-boundary-1 ((tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) (cond ((member (car cont) '(part mml)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let (... ... mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward ... nil t) (progn ... ...))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))) ((eq (car cont) 'multipart) (mapc 'mml-compute-boundary-1 (cdr (cdr cont))))) mml-compute-boundary-1((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) (catch 'not-unique (mml-compute-boundary-1 cont)) (not (catch 'not-unique (mml-compute-boundary-1 cont))) (while (not (catch 'not-unique (mml-compute-boundary-1 cont)))) (if mml-inhibit-compute-boundary nil (while (not (catch 'not-unique (mml-compute-boundary-1 cont))))) (let ((mml-boundary (funcall mml-boundary-function (setq mml-multipart-number (1+ mml-multipart-number))))) (if mml-inhibit-compute-boundary nil (while (not (catch 'not-unique (mml-compute-boundary-1 cont))))) mml-boundary) mml-compute-boundary((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) mml2015-epg-sign((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) mml2015-sign((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) mml-pgpmime-sign-buffer((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) funcall(mml-pgpmime-sign-buffer (multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) (progn (funcall (nth 1 sign-item) cont)) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont)))) (let ((style (mml-signencrypt-style (car (or sign-item encrypt-item))))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont))))) (progn (if (setq sender (cdr (assq 'sender cont))) (progn (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 (car (or sign-item encrypt-item))))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont)))))) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq 'sender cont))) (progn (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 (car (or sign-item encrypt-item))))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont))))))) (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq 'sender cont))) (progn (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 (car ...)))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall ... cont))) (if encrypt-item (progn (funcall ... 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 ... cont))) (filename (cdr (assq ... cont))) (type (or (cdr ...) (if filename ... "text/plain"))) (charset (cdr (assq ... cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or ... ...)))) (if (and (not raw) (member (car ...) '...)) (progn (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer ...)) (save-current-buffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont '...)) (name (cdr (assq ... cont))) (url (cdr (assq ... cont)))) (if name (progn (setq name (mml-parse-file-name name)) (if (stringp name) (mml-insert-parameter ... "access-type=local-file") (mml-insert-parameter ... ... ...) (mml-insert-parameter ...)))) (if url (progn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont '...))) (insert "\n\n") (insert "Content-Type: " (or (cdr (assq ... cont)) (if name (or ... "application/octet-stream") "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr (assq ... cont)) "binary")) (insert "\n\n") (insert (or (cdr (assq ... cont)))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or (cdr ...) "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) (let ((mml-boundary ...)) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" type mml-boundary) (if ... ... "\n")) (let (... part) (while ... ...)) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq ... cont))) (progn (message-options-set 'mml-sender sender) (message-options-set 'message-sender sender))) (if (setq recipients (cdr (assq ... cont))) (message-options-set 'message-recipients recipients)) (let ((style (mml-signencrypt-style ...))) (if (and sign-item encrypt-item (equal ... ...) (equal style ...)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn ...)) (if encrypt-item (progn ...)))))))) (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 ...)) (filename (cdr ...)) (type (or ... ...)) (charset (cdr ...)) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding ...) (setq charset nil coding nil)) (charset (setq charset ...))) (if (and (not raw) (member ... ...)) (progn (let ... ...) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont ...)) (name (cdr ...)) (url (cdr ...))) (if name (progn (setq name ...) (if ... ... ... ...))) (if url (progn (mml-insert-parameter ... "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont ...))) (insert "\n\n") (insert "Content-Type: " (or (cdr ...) (if name ... "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr ...) "binary")) (insert "\n\n") (insert (or (cdr ...))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or ... "mixed")) (mml-generate-default-type (if ... "message/rfc822" "text/plain")) (handler (assoc type mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont) (let (...) (insert ... ...) (let ... ...) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq ... cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq ... cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr ...)) (progn (message-options-set ... sender) (message-options-set ... sender))) (if (setq recipients (cdr ...)) (message-options-set 'message-recipients recipients)) (let ((style ...)) (if (and sign-item encrypt-item ... ...) (funcall ... cont t) (if sign-item ...) (if encrypt-item ...)))))))) mml-generate-mime-1((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))) (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) cont)))) (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) cont)))) (setq options message-options) (buffer-string)) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list 'multipart (cons ... ...)) cont)))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list ... ...) cont)))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp ...) (= ... 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc ... cont)))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and ... ...) (mml-generate-mime-1 ...)) ((eq ... ...) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 ...))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options)) (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond (... ...) (... ...) (t ...)) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options))) (let ((cont (mml-parse)) (mml-multipart-number mml-multipart-number) (options message-options)) (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ... ... ...) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options)))) mml-generate-mime(nil nil) message-encode-message-body() mml-to-mime() (progn (goto-char (point-min)) (mml-to-mime) nil) (condition-case nil (progn (goto-char (point-min)) (mml-to-mime) nil) (error t)) (or (condition-case nil (progn (goto-char (point-min)) (mml-to-mime) nil) (error t)) (cl--assertion-failed '(condition-case nil (progn (goto-char (point-min)) (mml-to-mime) nil) (error t)))) eval-buffer(# nil "/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." nil t) ; Reading at buffer position 2861 load-with-code-conversion("/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." "/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." nil nil) load("/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." nil nil t) load-file("~/src/emacs/bug-39884-bad-mml-parsing.el") funcall-interactively(load-file "~/src/emacs/bug-39884-bad-mml-parsing.el") call-interactively(load-file record nil) command-execute(load-file record) execute-extended-command(nil "load-file" "load-fi") funcall-interactively(execute-extended-command nil "load-file" "load-fi") call-interactively(execute-extended-command nil nil) command-execute(execute-extended-command)