2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
+ * dgnushack.el: Commented out the experimental code.
+
+2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-range.el (gnus-inverse-list-range-intersection): Off-by-one
+ error.
+
+ * gnus.el (gnus-server-to-method): Made into subst.
+ (gnus-server-method-cache): New variable.
+ (gnus-server-to-method): Use it.
+ (gnus-group-method-cache): New variable.
+ (gnus-find-method-for-group-1): Renamed.
+ (gnus-find-method-for-group): New function.
+ (gnus-group-method-cache): Removed.
+
+ * gnus-sum.el (gnus-compute-unseen-list): Use new optimized
+ function.
+
+ * gnus-range.el (gnus-members-of-range): New function.
+ (gnus-list-range-intersection): Renamed.
+ (gnus-inverse-list-range-intersection): New function.
+
+ * gnus-sum.el (gnus-compute-unseen-list): Made into own function.
+
+ * nnagent.el (nnagent-retrieve-headers): New implementation.
+
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): New, faster
+ implementation.
+
+2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
* lpath.el: Fbind `w3m-charset-to-coding-system'; bind
`w3m-meta-content-type-charset-regexp'.
(t (concat filename ".elc"))))
(require 'bytecomp)
+;; To avoid having defsubsts and inlines happen.
+;(if (featurep 'xemacs)
+; (require 'byte-optimize)
+; (require 'byte-opt))
+;(defun byte-optimize-inline-handler (form)
+; "byte-optimize-handler for the `inline' special-form."
+; (cons 'progn (cdr form)))
+;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun)
(when (boundp 'MULE)
(let (current-load-list)
(gnus-agent-method-p gnus-command-method))
(gnus-agent-load-alist gnus-newsgroup-name)
;; First mark all undownloaded articles as undownloaded.
- (dolist (article (mapcar (lambda (header) (mail-header-number header))
- gnus-newsgroup-headers))
- (unless (or (cdr (assq article gnus-agent-article-alist))
- (memq article gnus-newsgroup-downloadable)
- (memq article gnus-newsgroup-cached))
- (push article gnus-newsgroup-undownloaded)))
+ (let ((articles (mapcar (lambda (header) (mail-header-number header))
+ gnus-newsgroup-headers))
+ (agent-articles gnus-agent-article-alist)
+ candidates article)
+ (while (setq article (pop articles))
+ (while (and agent-articles
+ (< (caar agent-articles) article))
+ (setq agent-articles (cdr agent-articles)))
+ (when (or (not (cdar agent-articles))
+ (not (= (caar agent-articles) article)))
+ (push article candidates)))
+ (dolist (article candidates)
+ (unless (or (memq article gnus-newsgroup-downloadable)
+ (memq article gnus-newsgroup-cached))
+ (push article gnus-newsgroup-undownloaded))))
;; Then mark downloaded downloadable as not-downloadable,
;; if you get my drift.
(dolist (article gnus-newsgroup-downloadable)
(setq ranges (cdr ranges)))
(not not-stop))))
+(defun gnus-list-range-intersection (list ranges)
+ "Return a list of numbers in LIST that are members of RANGES.
+LIST is a sorted list."
+ (let (number result)
+ (while (setq number (pop list))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (< (car ranges) number)
+ (< (cdar ranges) number)))
+ (setq ranges (cdr ranges)))
+ (when (and ranges
+ (if (numberp (car ranges))
+ (= (car ranges) number)
+ (< number (cdar ranges))))
+ (push number result)))
+ (nreverse result)))
+
+(defun gnus-inverse-list-range-intersection (list ranges)
+ "Return a list of numbers in LIST that are not members of RANGES.
+LIST is a sorted list."
+ (let (number result)
+ (while (setq number (pop list))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (< (car ranges) number)
+ (< (cdar ranges) number)))
+ (setq ranges (cdr ranges)))
+ (when (or (not ranges)
+ (if (numberp (car ranges))
+ (not (= (car ranges) number))
+ (not (<= number (cdar ranges)))))
+ (push number result)))
+ (nreverse result)))
+
(defun gnus-range-length (range)
"Return the length RANGE would have if uncompressed."
(length (gnus-uncompress-range range)))
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
(defun gnus-get-unread-articles (&optional level)
+ (setq gnus-server-method-cache nil)
(let* ((newsrc (cdr gnus-newsrc-alist))
(level (or level gnus-activate-level (1+ gnus-level-subscribed)))
(foreign-level
(funcall gnus-alter-header-function header))
(gnus-dependencies-add-header header dependencies force-new)))
+(defsubst gnus-nov-parse-line-1 (number dependencies &optional force-new)
+ (let ((eol (gnus-point-at-eol))
+ (buffer (current-buffer))
+ header)
+
+ ;; overview: [num subject from date id refs chars lines misc]
+ (unwind-protect
+ (progn
+ (narrow-to-region (point) eol)
+ (unless (eobp)
+ (forward-char))
+
+ (setq header
+ (make-full-mail-header
+ number ; number
+ (nnheader-nov-field) ; subject
+ (nnheader-nov-field) ; from
+ (nnheader-nov-field) ; date
+ (nnheader-nov-read-message-id) ; id
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (unless (eobp)
+ (nnheader-nov-field)) ; Xref
+ (nnheader-nov-parse-extra)))) ; extra
+
+ (widen))
+ (gnus-dependencies-add-header header dependencies force-new)))
+
(defun gnus-build-get-header (id)
"Look through the buffer of NOV lines and find the header to ID.
Enter this line into the dependencies hash table, and return
(setq gnus-newsgroup-unreads
(gnus-set-sorted-intersection
gnus-newsgroup-unreads fetched-articles))
-
- ;; The `seen' marks are treated specially.
- (if (not gnus-newsgroup-seen)
- (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
- (dolist (article gnus-newsgroup-articles)
- (unless (gnus-member-of-range article gnus-newsgroup-seen)
- (push article gnus-newsgroup-unseen)))
- (setq gnus-newsgroup-unseen (nreverse gnus-newsgroup-unseen)))
+ (gnus-compute-unseen-list)
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
+(defun gnus-compute-unseen-list ()
+ ;; The `seen' marks are treated specially.
+ (if (not gnus-newsgroup-seen)
+ (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
+ (setq gnus-newsgroup-unseen
+ (gnus-inverse-list-range-intersection
+ gnus-newsgroup-articles gnus-newsgroup-seen))))
+
(defun gnus-summary-display-make-predicate (display)
(require 'gnus-agent)
(when (= (length display) 1)
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
(defvar gnus-ephemeral-servers nil)
+(defvar gnus-server-method-cache nil)
(defvar gnus-agent nil
"Whether we want to use the Gnus agent or not.")
(t
(gnus-server-add-address method))))
-(defun gnus-server-to-method (server)
+(defsubst gnus-server-to-method (server)
"Map virtual server names to select methods."
- (or
- ;; Is this a method, perhaps?
- (and server (listp server) server)
- ;; Perhaps this is the native server?
- (and (equal server "native") gnus-select-method)
- ;; It should be in the server alist.
- (cdr (assoc server gnus-server-alist))
- ;; It could be in the predefined server alist.
- (cdr (assoc server gnus-predefined-server-alist))
- ;; If not, we look through all the opened server
- ;; to see whether we can find it there.
- (let ((opened gnus-opened-servers))
- (while (and opened
- (not (equal server (format "%s:%s" (caaar opened)
- (cadaar opened)))))
- (pop opened))
- (caar opened))
- ;; It could be a named method, search all servers
- (let ((servers gnus-secondary-select-methods))
- (while (and servers
- (not (equal server (format "%s:%s" (caar servers)
- (cadar servers)))))
- (pop servers))
- (car servers))))
+ (or (and server (listp server) server)
+ (cdr (assoc server gnus-server-method-cache))
+ (let ((result
+ (or
+ ;; Perhaps this is the native server?
+ (and (equal server "native") gnus-select-method)
+ ;; It should be in the server alist.
+ (cdr (assoc server gnus-server-alist))
+ ;; It could be in the predefined server alist.
+ (cdr (assoc server gnus-predefined-server-alist))
+ ;; If not, we look through all the opened server
+ ;; to see whether we can find it there.
+ (let ((opened gnus-opened-servers))
+ (while (and opened
+ (not (equal server (format "%s:%s" (caaar opened)
+ (cadaar opened)))))
+ (pop opened))
+ (caar opened))
+ ;; It could be a named method, search all servers
+ (let ((servers gnus-secondary-select-methods))
+ (while (and servers
+ (not (equal server (format "%s:%s" (caar servers)
+ (cadar servers)))))
+ (pop servers))
+ (car servers)))))
+ (push (cons server result) gnus-server-method-cache)
+ result)))
(defmacro gnus-method-equal (ss1 ss2)
"Say whether two servers are equal."
(set-buffer nntp-server-buffer)
(erase-buffer)
(nnheader-insert-file-contents file)
- (goto-char (point-min))
- (while (and arts (not (eobp)))
- (cond
- ((looking-at "[0-9]")
- (setq n (read (current-buffer)))
- (if (> n (car arts))
- (beginning-of-line))
- (while (and arts (> n (car arts)))
- (insert (format
- "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
- (car arts) (car arts)))
- (pop arts))
- (if (and arts (= n (car arts)))
- (pop arts))))
- (forward-line 1))
- (while (and arts)
+ (goto-char (point-min))
+ ;; This loop is just for the `condition-case' -- if reading bugs
+ ;; out on a line, it'll still continue on to the next line. So
+ ;; this look is normally just executed once.
+
+ (while arts
(insert (format
"%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
(car arts) (car arts)))
projects / elisp / gnus.git- / commitdiff