comparison lisp/gnus/pop3.el @ 108439:c3622fa53abe

Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Fri, 26 Mar 2010 15:03:20 +0000
parents 0fe940324254
children 459fd421257a
comparison
equal deleted inserted replaced
108438:2485b1fb98d3 108439:c3622fa53abe
95 ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org 95 ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org
96 ;; Any volunteer to re-implement this? 96 ;; Any volunteer to re-implement this?
97 :version "22.1" ;; Oort Gnus 97 :version "22.1" ;; Oort Gnus
98 :type 'boolean 98 :type 'boolean
99 :group 'pop3) 99 :group 'pop3)
100
101 (defcustom pop3-display-message-size-flag t
102 "*If non-nil, display the size of the message that is being fetched."
103 :version "22.1" ;; Oort Gnus
104 :type 'boolean
105 :group 'pop3)
100 106
101 (defvar pop3-timestamp nil 107 (defvar pop3-timestamp nil
102 "Timestamp returned when initially connected to the POP server. 108 "Timestamp returned when initially connected to the POP server.
103 Used for APOP authentication.") 109 Used for APOP authentication.")
104 110
133 (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) 139 (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
134 (let* ((process (pop3-open-server pop3-mailhost pop3-port)) 140 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
135 (crashbuf (get-buffer-create " *pop3-retr*")) 141 (crashbuf (get-buffer-create " *pop3-retr*"))
136 (n 1) 142 (n 1)
137 message-count 143 message-count
144 message-sizes
138 (pop3-password pop3-password)) 145 (pop3-password pop3-password))
139 ;; for debugging only 146 ;; for debugging only
140 (if pop3-debug (switch-to-buffer (process-buffer process))) 147 (if pop3-debug (switch-to-buffer (process-buffer process)))
141 ;; query for password 148 ;; query for password
142 (if (and pop3-password-required (not pop3-password)) 149 (if (and pop3-password-required (not pop3-password))
147 ((equal 'pass pop3-authentication-scheme) 154 ((equal 'pass pop3-authentication-scheme)
148 (pop3-user process pop3-maildrop) 155 (pop3-user process pop3-maildrop)
149 (pop3-pass process)) 156 (pop3-pass process))
150 (t (error "Invalid POP3 authentication scheme"))) 157 (t (error "Invalid POP3 authentication scheme")))
151 (setq message-count (car (pop3-stat process))) 158 (setq message-count (car (pop3-stat process)))
159 (when (and pop3-display-message-size-flag
160 (> message-count 0))
161 (setq message-sizes (pop3-list process)))
152 (unwind-protect 162 (unwind-protect
153 (while (<= n message-count) 163 (while (<= n message-count)
154 (message "Retrieving message %d of %d from %s..." 164 (if pop3-display-message-size-flag
155 n message-count pop3-mailhost) 165 (message "Retrieving message %d of %d from %s... (%.1fk)"
166 n message-count pop3-mailhost
167 (/ (cdr (assoc n message-sizes))
168 1024.0))
169 (message "Retrieving message %d of %d from %s..."
170 n message-count pop3-mailhost))
156 (pop3-retr process n crashbuf) 171 (pop3-retr process n crashbuf)
157 (save-excursion 172 (save-excursion
158 (set-buffer crashbuf) 173 (set-buffer crashbuf)
159 (let ((coding-system-for-write 'binary)) 174 (let ((coding-system-for-write 'binary))
160 (write-region (point-min) (point-max) crashbox t 'nomesg)) 175 (write-region (point-min) (point-max) crashbox t 'nomesg))
449 (list (string-to-number (nth 1 (split-string response " "))) 464 (list (string-to-number (nth 1 (split-string response " ")))
450 (string-to-number (nth 2 (split-string response " ")))) 465 (string-to-number (nth 2 (split-string response " "))))
451 )) 466 ))
452 467
453 (defun pop3-list (process &optional msg) 468 (defun pop3-list (process &optional msg)
454 "Scan listing of available messages. 469 "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs.
455 This function currently does nothing.") 470 Otherwise, return the size of the message-id MSG"
471 (pop3-send-command process (if msg
472 (format "LIST %d" msg)
473 "LIST"))
474 (let ((response (pop3-read-response process t)))
475 (if msg
476 (string-to-number (nth 2 (split-string response " ")))
477 (let ((start pop3-read-point) end)
478 (save-excursion
479 (set-buffer (process-buffer process))
480 (while (not (re-search-forward "^\\.\r\n" nil t))
481 (pop3-accept-process-output process)
482 (goto-char start))
483 (setq pop3-read-point (point-marker))
484 (goto-char (match-beginning 0))
485 (setq end (point-marker))
486 (mapcar #'(lambda (s) (let ((split (split-string s " ")))
487 (cons (string-to-number (nth 0 split))
488 (string-to-number (nth 1 split)))))
489 (delete "" (split-string (buffer-substring start end)
490 "\r\n"))))))))
456 491
457 (defun pop3-retr (process msg crashbuf) 492 (defun pop3-retr (process msg crashbuf)
458 "Retrieve message-id MSG to buffer CRASHBUF." 493 "Retrieve message-id MSG to buffer CRASHBUF."
459 (pop3-send-command process (format "RETR %s" msg)) 494 (pop3-send-command process (format "RETR %s" msg))
460 (pop3-read-response process) 495 (pop3-read-response process)