-;;; elmo-nntp.el -- NNTP Interface for ELMO.
+;;; elmo-nntp.el --- NNTP Interface for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
+(eval-when-compile (require 'cl))
+(require 'elmo-vars)
+(require 'elmo-util)
+(require 'elmo-date)
(require 'elmo-msgdb)
-(eval-when-compile
- (require 'elmo-cache)
- (require 'elmo-util))
+(require 'elmo-cache)
+(require 'elmo)
(require 'elmo-net)
+(defvar elmo-nntp-overview-fetch-chop-length 200
+ "*Number of overviews to fetch in one request in nntp.")
+
+(defvar elmo-nntp-use-cache t
+ "Use cache in nntp folder.")
+
+(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?\).")
+
+(defvar elmo-nntp-group-coding-system nil
+ "A coding system for newsgroup string.")
+
+(defconst elmo-nntp-folder-name-syntax `(group
+ (?: [user "^\\([A-Za-z]\\|$\\)"])
+ ,@elmo-net-folder-name-syntax))
+
+(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))
+
+;; 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)
+ (group temp-crosses reads))
+ (luna-define-internal-accessors 'elmo-nntp-folder))
+
+(luna-define-method elmo-folder-initialize ((folder elmo-nntp-folder) name)
+ (let ((elmo-network-stream-type-alist
+ (if elmo-nntp-stream-type-alist
+ (setq elmo-network-stream-type-alist
+ (append elmo-nntp-stream-type-alist
+ elmo-network-stream-type-alist))
+ elmo-network-stream-type-alist))
+ tokens)
+ (setq tokens (car (elmo-parse-separated-tokens
+ name
+ elmo-nntp-folder-name-syntax)))
+ ;; group
+ (elmo-nntp-folder-set-group-internal folder
+ (elmo-nntp-encode-group-string
+ (cdr (assq 'group tokens))))
+ ;; user
+ (elmo-net-folder-set-user-internal folder
+ (let ((user (cdr (assq 'user tokens))))
+ (if user
+ (and (> (length user) 0) user)
+ elmo-nntp-default-user)))
+ ;; network
+ (elmo-net-folder-set-parameters
+ folder
+ tokens
+ (list :server elmo-nntp-default-server
+ :port elmo-nntp-default-port
+ :stream-type
+ (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
+ (expand-file-name
+ (elmo-nntp-folder-group-internal folder)
+ (expand-file-name (or (elmo-net-folder-server-internal folder) "nowhere")
+ (expand-file-name "nntp"
+ 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
(luna-define-class elmo-nntp-session (elmo-network-session)
(current-group))
Don't cache if nil.")
(defvar elmo-nntp-list-folders-cache nil)
-(defvar elmo-nntp-groups-hashtb nil)
+
(defvar elmo-nntp-groups-async nil)
(defvar elmo-nntp-header-fetch-chop-length 200)
(defconst elmo-nntp-server-command-index '((xover . 0)
(listgroup . 1)
- (list-active . 2)))
+ (list-active . 2)
+ (xhdr . 3)))
(defmacro elmo-nntp-get-server-command (session)
- (` (assoc (cons (elmo-network-session-host-internal (, session))
- (elmo-network-session-port-internal (, session)))
- elmo-nntp-server-command-alist)))
+ `(assoc (cons (elmo-network-session-server-internal ,session)
+ (elmo-network-session-port-internal ,session))
+ elmo-nntp-server-command-alist))
(defmacro elmo-nntp-set-server-command (session com value)
- (` (let (entry)
- (unless (setq entry (cdr (elmo-nntp-get-server-command
- (, session))))
- (setq elmo-nntp-server-command-alist
- (nconc elmo-nntp-server-command-alist
- (list (cons
- (cons
- (elmo-network-session-host-internal (, session))
- (elmo-network-session-port-internal (, session)))
- (setq entry
- (vector
- elmo-nntp-default-use-xover
- elmo-nntp-default-use-listgroup
- elmo-nntp-default-use-list-active
- elmo-nntp-default-use-xhdr)))))))
- (aset entry
- (cdr (assq (, com) elmo-nntp-server-command-index))
- (, value)))))
+ `(let (entry)
+ (unless (setq entry (cdr (elmo-nntp-get-server-command
+ ,session)))
+ (setq elmo-nntp-server-command-alist
+ (nconc elmo-nntp-server-command-alist
+ (list (cons
+ (cons
+ (elmo-network-session-server-internal ,session)
+ (elmo-network-session-port-internal ,session))
+ (setq entry
+ (vector
+ elmo-nntp-default-use-xover
+ elmo-nntp-default-use-listgroup
+ elmo-nntp-default-use-list-active
+ elmo-nntp-default-use-xhdr)))))))
+ (aset entry
+ (cdr (assq ,com elmo-nntp-server-command-index))
+ ,value)))
(defmacro elmo-nntp-xover-p (session)
- (` (let ((entry (elmo-nntp-get-server-command (, session))))
- (if entry
- (aref (cdr entry)
- (cdr (assq 'xover elmo-nntp-server-command-index)))
- elmo-nntp-default-use-xover))))
+ `(let ((entry (elmo-nntp-get-server-command ,session)))
+ (if entry
+ (aref (cdr entry)
+ (cdr (assq 'xover elmo-nntp-server-command-index)))
+ elmo-nntp-default-use-xover)))
(defmacro elmo-nntp-set-xover (session value)
- (` (elmo-nntp-set-server-command (, session) 'xover (, value))))
+ `(elmo-nntp-set-server-command ,session 'xover ,value))
(defmacro elmo-nntp-listgroup-p (session)
- (` (let ((entry (elmo-nntp-get-server-command (, session))))
- (if entry
- (aref (cdr entry)
- (cdr (assq 'listgroup elmo-nntp-server-command-index)))
- elmo-nntp-default-use-listgroup))))
+ `(let ((entry (elmo-nntp-get-server-command ,session)))
+ (if entry
+ (aref (cdr entry)
+ (cdr (assq 'listgroup elmo-nntp-server-command-index)))
+ elmo-nntp-default-use-listgroup)))
(defmacro elmo-nntp-set-listgroup (session value)
- (` (elmo-nntp-set-server-command (, session) 'listgroup (, value))))
+ `(elmo-nntp-set-server-command ,session 'listgroup ,value))
(defmacro elmo-nntp-list-active-p (session)
- (` (let ((entry (elmo-nntp-get-server-command (, session))))
- (if entry
- (aref (cdr entry)
- (cdr (assq 'list-active elmo-nntp-server-command-index)))
- elmo-nntp-default-use-list-active))))
+ `(let ((entry (elmo-nntp-get-server-command ,session)))
+ (if entry
+ (aref (cdr entry)
+ (cdr (assq 'list-active elmo-nntp-server-command-index)))
+ elmo-nntp-default-use-list-active)))
(defmacro elmo-nntp-set-list-active (session value)
- (` (elmo-nntp-set-server-command (, session) 'list-active (, value))))
+ `(elmo-nntp-set-server-command ,session 'list-active ,value))
(defmacro elmo-nntp-xhdr-p (session)
- (` (let ((entry (elmo-nntp-get-server-command (, session))))
- (if entry
- (aref (cdr entry)
- (cdr (assq 'xhdr elmo-nntp-server-command-index)))
- elmo-nntp-default-use-xhdr))))
+ `(let ((entry (elmo-nntp-get-server-command ,session)))
+ (if entry
+ (aref (cdr entry)
+ (cdr (assq 'xhdr elmo-nntp-server-command-index)))
+ elmo-nntp-default-use-xhdr)))
(defmacro elmo-nntp-set-xhdr (session value)
- (` (elmo-nntp-set-server-command (, session) 'xhdr (, value))))
+ `(elmo-nntp-set-server-command ,session 'xhdr ,value))
(defsubst elmo-nntp-max-number-precedes-list-active-p ()
elmo-nntp-max-number-precedes-list-active)
(concat
(and user (concat ":" user))
(if (and server
- (null (string= server elmo-default-nntp-server)))
+ (null (string= server elmo-nntp-default-server)))
(concat "@" server))
(if (and port
- (null (eq port elmo-default-nntp-port)))
+ (null (eq port elmo-nntp-default-port)))
(concat ":" (if (numberp port)
(int-to-string port) port)))
(unless (eq (elmo-network-stream-type-symbol type)
- elmo-default-nntp-stream-type)
+ elmo-nntp-default-stream-type)
(elmo-network-stream-type-spec-string type))))
-(defun elmo-nntp-get-session (spec &optional if-exists)
+(defun elmo-nntp-get-session (folder &optional if-exists)
(elmo-network-get-session
'elmo-nntp-session
- "NNTP"
- (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-port spec)
- (elmo-nntp-spec-username spec)
- nil ; auth type
- (elmo-nntp-spec-stream-type spec)
+ (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
(elmo-network-session-stream-type-internal session))
'starttls)
(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))))))
(luna-define-method elmo-network-setup-session ((session
elmo-nntp-session))
- (if elmo-nntp-send-mode-reader
- (elmo-nntp-send-mode-reader session))
(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")))
-
-(defun elmo-nntp-send-command (session command &optional noerase)
+ (message "Mode reader failed")))
+
+(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 "<NO LOGGING>" 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)
(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)
(erase-buffer)
(insert-buffer-substring (elmo-network-session-buffer session)
start (- end 3))
- (elmo-delete-cr-get-content-type)))))
+ (elmo-delete-cr-buffer)))
+ t))
(defun elmo-nntp-select-group (session group &optional force)
(let (response)
(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 "^"
(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
)))))
(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)))))))
-
-(defun elmo-nntp-list-folders (spec &optional hierarchy)
- (let ((session (elmo-nntp-get-session spec))
- response ret-val top-ng append-serv use-list-active start)
+ (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)
+ (elmo-nntp-folder-list-subfolders folder one-level))
+
+(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 username append-serv use-list-active start)
(with-temp-buffer
- (if (and (elmo-nntp-spec-group spec)
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec)))
+ (set-buffer-multibyte nil)
+ (if (and (elmo-nntp-folder-group-internal folder)
+ (elmo-nntp-select-group
+ session
+ (elmo-nntp-folder-group-internal folder)))
;; add top newsgroups
- (setq ret-val (list (elmo-nntp-spec-group spec))))
+ (setq ret-val (list (elmo-nntp-folder-group-internal folder))))
(unless (setq response (elmo-nntp-list-folders-get-cache
- (elmo-nntp-spec-group spec)(current-buffer)))
+ (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-spec-group spec)
- (null (string= (elmo-nntp-spec-group spec) "")))
+ (if (and (elmo-nntp-folder-group-internal folder)
+ (not (string= (elmo-nntp-folder-group-internal
+ folder) "")))
(concat " active"
- (format " %s.*" (elmo-nntp-spec-group spec)
- "")))))
+ (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")
(when elmo-nntp-list-folders-use-cache
(setq elmo-nntp-list-folders-cache
- (list (current-time) (elmo-nntp-spec-group spec)
+ (list (current-time)
+ (elmo-nntp-folder-group-internal folder)
+ (elmo-net-folder-server-internal folder)
response)))
(erase-buffer)
(insert response))
(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 (elmo-nntp-spec-group spec)
- "")) ".*$")
+ (or
+ (elmo-nntp-folder-group-internal
+ folder)
+ "")) ".*$")
response start)
(insert (match-string 0 response) "\n")
(setq start (match-end 0)))))
(goto-char (point-min))
- (let ((len (count-lines (point-min) (point-max)))
- (i 0) regexp)
- (if hierarchy
- (progn
- (setq regexp
- (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
- (if (and (elmo-nntp-spec-group spec)
- (null (string=
- (elmo-nntp-spec-group spec) "")))
- (concat (elmo-nntp-spec-group spec)
- "\\.") "")))
+ (elmo-with-progress-display
+ (elmo-nntp-parse-active (count-lines (point-min) (point-max)))
+ "Parsing active"
+ (if one-level
+ (let ((regexp
+ (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
+ (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) " ")
(setq ret-val (delete top-ng ret-val)))
(if (not (assoc top-ng ret-val))
(setq ret-val (nconc ret-val (list (list top-ng))))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'elmo-nntp-list-folders "Parsing active..."
- (/ (* i 100) len))))
+ (elmo-progress-notify 'elmo-nntp-parse-active)
(forward-line 1)))
(while (re-search-forward "\\([^ ]+\\) .*\n" nil t)
(setq ret-val (nconc ret-val
(list (elmo-match-buffer 1))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'elmo-nntp-list-folders "Parsing active..."
- (/ (* i 100) len))))))
- (when (> len elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-list-folders "Parsing active..." 100))))
- (unless (string= (elmo-nntp-spec-hostname spec)
- elmo-default-nntp-server)
- (setq append-serv (concat "@" (elmo-nntp-spec-hostname spec))))
- (unless (eq (elmo-nntp-spec-port spec) elmo-default-nntp-port)
+ (elmo-progress-notify 'elmo-nntp-parse-active)))))
+
+ (setq username (or (elmo-net-folder-user-internal folder) ""))
+ (unless (string= username (or elmo-nntp-default-user ""))
+ (setq append-serv (concat append-serv
+ ":" (elmo-quote-syntactical-element
+ username
+ 'user elmo-nntp-folder-name-syntax))))
+ (unless (string= (elmo-net-folder-server-internal folder)
+ elmo-nntp-default-server)
+ (setq append-serv (concat append-serv
+ "@" (elmo-net-folder-server-internal folder))))
+ (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
(setq append-serv (concat append-serv
":" (int-to-string
- (elmo-nntp-spec-port spec)))))
+ (elmo-net-folder-port-internal folder)))))
(unless (eq (elmo-network-stream-type-symbol
- (elmo-nntp-spec-stream-type spec))
- elmo-default-nntp-stream-type)
+ (elmo-net-folder-stream-type-internal folder))
+ elmo-nntp-default-stream-type)
(setq append-serv
(concat append-serv
(elmo-network-stream-type-spec-string
- (elmo-nntp-spec-stream-type spec)))))
- (mapcar '(lambda (fld)
- (if (consp fld)
- (list (concat "-" (car fld)
- (and (elmo-nntp-spec-username spec)
- (concat
- ":" (elmo-nntp-spec-username spec)))
- (and append-serv
- (concat append-serv))))
- (concat "-" fld
- (and (elmo-nntp-spec-username spec)
- (concat ":" (elmo-nntp-spec-username spec)))
- (and append-serv
- (concat append-serv)))))
+ (elmo-net-folder-stream-type-internal folder)))))
+ (mapcar (lambda (fld)
+ (if (consp fld)
+ (list (concat "-" (elmo-nntp-decode-group-string (car fld))
+ append-serv))
+ (concat "-" (elmo-nntp-decode-group-string fld) append-serv)))
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)))))
-
-(defun elmo-nntp-list-folder (spec)
- (let ((session (elmo-nntp-get-session spec))
- (group (elmo-nntp-spec-group spec))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
+ (elmo-make-number-list (string-to-number beg-str)
+ (string-to-number end-str)))
+
+(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)
(save-excursion
(when (setq use-listgroup (elmo-nntp-listgroup-p session))
(string-match
"211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
response)
- (> (string-to-int (elmo-match-string 1 response)) 0))
+ (> (string-to-number (elmo-match-string 1 response)) 0))
(setq numbers (elmo-nntp-make-msglist
(elmo-match-string 2 response)
(elmo-match-string 3 response)))))
- (elmo-living-messages numbers killed))))
+ numbers)))
-(defun elmo-nntp-max-of-folder (spec)
- (let ((killed-list (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
+(luna-define-method elmo-folder-status ((folder elmo-nntp-folder))
+ (elmo-nntp-folder-status folder))
+
+(defun elmo-nntp-folder-status (folder)
+ (let ((killed-list (elmo-msgdb-killed-list-load
+ (elmo-folder-msgdb-path folder)))
end-num entry)
(if elmo-nntp-groups-async
(if (setq entry
(elmo-get-hash-val
- (concat (elmo-nntp-spec-group spec)
+ (concat (elmo-nntp-folder-group-internal folder)
(elmo-nntp-folder-postfix
- (elmo-nntp-spec-username spec)
- (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-port spec)
- (elmo-nntp-spec-stream-type spec)))
- elmo-nntp-groups-hashtb))
+ (elmo-net-folder-user-internal folder)
+ (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-stream-type-internal folder)))
+ elmo-newsgroups-hashtb))
(progn
(setq end-num (nth 2 entry))
- (when (and killed-list elmo-use-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\"" (elmo-nntp-spec-group spec)))
- (let ((session (elmo-nntp-get-session spec))
+ (error "No such newsgroup \"%s\""
+ (elmo-nntp-folder-group-internal folder)))
+ (let ((session (elmo-nntp-get-session folder))
response e-num)
(if (null session)
(error "Connection failed"))
(save-excursion
(elmo-nntp-send-command session
- (format "group %s"
- (elmo-nntp-spec-group spec)))
+ (format
+ "group %s"
+ (elmo-nntp-folder-group-internal folder)))
(setq response (elmo-nntp-read-response session))
(if (and response
(string-match
"211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
response))
(progn
- (setq end-num (string-to-int
+ (setq end-num (string-to-number
(elmo-match-string 3 response)))
- (setq e-num (string-to-int
+ (setq e-num (string-to-number
(elmo-match-string 1 response)))
- (when (and killed-list elmo-use-killed-list
+ (when (and killed-list
(elmo-number-set-member end-num killed-list))
;; Max is killed.
(setq end-num nil))
(cons end-num e-num))
(if (null response)
(error "Selecting newsgroup \"%s\" failed"
- (elmo-nntp-spec-group spec))
+ (elmo-nntp-folder-group-internal folder))
nil)))))))
(defconst elmo-nntp-overview-index
("lines" . 7)
("xref" . 8)))
-(defun elmo-nntp-create-msgdb-from-overview-string (str
- folder
- new-mark
- already-mark
- seen-mark
- important-mark
- seen-list
+(defun elmo-nntp-create-msgdb-from-overview-string (folder
+ str
+ flag-table
&optional numlist)
- (let (ov-list gmark message-id seen
- ov-entity overview number-alist mark-alist num
- extras extra ext field field-index)
+ (let ((new-msgdb (elmo-make-msgdb))
+ ov-list message-id entity
+ ov-entity num
+ field field-index flags)
(setq ov-list (elmo-nntp-parse-overview-string str))
(while ov-list
(setq ov-entity (car ov-list))
;;; (<= num 0))
;;; (setq num 0))
;;; (setq num (int-to-string num))
- (setq num (string-to-int (aref ov-entity 0)))
+ (setq num (string-to-number (aref ov-entity 0)))
(when (or (null numlist)
(memq num numlist))
- (setq extras elmo-msgdb-extra-fields
- extra nil)
- (while extras
- (setq ext (downcase (car extras)))
- (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index)))
+ (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
+ (aref ov-entity 5))
+ :from (elmo-with-enable-multibyte
+ (eword-decode-string
+ (elmo-delete-char ?\"
+ (or (aref ov-entity 2)
+ elmo-no-from))))
+ :subject (or (elmo-with-enable-multibyte
+ (eword-decode-string
+ (aref ov-entity 1)))
+ elmo-no-subject)
+ :date (aref ov-entity 3)
+ :size (string-to-number (aref ov-entity 6))))
+ (dolist (extra elmo-msgdb-extra-fields)
+ (setq extra (downcase extra))
+ (when (and (setq field-index
+ (cdr (assoc extra elmo-nntp-overview-index)))
+ (> (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
- overview
- (cons (aref ov-entity 4)
- (vector num
- (elmo-msgdb-get-last-message-id
- (aref ov-entity 5))
- ;; from
- (elmo-mime-string (elmo-delete-char
- ?\"
- (or
- (aref ov-entity 2)
- elmo-no-from) 'uni))
- ;; subject
- (elmo-mime-string (or (aref ov-entity 1)
- elmo-no-subject))
- (aref ov-entity 3) ;date
- nil ; to
- nil ; cc
- (string-to-int
- (aref ov-entity 6)) ; size
- extra ; extra-field-list
- ))))
- (setq number-alist
- (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-cache-exists-p message-id);; XXX
- (if seen
- nil
- already-mark)
- (if seen
- (if elmo-nntp-use-cache
- seen-mark)
- new-mark))))
- (setq mark-alist
- (elmo-msgdb-mark-append mark-alist
- num gmark))))
+ (elmo-message-entity-set-field entity (intern extra) field)))
+ (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)))
- (list overview number-alist mark-alist)))
-
-(defun elmo-nntp-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- "Create msgdb for SPEC for NUMLIST."
- (elmo-nntp-msgdb-create spec numlist new-mark already-mark
- seen-mark important-mark seen-list
- t))
-
-(defun elmo-nntp-msgdb-create (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list &optional as-num)
- (when numlist
- (let ((filter numlist)
- (session (elmo-nntp-get-session spec))
- beg-num end-num cur length
- ret-val ov-str use-xover dir)
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec))
- (when (setq use-xover (elmo-nntp-xover-p session))
- (setq beg-num (car numlist)
- cur beg-num
- end-num (nth (1- (length numlist)) numlist)
- length (+ (- end-num beg-num) 1))
- (message "Getting overview...")
+ new-msgdb))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder)
+ 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))
+ (new-msgdb (elmo-make-msgdb))
+ beg-num end-num cur length
+ new-msgdb ov-str use-xover dir)
+ (elmo-nntp-select-group session (elmo-nntp-folder-group-internal
+ folder))
+ (when (setq use-xover (elmo-nntp-xover-p session))
+ (setq beg-num (car numbers)
+ cur beg-num
+ end-num (nth (1- (length numbers)) numbers)
+ length (+ (- end-num beg-num) 1))
+ (elmo-with-progress-display (elmo-retrieve-overview length)
+ "Getting overview"
(while (<= cur end-num)
(elmo-nntp-send-command
session
elmo-nntp-overview-fetch-chop-length))))
(with-current-buffer (elmo-network-session-buffer session)
(if ov-str
- (setq ret-val
- (elmo-msgdb-append
- ret-val
- (elmo-nntp-create-msgdb-from-overview-string
- ov-str
- (elmo-nntp-spec-group spec)
- new-mark
- already-mark
- seen-mark
- important-mark
- seen-list
- filter
- )))))
+ (elmo-msgdb-append
+ new-msgdb
+ (elmo-nntp-create-msgdb-from-overview-string
+ folder
+ ov-str
+ flag-table
+ filter))))
(if (null (elmo-nntp-read-response session t))
(progn
(setq cur end-num);; exit while loop
(if (null (setq ov-str (elmo-nntp-read-contents session)))
(error "Fetching overview failed")))
(setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
- (when (> length elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create "Getting overview..."
- (/ (* (+ (- (min cur end-num)
- beg-num) 1) 100) length))))
- (when (> length elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create "Getting overview..." 100)))
- (if (not use-xover)
- (setq ret-val (elmo-nntp-msgdb-create-by-header
- session numlist
- new-mark already-mark seen-mark seen-list))
- (with-current-buffer (elmo-network-session-buffer session)
- (if ov-str
- (setq ret-val
- (elmo-msgdb-append
- ret-val
- (elmo-nntp-create-msgdb-from-overview-string
- ov-str
- (elmo-nntp-spec-group spec)
- new-mark
- already-mark
- seen-mark
- important-mark
- seen-list
- filter))))))
- (when elmo-use-killed-list
- (setq dir (elmo-msgdb-expand-path spec))
- (elmo-msgdb-killed-list-save
- dir
- (nconc
- (elmo-msgdb-killed-list-load dir)
- (car (elmo-list-diff
- numlist
- (mapcar 'car
- (elmo-msgdb-get-number-alist
- 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)
- (elmo-nntp-list-active-p session))
- (elmo-nntp-send-command session
- (format "list active %s"
- (elmo-nntp-spec-group spec)))
- (if (null (elmo-nntp-read-response session))
- (progn
- (elmo-nntp-set-list-active session nil)
- (error "NNTP list command failed")))
- (elmo-nntp-catchup-msgdb
- ret-val
- (nth 1 (read (concat "(" (elmo-nntp-read-contents
- session) ")")))))
- ret-val)))
-
-(defun elmo-nntp-sync-number-alist (spec number-alist)
- (if (elmo-nntp-max-number-precedes-list-active-p)
- (let ((session (elmo-nntp-get-session spec)))
- (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-spec-group spec))
- (elmo-nntp-send-command session
- (format "list active %s"
- (elmo-nntp-spec-group spec)))
- (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)))
- (nconc number-alist
- (list (cons max-number nil)))
- number-alist))
- number-alist))))
-
-(defun elmo-nntp-msgdb-create-by-header (session numlist
- new-mark already-mark
- seen-mark seen-list)
+ (elmo-progress-notify 'elmo-retrieve-overview
+ :set (+ (- (min cur end-num) beg-num) 1)))))
+ (if (not use-xover)
+ (setq new-msgdb (elmo-nntp-msgdb-create-by-header
+ session numbers flag-table))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (if ov-str
+ (elmo-msgdb-append
+ new-msgdb
+ (elmo-nntp-create-msgdb-from-overview-string
+ folder
+ ov-str
+ flag-table
+ filter)))))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (nconc
+ (elmo-folder-killed-list-internal folder)
+ (car (elmo-list-diff
+ numbers
+ (elmo-msgdb-list-messages new-msgdb)))))
+ ;; 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)
+ (elmo-nntp-list-active-p session))
+ (elmo-nntp-send-command session
+ (format "list active %s"
+ (elmo-nntp-folder-group-internal
+ folder)))
+ (if (null (elmo-nntp-read-response session))
+ (progn
+ (elmo-nntp-set-list-active session nil)
+ (error "NNTP list command failed")))
+ (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))
+ (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
- (elmo-nntp-retrieve-headers session (current-buffer) numlist)
+ (elmo-nntp-retrieve-headers session (current-buffer) numbers)
(elmo-nntp-msgdb-create-message
- (length numlist) new-mark already-mark seen-mark seen-list)))
+ (length numbers) flag-table)))
(defun elmo-nntp-parse-xhdr-response (string)
(let (response)
(goto-char (point-min))
(while (not (eobp))
(if (looking-at "^\\([0-9]+\\) \\(.*\\)$")
- (setq response (cons (cons (string-to-int (elmo-match-buffer 1))
+ (setq response (cons (cons (string-to-number (elmo-match-buffer 1))
(elmo-match-buffer 2))
response)))
(forward-line 1)))
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))
"Get nntp header string."
(save-excursion
(let ((session (elmo-nntp-get-session
- (list 'nntp nil user server port type))))
+ (luna-make-entity
+ 'elmo-nntp-folder
+ :user user
+ :server server
+ :port port
+ :stream-type type))))
(elmo-nntp-send-command session
(format "head %s" msgid))
(if (elmo-nntp-read-response session)
(with-current-buffer (elmo-network-session-buffer session)
(std11-field-body "Newsgroups")))))
-(defun elmo-nntp-read-msg (spec number outbuf)
- (let ((session (elmo-nntp-get-session spec)))
+(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
+ (elmo-nntp-folder-update-crosspost-message-alist
+ folder (list number)))
+ t))
+
+(luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
+ number strategy
+ &optional section outbuf
+ unread)
+ (elmo-nntp-message-fetch folder number strategy section outbuf unread))
+
+(defun elmo-nntp-message-fetch (folder number strategy section outbuf unread)
+ (let ((session (elmo-nntp-get-session folder))
+ newsgroups)
(with-current-buffer (elmo-network-session-buffer session)
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec))
+ (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))
(elmo-nntp-send-command session (format "article %s" number))
(if (null (elmo-nntp-read-response session t))
(progn
(goto-char (point-min))
(while (re-search-forward "^\\." nil t)
(replace-match "")
- (forward-line))))))))
-
-;;(defun elmo-msgdb-nntp-overview-create-range (spec beg end mark)
-;; (elmo-nntp-overview-create-range hostname beg end mark folder)))
-
-;;(defun elmo-msgdb-nntp-max-of-folder (spec)
-;; (elmo-nntp-max-of-folder hostname folder)))
-
-(defun elmo-nntp-append-msg (spec string &optional msg no-see))
+ (forward-line))
+ (elmo-nntp-setup-crosspost-buffer folder number)
+ (unless unread
+ (elmo-nntp-folder-update-crosspost-message-alist
+ folder (list number)))))))))
(defun elmo-nntp-post (hostname content-buf)
(let ((session (elmo-nntp-get-session
- (list 'nntp nil elmo-default-nntp-user
- hostname elmo-default-nntp-port
- elmo-default-nntp-stream-type)))
+ (luna-make-entity
+ 'elmo-nntp-folder
+ :user elmo-nntp-default-user
+ :server hostname
+ :port elmo-nntp-default-port
+ :stream-type
+ (elmo-get-network-stream-type
+ elmo-nntp-default-stream-type))))
response has-message-id)
(save-excursion
(set-buffer content-buf)
(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."
(unless (eq (forward-line 1) 0) (setq data-continue nil))
(elmo-nntp-send-data-line session line)))))
-(defun elmo-nntp-delete-msgs (spec msgs)
- "MSGS on FOLDER at SERVER pretended as Deleted. Returns nil if failed."
- (if elmo-use-killed-list
- (let* ((dir (elmo-msgdb-expand-path spec))
- (killed-list (elmo-msgdb-killed-list-load dir)))
- (mapcar '(lambda (msg)
- (setq killed-list
- (elmo-msgdb-set-as-killed killed-list msg)))
- msgs)
- (elmo-msgdb-killed-list-save dir killed-list)))
- t)
-
-(defun elmo-nntp-check-validity (spec validity-file)
- t)
-(defun elmo-nntp-sync-validity (spec validity-file)
+(luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
+ numbers)
+ (elmo-folder-kill-messages folder numbers)
t)
-(defun elmo-nntp-folder-exists-p (spec)
- (let ((session (elmo-nntp-get-session spec)))
- (if (elmo-nntp-plugged-p spec)
- (progn
- (elmo-nntp-send-command session
- (format "group %s"
- (elmo-nntp-spec-group spec)))
- (elmo-nntp-read-response session))
- t)))
-
-(defun elmo-nntp-folder-creatable-p (spec)
- nil)
-
-(defun elmo-nntp-create-folder (spec)
- nil) ; noop
+(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-read-response session)))
(defun elmo-nntp-retrieve-field (spec field from-msgs)
"Retrieve FIELD values from FROM-MSGS.
(let ((session (elmo-nntp-get-session spec)))
(if (elmo-nntp-xhdr-p session)
(progn
- (elmo-nntp-select-group session (elmo-nntp-spec-group spec))
+ (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec))
(elmo-nntp-send-command session
(format "xhdr %s %s"
field
(let ((search-key (elmo-filter-key condition)))
(cond
((string= "last" search-key)
- (let ((numbers (or from-msgs (elmo-nntp-list-folder spec))))
+ (let ((numbers (or from-msgs (elmo-folder-list-messages spec))))
(nthcdr (max (- (length numbers)
- (string-to-int (elmo-filter-value condition)))
+ (string-to-number (elmo-filter-value condition)))
0)
numbers)))
((string= "first" search-key)
- (let* ((numbers (or from-msgs (elmo-nntp-list-folder spec)))
- (rest (nthcdr (string-to-int (elmo-filter-value condition) )
+ (let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
+ (rest (nthcdr (string-to-number (elmo-filter-value condition) )
numbers)))
(mapcar '(lambda (x) (delete x numbers)) rest)
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))
(elmo-list-filter from-msgs result)
result))))))
-(defun elmo-nntp-search (spec condition &optional from-msgs)
+(defun elmo-nntp-search-internal (folder condition from-msgs)
(let (result)
(cond
((vectorp condition)
(setq result (elmo-nntp-search-primitive
- spec condition from-msgs)))
+ folder condition from-msgs)))
((eq (car condition) 'and)
- (setq result (elmo-nntp-search spec (nth 1 condition) from-msgs)
+ (setq result (elmo-nntp-search-internal folder
+ (nth 1 condition)
+ from-msgs)
result (elmo-list-filter result
- (elmo-nntp-search
- spec (nth 2 condition)
+ (elmo-nntp-search-internal
+ folder (nth 2 condition)
from-msgs))))
((eq (car condition) 'or)
- (setq result (elmo-nntp-search spec (nth 1 condition) from-msgs)
+ (setq result (elmo-nntp-search-internal folder
+ (nth 1 condition)
+ from-msgs)
result (elmo-uniq-list
(nconc result
- (elmo-nntp-search spec (nth 2 condition)
- from-msgs)))
+ (elmo-nntp-search-internal folder
+ (nth 2 condition)
+ from-msgs)))
result (sort result '<))))))
-(defun elmo-nntp-get-folders-info-prepare (spec session-keys)
+(defun elmo-nntp-use-server-search-p (condition)
+ (if (vectorp condition)
+ (not (string= "body" (elmo-filter-key condition)))
+ (and (elmo-nntp-use-server-search-p (nth 1 condition))
+ (elmo-nntp-use-server-search-p (nth 2 condition)))))
+
+(luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder)
+ condition &optional from-msgs)
+ (if (and (elmo-folder-plugged-p folder)
+ (elmo-nntp-use-server-search-p 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 spec))
+ (let ((session (elmo-nntp-get-session folder))
key count)
(with-current-buffer (elmo-network-session-buffer session)
(unless (setq key (assoc session session-keys))
(erase-buffer)
(setq key (cons session
(vector 0
- (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-username spec)
- (elmo-nntp-spec-port spec)
- (elmo-nntp-spec-stream-type spec))))
+ (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-user-internal folder)
+ (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-stream-type-internal
+ folder))))
(setq session-keys (nconc session-keys (list key))))
(elmo-nntp-send-command session
(format "group %s"
- (elmo-nntp-spec-group spec))
+ (elmo-nntp-folder-group-internal
+ folder))
'noerase)
(if elmo-nntp-get-folders-securely
(accept-process-output
(user (aref key 2))
(port (aref key 3))
(type (aref key 4))
- (hashtb (or elmo-nntp-groups-hashtb
- (setq elmo-nntp-groups-hashtb
+ (hashtb (or elmo-newsgroups-hashtb
+ (setq elmo-newsgroups-hashtb
(elmo-make-hash count)))))
(save-excursion
(elmo-nntp-groups-read-response session cur count)
(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 ()
(elmo-network-session-process-internal session) 1)
(discard-input)
;; Wait for all replies.
- (message "Getting folders info...")
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (setq received
- (1+ received)))
- (setq last-point (point))
- (< received count))
- (accept-process-output (elmo-network-session-process-internal session)
- 1)
- (discard-input)
- (when (> count elmo-display-progress-threshold)
- (if (or (zerop (% received 10)) (= received count))
- (elmo-display-progress
- 'elmo-nntp-groups-read-response "Getting folders info..."
- (/ (* received 100) count)))))
- (when (> count elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-groups-read-response "Getting folders info..." 100))
+ (elmo-with-progress-display (elmo-nntp-groups-read-response count)
+ "Getting folders info"
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (accept-process-output
+ (elmo-network-session-process-internal session)
+ 1)
+ (discard-input)
+ (elmo-progress-notify 'elmo-nntp-groups-read-response :set received)))
;; Wait for the reply from the final command.
(goto-char (point-max))
(re-search-backward "^[0-9]" nil t)
(replace-match "" t t))
(copy-to-buffer outbuf (point-min) (point-max)))))
-(defun elmo-nntp-make-groups-hashtb (folders &optional size)
- (let ((hashtb (or elmo-nntp-groups-hashtb
- (setq elmo-nntp-groups-hashtb
- (elmo-make-hash (or size (length folders)))))))
- (mapcar
- '(lambda (fld)
- (or (elmo-get-hash-val fld hashtb)
- (elmo-set-hash-val fld nil hashtb)))
- folders)
- hashtb))
-
;; from nntp.el [Gnus]
(defsubst elmo-nntp-next-result-arrived-p ()
(received 0)
(last-point (point-min))
article)
- ;; Send HEAD commands.
- (while (setq article (pop articles))
- (elmo-nntp-send-command session
- (format "head %s" article)
- 'noerase)
- (setq count (1+ count))
- ;; Every 200 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count elmo-nntp-header-fetch-chop-length)))
- (accept-process-output
- (elmo-network-session-process-internal session) 1)
- (discard-input)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (elmo-nntp-next-result-arrived-p)
- (setq last-point (point))
- (setq received (1+ received)))
- (< received count))
- (when (> number elmo-display-progress-threshold)
- (if (or (zerop (% received 20)) (= received number))
- (elmo-display-progress
- 'elmo-nntp-retrieve-headers "Getting headers..."
- (/ (* received 100) number))))
+ (elmo-with-progress-display (elmo-retrieve-header number)
+ "Getting headers"
+ ;; Send HEAD commands.
+ (while (setq article (pop articles))
+ (elmo-nntp-send-command session
+ (format "head %s" article)
+ 'noerase)
+ (setq count (1+ count))
+ ;; Every 200 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count elmo-nntp-header-fetch-chop-length)))
(accept-process-output
(elmo-network-session-process-internal session) 1)
- (discard-input))))
- (when (> number elmo-display-progress-threshold)
- (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"))
+ (discard-input)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (elmo-nntp-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
+ (elmo-network-session-process-internal session) 1)
+ (discard-input)))))
+ ;; Replace all CRLF with LF.
+ (elmo-delete-cr-buffer)
(copy-to-buffer outbuf (point-min) (point-max)))))
;; 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)
- (elmo-set-buffer-multibyte nil)
+ (let ((new-msgdb (elmo-make-msgdb))
+ beg entity num message-id)
+ (set-buffer-multibyte nil)
(goto-char (point-min))
- (setq i 0)
- (message "Creating msgdb...")
- (while (not (eobp))
- (setq beg (save-excursion (forward-line 1) (point)))
- (setq num
- (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
- (string-to-int
- (elmo-match-buffer 1))))
- (elmo-nntp-next-result-arrived-p)
- (when num
- (save-excursion
- (forward-line -1)
- (save-restriction
- (narrow-to-region beg (point))
- (setq entity
- (elmo-msgdb-create-overview-from-buffer num))
- (when entity
- (setq overview
- (elmo-msgdb-append-element
- overview entity))
- (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-nntp-use-cache
- seen-mark)
- new-mark))))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
- num gmark)))
- ))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 20)) (= i len))
- (elmo-display-progress
- 'elmo-nntp-msgdb-create-message "Creating msgdb..."
- (/ (* i 100) len)))))
- (when (> len elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create-message "Creating msgdb..." 100))
- (list overview number-alist mark-alist))))
-
-(defun elmo-nntp-use-cache-p (spec number)
+ (elmo-with-progress-display (elmo-folder-msgdb-create len)
+ "Creating msgdb"
+ (while (not (eobp))
+ (setq beg (save-excursion (forward-line 1) (point)))
+ (setq num
+ (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
+ (string-to-number
+ (elmo-match-buffer 1))))
+ (elmo-nntp-next-result-arrived-p)
+ (when num
+ (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) num))
+ (when entity
+ (setq message-id
+ (elmo-message-entity-field entity 'message-id))
+ (elmo-msgdb-append-entity
+ new-msgdb
+ entity
+ (elmo-flag-table-get flag-table message-id))))))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
+ new-msgdb)))
+
+(luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
elmo-nntp-use-cache)
-(defun elmo-nntp-local-file-p (spec number)
- nil)
-
-(defun elmo-nntp-port-label (spec)
- (concat "nntp"
- (if (elmo-nntp-spec-stream-type spec)
- (concat "!" (symbol-name
- (elmo-network-stream-type-symbol
- (elmo-nntp-spec-stream-type spec)))))))
-
-(defsubst elmo-nntp-portinfo (spec)
- (list (elmo-nntp-spec-hostname spec)
- (elmo-nntp-spec-port spec)))
-
-(defun elmo-nntp-plugged-p (spec)
- (apply 'elmo-plugged-p
- (append (elmo-nntp-portinfo spec)
- (list nil (quote (elmo-nntp-port-label spec))))))
-
-(defun elmo-nntp-set-plugged (spec plugged add)
- (apply 'elmo-set-plugged plugged
- (append (elmo-nntp-portinfo spec)
- (list nil nil (quote (elmo-nntp-port-label spec)) add))))
-
-(defalias 'elmo-nntp-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-nntp-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-nntp-commit 'elmo-generic-commit)
-(defalias 'elmo-nntp-folder-diff 'elmo-generic-folder-diff)
+(defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
+ (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
+ ngs)
+ (if (not subscribe-only)
+ nglist
+ (dolist (ng nglist)
+ (if (intern-soft ng elmo-newsgroups-hashtb)
+ (setq ngs (cons ng ngs))))
+ ngs)))
+
+;;; Crosspost processing.
+
+;; 1. setup crosspost alist.
+;; 1.1. When message is fetched and is crossposted message,
+;; it is remembered in `temp-crosses' slot.
+;; 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-flag-as-read, move crosspost entry
+;; from `temp-crosses' slot to `elmo-crosspost-message-alist'.
+
+;; 2. process crosspost alist.
+;; 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'.
+;; 2.3. elmo-folder-list-unreads return unread message list according to
+;; `reads' slot.
+;; (There's a problem that if `elmo-folder-list-unreads'
+;; never executed, crosspost information is thrown away.)
+;; 2.4. In elmo-folder-close, `read' slot is cleared,
+
+(defun elmo-nntp-setup-crosspost-buffer (folder number)
+;; 1.1. When message is fetched and is crossposted message,
+;; it is remembered in `temp-crosses' slot.
+;; temp-crosses slot is a list of cons cell:
+;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
+ (let (newsgroups crosspost-newsgroups message-id)
+ (save-restriction
+ (std11-narrow-to-header)
+ (setq newsgroups (std11-fetch-field "newsgroups")
+ message-id (std11-msg-id-string
+ (car (std11-parse-msg-id-string
+ (std11-fetch-field "message-id"))))))
+ (when newsgroups
+ (when (setq crosspost-newsgroups
+ (delete
+ (elmo-nntp-folder-group-internal folder)
+ (elmo-nntp-parse-newsgroups newsgroups t)))
+ (unless (assq number
+ (elmo-nntp-folder-temp-crosses-internal folder))
+ (elmo-nntp-folder-set-temp-crosses-internal
+ folder
+ (cons (cons number (list message-id crosspost-newsgroups 'ng))
+ (elmo-nntp-folder-temp-crosses-internal folder))))))))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder))
+;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
+ (elmo-nntp-folder-set-temp-crosses-internal folder nil)
+ (elmo-nntp-folder-set-reads-internal folder nil)
+ )
+
+(defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers)
+;; 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)
+ (when (setq elem (assq number
+ (elmo-nntp-folder-temp-crosses-internal folder)))
+ (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist)
+ (setq elmo-crosspost-message-alist
+ (cons (cdr elem) elmo-crosspost-message-alist)))
+ (elmo-nntp-folder-set-temp-crosses-internal
+ folder
+ (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
+
+(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
+;; `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)
+ (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)))
+ (setcar (cdr cross) ngs)
+ (setq cross-deletes (cons cross cross-deletes)))
+ (setq elmo-crosspost-message-alist-modified t)))
+ (dolist (dele cross-deletes)
+ (setq elmo-crosspost-message-alist (delq
+ dele
+ elmo-crosspost-message-alist)))
+ (elmo-nntp-folder-set-reads-internal folder reads)))
+
+(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder))
+ (elmo-nntp-folder-process-crosspost 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.
+ (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))
projects / elisp / wanderlust.git / blobdiff