From f6d26e920ddadbedca424beefe7978e0c3a76923 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 25 Jan 2002 09:27:20 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 31 ++++++++++++++++++++++++++++++ lisp/dgnushack.el | 8 ++++++++ lisp/gnus-agent.el | 21 ++++++++++++++------ lisp/gnus-range.el | 34 +++++++++++++++++++++++++++++++++ lisp/gnus-start.el | 1 + lisp/gnus-sum.el | 46 ++++++++++++++++++++++++++++++++++++-------- lisp/gnus.el | 54 ++++++++++++++++++++++++++++------------------------ lisp/nnagent.el | 22 ++++++--------------- 8 files changed, 162 insertions(+), 55 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e41a933..6aec60c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,36 @@ 2002-01-25 Katsumi Yamaoka + * dgnushack.el: Commented out the experimental code. + +2002-01-25 Lars Magne Ingebrigtsen + + * 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 + * lpath.el: Fbind `w3m-charset-to-coding-system'; bind `w3m-meta-content-type-charset-regexp'. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index efd9c4d..acb0c4c 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -86,6 +86,14 @@ (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) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 6ee9ef1..48322d5 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -696,12 +696,21 @@ the actual number of articles toggled is returned." (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) diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 9358c13..8e3c097 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -325,6 +325,40 @@ modified." (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))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 705b9ce..2d7e6d9 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1575,6 +1575,7 @@ newsgroup." ;; 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 diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index f291d86..6b0c027 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -3734,6 +3734,35 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (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 @@ -4763,14 +4792,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (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 @@ -4803,6 +4825,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; 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) diff --git a/lisp/gnus.el b/lisp/gnus.el index 5997d40..265b33e 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1824,6 +1824,7 @@ covered by that variable." (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.") @@ -2766,32 +2767,35 @@ that that variable is buffer-local to the summary buffers." (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." diff --git a/lisp/nnagent.el b/lisp/nnagent.el index c77b91f..5bdc1e6 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -138,22 +138,12 @@ (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))) -- 1.7.10.4