X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-nntp.el;h=810da853f9a186d06d11f2fea2d4cfce7ea58209;hb=a717271e46f76079d48f9f976807cfaeeb0a3f85;hp=151ec9439bb72f45987e6c5bf01ce309e2f9cb45;hpb=4284fb26bc3e57f224fbdb1f343f5db40d102b95;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 151ec94..810da85 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -49,7 +49,7 @@ (defvar elmo-nntp-max-number-precedes-list-active nil "Non-nil means max number of msgdb is set as the max number of `list active'. -(Needed for inn 2.3 or later?).") +\(Needed for inn 2.3 or later?\).") (defvar elmo-nntp-group-coding-system nil "A coding system for newsgroup string.") @@ -64,6 +64,22 @@ (decode-coding-string string elmo-nntp-group-coding-system) string)) +;; For debugging. +(defvar elmo-nntp-debug nil + "Non-nil forces NNTP folder as debug mode. +Debug information is inserted in the buffer \"*NNTP DEBUG*\"") + +;;; Debug +(defsubst elmo-nntp-debug (message &rest args) + (if elmo-nntp-debug + (let ((biff (string-match "BIFF-" (buffer-name))) + pos) + (with-current-buffer (get-buffer-create (concat "*NNTP DEBUG*" + (if biff "BIFF"))) + (goto-char (point-max)) + (setq pos (point)) + (insert (apply 'format message args) "\n"))))) + ;;; ELMO NNTP folder (eval-and-compile (luna-define-class elmo-nntp-folder (elmo-net-folder) @@ -79,16 +95,18 @@ (append elmo-nntp-stream-type-alist elmo-network-stream-type-alist)) elmo-network-stream-type-alist)) - parse) + explicit-user parse) (setq name (luna-call-next-method)) (setq parse (elmo-parse-token name ":")) (elmo-nntp-folder-set-group-internal folder (elmo-nntp-encode-group-string (car parse))) + (setq explicit-user (eq ?: (string-to-char (cdr parse)))) (setq parse (elmo-parse-prefixed-element ?: (cdr parse))) (elmo-net-folder-set-user-internal folder (if (eq (length (car parse)) 0) - elmo-nntp-default-user + (unless explicit-user + elmo-nntp-default-user) (car parse))) (unless (elmo-net-folder-server-internal folder) (elmo-net-folder-set-server-internal folder @@ -254,7 +272,8 @@ Don't cache if nil.") (luna-define-method elmo-network-initialize-session ((session elmo-nntp-session)) - (let ((process (elmo-network-session-process-internal session))) + (let ((process (elmo-network-session-process-internal session)) + response) (set-process-filter (elmo-network-session-process-internal session) 'elmo-nntp-process-filter) (with-current-buffer (elmo-network-session-buffer session) @@ -266,8 +285,9 @@ Don't cache if nil.") (not (looking-at "^[2-5][0-9][0-9]"))) (accept-process-output process 1)) (setq elmo-nntp-read-point (point)) - (or (elmo-nntp-read-response session t) - (error "Cannot open network")) + (setq response (elmo-nntp-read-response session t t)) + (unless (car response) + (signal 'elmo-open-error (list (cdr response)))) (if elmo-nntp-send-mode-reader (elmo-nntp-send-mode-reader session)) (when (eq (elmo-network-stream-type-symbol @@ -285,13 +305,17 @@ Don't cache if nil.") (elmo-nntp-send-command session (format "authinfo user %s" (elmo-network-session-user-internal - session))) + session)) + nil + 'no-log) (or (elmo-nntp-read-response session) (signal 'elmo-authenticate-error '(authinfo))) (elmo-nntp-send-command session (format "authinfo pass %s" - (elmo-get-passwd (elmo-network-session-password-key session)))) + (elmo-get-passwd (elmo-network-session-password-key session))) + nil + 'no-log) (or (elmo-nntp-read-response session) (signal 'elmo-authenticate-error '(authinfo)))))) @@ -300,28 +324,30 @@ Don't cache if nil.") (run-hooks 'elmo-nntp-opened-hook)) (defun elmo-nntp-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (goto-char (point-max)) + (insert output) + (elmo-nntp-debug "RECEIVED: %s\n" output)))) (defun elmo-nntp-send-mode-reader (session) (elmo-nntp-send-command session "mode reader") (if (null (elmo-nntp-read-response session t)) - (error "Mode reader failed"))) + (message "Mode reader failed"))) -(defun elmo-nntp-send-command (session command &optional noerase) +(defun elmo-nntp-send-command (session command &optional noerase no-log) (with-current-buffer (elmo-network-session-buffer session) (unless noerase (erase-buffer) (goto-char (point-min))) (setq elmo-nntp-read-point (point)) + (elmo-nntp-debug "SEND: %s\n" (if no-log "" command)) (process-send-string (elmo-network-session-process-internal session) command) (process-send-string (elmo-network-session-process-internal session) "\r\n"))) -(defun elmo-nntp-read-response (session &optional not-command) +(defun elmo-nntp-read-response (session &optional not-command error-msg) (with-current-buffer (elmo-network-session-buffer session) (let ((process (elmo-network-session-process-internal session)) (case-fold-search nil) @@ -337,14 +363,14 @@ Don't cache if nil.") (setq response-string (buffer-substring elmo-nntp-read-point (- match-end 2))) (goto-char elmo-nntp-read-point) - (if (looking-at "[234][0-9]+ .*$") + (if (looking-at "[23][0-9]+ .*$") (progn (setq response-continue nil) (setq elmo-nntp-read-point match-end) (setq response (if response (concat response "\n" response-string) response-string))) - (if (looking-at "[^234][0-9]+ .*$") + (if (looking-at "[^23][0-9]+ .*$") (progn (setq response-continue nil) (setq elmo-nntp-read-point match-end) (setq response nil)) @@ -356,7 +382,9 @@ Don't cache if nil.") (concat response "\n" response-string) response-string))) (setq elmo-nntp-read-point match-end))) - response))) + (if error-msg + (cons response response-string) + response)))) (defun elmo-nntp-read-raw-response (session) (with-current-buffer (elmo-network-session-buffer session) @@ -405,7 +433,7 @@ Don't cache if nil.") (and response group)) response)))) -(defun elmo-nntp-list-folders-get-cache (folder buf) +(defun elmo-nntp-list-folders-get-cache (group server buf) (when (and elmo-nntp-list-folders-use-cache elmo-nntp-list-folders-cache (string-match (concat "^" @@ -413,18 +441,24 @@ Don't cache if nil.") (or (nth 1 elmo-nntp-list-folders-cache) ""))) - (or folder ""))) + (or group "")) + (string-match (concat "^" + (regexp-quote + (or + (nth 2 elmo-nntp-list-folders-cache) + ""))) + (or server ""))) (let* ((cache-time (car elmo-nntp-list-folders-cache))) (unless (elmo-time-expire cache-time elmo-nntp-list-folders-use-cache) (save-excursion (set-buffer buf) (erase-buffer) - (insert (nth 2 elmo-nntp-list-folders-cache)) + (insert (nth 3 elmo-nntp-list-folders-cache)) (goto-char (point-min)) - (or (string= folder "") - (and folder - (keep-lines (concat "^" (regexp-quote folder) "\\.")))) + (or (string= group "") + (and group + (keep-lines (concat "^" (regexp-quote group) "\\.")))) t ))))) @@ -446,7 +480,8 @@ Don't cache if nil.") (defun elmo-nntp-folder-list-subfolders (folder one-level) (let ((session (elmo-nntp-get-session folder)) - response ret-val top-ng append-serv use-list-active start) + (case-fold-search nil) + response ret-val top-ng username append-serv use-list-active start) (with-temp-buffer (set-buffer-multibyte nil) (if (and (elmo-nntp-folder-group-internal folder) @@ -457,6 +492,7 @@ Don't cache if nil.") (setq ret-val (list (elmo-nntp-folder-group-internal folder)))) (unless (setq response (elmo-nntp-list-folders-get-cache (elmo-nntp-folder-group-internal folder) + (elmo-net-folder-server-internal folder) (current-buffer))) (when (setq use-list-active (elmo-nntp-list-active-p session)) (elmo-nntp-send-command @@ -476,6 +512,7 @@ Don't cache if nil.") (setq elmo-nntp-list-folders-cache (list (current-time) (elmo-nntp-folder-group-internal folder) + (elmo-net-folder-server-internal folder) response))) (erase-buffer) (insert response)) @@ -488,7 +525,7 @@ Don't cache if nil.") (error "NNTP List folders failed")) (when elmo-nntp-list-folders-use-cache (setq elmo-nntp-list-folders-cache - (list (current-time) nil response))) + (list (current-time) nil nil response))) (erase-buffer) (setq start nil) (while (string-match (concat "^" @@ -544,8 +581,16 @@ Don't cache if nil.") (when (> len elmo-display-progress-threshold) (elmo-display-progress 'elmo-nntp-list-folders "Parsing active..." 100)))) - (unless (string= (elmo-net-folder-server-internal folder) - elmo-nntp-default-server) + + (setq username (elmo-net-folder-user-internal folder)) + (when (and username + elmo-nntp-default-user + (string= username elmo-nntp-default-user)) + (setq username nil)) + + (when (or username ; XXX: ad-hoc fix against username includes "@" + (not (string= (elmo-net-folder-server-internal folder) + elmo-nntp-default-server))) (setq append-serv (concat "@" (elmo-net-folder-server-internal folder)))) (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port) @@ -562,16 +607,15 @@ Don't cache if nil.") (mapcar '(lambda (fld) (if (consp fld) (list (concat "-" (elmo-nntp-decode-group-string (car fld)) - (and (elmo-net-folder-user-internal folder) + (and username (concat ":" - (elmo-net-folder-user-internal folder))) + username)) (and append-serv (concat append-serv)))) (concat "-" (elmo-nntp-decode-group-string fld) - (and (elmo-net-folder-user-internal folder) - (concat ":" (elmo-net-folder-user-internal - folder))) + (and username + (concat ":" username)) (and append-serv (concat append-serv))))) ret-val))) @@ -590,9 +634,9 @@ Don't cache if nil.") (goto-char (point-min)) (read (current-buffer))))) -(luna-define-method elmo-folder-list-messages-internal ((folder - elmo-nntp-folder) - &optional nohide) +(luna-define-method elmo-folder-list-messages-plugged ((folder + elmo-nntp-folder) + &optional nohide) (let ((session (elmo-nntp-get-session folder)) (group (elmo-nntp-folder-group-internal folder)) response numbers use-listgroup) @@ -690,11 +734,7 @@ Don't cache if nil.") ("xref" . 8))) (defun elmo-nntp-create-msgdb-from-overview-string (str - new-mark - already-mark - seen-mark - important-mark - seen-list + flag-table &optional numlist) (let (ov-list gmark message-id seen ov-entity overview number-alist mark-alist num @@ -749,17 +789,12 @@ Don't cache if nil.") (elmo-msgdb-number-add number-alist num (aref ov-entity 4))) (setq message-id (aref ov-entity 4)) - (setq seen (member message-id seen-list)) (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-nntp-use-cache - seen-mark) - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist num gmark)))) @@ -767,16 +802,10 @@ Don't cache if nil.") (list overview number-alist mark-alist))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder) - numbers new-mark already-mark - seen-mark important-mark - seen-list) - (elmo-nntp-folder-msgdb-create folder numbers new-mark already-mark - seen-mark important-mark - seen-list)) - -(defun elmo-nntp-folder-msgdb-create (folder numbers new-mark already-mark - seen-mark important-mark - seen-list) + numbers flag-table) + (elmo-nntp-folder-msgdb-create folder numbers flag-table)) + +(defun elmo-nntp-folder-msgdb-create (folder numbers flag-table) (let ((filter numbers) (session (elmo-nntp-get-session folder)) beg-num end-num cur length @@ -805,11 +834,7 @@ Don't cache if nil.") ret-val (elmo-nntp-create-msgdb-from-overview-string ov-str - new-mark - already-mark - seen-mark - important-mark - seen-list + flag-table filter ))))) (if (null (elmo-nntp-read-response session t)) @@ -830,8 +855,7 @@ Don't cache if nil.") 'elmo-nntp-msgdb-create "Getting overview..." 100))) (if (not use-xover) (setq ret-val (elmo-nntp-msgdb-create-by-header - session numbers - new-mark already-mark seen-mark seen-list)) + session numbers flag-table)) (with-current-buffer (elmo-network-session-buffer session) (if ov-str (setq ret-val @@ -839,11 +863,7 @@ Don't cache if nil.") ret-val (elmo-nntp-create-msgdb-from-overview-string ov-str - new-mark - already-mark - seen-mark - important-mark - seen-list + flag-table filter)))))) (elmo-folder-set-killed-list-internal folder @@ -851,9 +871,7 @@ Don't cache if nil.") (elmo-folder-killed-list-internal folder) (car (elmo-list-diff numbers - (mapcar 'car - (elmo-msgdb-get-number-alist - ret-val)))))) + (elmo-msgdb-list-messages ret-val))))) ;; If there are canceled messages, overviews are not obtained ;; to max-number(inn 2.3?). (when (and (elmo-nntp-max-number-precedes-list-active-p) @@ -903,13 +921,11 @@ Don't cache if nil.") (nconc number-alist (list (cons max-number nil)))))))))) -(defun elmo-nntp-msgdb-create-by-header (session numbers - new-mark already-mark - seen-mark seen-list) +(defun elmo-nntp-msgdb-create-by-header (session numbers flag-table) (with-temp-buffer (elmo-nntp-retrieve-headers session (current-buffer) numbers) (elmo-nntp-msgdb-create-message - (length numbers) new-mark already-mark seen-mark seen-list))) + (length numbers) flag-table))) (defun elmo-nntp-parse-xhdr-response (string) (let (response) @@ -1035,7 +1051,7 @@ Don't cache if nil.") (if (not (string-match "^2" (setq response (elmo-nntp-read-raw-response session)))) - (error (concat "NNTP error: " response)))))) + (error "NNTP error: %s" response))))) (defsubst elmo-nntp-send-data-line (session line) "Send LINE to SESSION." @@ -1074,16 +1090,13 @@ Don't cache if nil.") (elmo-folder-set-killed-list-internal folder killed-list)) t) -(luna-define-method elmo-folder-exists-p ((folder elmo-nntp-folder)) +(luna-define-method elmo-folder-exists-p-plugged ((folder elmo-nntp-folder)) (let ((session (elmo-nntp-get-session folder))) - (if (elmo-folder-plugged-p folder) - (progn (elmo-nntp-send-command session (format "group %s" (elmo-nntp-folder-group-internal folder))) - (elmo-nntp-read-response session)) - t))) + (elmo-nntp-read-response session))) (defun elmo-nntp-retrieve-field (spec field from-msgs) "Retrieve FIELD values from FROM-MSGS. @@ -1153,6 +1166,8 @@ Returns a list of cons cells like (NUMBER . VALUE)" (if from-msgs (elmo-list-filter from-msgs result) result))) + ((string= "body" search-key) + nil) (t (let ((val (elmo-filter-value condition)) (negative (eq (elmo-filter-type condition) 'unmatch)) @@ -1174,27 +1189,38 @@ Returns a list of cons cells like (NUMBER . VALUE)" (elmo-list-filter from-msgs result) result)))))) -(luna-define-method elmo-folder-search ((folder elmo-nntp-folder) - condition &optional from-msgs) +(defun elmo-nntp-search-internal (folder condition from-msgs) (let (result) (cond ((vectorp condition) (setq result (elmo-nntp-search-primitive folder condition from-msgs))) ((eq (car condition) 'and) - (setq result (elmo-folder-search folder (nth 1 condition) from-msgs) + (setq result (elmo-nntp-search-internal folder + (nth 1 condition) + from-msgs) result (elmo-list-filter result - (elmo-folder-search + (elmo-nntp-search-internal folder (nth 2 condition) from-msgs)))) ((eq (car condition) 'or) - (setq result (elmo-folder-search folder (nth 1 condition) from-msgs) + (setq result (elmo-nntp-search-internal folder + (nth 1 condition) + from-msgs) result (elmo-uniq-list (nconc result - (elmo-folder-search folder (nth 2 condition) - from-msgs))) + (elmo-nntp-search-internal folder + (nth 2 condition) + from-msgs))) result (sort result '<)))))) +(luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder) + condition &optional from-msgs) + (if (and (elmo-folder-plugged-p folder) + (not (string= "body" (elmo-filter-key condition)))) + (elmo-nntp-search-internal folder condition from-msgs) + (luna-call-next-method))) + (defun elmo-nntp-get-folders-info-prepare (folder session-keys) (condition-case () (let ((session (elmo-nntp-get-session folder)) @@ -1249,11 +1275,11 @@ Returns a list of cons cells like (NUMBER . VALUE)" (postfix (elmo-nntp-folder-postfix user server port type))) (if (not (string= postfix "")) (save-excursion - (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$" - (concat "\\1" - (elmo-replace-in-string - postfix - "\\\\" "\\\\\\\\\\\\\\\\")))))) + (while (re-search-forward "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\)\\(.*\\)$" nil t) + (replace-match (concat (match-string 1) + (elmo-replace-in-string + postfix + "\\\\" "\\\\\\\\\\\\\\\\"))))))) (let (len min max group) (while (not (eobp)) (condition-case () @@ -1378,8 +1404,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" ;; end of from Gnus -(defun elmo-nntp-msgdb-create-message (len new-mark - already-mark seen-mark seen-list) +(defun elmo-nntp-msgdb-create-message (len flag-table) (save-excursion (let (beg overview number-alist mark-alist entity i num gmark seen message-id) @@ -1411,18 +1436,13 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-nntp-use-cache - seen-mark) - new-mark)))) + (elmo-msgdb-mark + (elmo-flag-table-get flag-table message-id) + (elmo-file-cache-status + (elmo-file-cache-get message-id)) + 'new))) (setq mark-alist (elmo-msgdb-mark-append mark-alist @@ -1442,9 +1462,6 @@ Returns a list of cons cells like (NUMBER . VALUE)" (luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number) elmo-nntp-use-cache) -(luna-define-method elmo-folder-creatable-p ((folder elmo-nntp-folder)) - nil) - (defun elmo-nntp-parse-newsgroups (string &optional subscribe-only) (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")) ngs) @@ -1521,31 +1538,21 @@ 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 ((folder elmo-nntp-folder) - numbers) - (elmo-nntp-folder-update-crosspost-message-alist folder numbers) - t) - -(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder) - &optional - number-alist) - (elmo-nntp-folder-process-crosspost folder number-alist)) +(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)) -(defun elmo-nntp-folder-process-crosspost (folder number-alist) +(defsubst elmo-nntp-folder-process-crosspost (folder) ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from ;; `elmo-crosspost-message-alist'. ;; 2.2. remove crosspost entry for current newsgroup from ;; `elmo-crosspost-message-alist'. (let (cross-deletes reads entity ngs) (dolist (cross elmo-crosspost-message-alist) - (if number-alist - (when (setq entity (rassoc (nth 0 cross) number-alist)) - (setq reads (cons (car entity) reads))) - (when (setq entity (elmo-msgdb-overview-get-entity - (nth 0 cross) - (elmo-folder-msgdb folder))) - (setq reads (cons (elmo-msgdb-overview-entity-get-number entity) - reads)))) + (when (setq entity (elmo-message-entity folder (nth 0 cross))) + (setq reads (cons (elmo-message-entity-number entity) reads))) (when entity (if (setq ngs (delete (elmo-nntp-folder-group-internal folder) (nth 1 cross))) @@ -1558,19 +1565,15 @@ Returns a list of cons cells like (NUMBER . VALUE)" elmo-crosspost-message-alist))) (elmo-nntp-folder-set-reads-internal folder reads))) -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-nntp-folder) unread-marks mark-alist) +(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)) ;; 2.3. elmo-folder-list-unreads return unread message list according to ;; `reads' slot. - (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder))))) - (elmo-living-messages (delq nil - (mapcar - (lambda (x) - (if (member (nth 1 x) unread-marks) - (car x))) - mark-alist)) - (elmo-nntp-folder-reads-internal folder)))) + (elmo-living-messages (luna-call-next-method) + (elmo-nntp-folder-reads-internal folder))) (require 'product) (product-provide (provide 'elmo-nntp) (require 'elmo-version))