;;; very unpleasant hacking; may it not last long

(require 'imap)
(require 'nnimap)
(require 'cl)

(defsubst imap-parse-number ()
  (when (looking-at "-?[0-9]+")
    (prog1
	(string-to-number (match-string 0))
      (goto-char (match-end 0)))))

(defun imap-parse-body ()
  (let (body)
    (when (eq (char-after) ?\()
      (imap-forward)
      (if (eq (char-after) ?\()
	  (let (subbody)
	    (while (and (eq (char-after) ?\()
			(setq subbody
			      (imap-parse-body)))
	      ;; buggy stalker communigate pro
	      ;; 3.0 insert a SPC between
	      ;; parts in multiparts
	      (when (and (eq (char-after) ?\
			     )
			     (eq (char-after (1+
					      (point))) ?\())
		(imap-forward))
	      (push subbody body))
	      (imap-forward)
	      (push (imap-parse-string) body)
	      ;; media-subtype
	      (when (eq (char-after) ?\ ) ;; body-ext-mpart:
		(imap-forward)
		(if (eq
		     (char-after)
		     ?\() ;; body-fld-param
		    (push
		     (imap-parse-string-list) body)
		  (push (and
			 (imap-parse-nil) nil) body))
		(setq body
		      (append
		       (imap-parse-body-ext) body))) ;; body-ext-...
	      (assert (eq (char-after)
			  ?\)) nil "In imap-parse-body")
	      (imap-forward)
	      (nreverse body))

	    (push (imap-parse-string) body) ;; media-type
	    (imap-forward)
	    (push (imap-parse-string) body) ;; media-subtype
	    (imap-forward)
	    ;; next line for Sun SIMS bug
	    (and (eq (char-after) ? ) (imap-forward))
	    (if (eq (char-after) ?\() ;; body-fld-param
		(push (imap-parse-string-list) body)
	      (push (and (imap-parse-nil) nil) body))
	    (imap-forward)
	    (push (imap-parse-nstring) body) ;; body-fld-id
	    (imap-forward)
	    (push (imap-parse-nstring) body) ;; body-fld-desc
	    (imap-forward)
	    ;; next `or' for Sun SIMS bug, it regard
	    ;; body-fld-enc as a
	    ;; nstring and return nil instead of defaulting
	    ;; back to 7BIT
	    ;; as the standard says.
	    (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
	    (imap-forward)
	    (push (imap-parse-number) body) ;; body-fld-octets

	    ;; ok, we're done parsing the required parts,
	    ;; what comes now is one
	    ;; of three things:
	    ;;
	    ;; envelope       (then we're parsing
	    ;; body-type-msg)
	    ;; body-fld-lines (then we're parsing
	    ;; body-type-text)
	    ;; body-ext-1part (then we're parsing
	    ;; body-type-basic)
	    ;;
	    ;; the problem is that the two first are in
	    ;; turn optionally followed
	    ;; by the third.  So we parse the first two here
	    ;; (if there are any)...

	    (when (eq (char-after) ?\ )
	      (imap-forward)
	      (let (lines)
		(cond ((eq (char-after) ?\() ;; body-type-msg:
		       (push (imap-parse-envelope)
			     body) ;; envelope
		       (imap-forward)
		       (push
			(imap-parse-body) body) ;; body
		       ;; buggy stalker
		       ;; communigate pro
		       ;; 3.0 doesn't
		       ;; print
		       ;; number of lines
		       ;; in
		       ;; message/rfc822
		       ;; attachment
		       (if (eq
			    (char-after) ?\))
			   (push 0
				 body)
			 (imap-forward)
			 (push
			  (imap-parse-number) body))) ;; body-fld-lines
		      ((setq lines
			     (imap-parse-number)) ;; body-type-text:
		       (push lines body))	  ;; body-fld-lines
		      (t
		       (backward-char))))) ;; no match...

	    ;; ...and then parse the third one here...

	    (when (eq (char-after) ?\ ) ;; body-ext-1part:
	      (imap-forward)
	      (push (imap-parse-nstring) body) ;; body-fld-md5
	      (setq body (append (imap-parse-body-ext)
				 body))) ;; body-ext-1part..

	    (assert (eq (char-after) ?\)) nil "In
			    imap-parse-body 2")
	    (imap-forward)
	    (nreverse body)))))

(defvar imap-enable-exchange-bug-workaround nil
  "Send FETCH UID commands as *:* instead of *.
Enabling this appears to be required for some servers (e.g.,
Microsoft Exchange) which otherwise would trigger a response 'BAD
The specified message set is invalid.'.

BACKPORT from No Gnus!")

(defun nnimap-find-minmax-uid (group &optional examine)
  "Find lowest and highest active article number in GROUP.
If EXAMINE is non-nil the group is selected read-only."
  (with-current-buffer nnimap-server-buffer
    (when (or (string= group (imap-current-mailbox))
	      (imap-mailbox-select group examine))
      (let (minuid maxuid)
	(when (> (imap-mailbox-get 'exists) 0)
	  (imap-fetch (if imap-enable-exchange-bug-workaround "1,*:*" "1,*")
		      "UID" nil 'nouidfetch)
	  (imap-message-map (lambda (uid Uid)
			      (setq minuid (if minuid (min minuid uid) uid)
				    maxuid (if maxuid (max maxuid uid) uid)))
			    'UID))
	(list (imap-mailbox-get 'exists) minuid maxuid)))))

(defun imap-message-copyuid-1 (mailbox)
  (if (imap-capability 'UIDPLUS)
      (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
	    (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
    (let ((old-mailbox imap-current-mailbox)
	  (state imap-state)
	  (imap-message-data (make-vector 2 0)))
      (when (imap-mailbox-examine-1 mailbox)
	(prog1
	    (and (imap-fetch
		  (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
		 (list (imap-mailbox-get-1 'uidvalidity mailbox)
		       (apply 'max (imap-message-map
				    (lambda (uid prop) uid) 'UID))))
	  (if old-mailbox
	      (imap-mailbox-select old-mailbox (eq state 'examine))
	    (imap-mailbox-unselect)))))))

(defun imap-message-appenduid-1 (mailbox)
  (if (imap-capability 'UIDPLUS)
      (imap-mailbox-get-1 'appenduid mailbox)
    (let ((old-mailbox imap-current-mailbox)
	  (state imap-state)
	  (imap-message-data (make-vector 2 0)))
      (when (imap-mailbox-examine-1 mailbox)
	(prog1
	    (and (imap-fetch
		  (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
		 (list (imap-mailbox-get-1 'uidvalidity mailbox)
		       (apply 'max (imap-message-map
				    (lambda (uid prop) uid) 'UID))))
	  (if old-mailbox
	      (imap-mailbox-select old-mailbox (eq state 'examine))
	    (imap-mailbox-unselect)))))))

;;(setq imap-log t)
(provide 'mdw-gnus-patch)