;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
+
+(require 'base64)
+
(eval-and-compile
(autoload 'open-ssl-stream "ssl")
- (autoload 'base64-decode-string "base64")
- (autoload 'base64-encode-string "base64")
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
- (autoload 'digest-md5-parse-digest-challenge "digest-md5")
- (autoload 'digest-md5-digest-response "digest-md5")
- (autoload 'digest-md5-digest-uri "digest-md5")
- (autoload 'digest-md5-challenge "digest-md5")
(autoload 'rfc2104-hash "rfc2104")
(autoload 'md5 "md5")
(autoload 'utf7-encode "utf7")
(defun imap-point-at-eol ()
(save-excursion
(end-of-line)
- (point)))))
+ (point))))
+ (autoload 'sasl-digest-md5-digest-response "sasl"))
;; User variables.
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
(defconst imap-default-stream 'network)
-(defconst imap-coding-system-for-read 'binary)
-(defconst imap-coding-system-for-write 'binary)
(defconst imap-local-variables '(imap-server
imap-port
imap-client-eol
(setcdr alist (imap-remassoc key (cdr alist)))
alist)))
-(defsubst imap-disable-multibyte ()
- "Enable multibyte in the current buffer."
- (when (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil)))
-
(defun imap-read-passwd (prompt &rest args)
"Read a password using PROMPT.
If ARGS, PROMPT is used as an argument to `format'."
(message "Opening Kerberos 4 IMAP connection with `%s'..." cmd)
(erase-buffer)
(let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
(process-connection-type imap-process-connection-type)
- (process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
+ (process (as-binary-process
+ (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?s server
+ ?p (number-to-string port)
+ ?l imap-default-user)))))
response)
(when process
(with-current-buffer buffer
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
+ (or (while (looking-at "^C:")
(forward-line))
t)
;; cyrus 1.6 imtest print "S: " before server greeting
(sit-for 1))
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
(not (string-match "failed" response))))
(setq done process)
(if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
+ (imap-send-command "LOGOUT"))
(delete-process process)
nil)))))
done))
(while (and (not done) (setq cmd (pop cmds)))
(message "Opening GSSAPI IMAP connection with `%s'..." cmd)
(let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
(process-connection-type imap-process-connection-type)
- (process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
+ (process (as-binary-process
+ (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?s server
+ ?p (number-to-string port)
+ ?l imap-default-user)))))
response)
(when process
(with-current-buffer buffer
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
+ (or (while (looking-at "^C:")
(forward-line))
t)
;; cyrus 1.6 imtest print "S: " before server greeting
(sit-for 1))
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
(not (string-match "failed" response))))
(setq done process)
(if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
+ (imap-send-command "LOGOUT"))
(delete-process process)
nil)))))
done))
(let ((cmds (if (listp imap-ssl-program) imap-ssl-program
(list imap-ssl-program)))
cmd done)
- (ignore-errors (require 'ssl))
+ (condition-case ()
+ (require 'ssl)
+ (error))
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening SSL connection with `%s'..." cmd)
(let* ((port (or port imap-default-ssl-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
(ssl-program-name shell-file-name)
(ssl-program-arguments
(list shell-command-switch
?s server
?p (number-to-string port)))))
process)
- (when (setq process (ignore-errors (open-ssl-stream
- name buffer server port)))
+ (when (setq process
+ (condition-case nil
+ (as-binary-process
+ (open-ssl-stream name buffer server port))
+ (error nil)))
(with-current-buffer buffer
(goto-char (point-min))
(while (and (memq (process-status process) '(open run))
(sit-for 1))
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
(defun imap-network-open (name buffer server port)
(let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (open-network-stream name buffer server port)))
+ (process (open-network-stream-as-binary name buffer server port)))
(when process
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(sit-for 1))
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
nil)
(defun imap-shell-open (name buffer server port)
- (let ((cmds imap-shell-program)
+ (let ((cmds (if (listp imap-shell-program) imap-shell-program
+ (list imap-shell-program)))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening IMAP connection with `%s'..." cmd)
(setq imap-client-eol "\n")
(let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?g imap-shell-host
- ?p (number-to-string port)
- ?l imap-default-user)))))
+ (process (as-binary-process
+ (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?s server
+ ?g imap-shell-host
+ ?p (number-to-string port)
+ ?l imap-default-user))))))
(when process
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
nil)))
(defun imap-starttls-p (buffer)
- (and (imap-capability 'STARTTLS buffer)
- (condition-case ()
- (progn
- (require 'starttls)
- (call-process "starttls"))
- (error nil))))
+ (imap-capability 'STARTTLS buffer))
(defun imap-starttls-open (name buffer server port)
(let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (starttls-open-stream name buffer server port))
+ (process (as-binary-process
+ (starttls-open-stream name buffer server port)))
done)
(message "imap: Connecting with STARTTLS...")
(when process
(while (or (not user) (not passwd))
(setq user (or imap-username
(read-from-minibuffer
- (concat "IMAP username for " imap-server ": ")
+ (concat "IMAP username for " imap-server
+ " (using stream `" (symbol-name imap-stream)
+ "'): ")
(or user imap-default-user))))
(setq passwd (or imap-password
(imap-read-passwd
(concat "IMAP password for " user "@"
- imap-server ": "))))
+ imap-server " (using authenticator `"
+ (symbol-name imap-auth) "'): "))))
(when (and user passwd)
(if (funcall loginfunc user passwd)
(progn
(defun imap-gssapi-auth-p (buffer)
(and (imap-capability 'AUTH=GSSAPI buffer)
- (catch 'imtest-found
- (let (prg (prgs imap-gssapi-program))
- (while (setq prg (pop prgs))
- (condition-case ()
- (and (call-process (substring prg 0 (string-match " " prg)))
- (throw 'imtest-found t))
- (error nil)))))))
+ (eq imap-stream 'gssapi)))
(defun imap-gssapi-auth (buffer)
(message "imap: Authenticating using GSSAPI...%s"
(defun imap-kerberos4-auth-p (buffer)
(and (imap-capability 'AUTH=KERBEROS_V4 buffer)
- (catch 'imtest-found
- (let (prg (prgs imap-kerberos4-program))
- (while (setq prg (pop prgs))
- (condition-case ()
- (and (call-process (substring prg 0 (string-match " " prg)))
- (throw 'imtest-found t))
- (error nil)))))))
+ (eq imap-stream 'kerberos4)))
(defun imap-kerberos4-auth (buffer)
(message "imap: Authenticating using Kerberos 4...%s"
"AUTHENTICATE CRAM-MD5"
(lambda (challenge)
(let* ((decoded (base64-decode-string challenge))
- (hash (rfc2104-hash 'md5 64 16 passwd decoded))
+ (hash-function
+ (if (and (featurep 'xemacs)
+ (>= (function-max-args 'md5) 4))
+ (lambda (object &optional start end)
+ (md5 object start end 'binary))
+ 'md5))
+ (hash (rfc2104-hash hash-function 64 16
+ passwd decoded))
(response (concat user " " hash))
(encoded (base64-encode-string response)))
encoded)))))))))
t)
(defun imap-anonymous-auth (buffer)
- (message "imap: Loging in anonymously...")
+ (message "imap: Logging in anonymously...")
(with-current-buffer buffer
(imap-ok-p (imap-send-command-wait
(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
(list
"AUTHENTICATE DIGEST-MD5"
(lambda (challenge)
- (digest-md5-parse-digest-challenge
- (base64-decode-string challenge))
- (let* ((digest-uri
- (digest-md5-digest-uri
- "imap" (digest-md5-challenge 'realm)))
- (response
- (digest-md5-digest-response
- user passwd digest-uri)))
- (base64-encode-string response 'no-line-break))))
- )))
+ (base64-encode-string
+ (sasl-digest-md5-digest-response
+ (base64-decode-string challenge)
+ user passwd "imap" imap-server)
+ 'no-line-break))))))
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
nil
(setq imap-continuation nil)
(if (imap-opened buffer)
(imap-close buffer))
(mapcar 'make-local-variable imap-local-variables)
- (imap-disable-multibyte)
+ (set-buffer-multibyte nil)
(buffer-disable-undo)
(setq imap-server (or server imap-server))
(setq imap-port (or port imap-port))
(setq imap-auth (or auth imap-auth))
(setq imap-stream (or stream imap-stream))
(message "imap: Connecting to %s..." imap-server)
- (if (let ((imap-stream (or imap-stream imap-default-stream)))
- (imap-open-1 buffer))
- ;; Choose stream.
- (let (stream-changed)
- (message "imap: Connecting to %s...done" imap-server)
- (when (null imap-stream)
- (let ((streams imap-streams))
- (while (setq stream (pop streams))
- (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
- (setq stream-changed (not (eq (or imap-stream
- imap-default-stream)
- stream))
- imap-stream stream
- streams nil)))
- (unless imap-stream
- (error "Couldn't figure out a stream for server"))))
- (when stream-changed
- (message "imap: Reconnecting with stream `%s'..." imap-stream)
- (imap-close buffer)
- (if (imap-open-1 buffer)
- (message "imap: Reconnecting with stream `%s'...done"
- imap-stream)
- (message "imap: Reconnecting with stream `%s'...failed"
- imap-stream))
- (setq imap-capability nil))
- (if (imap-opened buffer)
- ;; Choose authenticator
- (when (and (null imap-auth) (not (eq imap-state 'auth)))
- (let ((auths imap-authenticators))
- (while (setq auth (pop auths))
- (if (funcall (nth 1 (assq auth imap-authenticator-alist))
- buffer)
- (setq imap-auth auth
- auths nil)))
- (unless imap-auth
- (error "Couldn't figure out authenticator for server"))))))
- (message "imap: Connecting to %s...failed" imap-server))
- (when (imap-opened buffer)
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
- buffer)))
+ (if (null (let ((imap-stream (or imap-stream imap-default-stream)))
+ (imap-open-1 buffer)))
+ (progn
+ (message "imap: Connecting to %s...failed" imap-server)
+ nil)
+ (when (null imap-stream)
+ ;; Need to choose stream.
+ (let ((streams imap-streams))
+ (while (setq stream (pop streams))
+ ;; OK to use this stream?
+ (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
+ ;; Stream changed?
+ (if (not (eq imap-default-stream stream))
+ (with-current-buffer (get-buffer-create
+ (generate-new-buffer-name " *temp*"))
+ (mapcar 'make-local-variable imap-local-variables)
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo)
+ (setq imap-server (or server imap-server))
+ (setq imap-port (or port imap-port))
+ (setq imap-auth (or auth imap-auth))
+ (message "imap: Reconnecting with stream `%s'..." stream)
+ (if (null (let ((imap-stream stream))
+ (imap-open-1 (current-buffer))))
+ (progn
+ (kill-buffer (current-buffer))
+ (message
+ "imap: Reconnecting with stream `%s'...failed"
+ stream))
+ ;; We're done, kill the first connection
+ (imap-close buffer)
+ (kill-buffer buffer)
+ (rename-buffer buffer)
+ (message "imap: Reconnecting with stream `%s'...done"
+ stream)
+ (setq imap-stream stream)
+ (setq imap-capability nil)
+ (setq streams nil)))
+ ;; We're done
+ (message "imap: Connecting to %s...done" imap-server)
+ (setq imap-stream stream)
+ (setq imap-capability nil)
+ (setq streams nil))))))
+ (when (imap-opened buffer)
+ (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
+ (when imap-stream
+ buffer))))
(defun imap-opened (&optional buffer)
"Return non-nil if connection to imap server in BUFFER is open.
(make-local-variable 'imap-password)
(if user (setq imap-username user))
(if passwd (setq imap-password passwd))
- (if (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer)
- (setq imap-state 'auth)))))
+ (if imap-auth
+ (and (funcall (nth 2 (assq imap-auth
+ imap-authenticator-alist)) buffer)
+ (setq imap-state 'auth))
+ ;; Choose authenticator.
+ (let ((auths imap-authenticators)
+ auth)
+ (while (setq auth (pop auths))
+ ;; OK to use authenticator?
+ (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
+ (message "imap: Authenticating to `%s' using `%s'..."
+ imap-server auth)
+ (setq imap-auth auth)
+ (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
+ (progn
+ (message "imap: Authenticating to `%s' using `%s'...done"
+ imap-server auth)
+ (setq auths nil))
+ (message "imap: Authenticating to `%s' using `%s'...failed"
+ imap-server auth)))))
+ imap-state))))
(defun imap-close (&optional buffer)
"Close connection to server in BUFFER.
If BUFFER is nil, the current buffer is used."
(with-current-buffer (or buffer (current-buffer))
(when (imap-opened)
- (imap-send-command-wait "LOGOUT"))
+ (condition-case nil
+ (imap-send-command-wait "LOGOUT")
+ (quit nil)))
(when (and imap-process
(memq (process-status imap-process) '(open run)))
(delete-process imap-process))
items)
(imap-mailbox-get items mailbox)))))
+(defun imap-mailbox-status-asynch (mailbox items &optional buffer)
+ "Send status item request ITEM on MAILBOX to server in BUFFER.
+ITEMS can be a symbol or a list of symbols, valid symbols are one of
+the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
+or 'unseen. The IMAP command tag is returned."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-send-command (list "STATUS \""
+ (imap-utf7-encode mailbox)
+ "\" "
+ (format "%s"
+ (if (listp items)
+ items
+ (list items)))))))
+
(defun imap-mailbox-acl-get (&optional mailbox buffer)
"Get ACL on mailbox from server in BUFFER."
(let ((mailbox (imap-utf7-encode mailbox)))
(setq cmdstr (concat cmdstr imap-client-eol))
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert cmdstr)))
(imap-send-command-1 cmdstr)
(setq cmdstr nil)
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil) ;; abort command if no cont-req
+ (setq command nil);; abort command if no cont-req
(let ((process imap-process)
(stream imap-stream)
(eol imap-client-eol))
(and imap-log
(with-current-buffer (get-buffer-create
imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring cmd)))
(setq cmdstr nil)
(unwind-protect
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil) ;; abort command if no cont-req
+ (setq command nil);; abort command if no cont-req
(setq command (cons (funcall cmd imap-continuation)
command)))
(setq imap-continuation nil)))
(insert string)
(and imap-log
(with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert string)))
;; resp-cond-bye = "BYE" SP resp-text
;;
;; mailbox-data = "FLAGS" SP flag-list /
-;; "LIST" SP mailbox-list /
+;; "LIST" SP mailbox-list /
;; "LSUB" SP mailbox-list /
-;; "SEARCH" *(SP nz-number) /
+;; "SEARCH" *(SP nz-number) /
;; "STATUS" SP mailbox SP "("
-;; [status-att SP number *(SP status-att SP number)] ")" /
+;; [status-att SP number *(SP status-att SP number)] ")" /
;; number SP "EXISTS" /
-;; number SP "RECENT"
+;; number SP "RECENT"
;;
;; message-data = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att))
;;
;; resp-text-code = "ALERT" /
;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
;; "NEWNAME" SP string SP string /
-;; "PARSE" /
+;; "PARSE" /
;; "PERMANENTFLAGS" SP "("
;; [flag-perm *(SP flag-perm)] ")" /
;; "READ-ONLY" /
-;; "READ-WRITE" /
-;; "TRYCREATE" /
+;; "READ-WRITE" /
+;; "TRYCREATE" /
;; "UIDNEXT" SP nz-number /
-;; "UIDVALIDITY" SP nz-number /
+;; "UIDVALIDITY" SP nz-number /
;; "UNSEEN" SP nz-number /
;; resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
;;
(imap-forward)
(cond ((search-forward "PERMANENTFLAGS " nil t)
(imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
- ((search-forward "UIDNEXT " nil t)
- (imap-mailbox-put 'uidnext (read (current-buffer))))
+ ((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
+ (imap-mailbox-put 'uidnext (match-string 1)))
((search-forward "UNSEEN " nil t)
(imap-mailbox-put 'unseen (read (current-buffer))))
((looking-at "UIDVALIDITY \\([0-9]+\\)")
(let ((token (read (current-buffer))))
(imap-forward)
(cond ((eq token 'UID)
- (setq uid (ignore-errors (read (current-buffer)))))
+ (setq uid (condition-case ()
+ (read (current-buffer))
+ (error))))
((eq token 'FLAGS)
(setq flags (imap-parse-flag-list))
(if (not flags)
;; mailbox-data = ...
;; "STATUS" SP mailbox SP "("
-;; [status-att SP number
+;; [status-att SP number
;; *(SP status-att SP number)] ")"
;; ...
;;
((eq token 'RECENT)
(imap-mailbox-put 'recent (read (current-buffer)) mailbox))
((eq token 'UIDNEXT)
- (imap-mailbox-put 'uidnext (read (current-buffer)) mailbox))
+ (and (looking-at " \\([0-9]+\\)")
+ (imap-mailbox-put 'uidnext (match-string 1) mailbox)
+ (goto-char (match-end 1))))
((eq token 'UIDVALIDITY)
(and (looking-at " \\([0-9]+\\)")
(imap-mailbox-put 'uidvalidity (match-string 1) mailbox)
(defun imap-parse-envelope ()
(when (eq (char-after) ?\()
(imap-forward)
- (vector (prog1 (imap-parse-nstring) ;; date
+ (vector (prog1 (imap-parse-nstring);; date
(imap-forward))
- (prog1 (imap-parse-nstring) ;; subject
+ (prog1 (imap-parse-nstring);; subject
(imap-forward))
- (prog1 (imap-parse-address-list) ;; from
+ (prog1 (imap-parse-address-list);; from
(imap-forward))
- (prog1 (imap-parse-address-list) ;; sender
+ (prog1 (imap-parse-address-list);; sender
(imap-forward))
- (prog1 (imap-parse-address-list) ;; reply-to
+ (prog1 (imap-parse-address-list);; reply-to
(imap-forward))
- (prog1 (imap-parse-address-list) ;; to
+ (prog1 (imap-parse-address-list);; to
(imap-forward))
- (prog1 (imap-parse-address-list) ;; cc
+ (prog1 (imap-parse-address-list);; cc
(imap-forward))
- (prog1 (imap-parse-address-list) ;; bcc
+ (prog1 (imap-parse-address-list);; bcc
(imap-forward))
- (prog1 (imap-parse-nstring) ;; in-reply-to
+ (prog1 (imap-parse-nstring);; in-reply-to
(imap-forward))
- (prog1 (imap-parse-nstring) ;; message-id
+ (prog1 (imap-parse-nstring);; message-id
(imap-forward)))))
;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil
(defsubst imap-parse-string-list ()
- (cond ((eq (char-after) ?\() ;; body-fld-param
+ (cond ((eq (char-after) ?\();; body-fld-param
(let (strlist str)
(imap-forward)
(while (setq str (imap-parse-string))
(defsubst imap-parse-body-ext ()
(let (ext)
- (when (eq (char-after) ?\ ) ;; body-fld-dsp
+ (when (eq (char-after) ?\ );; body-fld-dsp
(imap-forward)
(let (dsp)
(if (eq (char-after) ?\()
(imap-forward))
(assert (imap-parse-nil) t "In imap-parse-body-ext"))
(push (nreverse dsp) ext))
- (when (eq (char-after) ?\ ) ;; body-fld-lang
+ (when (eq (char-after) ?\ );; body-fld-lang
(imap-forward)
(if (eq (char-after) ?\()
(push (imap-parse-string-list) ext)
(push (imap-parse-nstring) ext))
- (while (eq (char-after) ?\ ) ;; body-extension
+ (while (eq (char-after) ?\ );; body-extension
(imap-forward)
(setq ext (append (imap-parse-body-extension) ext)))))
ext))
(let (subbody)
(while (and (eq (char-after) ?\()
(setq subbody (imap-parse-body)))
- ;; buggy stalker communigate pro 3.0 insert a SPC between
+ ;; 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:
+ (push (imap-parse-string) body);; media-subtype
+ (when (eq (char-after) ?\ );; body-ext-mpart:
(imap-forward)
- (if (eq (char-after) ?\() ;; body-fld-param
+ (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-...
+ (append (imap-parse-body-ext) body)));; body-ext-...
(assert (eq (char-after) ?\)) t "In imap-parse-body")
(imap-forward)
(nreverse body))
- (push (imap-parse-string) body) ;; media-type
+ (push (imap-parse-string) body);; media-type
(imap-forward)
- (push (imap-parse-string) body) ;; media-subtype
+ (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
+ (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
+ (push (imap-parse-nstring) body);; body-fld-id
(imap-forward)
- (push (imap-parse-nstring) body) ;; body-fld-desc
+ (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
+ (push (or (imap-parse-nstring) "7BIT") body);; body-fld-enc
(imap-forward)
- (push (imap-parse-number) body) ;; body-fld-octets
+ (push (imap-parse-number) body);; body-fld-octets
- ;; ok, we're done parsing the required parts, what comes now is one
+ ;; 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)...
+ ;; 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
+ (cond ((eq (char-after) ?\();; body-type-msg:
+ (push (imap-parse-envelope) body);; envelope
(imap-forward)
- (push (imap-parse-body) body) ;; body
+ (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
+ ((setq lines (imap-parse-number)) ;; body-type-text:
+ (push lines body)) ;; body-fld-lines
(t
- (backward-char))))) ;; no match...
+ (backward-char))))) ;; no match...
;; ...and then parse the third one here...
- (when (eq (char-after) ?\ ) ;; body-ext-1part:
+ (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..
+ (push (imap-parse-nstring) body);; body-fld-md5
+ (setq body (append (imap-parse-body-ext) body)));; body-ext-1part..
(assert (eq (char-after) ?\)) t "In imap-parse-body 2")
(imap-forward)
projects / elisp / gnus.git- / blobdiff