X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-pop3.el;h=19db3b0ca86b1ceaf2bdda8c4475f7bcff72b398;hb=0a4f27eec0a2e5035d6bb853a62dd7631ea8cb2a;hp=05033f2772fab9e6f5e7cc8ee4d8abc74eb93290;hpb=46b78d195741a2fcf63cdaaf09382506a3a1fd0c;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 05033f2..19db3b0 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -1,4 +1,4 @@ -;;; elmo-pop3.el -- POP3 Interface for ELMO. +;;; elmo-pop3.el --- POP3 Interface for ELMO. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Copyright (C) 1999,2000 Kenichi OKADA @@ -26,10 +26,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'elmo-msgdb) (require 'elmo-net) @@ -40,7 +40,27 @@ (eval-and-compile (autoload 'md5 "md5")) -(defvar elmo-pop3-exists-exactly t) +(defcustom elmo-pop3-default-use-uidl t + "If non-nil, use UIDL on POP3." + :type 'boolean + :group 'elmo) + +(defvar elmo-pop3-use-uidl-internal t + "(Internal switch for using UIDL on POP3).") + +(defvar elmo-pop3-use-cache t + "Use cache in pop3 folder.") + +(defvar elmo-pop3-send-command-synchronously nil + "If non-nil, commands are send synchronously. +If server doesn't accept asynchronous commands, this variable should be +set as non-nil.") + +(defcustom elmo-pop3-exists-exactly nil + "If non-nil, POP3 folder existence is checked everytime before the session." + :type 'boolean + :group 'elmo) + (defvar sasl-mechanism-alist) (defvar elmo-pop3-total-size nil) @@ -50,18 +70,66 @@ "Non-nil forces POP3 folder as debug mode. Debug information is inserted in the buffer \"*POP3 DEBUG*\"") -(defvar elmo-pop3-debug-inhibit-logging nil) - ;;; Debug (defsubst elmo-pop3-debug (message &rest args) (if elmo-pop3-debug - (with-current-buffer (get-buffer-create "*POP3 DEBUG*") - (goto-char (point-max)) - (if elmo-pop3-debug-inhibit-logging - (insert "NO LOGGING\n") + (let ((biff (string-match "BIFF-" (buffer-name))) + pos) + (with-current-buffer (get-buffer-create (concat "*POP3 DEBUG*" + (if biff "BIFF"))) + (goto-char (point-max)) + (setq pos (point)) (insert (apply 'format message args) "\n"))))) -(luna-define-class elmo-pop3-session (elmo-network-session)) +;;; ELMO POP3 folder +(eval-and-compile + (luna-define-class elmo-pop3-folder (elmo-net-folder) + (use-uidl location-alist)) + (luna-define-internal-accessors 'elmo-pop3-folder)) + +(luna-define-method elmo-folder-initialize :around ((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)) + ;; 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))) + ;; auth + (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) ":")) + (elmo-net-folder-set-auth-internal folder + (if (eq (length (car parse)) 0) + elmo-pop3-default-authenticate-type + (intern (downcase (car parse))))) + ;; uidl + (setq parse (elmo-parse-prefixed-element ?: (cdr parse))) + (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))) + folder)) + +;;; POP3 session +(luna-define-class elmo-pop3-session (elmo-network-session) ()) ;; buffer-local (defvar elmo-pop3-read-point nil) @@ -87,36 +155,53 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") '(open run)) (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) + (elmo-network-session-process-internal session) + t) (error "POP error: QUIT failed"))) (kill-buffer (process-buffer (elmo-network-session-process-internal session))) (delete-process (elmo-network-session-process-internal session)))) -(defun elmo-pop3-get-session (spec &optional if-exists) - (elmo-network-get-session - 'elmo-pop3-session - "POP3" - (elmo-pop3-spec-hostname spec) - (elmo-pop3-spec-port spec) - (elmo-pop3-spec-username spec) - (elmo-pop3-spec-auth spec) - (elmo-pop3-spec-stream-type spec) - if-exists)) - -(defun elmo-pop3-send-command (process command &optional no-erase) +(defun elmo-pop3-get-session (folder &optional if-exists) + "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)))) + (prog1 + (if (eq if-exists 'any-exists) + (or (elmo-network-get-session 'elmo-pop3-session + "POP3" + folder if-exists) + (elmo-network-get-session 'elmo-pop3-session + "BIFF-POP3" + folder if-exists)) + (elmo-network-get-session 'elmo-pop3-session + (concat + (if (elmo-folder-biff-internal folder) + "BIFF-") + "POP3") + folder if-exists)) + ;; For saving existency. + (unless (file-exists-p (elmo-folder-msgdb-path folder)) + (elmo-make-directory (elmo-folder-msgdb-path folder)))))) + +(defun elmo-pop3-send-command (process command &optional no-erase no-log) (with-current-buffer (process-buffer process) (unless no-erase (erase-buffer)) (goto-char (point-min)) (setq elmo-pop3-read-point (point)) - (elmo-pop3-lock) - (elmo-pop3-debug "SEND: %s\n" command) + (elmo-pop3-debug "SEND: %s\n" (if no-log "" command)) (process-send-string process command) (process-send-string process "\r\n"))) -(defun elmo-pop3-read-response (process &optional not-command keep-lock) +(defun elmo-pop3-read-response (process &optional not-command) + ;; buffer is in case for process is dead. (with-current-buffer (process-buffer process) (let ((case-fold-search nil) (response-string nil) @@ -126,7 +211,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (while response-continue (goto-char elmo-pop3-read-point) (while (not (re-search-forward "\r?\n" nil t)) - (accept-process-output process) + (accept-process-output process 1) (goto-char elmo-pop3-read-point)) (setq match-end (point)) (setq response-string @@ -147,43 +232,53 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq return-value nil)) (setq elmo-pop3-read-point match-end) (if not-command - (setq response-continue nil)) + (setq response-continue nil)) (setq return-value (if return-value (concat return-value "\n" response-string) response-string))) (setq elmo-pop3-read-point match-end))) - (unless keep-lock - (elmo-pop3-unlock)) return-value))) (defun elmo-pop3-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output) - (elmo-pop3-debug "RECEIVED: %s\n" output) - (if elmo-pop3-total-size - (message "Retrieving...(%d/%d bytes)." - (buffer-size) elmo-pop3-total-size)))) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (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))))))) (defun elmo-pop3-auth-user (session) (let ((process (elmo-network-session-process-internal session))) ;; try USER/PASS (elmo-pop3-send-command process - (format "user %s" (elmo-network-session-user-internal session))) + (format "user %s" (elmo-network-session-user-internal session)) + nil 'no-log) (or (elmo-pop3-read-response process t) - (signal 'elmo-authenticate-error - '(elmo-pop-auth-user))) + (progn + (delete-process process) + (signal 'elmo-authenticate-error + '(elmo-pop-auth-user)))) (elmo-pop3-send-command process (format "pass %s" (elmo-get-passwd - (elmo-network-session-password-key session)))) + (elmo-network-session-password-key session))) + nil 'no-log) (or (elmo-pop3-read-response process t) - (signal 'elmo-authenticate-error - '(elmo-pop-auth-user))))) + (progn + (delete-process process) + (signal 'elmo-authenticate-error + '(elmo-pop-auth-user)))))) (defun elmo-pop3-auth-apop (session) (if (string-match "^\+OK .*\\(<[^\>]+>\\)" @@ -199,14 +294,17 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") 1 (elmo-network-session-greeting-internal session)) (elmo-get-passwd - (elmo-network-session-password-key session)))))) + (elmo-network-session-password-key session))))) + nil 'no-log) (or (elmo-pop3-read-response (elmo-network-session-process-internal session) t) - (signal 'elmo-authenticate-error - '(elmo-pop3-auth-apop)))) + (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)))) - + (luna-define-method elmo-network-initialize-session-buffer :after ((session elmo-pop3-session) buffer) (with-current-buffer buffer @@ -217,7 +315,6 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (let ((process (elmo-network-session-process-internal session)) response mechanism) (with-current-buffer (process-buffer process) - (elmo-pop3-lock) (set-process-filter process 'elmo-pop3-process-filter) (setq elmo-pop3-read-point (point-min)) ;; Skip garbage output from process before greeting. @@ -244,10 +341,9 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (luna-define-method elmo-network-authenticate-session ((session elmo-pop3-session)) - (with-current-buffer (process-buffer + (with-current-buffer (process-buffer (elmo-network-session-process-internal session)) (let* ((process (elmo-network-session-process-internal session)) - (elmo-pop3-debug-inhibit-logging t) (auth (elmo-network-session-auth-internal session)) (auth (mapcar '(lambda (mechanism) (upcase (symbol-name mechanism))) (if (listp auth) auth (list auth)))) @@ -269,7 +365,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") mechanism (elmo-network-session-user-internal session) "pop" - (elmo-network-session-host-internal session))) + (elmo-network-session-server-internal session))) ;;; (if elmo-pop3-auth-user-realm ;;; (sasl-client-set-property client 'realm elmo-pop3-auth-user-realm)) (setq name (sasl-mechanism-name mechanism)) @@ -288,7 +384,8 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (concat " " (elmo-base64-encode-string - (sasl-step-data step) 'no-line-break))))) ;) + (sasl-step-data step) 'no-line-break)))) + nil 'no-log) (catch 'done (while t (unless (setq response (elmo-pop3-read-response process t)) @@ -308,7 +405,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (throw 'done nil))) (sasl-step-set-data step - (elmo-base64-decode-string + (elmo-base64-decode-string (cadr (split-string response " ")))) (setq step (sasl-next-step client step)) (elmo-pop3-send-command @@ -316,7 +413,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (if (sasl-step-data step) (elmo-base64-encode-string (sasl-step-data step) 'no-line-break) - ""))))))))) + "") nil 'no-log)))))))) (luna-define-method elmo-network-setup-session ((session elmo-pop3-session)) @@ -326,7 +423,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (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 nil 'keep-lock)) + (if (null (elmo-pop3-read-response process)) (error "POP LIST command failed")) (if (null (setq response (elmo-pop3-read-contents @@ -335,12 +432,12 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") ;; POP server always returns a sequence of serial numbers. (setq count (elmo-pop3-parse-list-response response)) ;; UIDL - (when elmo-pop3-use-uidl + (when elmo-pop3-use-uidl-internal (setq elmo-pop3-uidl-number-hash (elmo-make-hash (* count 2))) (setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2))) ;; UIDL (elmo-pop3-send-command process "uidl") - (unless (elmo-pop3-read-response process nil 'keep-lock) + (unless (elmo-pop3-read-response process) (error "POP UIDL failed")) (unless (setq response (elmo-pop3-read-contents (current-buffer) process)) @@ -353,32 +450,38 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") match-end) (goto-char elmo-pop3-read-point) (while (not (re-search-forward "^\\.\r\n" nil t)) - (accept-process-output process) + (accept-process-output process 1) (goto-char elmo-pop3-read-point)) (setq match-end (point)) - (elmo-pop3-unlock) (elmo-delete-cr (buffer-substring elmo-pop3-read-point (- match-end 3)))))) -;; dummy functions -(defun elmo-pop3-list-folders (spec &optional hierarchy) nil) -(defun elmo-pop3-append-msg (spec string) nil nil) -(defun elmo-pop3-folder-creatable-p (spec) nil) -(defun elmo-pop3-create-folder (spec) nil) +(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-pop3-folder)) + (convert-standard-filename + (expand-file-name + (elmo-safe-filename (elmo-net-folder-user-internal folder)) + (expand-file-name (elmo-net-folder-server-internal folder) + (expand-file-name + "pop" + elmo-msgdb-directory))))) -(defun elmo-pop3-folder-exists-p (spec) +(luna-define-method elmo-folder-exists-p ((folder elmo-pop3-folder)) (if (and elmo-pop3-exists-exactly - (elmo-pop3-plugged-p spec)) + (elmo-folder-plugged-p folder)) (save-excursion - (let (elmo-auto-change-plugged ; don't change plug status. - elmo-pop3-use-uidl ; No need to use uidl. + (let (elmo-auto-change-plugged ; don't change plug status. + (elmo-inhibit-number-mapping t) ; No need to use uidl. session) (prog1 - (setq session (elmo-pop3-get-session spec)) + (setq session (elmo-pop3-get-session folder)) (if session (elmo-network-close-session session))))) - t)) + (or (file-directory-p (elmo-folder-msgdb-path folder)) + ;; First time. + (when (elmo-folder-plugged-p folder) + (let ((elmo-pop3-exists-exactly t)) + (elmo-folder-exists-p folder)))))) (defun elmo-pop3-parse-uidl-response (string) (let ((buffer (current-buffer)) @@ -387,7 +490,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (let (number uid list) (insert string) (goto-char (point-min)) - (while (re-search-forward "^\\([0-9]+\\)[\t ]\\([^ \n]+\\)$" nil t) + (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([^ \n]+\\)$" nil t) (setq number (elmo-match-buffer 1)) (setq uid (elmo-match-buffer 2)) (with-current-buffer buffer @@ -405,7 +508,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (with-temp-buffer (insert string) (goto-char (point-min)) - (while (re-search-forward "^\\([0-9]+\\)[\t ]\\([0-9]+\\)$" nil t) + (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([0-9]+\\)$" nil t) (setq alist (cons (cons (elmo-match-buffer 1) @@ -422,32 +525,63 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq elmo-pop3-list-done t)) count))) -(defun elmo-pop3-list-location (spec) +(defun elmo-pop3-list-location (folder) (with-current-buffer (process-buffer (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) - (let (list) + (elmo-pop3-get-session folder))) + (let (locations) (if elmo-pop3-uidl-done (progn (mapatoms (lambda (atom) - (setq list (cons (symbol-name atom) list))) + (setq locations (cons (symbol-name atom) locations))) elmo-pop3-uidl-number-hash) - (nreverse list)) + (sort locations + (lambda (loc1 loc2) + (< (elmo-pop3-uidl-to-number loc1) + (elmo-pop3-uidl-to-number loc2))))) (error "POP3: Error in UIDL"))))) -(defun elmo-pop3-list-by-uidl-subr (spec &optional nonsort) - (let ((flist (elmo-list-folder-by-location - spec - (elmo-pop3-list-location spec)))) +(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))) + +(defun elmo-pop3-list-by-uidl-subr (folder &optional nonsort) + (let ((flist (elmo-pop3-list-folder-by-location + folder + (elmo-pop3-list-location folder)))) (if nonsort (cons (elmo-max-of-list flist) (length flist)) (sort flist '<)))) -(defun elmo-pop3-list-by-list (spec) +(defun elmo-pop3-list-by-list (folder) (with-current-buffer (process-buffer (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) + (elmo-pop3-get-session folder))) (let (list) (if elmo-pop3-list-done (progn @@ -459,25 +593,26 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (sort list '<)) (error "POP3: Error in list"))))) -(defun elmo-pop3-list-folder (spec &optional nohide) - (let ((killed (and elmo-use-killed-list - (elmo-msgdb-killed-list-load - (elmo-msgdb-expand-path spec)))) - numbers) - (elmo-pop3-commit spec) - (setq numbers (if elmo-pop3-use-uidl - (progn - (elmo-pop3-list-by-uidl-subr spec)) - (elmo-pop3-list-by-list spec))) - (elmo-living-messages numbers killed))) - -(defun elmo-pop3-max-of-folder (spec) - (elmo-pop3-commit spec) - (if elmo-pop3-use-uidl - (elmo-pop3-list-by-uidl-subr spec 'nonsort) +(defsubst elmo-pop3-folder-list-messages (folder) + (if (and (not elmo-inhibit-number-mapping) + (elmo-pop3-folder-use-uidl-internal folder)) + (elmo-pop3-list-by-uidl-subr folder) + (elmo-pop3-list-by-list folder))) + +(luna-define-method elmo-folder-list-messages-plugged + ((folder elmo-pop3-folder) &optional nohide) + (elmo-pop3-folder-list-messages folder)) + +(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) + (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 spec))) + (elmo-pop3-get-session folder))) (total 0) response) (with-current-buffer (process-buffer process) @@ -489,6 +624,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq total (string-to-int (substring response (match-beginning 1)(match-end 1 )))) + (elmo-folder-close-internal folder) (cons total total)))))) (defvar elmo-pop3-header-fetch-chop-length 200) @@ -497,32 +633,15 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (cond ((eq (following-char) ?+) (if (re-search-forward "\n\\.\r?\n" nil t) - t + t nil)) ((looking-at "-") (if (search-forward "\n" nil t) - t + t nil)) (t nil))) -(defun elmo-pop3-lock () - "Lock pop3 process." - (setq elmo-pop3-lock t)) - -(defun elmo-pop3-unlock () - "Unlock pop3 process." - (setq elmo-pop3-lock nil)) - -(defun elmo-pop3-locked-p (process) - "Return t if pop3 PROCESS is locked." - (with-current-buffer (process-buffer process) - (if elmo-pop3-lock - (progn - (elmo-pop3-debug "POP3 is LOCKED!") - t) - nil))) - (defun elmo-pop3-retrieve-headers (buffer tobuffer process articles) (save-excursion (set-buffer buffer) @@ -569,47 +688,35 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (replace-match "\n")) (copy-to-buffer tobuffer (point-min) (point-max))))) -(defalias 'elmo-pop3-msgdb-create 'elmo-pop3-msgdb-create-as-numlist) - -(defun elmo-pop3-sort-overview-by-original-number (overview loc-alist) - (if loc-alist - (sort overview - (lambda (ent1 ent2) - (< (elmo-pop3-uidl-to-number - (cdr (assq (elmo-msgdb-overview-entity-get-number ent1) - loc-alist))) - (elmo-pop3-uidl-to-number - (cdr (assq (elmo-msgdb-overview-entity-get-number ent2) - loc-alist)))))) - overview)) - -(defun elmo-pop3-sort-msgdb-by-original-number (msgdb) - (message "Sorting...") - (let ((overview (elmo-msgdb-get-overview msgdb))) - (setq overview (elmo-pop3-sort-overview-by-original-number - overview - (elmo-msgdb-get-location msgdb))) - (message "Sorting...done") - (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb)))) - -(defun elmo-pop3-msgdb-create-as-numlist (spec numlist new-mark - already-mark seen-mark - important-mark seen-list - &optional msgdb) - (when numlist - (let ((process (elmo-network-session-process-internal - (elmo-pop3-get-session spec))) - loc-alist) - (if elmo-pop3-use-uidl - (setq loc-alist (if msgdb (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load - (elmo-msgdb-expand-path spec))))) - (with-current-buffer (process-buffer process) - (elmo-pop3-sort-msgdb-by-original-number - (elmo-pop3-msgdb-create-by-header process numlist - new-mark already-mark - seen-mark seen-list - loc-alist)))))) +(luna-define-method elmo-folder-msgdb-create ((folder elmo-pop3-folder) + numlist flag-table) + (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 + 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)) (defun elmo-pop3-uidl-to-number (uidl) (string-to-number (elmo-get-hash-val uidl @@ -623,11 +730,9 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-get-hash-val (format "#%d" number) elmo-pop3-size-hash)) -(defun elmo-pop3-msgdb-create-by-header (process numlist - new-mark already-mark - seen-mark - seen-list - loc-alist) +(defun elmo-pop3-msgdb-create-by-header (folder process numlist + flag-table + loc-alist) (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))) (with-current-buffer (process-buffer process) (if loc-alist ; use uidl. @@ -642,23 +747,24 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") tmp-buffer process numlist) (prog1 (elmo-pop3-msgdb-create-message + folder tmp-buffer process (length numlist) numlist - new-mark already-mark seen-mark seen-list loc-alist) + flag-table loc-alist) (kill-buffer tmp-buffer))))) -(defun elmo-pop3-msgdb-create-message (buffer +(defun elmo-pop3-msgdb-create-message (folder + buffer process num - numlist new-mark already-mark - seen-mark - seen-list + numlist + flag-table loc-alist) (save-excursion - (let (beg overview number-alist mark-alist - entity i number message-id gmark seen size) + (let ((new-msgdb (elmo-make-msgdb)) + beg entity i number message-id flags) (set-buffer buffer) (elmo-set-buffer-multibyte default-enable-multibyte-characters) (goto-char (point-min)) @@ -672,55 +778,35 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (save-restriction (narrow-to-region beg (point)) (setq entity - (elmo-msgdb-create-overview-from-buffer - (car numlist))) + (elmo-msgdb-create-message-entity-from-buffer + new-msgdb (car numlist))) (setq numlist (cdr numlist)) (when entity - (setq overview - (elmo-msgdb-append-element - overview entity)) (with-current-buffer (process-buffer process) - (elmo-msgdb-overview-entity-set-size + (elmo-message-entity-set-field entity + 'size (string-to-number (elmo-pop3-number-to-size - (elmo-msgdb-overview-entity-get-number entity)))) + (elmo-message-entity-number entity)))) (if (setq number (car (rassoc (elmo-pop3-number-to-uidl - (elmo-msgdb-overview-entity-get-number entity)) + (elmo-message-entity-number entity)) loc-alist))) - (elmo-msgdb-overview-entity-set-number entity number))) - (setq number-alist - (elmo-msgdb-number-add - number-alist - (elmo-msgdb-overview-entity-get-number entity) - (car entity))) - (setq message-id (car entity)) - (setq seen (member message-id seen-list)) - (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-cache-exists-p - message-id) ; XXX - (if seen - nil - already-mark) - (if seen - (if elmo-pop3-use-cache - seen-mark) - new-mark)))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - (elmo-msgdb-overview-entity-get-number entity) - gmark)))))) + (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))))) - (list overview number-alist mark-alist loc-alist)))) + new-msgdb))) (defun elmo-pop3-read-body (process outbuf) (with-current-buffer (process-buffer process) @@ -728,24 +814,39 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") end) (goto-char start) (while (not (re-search-forward "^\\.\r?\n" nil t)) - (accept-process-output process) + (accept-process-output process 1) (goto-char start)) (setq end (point)) - (elmo-pop3-unlock) (with-current-buffer outbuf (erase-buffer) - (insert-buffer-substring (process-buffer process) start (- end 3)) - (elmo-delete-cr-get-content-type))))) - -(defun elmo-pop3-read-msg (spec number outbuf &optional msgdb unread) - (let* ((loc-alist (if elmo-pop3-use-uidl - (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load - (elmo-msgdb-expand-path spec))))) + (insert-buffer-substring (process-buffer process) start (- end 3))) + 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))))) + +(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)))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-pop3-folder)) + (elmo-pop3-folder-set-location-alist-internal folder nil) + ;; Just close connection + (elmo-folder-check folder)) + +(luna-define-method elmo-message-fetch-plugged ((folder elmo-pop3-folder) + 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 spec))) - size response errmsg msg) + (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 @@ -755,24 +856,24 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (when number (elmo-pop3-send-command process (format "retr %s" number)) - (setq elmo-pop3-total-size size) (unless elmo-inhibit-display-retrieval-progress (setq elmo-pop3-total-size size) (elmo-display-progress - 'elmo-pop3-display-retrieval-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 'keep-lock))) + process t))) (error "Fetching message failed")) - (setq response (elmo-pop3-read-body process outbuf))) + (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 "" 100) ; remove progress bar. - (message "Retrieving...done.")) + 'elmo-display-retrieval-progress + "Retrieving..." 100) ; remove progress bar. + (message "Retrieving...done")) (set-buffer outbuf) (goto-char (point-min)) (while (re-search-forward "^\\." nil t) @@ -795,64 +896,33 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (error "Deleting message failed"))) (error "Deleting message failed"))))) -(defun elmo-pop3-delete-msgs (spec msgs &optional msgdb) - (let ((loc-alist (if elmo-pop3-use-uidl - (if msgdb - (elmo-msgdb-get-location msgdb) - (elmo-msgdb-location-load - (elmo-msgdb-expand-path spec))))) +(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 - (elmo-pop3-get-session spec)))) - (mapcar '(lambda (msg) (elmo-pop3-delete-msg - process msg loc-alist)) + (elmo-pop3-get-session folder)))) + (mapcar '(lambda (msg) (elmo-pop3-delete-msg process msg loc-alist)) msgs))) -(defun elmo-pop3-search (spec condition &optional numlist) - (error "Searching in pop3 folder is not implemented yet")) - -(defun elmo-pop3-use-cache-p (spec number) +(luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number) elmo-pop3-use-cache) -(defun elmo-pop3-local-file-p (spec number) - nil) - -(defun elmo-pop3-port-label (spec) - (concat "pop3" - (if (elmo-pop3-spec-stream-type spec) - (concat "!" (symbol-name - (elmo-network-stream-type-symbol - (elmo-pop3-spec-stream-type spec))))))) - -(defsubst elmo-pop3-portinfo (spec) - (list (elmo-pop3-spec-hostname spec) - (elmo-pop3-spec-port spec))) - -(defun elmo-pop3-plugged-p (spec) - (apply 'elmo-plugged-p - (append (elmo-pop3-portinfo spec) - (list nil (quote (elmo-pop3-port-label spec)))))) - -(defun elmo-pop3-set-plugged (spec plugged add) - (apply 'elmo-set-plugged plugged - (append (elmo-pop3-portinfo spec) - (list nil nil (quote (elmo-pop3-port-label spec)) add)))) - -(defalias 'elmo-pop3-sync-number-alist - 'elmo-generic-sync-number-alist) -(defalias 'elmo-pop3-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-pop3-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-pop3-folder-diff 'elmo-generic-folder-diff) - -(defun elmo-pop3-commit (spec) - (if (elmo-pop3-plugged-p spec) - (let ((session (elmo-pop3-get-session spec 'if-exists))) - (when (and session - (not (elmo-pop3-locked-p - (elmo-network-session-process-internal session)))) +(luna-define-method elmo-folder-persistent-p ((folder elmo-pop3-folder)) + (and (elmo-folder-persistent-internal folder) + (elmo-pop3-folder-use-uidl-internal folder))) + +(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)) + (luna-call-next-method)) + +(luna-define-method elmo-folder-check ((folder elmo-pop3-folder)) + (if (elmo-folder-plugged-p folder) + (let ((session (elmo-pop3-get-session folder 'if-exists))) + (when session (elmo-network-close-session session))))) - (require 'product) (product-provide (provide 'elmo-pop3) (require 'elmo-version))