Function: feedmail-fiddle-header

feedmail-fiddle-header is a byte-compiled function defined in feedmail.el.gz.

Signature

(feedmail-fiddle-header NAME VALUE &optional ACTION FOLDING)

Documentation

Internal feedmail function for jamming fields into message header.

NAME, VALUE, ACTION, and FOLDING are the four elements of a fiddle-plex, as described in the documentation for the variable feedmail-fiddle-plex-blurb.

Source Code

;; Defined in /usr/src/emacs/lisp/mail/feedmail.el.gz
(defun feedmail-fiddle-header (name value &optional action folding)
  "Internal feedmail function for jamming fields into message header.
NAME, VALUE, ACTION, and FOLDING are the four elements of a
fiddle-plex, as described in the documentation for the variable
`feedmail-fiddle-plex-blurb'."
  (feedmail-say-debug ">in-> feedmail-fiddle-header %s %s %s %s"
		      name value action folding)
  (let ((case-fold-search t)
	(header-colon (concat (regexp-quote name) ":"))
	header-regexp eoh-marker has-like ag-like val-like that-point)
    (setq header-regexp (concat "^" header-colon))
    (setq eoh-marker (feedmail-find-eoh))
    (goto-char (point-min))
    (setq has-like (re-search-forward header-regexp eoh-marker t))

    (if (not action) (setq action 'supplement))
    (cond
     ((eq action 'supplement)
      ;; trim leading/trailing whitespace
      (if (string-match "\\`[ \t\n]+" value)
	  (setq value (substring value (match-end 0))))
      (if (string-match "[ \t\n]+\\'" value)
	  (setq value (substring value 0 (match-beginning 0))))
      (if (> (length value) 0)
	  (progn
	    (if feedmail-fiddle-headers-upwardly
		(goto-char (point-min))
	      (goto-char eoh-marker))
	    (setq that-point (point))
	    (insert name ": " value "\n")
	    (if folding (feedmail-fill-this-one that-point (point))))))

     ((eq action 'replace)
      (if has-like (feedmail-accume-n-nuke-header eoh-marker header-regexp))
      (feedmail-fiddle-header name value 'supplement folding))

     ((eq action 'create)
      (if (not has-like) (feedmail-fiddle-header name value 'supplement folding)))

     ((eq action 'combine)
      (setq val-like (nth 1 value))
      (setq ag-like (or (feedmail-accume-n-nuke-header eoh-marker header-regexp) ""))
      ;; get rid of initial header name from first instance (front of string)
      (if (string-match (concat header-regexp "[ \t\n]+") ag-like)
	  (setq ag-like (replace-match "" t t ag-like)))
      ;; get rid of embedded header names from subsequent instances
      (while (string-match (concat "\n" header-colon "[ \t\n]+") ag-like)
	(setq ag-like (replace-match "\n\t" t t ag-like)))
      ;; trim leading/trailing whitespace
      (if (string-match "\\`[ \t\n]+" ag-like)
	  (setq ag-like (substring ag-like (match-end 0))))
      (if (string-match "[ \t\n]+\\'" ag-like)
	  (setq ag-like (substring ag-like 0 (match-beginning 0))))
      ;; if ag-like is not nil and not an empty string, transform it via a function
      ;; call or format operation
      (if (> (length ag-like) 0)
	  (setq ag-like
		(cond
		 ((and (symbolp val-like) (fboundp val-like))
		  (funcall val-like name ag-like))
		 ((stringp val-like)
		  (format val-like ag-like))
		 (t nil))))
      (feedmail-fiddle-header name (concat (nth 0 value) ag-like (nth 2 value)) 'supplement folding)))
    ))