X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-pop3.el;h=2801637ca3e608087189e77546f592861f17d673;hb=b411c26020b3dfcbb70ec1c330958774f07f8ea6;hp=afc7cbde8b7df03d2f04052412a85aa8afb23eef;hpb=fbefe5cd8d62ccb154b90f0d31a522a49151d004;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index afc7cbd..2801637 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -33,8 +33,10 @@ (require 'elmo-msgdb) (require 'elmo-net) +(require 'elmo-map) (eval-when-compile + (require 'cl) (require 'elmo-util)) (eval-and-compile @@ -61,9 +63,14 @@ set as non-nil.") :type 'boolean :group 'elmo) +(defconst elmo-pop3-folder-name-syntax `(([user ".+"]) + (?/ [auth ".+"]) + (?: [uidl "^[A-Za-z]+$"]) + ,@elmo-net-folder-name-syntax)) + (defvar sasl-mechanism-alist) -(defvar elmo-pop3-total-size nil) +(defvar elmo-pop3-retrieve-progress-reporter nil) ;; For debugging. (defvar elmo-pop3-debug nil @@ -83,49 +90,49 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") ;;; ELMO POP3 folder (eval-and-compile - (luna-define-class elmo-pop3-folder (elmo-net-folder) - (use-uidl location-alist)) + (luna-define-class elmo-pop3-folder (elmo-net-folder elmo-location-map) + (use-uidl)) (luna-define-internal-accessors 'elmo-pop3-folder)) -(luna-define-method elmo-folder-initialize :around ((folder - elmo-pop3-folder) - name) +(defsubst elmo-pop3-folder-use-uidl (folder) + (if elmo-inhibit-number-mapping + nil + (elmo-pop3-folder-use-uidl-internal folder))) + +(luna-define-method elmo-folder-initialize ((folder elmo-pop3-folder) name) (let ((elmo-network-stream-type-alist (if elmo-pop3-stream-type-alist (append elmo-pop3-stream-type-alist elmo-network-stream-type-alist) elmo-network-stream-type-alist)) - parse) - (setq name (luna-call-next-method)) + tokens auth uidl) + (setq tokens (car (elmo-parse-separated-tokens + name + elmo-pop3-folder-name-syntax))) ;; user - (setq parse (elmo-parse-token name "/:")) (elmo-net-folder-set-user-internal folder - (if (eq (length (car parse)) 0) - elmo-pop3-default-user - (car parse))) + (or (cdr (assq 'user tokens)) + elmo-pop3-default-user)) ;; auth - (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) ":")) + (setq auth (cdr (assq 'auth tokens))) (elmo-net-folder-set-auth-internal folder - (if (eq (length (car parse)) 0) - elmo-pop3-default-authenticate-type - (intern (downcase (car parse))))) + (if auth + (intern (downcase auth)) + elmo-pop3-default-authenticate-type)) ;; uidl - (setq parse (elmo-parse-prefixed-element ?: (cdr parse))) + (setq uidl (cdr (assq 'uidl tokens))) (elmo-pop3-folder-set-use-uidl-internal folder - (if (eq (length (car parse)) 0) - elmo-pop3-default-use-uidl - (string= (car parse) "uidl"))) - (unless (elmo-net-folder-server-internal folder) - (elmo-net-folder-set-server-internal folder - elmo-pop3-default-server)) - (unless (elmo-net-folder-port-internal folder) - (elmo-net-folder-set-port-internal folder - elmo-pop3-default-port)) - (unless (elmo-net-folder-stream-type-internal folder) - (elmo-net-folder-set-stream-type-internal - folder - (elmo-get-network-stream-type - elmo-pop3-default-stream-type))) + (if uidl + (string= uidl "uidl") + elmo-pop3-default-use-uidl)) + ;; network + (elmo-net-folder-set-parameters + folder + tokens + (list :server elmo-pop3-default-server + :port elmo-pop3-default-port + :stream-type + (elmo-get-network-stream-type elmo-pop3-default-stream-type))) folder)) ;;; POP3 session @@ -156,9 +163,9 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-pop3-send-command (elmo-network-session-process-internal session) "quit") ;; process is dead. - (or (elmo-pop3-read-response - (elmo-network-session-process-internal session) - t) + (or (cdr (elmo-pop3-read-response + (elmo-network-session-process-internal session) + t)) (error "POP error: QUIT failed"))) (kill-buffer (process-buffer (elmo-network-session-process-internal session))) @@ -168,10 +175,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") "Get POP3 session for FOLDER. If IF-EXISTS is non-nil, don't get new session. If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." - (let ((elmo-pop3-use-uidl-internal (if elmo-inhibit-number-mapping - nil - (elmo-pop3-folder-use-uidl-internal - folder)))) + (let ((elmo-pop3-use-uidl-internal (elmo-pop3-folder-use-uidl folder))) (prog1 (if (eq if-exists 'any-exists) (or (elmo-network-get-session 'elmo-pop3-session @@ -200,12 +204,22 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (process-send-string process (concat command "\r\n")))) (defun elmo-pop3-read-response (process &optional not-command) + "Read response and return a cons cell of \(CODE . BODY\). +PROCESS is the process to read response from. +If optional NOT-COMMAND is non-nil, read only the first line. +CODE is one of the following: +'ok ... response is OK. +'err ... response is ERROR. +'login-delay ... user is not allowed to login until the login delay + period has expired. +'in-use ... authentication was successful but the mailbox is in use." ;; buffer is in case for process is dead. (with-current-buffer (process-buffer process) (let ((case-fold-search nil) (response-string nil) (response-continue t) (return-value nil) + (err nil) match-end) (while response-continue (goto-char elmo-pop3-read-point) @@ -214,7 +228,8 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (goto-char elmo-pop3-read-point)) (setq match-end (point)) (setq response-string - (buffer-substring elmo-pop3-read-point (- match-end 2))) + (buffer-substring elmo-pop3-read-point + (max (- match-end 2) elmo-pop3-read-point))) (goto-char elmo-pop3-read-point) (if (looking-at "\\+.*$") (progn @@ -226,9 +241,16 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." response-string))) (if (looking-at "\\-.*$") (progn - (setq response-continue nil) - (setq elmo-pop3-read-point match-end) - (setq return-value nil)) + (when (looking-at "[^ ]+ \\[\\([^]]+\\)\\]") + (setq return-value + (intern + (downcase + (buffer-substring (match-beginning 1) + (match-end 1)))))) + (setq err t + response-continue nil + elmo-pop3-read-point match-end + return-value (cons (or return-value 'err) nil))) (setq elmo-pop3-read-point match-end) (if not-command (setq response-continue nil)) @@ -237,7 +259,9 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (concat return-value "\n" response-string) response-string))) (setq elmo-pop3-read-point match-end))) - return-value))) + (if err + return-value + (cons 'ok return-value))))) (defun elmo-pop3-process-filter (process output) (when (buffer-live-p (process-buffer process)) @@ -245,64 +269,65 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (goto-char (point-max)) (insert output) (elmo-pop3-debug "RECEIVED: %s\n" output) - (if (and elmo-pop3-total-size - (> elmo-pop3-total-size - (min elmo-display-retrieval-progress-threshold 100))) - (elmo-display-progress - 'elmo-display-retrieval-progress - (format "Retrieving (%d/%d bytes)..." - (buffer-size) - elmo-pop3-total-size) - (/ (buffer-size) (/ elmo-pop3-total-size 100))))))) + (when elmo-pop3-retrieve-progress-reporter + (elmo-progress-notify 'elmo-retrieve-message :set (buffer-size)))))) (defun elmo-pop3-auth-user (session) - (let ((process (elmo-network-session-process-internal session))) + (let ((process (elmo-network-session-process-internal session)) + response) ;; try USER/PASS (elmo-pop3-send-command process (format "user %s" (elmo-network-session-user-internal session)) nil 'no-log) - (or (elmo-pop3-read-response process t) - (progn - (delete-process process) - (signal 'elmo-authenticate-error - '(elmo-pop-auth-user)))) + (setq response (elmo-pop3-read-response process t)) + (unless (eq (car response) 'ok) + (signal 'elmo-open-error '(elmo-pop-auth-user))) (elmo-pop3-send-command process (format "pass %s" (elmo-get-passwd (elmo-network-session-password-key session))) nil 'no-log) - (or (elmo-pop3-read-response process t) - (progn - (delete-process process) - (signal 'elmo-authenticate-error - '(elmo-pop-auth-user)))))) + (setq response (elmo-pop3-read-response process t)) + (case (car response) + (ok) + (in-use + (error "Maildrop is currently in use")) + (login-delay + (error "Not allowed to login until the login delay period has expired")) + (t + (signal 'elmo-authenticate-error '(elmo-pop-auth-user)))) + (car response))) (defun elmo-pop3-auth-apop (session) - (if (string-match "^\+OK .*\\(<[^\>]+>\\)" - (elmo-network-session-greeting-internal session)) - ;; good, APOP ready server - (progn - (elmo-pop3-send-command - (elmo-network-session-process-internal session) - (format "apop %s %s" - (elmo-network-session-user-internal session) - (md5 - (concat (match-string - 1 - (elmo-network-session-greeting-internal session)) - (elmo-get-passwd - (elmo-network-session-password-key session))))) - nil 'no-log) - (or (elmo-pop3-read-response - (elmo-network-session-process-internal session) - t) - (progn - (delete-process (elmo-network-session-process-internal session)) - (signal 'elmo-authenticate-error - '(elmo-pop3-auth-apop))))) - (signal 'elmo-open-error '(elmo-pop3-auth-apop)))) + (unless (string-match "^\+OK .*\\(<[=!-;?-~]+@[=!-;?-~]+>\\)" + (elmo-network-session-greeting-internal session)) + (signal 'elmo-open-error '(elmo-pop3-auth-apop))) + ;; good, APOP ready server + (elmo-pop3-send-command + (elmo-network-session-process-internal session) + (format "apop %s %s" + (elmo-network-session-user-internal session) + (md5 + (concat (match-string + 1 + (elmo-network-session-greeting-internal session)) + (elmo-get-passwd + (elmo-network-session-password-key session))))) + nil 'no-log) + (let ((response (elmo-pop3-read-response + (elmo-network-session-process-internal session) + t))) + (case (car response) + (ok) + (in-use + (error "Maildrop is currently in use")) + (login-delay + (error "Not allowed to login until the login delay period has expired")) + (t + (signal 'elmo-authenticate-error '(elmo-pop-auth-apop)))) + (car response))) (luna-define-method elmo-network-initialize-session-buffer :after ((session elmo-pop3-session) buffer) @@ -325,18 +350,16 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (setq elmo-pop3-read-point (point)) (or (elmo-network-session-set-greeting-internal session - (elmo-pop3-read-response process t)) + (cdr (elmo-pop3-read-response process t))) ; if ok, cdr is non-nil. (signal 'elmo-open-error '(elmo-network-intialize-session))) (when (eq (elmo-network-stream-type-symbol (elmo-network-session-stream-type-internal session)) 'starttls) (elmo-pop3-send-command process "stls") - (if (string-match "^\+OK" - (elmo-pop3-read-response process)) + (if (eq 'ok (car (elmo-pop3-read-response process))) (starttls-negotiate process) - (signal 'elmo-open-error - '(elmo-pop3-starttls-error))))))) + (signal 'elmo-open-error '(elmo-pop3-starttls-error))))))) (luna-define-method elmo-network-authenticate-session ((session elmo-pop3-session)) @@ -344,16 +367,15 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (elmo-network-session-process-internal session)) (let* ((process (elmo-network-session-process-internal session)) (auth (elmo-network-session-auth-internal session)) - (auth (mapcar '(lambda (mechanism) (upcase (symbol-name mechanism))) - (if (listp auth) auth (list auth)))) - sasl-mechanisms - client name step response mechanism - sasl-read-passphrase) + (auth (mapcar (lambda (mechanism) (upcase (symbol-name mechanism))) + (if (listp auth) auth (list auth))))) (or (and (string= "USER" (car auth)) (elmo-pop3-auth-user session)) (and (string= "APOP" (car auth)) (elmo-pop3-auth-apop session)) - (progn + (let (sasl-mechanisms + client name step response mechanism + sasl-read-passphrase) (require 'sasl) (setq sasl-mechanisms (mapcar 'car sasl-mechanism-alist)) (setq mechanism (sasl-find-mechanism auth)) @@ -371,10 +393,9 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (elmo-network-session-set-auth-internal session (intern (downcase name))) (setq sasl-read-passphrase - (function - (lambda (prompt) - (elmo-get-passwd - (elmo-network-session-password-key session))))) + (lambda (prompt) + (elmo-get-passwd + (elmo-network-session-password-key session)))) (setq step (sasl-next-step client nil)) (elmo-pop3-send-command process @@ -387,21 +408,26 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." nil 'no-log) (catch 'done (while t - (unless (setq response (elmo-pop3-read-response process t)) - ;; response is NO or BAD. - (signal 'elmo-authenticate-error - (list (intern - (concat "elmo-pop3-auth-" - (downcase name)))))) - (if (string-match "^\+OK" response) - (if (sasl-next-step client step) - ;; Bogus server? - (signal 'elmo-authenticate-error - (list (intern - (concat "elmo-pop3-auth-" - (downcase name))))) - ;; The authentication process is finished. - (throw 'done nil))) + (setq response (elmo-pop3-read-response process t)) + (case (car response) + (ok) + (in-use + (error "Maildrop is currently in use")) + (login-delay + (error "Not allowed to login \ +until the login delay period has expired")) + (t + (signal 'elmo-authenticate-error + (list (intern (concat "elmo-pop3-auth-" + (downcase name))))))) + (if (sasl-next-step client step) + ;; Bogus server? + (signal 'elmo-authenticate-error + (list (intern + (concat "elmo-pop3-auth-" + (downcase name))))) + ;; The authentication process is finished. + (throw 'done nil)) (sasl-step-set-data step (elmo-base64-decode-string @@ -422,7 +448,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (setq elmo-pop3-size-hash (elmo-make-hash 31)) ;; To get obarray of uidl and size (elmo-pop3-send-command process "list") - (if (null (elmo-pop3-read-response process)) + (if (null (cdr (elmo-pop3-read-response process))) (error "POP LIST command failed")) (if (null (setq response (elmo-pop3-read-contents process))) @@ -435,7 +461,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2))) ;; UIDL (elmo-pop3-send-command process "uidl") - (unless (elmo-pop3-read-response process) + (unless (cdr (elmo-pop3-read-response process)) (error "POP UIDL failed")) (unless (setq response (elmo-pop3-read-contents process)) (error "POP UIDL failed")) @@ -444,15 +470,15 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (defun elmo-pop3-read-contents (process) (with-current-buffer (process-buffer process) (let ((case-fold-search nil) - match-end) - (goto-char elmo-pop3-read-point) - (while (not (re-search-forward "^\\.\r\n" nil t)) - (accept-process-output process 1) - (goto-char elmo-pop3-read-point)) - (setq match-end (point)) + (point elmo-pop3-read-point)) + (while (and (goto-char (- point 2)) + (not (search-forward "\r\n.\r\n" nil t))) + (setq point (max (- (point-max) 2) ; Care of \r\n.\r[EOF] case + elmo-pop3-read-point)) + (accept-process-output process 1)) (elmo-delete-cr (buffer-substring elmo-pop3-read-point - (- match-end 3)))))) + (- (point) 3)))))) (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-pop3-folder)) (convert-standard-filename @@ -540,32 +566,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (error "POP3: Error in UIDL"))))) (defun elmo-pop3-list-folder-by-location (folder locations) - (let* ((location-alist (elmo-pop3-folder-location-alist-internal folder)) - (locations-in-db (mapcar 'cdr location-alist)) - result new-locs new-alist deleted-locs i) - (setq new-locs - (elmo-delete-if (function - (lambda (x) (member x locations-in-db))) - locations)) - (setq deleted-locs - (elmo-delete-if (function - (lambda (x) (member x locations))) - locations-in-db)) - (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0)) - (mapcar - (function - (lambda (x) - (setq location-alist - (delq (rassoc x location-alist) location-alist)))) - deleted-locs) - (while new-locs - (setq i (1+ i)) - (setq new-alist (cons (cons i (car new-locs)) new-alist)) - (setq new-locs (cdr new-locs))) - (setq result (nconc location-alist new-alist)) - (setq result (sort result (lambda (x y) (< (car x)(car y))))) - (elmo-pop3-folder-set-location-alist-internal folder result) - (mapcar 'car result))) + (mapcar #'car (elmo-location-map-update folder locations))) (defun elmo-pop3-list-by-uidl-subr (folder &optional nonsort) (let ((flist (elmo-pop3-list-folder-by-location @@ -583,7 +584,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (if elmo-pop3-list-done (progn (mapatoms (lambda (atom) - (setq list (cons (string-to-int + (setq list (cons (string-to-number (substring (symbol-name atom) 1)) list))) elmo-pop3-size-hash) @@ -591,8 +592,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (error "POP3: Error in list"))))) (defsubst elmo-pop3-folder-list-messages (folder) - (if (and (not elmo-inhibit-number-mapping) - (elmo-pop3-folder-use-uidl-internal folder)) + (if (elmo-pop3-folder-use-uidl folder) (elmo-pop3-list-by-uidl-subr folder) (elmo-pop3-list-by-list folder))) @@ -603,23 +603,23 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (luna-define-method elmo-folder-status ((folder elmo-pop3-folder)) (elmo-folder-open-internal folder) (elmo-folder-check folder) - (if (elmo-pop3-folder-use-uidl-internal folder) + (if (elmo-pop3-folder-use-uidl folder) (prog1 (elmo-pop3-list-by-uidl-subr folder 'nonsort) (elmo-folder-close-internal folder)) - (let* ((process - (elmo-network-session-process-internal - (elmo-pop3-get-session folder))) - (total 0) - response) + (let ((process + (elmo-network-session-process-internal + (elmo-pop3-get-session folder))) + (total 0) + response) (with-current-buffer (process-buffer process) (elmo-pop3-send-command process "STAT") - (setq response (elmo-pop3-read-response process)) + (setq response (cdr (elmo-pop3-read-response process))) ;; response: "^\+OK 2 7570$" (if (not (string-match "^\+OK[ \t]*\\([0-9]*\\)" response)) (error "POP STAT command failed") (setq total - (string-to-int + (string-to-number (substring response (match-beginning 1)(match-end 1 )))) (elmo-folder-close-internal folder) (cons total total)))))) @@ -640,44 +640,40 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." nil))) (defun elmo-pop3-retrieve-headers (process tobuffer articles) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (erase-buffer) - (let ((number (length articles)) - (count 0) + (let ((count 0) (received 0) (last-point (point-min))) - ;; Send HEAD commands. - (while articles - (elmo-pop3-send-command process (format - "top %s 0" (car articles)) - 'no-erase) -;;; (accept-process-output process 1) - (setq articles (cdr articles)) - (setq count (1+ count)) - ;; Every 200 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or elmo-pop3-send-command-synchronously - (null articles) ;All requests have been sent. - (zerop (% count elmo-pop3-header-fetch-chop-length))) - (unless elmo-pop3-send-command-synchronously - (accept-process-output process 1)) - (discard-input) - (while (progn - (goto-char last-point) - ;; Count replies. - (while (elmo-pop3-next-result-arrived-p) - (setq last-point (point)) - (setq received (1+ received))) - (< received count)) - (when (> number elmo-display-progress-threshold) - (if (or (zerop (% received 5)) (= received number)) - (elmo-display-progress - 'elmo-pop3-retrieve-headers "Getting headers..." - (/ (* received 100) number)))) - (accept-process-output process 1) -;;; (accept-process-output process) - (discard-input)))) + (elmo-with-progress-display (elmo-retrieve-header (length articles)) + "Getting headers" + ;; Send HEAD commands. + (while articles + (elmo-pop3-send-command process + (format "top %s 0" (car articles)) + 'no-erase) +;;; (accept-process-output process 1) + (setq articles (cdr articles)) + (setq count (1+ count)) + ;; Every 200 requests we have to read the stream in + ;; order to avoid deadlocks. + (when (or elmo-pop3-send-command-synchronously + (null articles) ;All requests have been sent. + (zerop (% count elmo-pop3-header-fetch-chop-length))) + (unless elmo-pop3-send-command-synchronously + (accept-process-output process 1)) + (discard-input) + (while (progn + (goto-char last-point) + ;; Count replies. + (while (elmo-pop3-next-result-arrived-p) + (setq last-point (point)) + (setq received (1+ received))) + (< received count)) + (elmo-progress-notify 'elmo-retrieve-header :set received) + (accept-process-output process 1) +;;; (accept-process-output process) + (discard-input))))) ;; Replace all CRLF with LF. (elmo-delete-cr-buffer) (copy-to-buffer tobuffer (point-min) (point-max))))) @@ -687,30 +683,11 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (let ((process (elmo-network-session-process-internal (elmo-pop3-get-session folder)))) (with-current-buffer (process-buffer process) - (elmo-pop3-sort-msgdb-by-original-number + (elmo-pop3-msgdb-create-by-header folder - (elmo-pop3-msgdb-create-by-header - folder - process - numlist - flag-table - (if (elmo-pop3-folder-use-uidl-internal folder) - (elmo-pop3-folder-location-alist-internal folder))))))) - -(defun elmo-pop3-sort-msgdb-by-original-number (folder msgdb) - (let ((location-alist (elmo-pop3-folder-location-alist-internal folder))) - (when location-alist - (elmo-msgdb-sort-entities - msgdb - (lambda (ent1 ent2 loc-alist) - (< (elmo-pop3-uidl-to-number - (cdr (assq (elmo-message-entity-number ent1) - loc-alist))) - (elmo-pop3-uidl-to-number - (cdr (assq (elmo-message-entity-number ent2) - loc-alist))))) - location-alist)) - msgdb)) + process + (sort numlist #'<) + flag-table)))) (defun elmo-pop3-uidl-to-number (uidl) (string-to-number (elmo-get-hash-val uidl @@ -721,85 +698,77 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." elmo-pop3-number-uidl-hash)) (defun elmo-pop3-number-to-size (number) - (elmo-get-hash-val (format "#%d" number) - elmo-pop3-size-hash)) + (string-to-number + (elmo-get-hash-val (format "#%d" number) elmo-pop3-size-hash))) (defun elmo-pop3-msgdb-create-by-header (folder process numlist - flag-table - loc-alist) + flag-table) (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))) - (with-current-buffer (process-buffer process) - (if loc-alist ; use uidl. - (setq numlist - (delq - nil - (mapcar - (lambda (number) - (elmo-pop3-uidl-to-number (cdr (assq number loc-alist)))) - numlist)))) - (elmo-pop3-retrieve-headers process tmp-buffer numlist) - (prog1 + (unwind-protect + (with-current-buffer (process-buffer process) + (when (elmo-pop3-folder-use-uidl folder) + (setq numlist + (delq + nil + (mapcar + (lambda (number) + (elmo-pop3-uidl-to-number + (elmo-map-message-location folder number))) + numlist)))) + (elmo-pop3-retrieve-headers process tmp-buffer numlist) (elmo-pop3-msgdb-create-message folder tmp-buffer process (length numlist) numlist - flag-table loc-alist) - (kill-buffer tmp-buffer))))) + flag-table)) + (kill-buffer tmp-buffer)))) (defun elmo-pop3-msgdb-create-message (folder buffer process num numlist - flag-table - loc-alist) + flag-table) (save-excursion (let ((new-msgdb (elmo-make-msgdb)) - beg entity i number message-id flags) + beg entity number message-id flags) (set-buffer buffer) - (elmo-set-buffer-multibyte default-enable-multibyte-characters) + (set-buffer-multibyte default-enable-multibyte-characters) (goto-char (point-min)) - (setq i 0) - (message "Creating msgdb...") - (while (not (eobp)) - (setq beg (save-excursion (forward-line 1) (point))) - (elmo-pop3-next-result-arrived-p) - (save-excursion - (forward-line -1) - (save-restriction - (narrow-to-region beg (point)) - (setq entity - (elmo-msgdb-create-message-entity-from-buffer - (elmo-msgdb-message-entity-handler new-msgdb) - (car numlist))) - (setq numlist (cdr numlist)) - (when entity - (with-current-buffer (process-buffer process) - (elmo-message-entity-set-field - entity - 'size - (string-to-number - (elmo-pop3-number-to-size - (elmo-message-entity-number entity)))) - (if (setq number - (car - (rassoc - (elmo-pop3-number-to-uidl - (elmo-message-entity-number entity)) - loc-alist))) + (elmo-with-progress-display (elmo-folder-msgdb-create num) + "Creating msgdb" + (while (not (eobp)) + (setq beg (save-excursion (forward-line 1) (point))) + (elmo-pop3-next-result-arrived-p) + (save-excursion + (forward-line -1) + (save-restriction + (narrow-to-region beg (point)) + (setq entity + (elmo-msgdb-create-message-entity-from-buffer + (elmo-msgdb-message-entity-handler new-msgdb) + (car numlist))) + (setq numlist (cdr numlist)) + (when entity + (with-current-buffer (process-buffer process) + (elmo-message-entity-set-field + entity + 'size + (elmo-pop3-number-to-size + (elmo-message-entity-number entity))) + (when (setq number + (elmo-map-message-number + folder + (elmo-pop3-number-to-uidl + (elmo-message-entity-number entity)))) (elmo-message-entity-set-number entity number))) - (setq message-id (elmo-message-entity-field entity 'message-id) - flags (elmo-flag-table-get flag-table message-id)) - (elmo-global-flags-set flags folder number message-id) - (elmo-msgdb-append-entity new-msgdb entity flags)))) - (when (> num elmo-display-progress-threshold) - (setq i (1+ i)) - (if (or (zerop (% i 5)) (= i num)) - (elmo-display-progress - 'elmo-pop3-msgdb-create-message "Creating msgdb..." - (/ (* i 100) num))))) + (setq message-id (elmo-message-entity-field entity 'message-id) + flags (elmo-flag-table-get flag-table message-id)) + (elmo-global-flags-set flags folder number message-id) + (elmo-msgdb-append-entity new-msgdb entity flags)))) + (elmo-progress-notify 'elmo-folder-msgdb-create))) new-msgdb))) (defun elmo-pop3-read-body (process outbuf) @@ -817,19 +786,19 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." t))) (luna-define-method elmo-folder-open-internal ((folder elmo-pop3-folder)) - (if (and (not elmo-inhibit-number-mapping) - (elmo-pop3-folder-use-uidl-internal folder)) - (elmo-pop3-folder-set-location-alist-internal - folder (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))) + (when (elmo-pop3-folder-use-uidl folder) + (elmo-location-map-load folder (elmo-folder-msgdb-path folder)))) + +(luna-define-method elmo-folder-open-internal-p ((folder elmo-pop3-folder)) + (elmo-location-map-alist folder)) (luna-define-method elmo-folder-commit :after ((folder elmo-pop3-folder)) - (when (elmo-folder-persistent-p folder) - (elmo-msgdb-location-save (elmo-folder-msgdb-path folder) - (elmo-pop3-folder-location-alist-internal - folder)))) + (when (and (not elmo-inhibit-number-mapping) + (elmo-folder-persistent-p folder)) + (elmo-location-map-save folder (elmo-folder-msgdb-path folder)))) (luna-define-method elmo-folder-close-internal ((folder elmo-pop3-folder)) - (elmo-pop3-folder-set-location-alist-internal folder nil) + (elmo-location-map-teardown folder) ;; Just close connection (elmo-folder-check folder)) @@ -837,37 +806,23 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." number strategy &optional section outbuf unseen) - (let* ((loc-alist (elmo-pop3-folder-location-alist-internal folder)) - (process (elmo-network-session-process-internal - (elmo-pop3-get-session folder))) + (let ((process (elmo-network-session-process-internal + (elmo-pop3-get-session folder))) size response errmsg msg) (with-current-buffer (process-buffer process) - (if loc-alist - (setq number (elmo-pop3-uidl-to-number - (cdr (assq number loc-alist))))) - (setq size (string-to-number - (elmo-pop3-number-to-size number))) + (when (elmo-pop3-folder-use-uidl folder) + (setq number (elmo-pop3-uidl-to-number + (elmo-map-message-location folder number)))) + (setq size (elmo-pop3-number-to-size number)) (when number - (elmo-pop3-send-command process - (format "retr %s" number)) - (unless elmo-inhibit-display-retrieval-progress - (setq elmo-pop3-total-size size) - (elmo-display-progress - 'elmo-display-retrieval-progress - (format "Retrieving (0/%d bytes)..." elmo-pop3-total-size) - 0)) - (unwind-protect - (progn - (when (null (setq response (elmo-pop3-read-response - process t))) - (error "Fetching message failed")) - (setq response (elmo-pop3-read-body process outbuf))) - (setq elmo-pop3-total-size nil)) - (unless elmo-inhibit-display-retrieval-progress - (elmo-display-progress - 'elmo-display-retrieval-progress - "Retrieving..." 100) ; remove progress bar. - (message "Retrieving...done")) + (elmo-with-progress-display + (elmo-retrieve-message size elmo-pop3-retrieve-progress-reporter) + "Retrieving" + (elmo-pop3-send-command process (format "retr %s" number)) + (when (null (setq response (cdr (elmo-pop3-read-response + process t)))) + (error "Fetching message failed")) + (setq response (elmo-pop3-read-body process outbuf))) (set-buffer outbuf) (goto-char (point-min)) (while (re-search-forward "^\\." nil t) @@ -876,29 +831,28 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (elmo-delete-cr-buffer) response)))) -(defun elmo-pop3-delete-msg (process number loc-alist) - (with-current-buffer (process-buffer process) - (let (response errmsg msg) - (if loc-alist - (setq number (elmo-pop3-uidl-to-number - (cdr (assq number loc-alist))))) - (if number - (progn - (elmo-pop3-send-command process - (format "dele %s" number)) - (when (null (setq response (elmo-pop3-read-response - process t))) - (error "Deleting message failed"))) - (error "Deleting message failed"))))) +(defun elmo-pop3-delete-msg (process number) + (unless number + (error "Deleting message failed")) + (elmo-pop3-send-command process (format "dele %s" number)) + (when (null (cdr (elmo-pop3-read-response process t))) + (error "Deleting message failed"))) (luna-define-method elmo-folder-delete-messages-plugged ((folder elmo-pop3-folder) msgs) - (let ((loc-alist (elmo-pop3-folder-location-alist-internal folder)) - (process (elmo-network-session-process-internal + (let ((process (elmo-network-session-process-internal (elmo-pop3-get-session folder)))) - (mapcar '(lambda (msg) (elmo-pop3-delete-msg process msg loc-alist)) - msgs))) + (with-current-buffer (process-buffer process) + (dolist (number (if (elmo-pop3-folder-use-uidl folder) + (mapcar + (lambda (number) + (elmo-pop3-uidl-to-number + (elmo-map-message-location folder number))) + msgs) + msgs)) + (elmo-pop3-delete-msg process number)) + t))) (luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number) elmo-pop3-use-cache) @@ -910,7 +864,7 @@ If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (luna-define-method elmo-folder-clear :around ((folder elmo-pop3-folder) &optional keep-killed) (unless keep-killed - (elmo-pop3-folder-set-location-alist-internal folder nil)) + (elmo-location-map-setup folder)) (luna-call-next-method)) (luna-define-method elmo-folder-check ((folder elmo-pop3-folder))