Function: nnimap-transform-headers

nnimap-transform-headers is a byte-compiled function defined in nnimap.el.gz.

Signature

(nnimap-transform-headers)

Documentation

Transform server's FETCH response into parsable headers.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnimap.el.gz
(defun nnimap-transform-headers ()
  "Transform server's FETCH response into parsable headers."
  (goto-char (point-min))
  (let (seen-articles article lines size string labels)
    (cl-block nil
      (while (not (eobp))
	(while (not (looking-at "\\* [0-9]+ FETCH"))
	  (delete-region (point) (progn (forward-line 1) (point)))
	  (when (eobp)
	    (cl-return)))
	(goto-char (match-end 0))
	;; Unfold quoted {number} strings.
	(while (or (looking-at "[ (]{\\([0-9]+\\)}\r?\n")
		   (re-search-forward
		    "[^]][ (]{\\([0-9]+\\)}\r?\n"
		    (save-excursion
		      ;; Start of the header section.
		      (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
			  ;; Start of the next FETCH.
			  (re-search-forward "\\* [0-9]+ FETCH" nil t)
			  (point-max)))
		    t))
	  (setq size (string-to-number (match-string 1)))
	  (delete-region (+ (match-beginning 0) 2) (point))
	  (setq string (buffer-substring (point) (+ (point) size)))
	  (delete-region (point) (+ (point) size))
	  (insert (format "%S" (subst-char-in-string ?\n ?\s string))))
	(beginning-of-line)
	(setq article
	      (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position)
				      t)
		   (match-string 1)))
	;; If we've already got headers for this article, or this
	;; FETCH line doesn't provide headers for the article, skip
	;; it.  See bug#35433.
	(if (or (member article seen-articles)
		(save-excursion
		  (forward-line)
		  (null (looking-at-p
			 ;; We're expecting a mail-ish header.
			 "^[!-9;-~]+:[[:space:]]?"))))
	    (delete-region (line-beginning-position)
			   (1+ (line-end-position)))
	  (setq lines nil)
	  (beginning-of-line)
	  (setq size
		(and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
					(line-end-position)
					t)
		     (match-string 1)))
	  (beginning-of-line)
	  (when (search-forward "X-GM-LABELS" (line-end-position) t)
	    (setq labels (ignore-errors (read (current-buffer)))))
	  (beginning-of-line)
	  (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
	    (let ((structure (ignore-errors
			       (read (current-buffer)))))
	      (while (and (consp structure)
			  (not (atom (car structure))))
		(setq structure (car structure)))
	      (setq lines (if (and
			       (stringp (car structure))
			       (equal (upcase (nth 0 structure)) "MESSAGE")
			       (equal (upcase (nth 1 structure)) "RFC822"))
			      (nth 9 structure)
			    (nth 7 structure)))))
	  (delete-region (line-beginning-position) (line-end-position))
	  (insert (format "211 %s Article retrieved." article))
	  (forward-line 1)
	  (when size
	    (insert (format "Chars: %s\n" size)))
	  (when lines
	    (insert (format "Lines: %s\n" lines)))
	  (when labels
	    (insert (format "X-GM-LABELS: %s\n" labels)))
	  ;; Most servers have a blank line after the headers, but
	  ;; Davmail doesn't.
	  (unless (re-search-forward "^\r$\\|^)\r?$" nil t)
	    (goto-char (point-max)))
	  (delete-region (line-beginning-position) (line-end-position))
	  (insert ".")
	  (forward-line 1)
	  (push article seen-articles))))))