X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-nntp.el;h=f894d693069fc614b7322dd0060b91008cdbc45d;hb=2953f6f04147a85361880c1fb8485a38f66d1b0a;hp=ff3e29dc310a5f4e2f72314c302f848153f8b9aa;hpb=b3015cee4e29eece4cfa8da6f05a4b6be940b265;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index ff3e29d..f894d69 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -1,4 +1,4 @@ -;;; elmo-nntp.el -- NNTP Interface for ELMO. +;;; elmo-nntp.el --- NNTP Interface for ELMO. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Copyright (C) 1998,1999,2000 Masahiro MURATA @@ -28,10 +28,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'elmo-vars) (require 'elmo-util) @@ -51,6 +51,19 @@ "Non-nil means max number of msgdb is set as the max number of `list active'. (Needed for inn 2.3 or later?).") +(defvar elmo-nntp-group-coding-system nil + "A coding system for newsgroup string.") + +(defsubst elmo-nntp-encode-group-string (string) + (if elmo-nntp-group-coding-system + (encode-coding-string string elmo-nntp-group-coding-system) + string)) + +(defsubst elmo-nntp-decode-group-string (string) + (if elmo-nntp-group-coding-system + (decode-coding-string string elmo-nntp-group-coding-system) + string)) + ;;; ELMO NNTP folder (eval-and-compile (luna-define-class elmo-nntp-folder (elmo-net-folder) @@ -65,32 +78,30 @@ (setq elmo-network-stream-type-alist (append elmo-nntp-stream-type-alist elmo-network-stream-type-alist)) - elmo-network-stream-type-alist))) + elmo-network-stream-type-alist)) + parse) (setq name (luna-call-next-method)) - (when (string-match - "^\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?" - name) - (elmo-nntp-folder-set-group-internal + (setq parse (elmo-parse-token name ":")) + (elmo-nntp-folder-set-group-internal folder + (elmo-nntp-encode-group-string + (car 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 + (car parse))) + (unless (elmo-net-folder-server-internal folder) + (elmo-net-folder-set-server-internal folder + elmo-nntp-default-server)) + (unless (elmo-net-folder-port-internal folder) + (elmo-net-folder-set-port-internal folder + elmo-nntp-default-port)) + (unless (elmo-net-folder-stream-type-internal folder) + (elmo-net-folder-set-stream-type-internal folder - (if (match-beginning 1) - (elmo-match-string 1 name))) - ;; Setup slots for elmo-net-folder - (elmo-net-folder-set-user-internal folder - (if (match-beginning 2) - (elmo-match-substring 2 name 1) - elmo-nntp-default-user)) - (unless (elmo-net-folder-server-internal folder) - (elmo-net-folder-set-server-internal folder - elmo-nntp-default-server)) - (unless (elmo-net-folder-port-internal folder) - (elmo-net-folder-set-port-internal folder - elmo-nntp-default-port)) - (unless (elmo-net-folder-stream-type-internal folder) - (elmo-net-folder-set-stream-type-internal - folder - (elmo-get-network-stream-type - elmo-nntp-default-stream-type))) - folder))) + (elmo-get-network-stream-type + elmo-nntp-default-stream-type))) + folder)) (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder)) (convert-standard-filename @@ -98,7 +109,10 @@ (elmo-nntp-folder-group-internal folder) (expand-file-name (or (elmo-net-folder-server-internal folder) "nowhere") (expand-file-name "nntp" - elmo-msgdb-dir))))) + elmo-msgdb-directory))))) + +(luna-define-method elmo-folder-newsgroups ((folder elmo-nntp-folder)) + (list (elmo-nntp-folder-group-internal folder))) ;;; NNTP Session (eval-and-compile @@ -231,26 +245,31 @@ Don't cache if nil.") (defun elmo-nntp-get-session (folder &optional if-exists) (elmo-network-get-session 'elmo-nntp-session - "NNTP" + (concat + (if (elmo-folder-biff-internal folder) + "BIFF-") + "NNTP") folder if-exists)) (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) (setq elmo-nntp-read-point (point-min)) ;; Skip garbage output from process before greeting. (while (and (memq (process-status process) '(open run)) - (goto-char (point-max)) - (forward-line -1) - (not (looking-at "20[01]"))) - (accept-process-output process 1)) + (goto-char (point-max)) + (forward-line -1) + (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 @@ -291,8 +310,8 @@ Don't cache if nil.") (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) (with-current-buffer (elmo-network-session-buffer session) (unless noerase @@ -304,7 +323,7 @@ Don't cache if nil.") (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) @@ -339,7 +358,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) @@ -372,7 +393,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)))) + t)) (defun elmo-nntp-select-group (session group &optional force) (let (response) @@ -387,7 +409,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 "^" @@ -395,18 +417,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 ))))) @@ -428,24 +456,27 @@ Don't cache if nil.") (defun elmo-nntp-folder-list-subfolders (folder one-level) (let ((session (elmo-nntp-get-session folder)) + (case-fold-search nil) response ret-val top-ng append-serv use-list-active start) (with-temp-buffer + (set-buffer-multibyte nil) (if (and (elmo-nntp-folder-group-internal folder) - (elmo-nntp-select-group + (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))) ;; add top newsgroups (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 session (concat "list" (if (and (elmo-nntp-folder-group-internal folder) - (null (string= (elmo-nntp-folder-group-internal - folder) ""))) + (not (string= (elmo-nntp-folder-group-internal + folder) ""))) (concat " active" (format " %s.*" (elmo-nntp-folder-group-internal folder) @@ -457,6 +488,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)) @@ -469,12 +501,12 @@ 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 "^" (regexp-quote - (or + (or (elmo-nntp-folder-group-internal folder) "")) ".*$") @@ -488,7 +520,7 @@ Don't cache if nil.") (progn (setq regexp (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n" - (if (and + (if (and (elmo-nntp-folder-group-internal folder) (null (string= (elmo-nntp-folder-group-internal @@ -542,14 +574,14 @@ Don't cache if nil.") (elmo-net-folder-stream-type-internal folder))))) (mapcar '(lambda (fld) (if (consp fld) - (list (concat "-" (car fld) + (list (concat "-" (elmo-nntp-decode-group-string (car fld)) (and (elmo-net-folder-user-internal folder) (concat ":" (elmo-net-folder-user-internal folder))) (and append-serv (concat append-serv)))) - (concat "-" fld + (concat "-" (elmo-nntp-decode-group-string fld) (and (elmo-net-folder-user-internal folder) (concat ":" (elmo-net-folder-user-internal folder))) @@ -571,9 +603,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) @@ -623,12 +655,12 @@ Don't cache if nil.") elmo-newsgroups-hashtb)) (progn (setq end-num (nth 2 entry)) - (when(and killed-list + (when (and killed-list (elmo-number-set-member end-num killed-list)) ;; Max is killed. (setq end-num nil)) (cons end-num (car entry))) - (error "No such newsgroup \"%s\"" + (error "No such newsgroup \"%s\"" (elmo-nntp-folder-group-internal folder))) (let ((session (elmo-nntp-get-session folder)) response e-num) @@ -636,7 +668,7 @@ Don't cache if nil.") (error "Connection failed")) (save-excursion (elmo-nntp-send-command session - (format + (format "group %s" (elmo-nntp-folder-group-internal folder))) (setq response (elmo-nntp-read-response session)) @@ -697,10 +729,11 @@ Don't cache if nil.") (while extras (setq ext (downcase (car extras))) (when (setq field-index (cdr (assoc ext elmo-nntp-overview-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))) + (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 extras (cdr extras))) (setq overview (elmo-msgdb-append-element @@ -944,12 +977,14 @@ 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 :after +(luna-define-method elmo-message-fetch-with-cache-process :around ((folder elmo-nntp-folder) number strategy &optional section unread) - (elmo-nntp-setup-crosspost-buffer folder number) - (unless unread - (elmo-nntp-folder-update-crosspost-message-alist - folder (list number)))) + (when (luna-call-next-method) + (elmo-nntp-setup-crosspost-buffer folder number) + (unless unread + (elmo-nntp-folder-update-crosspost-message-alist + folder (list number))) + t)) (luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder) number strategy @@ -1052,16 +1087,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. @@ -1105,32 +1137,34 @@ Returns a list of cons cells like (NUMBER . VALUE)" numbers)) ((or (string= "since" search-key) (string= "before" search-key)) - (let* ((key-date (elmo-date-get-datevec (elmo-filter-value condition))) - (key-datestr (elmo-date-make-sortable-string key-date)) + (let* ((specified-date (elmo-date-make-sortable-string + (elmo-date-get-datevec (elmo-filter-value + condition)))) (since (string= "since" search-key)) - result) + field-date result) (if (eq (elmo-filter-type condition) 'unmatch) (setq since (not since))) (setq result (delq nil (mapcar (lambda (pair) + (setq field-date + (elmo-date-make-sortable-string + (timezone-fix-time + (cdr pair) + (current-time-zone) nil))) (if (if since - (string< key-datestr - (elmo-date-make-sortable-string - (timezone-fix-time - (cdr pair) - (current-time-zone) nil))) - (not (string< key-datestr - (elmo-date-make-sortable-string - (timezone-fix-time - (cdr pair) - (current-time-zone) nil))))) + (or (string= specified-date field-date) + (string< specified-date field-date)) + (string< field-date + specified-date)) (car pair))) (elmo-nntp-retrieve-field spec "date" from-msgs)))) (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)) @@ -1152,27 +1186,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)) @@ -1420,12 +1465,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) - -(luna-define-method elmo-folder-writable-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) @@ -1470,7 +1509,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" message-id (std11-msg-id-string (car (std11-parse-msg-id-string (std11-fetch-field "message-id")))))) - (when newsgroups + (when newsgroups (when (setq crosspost-newsgroups (delete (elmo-nntp-folder-group-internal folder) @@ -1535,18 +1574,18 @@ Returns a list of cons cells like (NUMBER . VALUE)" (setq elmo-crosspost-message-alist-modified t))) (dolist (dele cross-deletes) (setq elmo-crosspost-message-alist (delq - dele + dele elmo-crosspost-message-alist))) (elmo-nntp-folder-set-reads-internal folder reads))) -(luna-define-method elmo-folder-list-unreads-internal +(luna-define-method elmo-folder-list-unreads-internal ((folder elmo-nntp-folder) unread-marks mark-alist) ;; 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 + (mapcar (lambda (x) (if (member (nth 1 x) unread-marks) (car x)))