X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-nntp.el;h=728adb86274c4fcd73391fa8b73254e3a6959d70;hb=4dee2f09b7c63b19e24942f13b2917addb2a6501;hp=11f2411de00204fea998f5de456c9a1f91e86b86;hpb=29fbdfaa0a89009f70f841a16a86f6faa1a2df4a;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 11f2411..728adb8 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -32,6 +32,7 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) (require 'elmo-vars) (require 'elmo-util) @@ -417,7 +418,8 @@ Don't cache if nil.") (with-current-buffer outbuf (erase-buffer) (insert-buffer-substring (elmo-network-session-buffer session) - start (- end 3)))) + start (- end 3)) + (elmo-delete-cr-buffer))) t)) (defun elmo-nntp-select-group (session group &optional force) @@ -463,16 +465,18 @@ Don't cache if nil.") ))))) (defsubst elmo-nntp-catchup-msgdb (msgdb max-number) - (let (msgdb-max number-alist) - (setq number-alist (elmo-msgdb-get-number-alist msgdb)) - (setq msgdb-max (car (nth (max (- (length number-alist) 1) 0) - number-alist))) - (if (or (not msgdb-max) - (and msgdb-max max-number - (< msgdb-max max-number))) - (elmo-msgdb-set-number-alist - msgdb - (nconc number-alist (list (cons max-number nil))))))) + (let ((numbers (elmo-msgdb-list-messages msgdb)) + msgdb-max) + (setq msgdb-max (if numbers (apply #'max numbers) 0)) + (when (and msgdb-max + max-number + (< msgdb-max max-number)) + (let ((i (1+ msgdb-max)) + killed) + (while (<= i max-number) + (setq killed (cons i killed)) + (incf i)) + (nreverse killed))))) (luna-define-method elmo-folder-list-subfolders ((folder elmo-nntp-folder) &optional one-level) @@ -502,9 +506,9 @@ Don't cache if nil.") (not (string= (elmo-nntp-folder-group-internal folder) ""))) (concat " active" - (format " %s.*" - (elmo-nntp-folder-group-internal folder) - ""))))) + (format + " %s.*" + (elmo-nntp-folder-group-internal folder)))))) (if (elmo-nntp-read-response session t) (if (null (setq response (elmo-nntp-read-contents session))) (error "NNTP List folders failed") @@ -544,14 +548,14 @@ Don't cache if nil.") (progn (setq regexp (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n" - (if (and - (elmo-nntp-folder-group-internal folder) - (null (string= - (elmo-nntp-folder-group-internal - folder) ""))) + (if (and (elmo-nntp-folder-group-internal folder) + (null (string= + (elmo-nntp-folder-group-internal + folder) ""))) (concat (elmo-nntp-folder-group-internal folder) - "\\.") ""))) + "\\.") + ""))) (while (looking-at regexp) (setq top-ng (elmo-match-buffer 1)) (if (string= (elmo-match-buffer 2) " ") @@ -621,18 +625,7 @@ Don't cache if nil.") ret-val))) (defun elmo-nntp-make-msglist (beg-str end-str) - (elmo-set-work-buf - (let ((beg-num (string-to-int beg-str)) - (end-num (string-to-int end-str)) - i) - (setq i beg-num) - (insert "(") - (while (<= i end-num) - (insert (format "%s " i)) - (setq i (1+ i))) - (insert ")") - (goto-char (point-min)) - (read (current-buffer))))) + (elmo-make-number-list (string-to-int beg-str) (string-to-int end-str))) (luna-define-method elmo-folder-list-messages-plugged ((folder elmo-nntp-folder) @@ -733,13 +726,14 @@ Don't cache if nil.") ("lines" . 7) ("xref" . 8))) -(defun elmo-nntp-create-msgdb-from-overview-string (str +(defun elmo-nntp-create-msgdb-from-overview-string (folder + str flag-table &optional numlist) (let ((new-msgdb (elmo-make-msgdb)) - ov-list gmark message-id entity + ov-list message-id entity ov-entity num - extras extra ext field field-index) + extras extra ext field field-index flags) (setq ov-list (elmo-nntp-parse-overview-string str)) (while ov-list (setq ov-entity (car ov-list)) @@ -757,13 +751,14 @@ Don't cache if nil.") (while extras (setq ext (downcase (car extras))) (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index))) - (when (> (length ov-entity) field-index) + (when (> (length ov-entity) field-index) (setq field (aref ov-entity field-index)) (when (eq field-index 8) ;; xref (setq field (elmo-msgdb-remove-field-string field))) - (setq extra (cons (cons ext field) extra)))) + (setq extra (cons (cons ext field) extra)))) (setq extras (cdr extras))) (setq entity (elmo-msgdb-make-message-entity + (elmo-msgdb-message-entity-handler new-msgdb) :message-id (aref ov-entity 4) :number num :references (elmo-msgdb-get-last-message-id @@ -778,14 +773,10 @@ Don't cache if nil.") :date (aref ov-entity 3) :size (string-to-int (aref ov-entity 6)) :extra extra)) - (setq message-id (elmo-message-entity-field entity 'message-id)) - (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (elmo-msgdb-mark - (elmo-flag-table-get flag-table message-id) - (elmo-file-cache-status - (elmo-file-cache-get message-id)) - 'new))) - (elmo-msgdb-append-entity new-msgdb entity gmark)) + (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 num message-id) + (elmo-msgdb-append-entity new-msgdb entity flags)) (setq ov-list (cdr ov-list))) new-msgdb)) @@ -821,6 +812,7 @@ Don't cache if nil.") (elmo-msgdb-append new-msgdb (elmo-nntp-create-msgdb-from-overview-string + folder ov-str flag-table filter)))) @@ -848,6 +840,7 @@ Don't cache if nil.") (elmo-msgdb-append new-msgdb (elmo-nntp-create-msgdb-from-overview-string + folder ov-str flag-table filter))))) @@ -870,42 +863,43 @@ Don't cache if nil.") (progn (elmo-nntp-set-list-active session nil) (error "NNTP list command failed"))) - (elmo-nntp-catchup-msgdb - new-msgdb - (nth 1 (read (concat "(" (elmo-nntp-read-contents - session) ")"))))) + (let ((killed (elmo-nntp-catchup-msgdb + new-msgdb + (nth 1 (read (concat "(" (elmo-nntp-read-contents + session) ")")))))) + (when killed + (elmo-folder-kill-messages folder killed)))) new-msgdb)) (luna-define-method elmo-folder-update-number ((folder elmo-nntp-folder)) - (if (elmo-nntp-max-number-precedes-list-active-p) - (let ((session (elmo-nntp-get-session folder)) - (number-alist (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder)))) - (if (elmo-nntp-list-active-p session) - (let (msgdb-max max-number) - ;; If there are canceled messages, overviews are not obtained - ;; to max-number(inn 2.3?). - (elmo-nntp-select-group session - (elmo-nntp-folder-group-internal folder)) - (elmo-nntp-send-command session - (format "list active %s" - (elmo-nntp-folder-group-internal - folder))) - (if (null (elmo-nntp-read-response session)) - (error "NNTP list command failed")) - (setq max-number - (nth 1 (read (concat "(" (elmo-nntp-read-contents - session) ")")))) - (setq msgdb-max - (car (nth (max (- (length number-alist) 1) 0) - number-alist))) - (if (or (and number-alist (not msgdb-max)) - (and msgdb-max max-number - (< msgdb-max max-number))) - (elmo-msgdb-set-number-alist - (elmo-folder-msgdb folder) - (nconc number-alist - (list (cons max-number nil)))))))))) + (when (elmo-nntp-max-number-precedes-list-active-p) + (let ((session (elmo-nntp-get-session folder))) + (when (elmo-nntp-list-active-p session) + (let ((numbers (elmo-folder-list-messages folder nil 'in-msgdb)) + msgdb-max max-number) + ;; If there are canceled messages, overviews are not obtained + ;; to max-number(inn 2.3?). + (elmo-nntp-select-group session + (elmo-nntp-folder-group-internal folder)) + (elmo-nntp-send-command session + (format "list active %s" + (elmo-nntp-folder-group-internal + folder))) + (if (null (elmo-nntp-read-response session)) + (error "NNTP list command failed")) + (setq max-number + (nth 1 (read (concat "(" (elmo-nntp-read-contents + session) ")")))) + (setq msgdb-max (if numbers (apply #'max numbers) 0)) + (when (and msgdb-max + max-number + (< msgdb-max max-number)) + (let ((i (1+ msgdb-max)) + killed) + (while (<= i max-number) + (setq killed (cons i killed)) + (incf i)) + (elmo-folder-kill-messages folder (nreverse killed))))))))) (defun elmo-nntp-msgdb-create-by-header (session numbers flag-table) (with-temp-buffer @@ -932,7 +926,7 @@ Don't cache if nil.") ret-list ret-val beg) (set-buffer tmp-buffer) (erase-buffer) - (elmo-set-buffer-multibyte nil) + (set-buffer-multibyte nil) (insert string) (goto-char (point-min)) (setq beg (point)) @@ -966,8 +960,8 @@ Don't cache if nil.") (with-current-buffer (elmo-network-session-buffer session) (std11-field-body "Newsgroups"))))) -(luna-define-method elmo-message-fetch-with-cache-process :around - ((folder elmo-nntp-folder) number strategy &optional section unread) +(luna-define-method elmo-message-fetch :around + ((folder elmo-nntp-folder) number strategy &optional unread section) (when (luna-call-next-method) (elmo-nntp-setup-crosspost-buffer folder number) (unless unread @@ -1066,22 +1060,15 @@ Don't cache if nil.") (luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder) numbers) - (elmo-nntp-folder-delete-messages folder numbers)) - -(defun elmo-nntp-folder-delete-messages (folder numbers) - (let ((killed-list (elmo-folder-killed-list-internal folder))) - (dolist (number numbers) - (setq killed-list - (elmo-msgdb-set-as-killed killed-list number))) - (elmo-folder-set-killed-list-internal folder killed-list)) + (elmo-folder-kill-messages folder numbers) t) (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-nntp-folder)) (let ((session (elmo-nntp-get-session folder))) - (elmo-nntp-send-command - session - (format "group %s" - (elmo-nntp-folder-group-internal folder))) + (elmo-nntp-send-command + session + (format "group %s" + (elmo-nntp-folder-group-internal folder))) (elmo-nntp-read-response session))) (defun elmo-nntp-retrieve-field (spec field from-msgs) @@ -1382,10 +1369,8 @@ Returns a list of cons cells like (NUMBER . VALUE)" (elmo-display-progress 'elmo-nntp-retrieve-headers "Getting headers..." 100)) (message "Getting headers...done") - ;; Remove all "\r"'s. - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) + ;; Replace all CRLF with LF. + (elmo-delete-cr-buffer) (copy-to-buffer outbuf (point-min) (point-max))))) ;; end of from Gnus @@ -1393,8 +1378,8 @@ Returns a list of cons cells like (NUMBER . VALUE)" (defun elmo-nntp-msgdb-create-message (len flag-table) (save-excursion (let ((new-msgdb (elmo-make-msgdb)) - beg entity i num gmark message-id) - (elmo-set-buffer-multibyte nil) + beg entity i num message-id) + (set-buffer-multibyte nil) (goto-char (point-min)) (setq i 0) (message "Creating msgdb...") @@ -1411,18 +1396,15 @@ Returns a list of cons cells like (NUMBER . VALUE)" (save-restriction (narrow-to-region beg (point)) (setq entity - (elmo-msgdb-create-overview-from-buffer num)) + (elmo-msgdb-create-message-entity-from-buffer + (elmo-msgdb-message-entity-handler new-msgdb) num)) (when entity (setq message-id - (elmo-message-entity-field entity 'message-id) - gmark - (or (elmo-msgdb-global-mark-get message-id) - (elmo-msgdb-mark - (elmo-flag-table-get flag-table message-id) - (elmo-file-cache-status - (elmo-file-cache-get message-id)) - 'new))) - (elmo-msgdb-append-entity new-msgdb entity gmark))))) + (elmo-message-entity-field entity 'message-id)) + (elmo-msgdb-append-entity + new-msgdb + entity + (elmo-flag-table-get flag-table message-id)))))) (when (> len elmo-display-progress-threshold) (setq i (1+ i)) (if (or (zerop (% i 20)) (= i len)) @@ -1455,7 +1437,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" ;; temp-crosses slot is a list of cons cell: ;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng)) ;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared, -;; 1.3. In elmo-folder-mark-as-read, move crosspost entry +;; 1.3. In elmo-folder-flag-as-read, move crosspost entry ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'. ;; 2. process crosspost alist. @@ -1500,7 +1482,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" ) (defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers) -;; 1.3. In elmo-folder-mark-as-read, move crosspost entry +;; 1.3. In elmo-folder-flag-as-read, move crosspost entry ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'. (let (elem) (dolist (number numbers) @@ -1513,11 +1495,19 @@ Returns a list of cons cells like (NUMBER . VALUE)" folder (delq elem (elmo-nntp-folder-temp-crosses-internal folder))))))) -(luna-define-method elmo-folder-mark-as-read :before ((folder - elmo-nntp-folder) - numbers - &optional ignore-flags) - (elmo-nntp-folder-update-crosspost-message-alist folder numbers)) +(luna-define-method elmo-folder-set-flag :before ((folder elmo-nntp-folder) + numbers + flag + &optional is-local) + (when (eq flag 'read) + (elmo-nntp-folder-update-crosspost-message-alist folder numbers))) + +(luna-define-method elmo-folder-unset-flag :before ((folder elmo-nntp-folder) + numbers + flag + &optional is-local) + (when (eq flag 'unread) + (elmo-nntp-folder-update-crosspost-message-alist folder numbers))) (defsubst elmo-nntp-folder-process-crosspost (folder) ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from @@ -1543,12 +1533,19 @@ Returns a list of cons cells like (NUMBER . VALUE)" (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)) (elmo-nntp-folder-process-crosspost folder)) -(luna-define-method elmo-folder-list-unreads :around ((folder - elmo-nntp-folder)) +(luna-define-method elmo-folder-list-flagged :around ((folder elmo-nntp-folder) + flag &optional in-msgdb) ;; 2.3. elmo-folder-list-unreads return unread message list according to ;; `reads' slot. - (elmo-living-messages (luna-call-next-method) - (elmo-nntp-folder-reads-internal folder))) + (let ((msgs (luna-call-next-method))) + (if in-msgdb + msgs + (case flag + (unread + (elmo-living-messages msgs (elmo-nntp-folder-reads-internal folder))) + ;; Should consider read, digest and any flag? + (otherwise + msgs))))) (require 'product) (product-provide (provide 'elmo-nntp) (require 'elmo-version))