-;;; 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:
-;;
+;;
(require 'elmo-vars)
(require 'elmo-util)
(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.")
+
+(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)
(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 folder 1)
- elmo-default-nntp-user))
- (unless (elmo-net-folder-server-internal folder)
- (elmo-net-folder-set-server-internal folder
- elmo-default-nntp-server))
- (unless (elmo-net-folder-port-internal folder)
- (elmo-net-folder-set-port-internal folder
- elmo-default-nntp-port))
- (unless (elmo-net-folder-stream-type-internal folder)
- (elmo-net-folder-set-stream-type-internal
- folder
- elmo-default-nntp-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
(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
(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 (folder &optional if-exists)
(elmo-network-get-session
'elmo-nntp-session
- "NNTP"
+ (concat
+ (if (elmo-folder-biff-internal folder)
+ "BIFF-")
+ "NNTP")
folder
if-exists))
(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 "20[01]")))
+ (accept-process-output process 1))
(setq elmo-nntp-read-point (point))
(or (elmo-nntp-read-response session t)
(error "Cannot open network"))
+ (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)
(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)
(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)
(with-current-buffer (elmo-network-session-buffer session)
(unless noerase
(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)
(let ((session (elmo-nntp-get-session folder))
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
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)
(setq start nil)
(while (string-match (concat "^"
(regexp-quote
- (or
+ (or
(elmo-nntp-folder-group-internal
folder)
"")) ".*$")
(progn
(setq regexp
(format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
- (if (and
+ (if (and
(elmo-nntp-folder-group-internal folder)
(null (string=
(elmo-nntp-folder-group-internal
(elmo-display-progress
'elmo-nntp-list-folders "Parsing active..." 100))))
(unless (string= (elmo-net-folder-server-internal folder)
- elmo-default-nntp-server)
+ elmo-nntp-default-server)
(setq append-serv (concat "@" (elmo-net-folder-server-internal
folder))))
- (unless (eq (elmo-net-folder-port-internal folder) elmo-default-nntp-port)
+ (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
(setq append-serv (concat append-serv
":" (int-to-string
(elmo-net-folder-port-internal folder)))))
(unless (eq (elmo-network-stream-type-symbol
(elmo-net-folder-stream-type-internal folder))
- elmo-default-nntp-stream-type)
+ elmo-nntp-default-stream-type)
(setq append-serv
(concat append-serv
(elmo-network-stream-type-spec-string
(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)))
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)
(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))
(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
(if (elmo-nntp-max-number-precedes-list-active-p)
(let ((session (elmo-nntp-get-session folder))
(number-alist (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
(if (elmo-nntp-list-active-p session)
(let (msgdb-max max-number)
;; If there are canceled messages, overviews are not obtained
(and msgdb-max max-number
(< msgdb-max max-number)))
(elmo-msgdb-set-number-alist
- (elmo-folder-msgdb-internal folder)
+ (elmo-folder-msgdb folder)
(nconc number-alist
(list (cons max-number nil))))))))))
"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")))))
+(luna-define-method elmo-message-fetch-with-cache-process :around
+ ((folder elmo-nntp-folder) number strategy &optional section unread)
+ (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
(let ((session (elmo-nntp-get-session
(luna-make-entity
'elmo-nntp-folder
- :user elmo-default-nntp-user
+ :user elmo-nntp-default-user
:server hostname
- :port elmo-default-nntp-port
- :stream-type elmo-default-nntp-stream-type)))
+ :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)
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))))))
-(luna-define-method elmo-folder-search ((folder elmo-nntp-folder)
+(luna-define-method elmo-folder-search ((folder elmo-nntp-folder)
condition &optional from-msgs)
(let (result)
(cond
(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)
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)
(setq reads (cons (car entity) reads)))
(when (setq entity (elmo-msgdb-overview-get-entity
(nth 0 cross)
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
(setq reads (cons (elmo-msgdb-overview-entity-get-number entity)
reads))))
(when entity
(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-internal folder)))))
+ (elmo-folder-msgdb folder)))))
(elmo-living-messages (delq nil
- (mapcar
+ (mapcar
(lambda (x)
(if (member (nth 1 x) unread-marks)
(car x)))
projects / elisp / wanderlust.git / blobdiff