Function: rfc2231-parse-string

rfc2231-parse-string is a byte-compiled function defined in rfc2231.el.gz.

Signature

(rfc2231-parse-string STRING &optional SIGNAL-ERROR)

Documentation

Parse STRING and return a list.

The list will be on the form
 (name (attribute . value) (attribute . value)...).

If the optional SIGNAL-ERROR is non-nil, signal an error when this function fails in parsing of parameters. Otherwise, this function must never cause a Lisp error.

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rfc2231.el.gz
(defun rfc2231-parse-string (string &optional signal-error)
  "Parse STRING and return a list.
The list will be on the form
 `(name (attribute . value) (attribute . value)...)'.

If the optional SIGNAL-ERROR is non-nil, signal an error when this
function fails in parsing of parameters.  Otherwise, this function
must never cause a Lisp error."
  (with-temp-buffer
    (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
	  (stoken (ietf-drums-token-to-list ietf-drums-tspecials))
	  (ntoken (ietf-drums-token-to-list "0-9"))
	  c type attribute encoded number parameters value)
      (ietf-drums-init
       (condition-case nil
	   (mail-header-remove-whitespace
	    (mail-header-remove-comments string))
	 ;; The most likely cause of an error is unbalanced parentheses
	 ;; or double-quotes.  If all parentheses and double-quotes are
	 ;; quoted meaninglessly with backslashes, removing them might
	 ;; make it parsable.  Let's try...
	 (error
	  (let (mod)
	    (when (and (string-search "\\\"" string)
		       (not (string-match "\\`\"\\|[^\\]\"" string)))
	      (setq string (string-replace "\\\"" "\"" string)
		    mod t))
	    (when (and (string-search "\\(" string)
		       (string-search "\\)" string)
		       (not (string-match "\\`(\\|[^\\][()]" string)))
	      (setq string (replace-regexp-in-string
			    "\\\\\\([()]\\)" "\\1" string)
		    mod t))
	    (or (and mod
		     (ignore-errors
		       (mail-header-remove-whitespace
			(mail-header-remove-comments string))))
		;; Finally, attempt to extract only type.
		(if (string-match
		     (concat "\\`[\t\n ]*\\([^" ietf-drums-tspecials "\t\n ]+"
			     "\\(?:/[^" ietf-drums-tspecials
			     "\t\n ]+\\)?\\)\\(?:[\t\n ;]\\|\\'\\)")
		     string)
		    (match-string 1 string)
		  ""))))))
      (let ((table (copy-syntax-table ietf-drums-syntax-table)))
	(modify-syntax-entry ?\' "w" table)
	(modify-syntax-entry ?* " " table)
	(modify-syntax-entry ?\; " " table)
	(modify-syntax-entry ?= " " table)
	;; The following isn't valid, but one should be liberal
	;; in what one receives.
	(modify-syntax-entry ?\: "w" table)
	(set-syntax-table table))
      (setq c (char-after))
      (when (and (memq c ttoken)
		 (not (memq c stoken))
		 (setq type (ignore-errors
			      (downcase
			       (buffer-substring (point) (progn
							   (forward-sexp 1)
							   (point)))))))
	;; Do the params
	(condition-case err
	    (progn
	      (while (not (eobp))
		(setq c (char-after))
		(unless (eq c ?\;)
		  (error "Invalid header: %s" string))
		(forward-char 1)
		;; If c in nil, then this is an invalid header, but
		;; since elm generates invalid headers on this form,
		;; we allow it.
		(when (setq c (char-after))
		  (if (and (memq c ttoken)
			   (not (memq c stoken)))
		      (setq attribute
			    (intern
			     (downcase
			      (buffer-substring
			       (point) (progn (forward-sexp 1) (point))))))
		    (error "Invalid header: %s" string))
		  (setq c (char-after))
		  (if (eq c ?*)
		      (progn
			(forward-char 1)
			(setq c (char-after))
			(if (not (memq c ntoken))
			    (setq encoded t
				  number nil)
			  (setq number
				(string-to-number
				 (buffer-substring
				  (point) (progn (forward-sexp 1) (point)))))
			  (setq c (char-after))
			  (when (eq c ?*)
			    (setq encoded t)
			    (forward-char 1)
			    (setq c (char-after)))))
		    (setq number nil
			  encoded nil))
		  (unless (eq c ?=)
		    (error "Invalid header: %s" string))
		  (forward-char 1)
		  (setq c (char-after))
		  (cond
		   ((eq c ?\")
		    (setq value (buffer-substring (1+ (point))
						  (progn
						    (forward-sexp 1)
						    (1- (point)))))
		    (when encoded
		      (setq value (mapconcat (lambda (c) (format "%%%02x" c))
					     value ""))))
		   ((and (or (memq c ttoken)
			     ;; EXTENSION: Support non-ascii chars.
			     (> c ?\177))
			 (not (memq c stoken)))
		    (setq value
			  (buffer-substring
			   (point)
			   (progn
			     ;; Jump over asterisk, non-ASCII
			     ;; and non-boundary characters.
			     (while (and c
					 (or (eq c ?*)
					     (> c ?\177)
					     (not (eq (char-syntax c) ? ))))
			       (forward-char 1)
			       (setq c (char-after)))
			     (point)))))
		   (t
		    (error "Invalid header: %s" string)))
		  (push (list attribute value number encoded)
			parameters))))
	  (error
	   (setq parameters nil)
	   (when signal-error
	     (signal (car err) (cdr err)))))

	;; Now collect and concatenate continuation parameters.
	(let ((cparams nil)
	      elem)
	  (cl-loop for (attribute value part encoded)
		in (sort parameters (lambda (e1 e2)
				      (< (or (caddr e1) 0)
					 (or (caddr e2) 0))))
		do (cond
		    ;; First part.
		    ((or (not (setq elem (assq attribute cparams)))
			 (and (numberp part)
			      (zerop part)))
		     (push (list attribute value encoded) cparams))
		    ;; Repetition of a part; do nothing.
		    ((and elem
			  (null number))
		     )
		    ;; Concatenate continuation parts.
		    (t
		     (setcar (cdr elem) (concat (cadr elem) value)))))
	  ;; Finally decode encoded values.
	  (cons type (mapcar
		      (lambda (elem)
			(cons (car elem)
			      (if (nth 2 elem)
				  (rfc2231-decode-encoded-string (nth 1 elem))
				(nth 1 elem))))
		      (nreverse cparams))))))))