Mercurial > emacs
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) |