(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.")
(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)
(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
(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))))))
(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))
(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 "<NO LOGGING>" command))
(process-send-string (elmo-network-session-process-internal
session) command)
(process-send-string (elmo-network-session-process-internal
(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)
+ 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)
(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)
(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)))
("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
(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))))
(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
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))
'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
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
(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)
(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."
(elmo-list-filter from-msgs result)
result)))
((string= "body" search-key)
- (error
-"Search by BODY is not supported (Toggle the plug off to search from caches)"))
+ nil)
(t
(let ((val (elmo-filter-value condition))
(negative (eq (elmo-filter-type condition) 'unmatch))
(luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder)
condition &optional from-msgs)
- (if (elmo-folder-plugged-p folder)
+ (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)))
(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 ()
;; 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-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
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)))
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))
projects / elisp / wanderlust.git / blobdiff