Function: imap-parse-response

imap-parse-response is a byte-compiled function defined in imap.el.gz.

Signature

(imap-parse-response)

Documentation

Parse an IMAP command response.

Source Code

;; Defined in /usr/src/emacs/lisp/net/imap.el.gz
;;   response        = *(continue-req / response-data) response-done
;;
;;   continue-req    = "+" SP (resp-text / base64) CRLF
;;
;;   response-data   = "*" SP (resp-cond-state / resp-cond-bye /
;;                     mailbox-data / message-data / capability-data) CRLF
;;
;;   response-done   = response-tagged / response-fatal
;;
;;   response-fatal  = "*" SP resp-cond-bye CRLF
;;                       ; Server closes connection immediately
;;
;;   response-tagged = tag SP resp-cond-state CRLF
;;
;;   resp-cond-state = ("OK" / "NO" / "BAD") SP resp-text
;;                       ; Status condition
;;
;;   resp-cond-bye   = "BYE" SP resp-text
;;
;;   mailbox-data    =  "FLAGS" SP flag-list /
;;		        "LIST" SP mailbox-list /
;;                      "LSUB" SP mailbox-list /
;;		        "SEARCH" *(SP nz-number) /
;;                      "STATUS" SP mailbox SP "("
;;	                      [status-att SP number *(SP status-att SP number)] ")" /
;;                      number SP "EXISTS" /
;;		        number SP "RECENT"
;;
;;   message-data    = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att))
;;
;;   capability-data = "CAPABILITY" *(SP capability) SP "IMAP4rev1"
;;                     *(SP capability)
;;                       ; IMAP4rev1 servers which offer RFC 1730
;;                       ; compatibility MUST list "IMAP4" as the first
;;                       ; capability.

(defun imap-parse-response ()
  "Parse an IMAP command response."
  (let (token)
    (pcase (setq token (read (current-buffer)))
      ('+ (setq imap-continuation
                (or (buffer-substring (min (point-max) (1+ (point)))
				      (point-max))
		    t)))
      ('* (pcase (prog1 (setq token (read (current-buffer)))
		   (imap-forward))
	    ('OK         (imap-parse-resp-text))
	    ('NO         (imap-parse-resp-text))
	    ('BAD        (imap-parse-resp-text))
	    ('BYE        (imap-parse-resp-text))
	    ('FLAGS      (imap-mailbox-put 'flags (imap-parse-flag-list)))
	    ('LIST       (imap-parse-data-list 'list))
	    ('LSUB       (imap-parse-data-list 'lsub))
	    ('SEARCH     (imap-mailbox-put
			  'search
			  (read (concat "(" (buffer-substring (point) (point-max)) ")"))))
	    ('STATUS     (imap-parse-status))
	    ('CAPABILITY (setq imap-capability
			       (read (concat "(" (upcase (buffer-substring
							  (point) (point-max)))
					     ")"))))
	    ('ID	       (setq imap-id (read (buffer-substring (point)
                                                                     (point-max)))))
	    ('ACL        (imap-parse-acl))
	    (_       (pcase (prog1 (read (current-buffer))
			      (imap-forward))
		       ('EXISTS  (imap-mailbox-put 'exists token))
		       ('RECENT  (imap-mailbox-put 'recent token))
		       ('EXPUNGE t)
		       ('FETCH   (imap-parse-fetch))
		       (_       (message "Garbage: %s" (buffer-string)))))))
      (_ (let (status)
	   (if (not (integerp token))
	       (message "Garbage: %s" (buffer-string))
	     (pcase (prog1 (setq status (read (current-buffer)))
		      (imap-forward))
	       ('OK  (progn
		       (setq imap-reached-tag (max imap-reached-tag token))
		       (imap-parse-resp-text)))
	       ('NO  (progn
		       (setq imap-reached-tag (max imap-reached-tag token))
		       (save-excursion
			 (imap-parse-resp-text))
		       (let (code text)
			 (when (eq (char-after) ?\[)
			   (setq code (buffer-substring (point)
                                                        (search-forward "]")))
			   (imap-forward))
			 (setq text (buffer-substring (point) (point-max)))
			 (push (list token status code text)
			       imap-failed-tags))))
	       ('BAD (progn
		       (setq imap-reached-tag (max imap-reached-tag token))
		       (save-excursion
			 (imap-parse-resp-text))
		       (let (code text)
			 (when (eq (char-after) ?\[)
			   (setq code (buffer-substring (point)
                                                        (search-forward "]")))
			   (imap-forward))
			 (setq text (buffer-substring (point) (point-max)))
			 (push (list token status code text) imap-failed-tags)
			 (error "Internal error, tag %s status %s code %s text %s"
                                token status code text))))
	       (_   (message "Garbage: %s" (buffer-string))))
	     (when (assq token imap-callbacks)
	       (funcall (cdr (assq token imap-callbacks)) token status)
	       (setq imap-callbacks
		     (imap-remassoc token imap-callbacks)))))))))