Function: mml-parse-1

mml-parse-1 is a byte-compiled function defined in mml.el.gz.

Signature

(mml-parse-1)

Documentation

Parse the current buffer as an MML document.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/mml.el.gz
(defun mml-parse-1 ()
  "Parse the current buffer as an MML document."
  (let (struct tag point contents charsets warn use-ascii no-markup-p raw)
    (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))
	       (keyfile (cdr (assq 'keyfile taginfo)))
	       (certfiles (delq nil (mapcar (lambda (tag)
					      (if (eq (car-safe tag) 'certfile)
						  (cdr tag)))
					    taginfo)))
	       (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
	    (setq secure-mode
		  (if (re-search-forward
		       "<#/?\\(multipart\\|part\\|external\\|mml\\)."
		       nil t)
		      "multipart"
		    "part")))
	  (save-excursion
	    (goto-char location)
	    (re-search-forward "<#secure[^\n]*>\n"))
	  (delete-region (match-beginning 0) (match-end 0))
	  (setq tags (cond ((string= mode "sign")
                            (list "sign" method))
                           ((string= mode "encrypt")
                            (list "encrypt" method))
                           ((string= mode "signencrypt")
                            (list "sign" method "encrypt" method))
                           (t
                            (error "Unknown secure mode %s" mode))))
	  (apply #'mml-insert-tag
		 secure-mode
		 `(,@tags
		   ,(if keyfile "keyfile")
		   ,keyfile
		   ,@(apply #'append
			    (mapcar (lambda (certfile)
				      (list "certfile" certfile))
				    certfiles))
		   ,(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")
	(push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
	      struct))
       (t
	(if (or (looking-at "<#part") (looking-at "<#mml"))
	    (setq tag (mml-read-tag)
		  no-markup-p nil
		  warn nil)
	  (setq tag (list 'part (cons 'type "text/plain"))
		no-markup-p t
		warn t))
	(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))))
	;; We have a part that already has a transfer encoding.  Undo
	;; that so that we don't double-encode later.
	(when (and raw
		   (cdr (assq 'data-encoding tag)))
	  (with-temp-buffer
	    (set-buffer-multibyte nil)
	    (insert contents)
	    (mm-decode-content-transfer-encoding
	     (intern (cdr (assq 'data-encoding tag)))
	     (cdr (assq 'type tag)))
	    (setq contents (buffer-string))))
	(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")))
	(if (or raw
		(eq 'mml (car tag))
		(< (length charsets) 2))
	    (if (or (not no-markup-p)
		    ;; Don't create blank parts.
		    (string-match "[^ \t\r\n]" contents))
		(push (nconc tag (list (cons 'contents contents)))
		      struct))
	  (let ((nstruct (mml-parse-singlepart-with-multiple-charsets
			  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)
      (forward-line 1))
    (nreverse struct)))