1 ;;; very unpleasant hacking; may it not last long
7 (defsubst imap-parse-number ()
8 (when (looking-at "-?[0-9]+")
10 (string-to-number (match-string 0))
11 (goto-char (match-end 0)))))
13 (defun imap-parse-body ()
15 (when (eq (char-after) ?\()
17 (if (eq (char-after) ?\()
19 (while (and (eq (char-after) ?\()
22 ;; buggy stalker communigate pro
23 ;; 3.0 insert a SPC between
24 ;; parts in multiparts
25 (when (and (eq (char-after) ?\
32 (push (imap-parse-string) body)
34 (when (eq (char-after) ?\ ) ;; body-ext-mpart:
38 ?\() ;; body-fld-param
40 (imap-parse-string-list) body)
42 (imap-parse-nil) nil) body))
45 (imap-parse-body-ext) body))) ;; body-ext-...
46 (assert (eq (char-after)
47 ?\)) nil "In imap-parse-body")
51 (push (imap-parse-string) body) ;; media-type
53 (push (imap-parse-string) body) ;; media-subtype
55 ;; next line for Sun SIMS bug
56 (and (eq (char-after) ? ) (imap-forward))
57 (if (eq (char-after) ?\() ;; body-fld-param
58 (push (imap-parse-string-list) body)
59 (push (and (imap-parse-nil) nil) body))
61 (push (imap-parse-nstring) body) ;; body-fld-id
63 (push (imap-parse-nstring) body) ;; body-fld-desc
65 ;; next `or' for Sun SIMS bug, it regard
67 ;; nstring and return nil instead of defaulting
69 ;; as the standard says.
70 (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
72 (push (imap-parse-number) body) ;; body-fld-octets
74 ;; ok, we're done parsing the required parts,
75 ;; what comes now is one
78 ;; envelope (then we're parsing
80 ;; body-fld-lines (then we're parsing
82 ;; body-ext-1part (then we're parsing
85 ;; the problem is that the two first are in
86 ;; turn optionally followed
87 ;; by the third. So we parse the first two here
88 ;; (if there are any)...
90 (when (eq (char-after) ?\ )
93 (cond ((eq (char-after) ?\() ;; body-type-msg:
94 (push (imap-parse-envelope)
98 (imap-parse-body) body) ;; body
113 (imap-parse-number) body))) ;; body-fld-lines
115 (imap-parse-number)) ;; body-type-text:
116 (push lines body)) ;; body-fld-lines
118 (backward-char))))) ;; no match...
120 ;; ...and then parse the third one here...
122 (when (eq (char-after) ?\ ) ;; body-ext-1part:
124 (push (imap-parse-nstring) body) ;; body-fld-md5
125 (setq body (append (imap-parse-body-ext)
126 body))) ;; body-ext-1part..
128 (assert (eq (char-after) ?\)) nil "In
133 (defvar imap-enable-exchange-bug-workaround nil
134 "Send FETCH UID commands as *:* instead of *.
135 Enabling this appears to be required for some servers (e.g.,
136 Microsoft Exchange) which otherwise would trigger a response 'BAD
137 The specified message set is invalid.'.
139 BACKPORT from No Gnus!")
141 (defun nnimap-find-minmax-uid (group &optional examine)
142 "Find lowest and highest active article number in GROUP.
143 If EXAMINE is non-nil the group is selected read-only."
144 (with-current-buffer nnimap-server-buffer
145 (when (or (string= group (imap-current-mailbox))
146 (imap-mailbox-select group examine))
148 (when (> (imap-mailbox-get 'exists) 0)
149 (imap-fetch (if imap-enable-exchange-bug-workaround "1,*:*" "1,*")
150 "UID" nil 'nouidfetch)
151 (imap-message-map (lambda (uid Uid)
152 (setq minuid (if minuid (min minuid uid) uid)
153 maxuid (if maxuid (max maxuid uid) uid)))
155 (list (imap-mailbox-get 'exists) minuid maxuid)))))
157 (defun imap-message-copyuid-1 (mailbox)
158 (if (imap-capability 'UIDPLUS)
159 (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
160 (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
161 (let ((old-mailbox imap-current-mailbox)
163 (imap-message-data (make-vector 2 0)))
164 (when (imap-mailbox-examine-1 mailbox)
167 (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
168 (list (imap-mailbox-get-1 'uidvalidity mailbox)
169 (apply 'max (imap-message-map
170 (lambda (uid prop) uid) 'UID))))
172 (imap-mailbox-select old-mailbox (eq state 'examine))
173 (imap-mailbox-unselect)))))))
175 (defun imap-message-appenduid-1 (mailbox)
176 (if (imap-capability 'UIDPLUS)
177 (imap-mailbox-get-1 'appenduid mailbox)
178 (let ((old-mailbox imap-current-mailbox)
180 (imap-message-data (make-vector 2 0)))
181 (when (imap-mailbox-examine-1 mailbox)
184 (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
185 (list (imap-mailbox-get-1 'uidvalidity mailbox)
186 (apply 'max (imap-message-map
187 (lambda (uid prop) uid) 'UID))))
189 (imap-mailbox-select old-mailbox (eq state 'examine))
190 (imap-mailbox-unselect)))))))
193 (provide 'mdw-gnus-patch)