From: yamaoka Date: Wed, 30 Apr 2003 01:05:45 +0000 (+0000) Subject: Synch to Oort Gnus 200304300107. X-Git-Tag: t-gnus-6_15_21-00-quimby~10 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a6066dd49463fc5bf4714c94a05634aec37742b2;p=elisp%2Fgnus.git- Synch to Oort Gnus 200304300107. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5edcbe3..44ee798 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2003-04-30 Kevin Greiner + + * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-name): + Wrapped in eval-when-compile. + (gnus-agent-mode): Bind gnus-agent-go-online to nil as you + shouldn't be asked twice to go online with each server. + (gnus-agent-get-undownloaded-list, gnus-agent-fetch-articles, + gnus-agent-crosspost, gnus-agent-flush-cache, + gnus-agent-fetch-session, gnus-agent-unread-articles, + gnus-agent-uncached-articles, gnus-agent-regenerate-group, + gnus-agent-group-covered-p): Expanded pop macros used for + effect. Avoids compilation warning in emacs 21.3. + + * gnus-int.el (gnus-open-server): Restructured to only open + nnagent when gnus-plugged is nil. + 2003-04-30 Katsumi Yamaoka * lpath.el: Fbind string-to-multibyte. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 29ae24c..9879e11 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -296,36 +296,36 @@ node `(gnus)Server Buffer'.") (setq category (cdr category))))))) category) -;; Fixme: These two can probably be in eval-when-compile. - -(defmacro gnus-agent-cat-defaccessor (name prop-name) - "Define accessor and setter methods for manipulating a list of the form +(eval-when-compile + (defmacro gnus-agent-cat-defaccessor (name prop-name) + "Define accessor and setter methods for manipulating a list of the form \(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)). Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be manipulated as follows: (func LIST): Returns VALUE1 (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1." - `(progn (defmacro ,name (category) - (list (quote cdr) (list (quote assq) - (quote (quote ,prop-name)) category))) - - (define-setf-method ,name (category) - (let* ((--category--temp-- (make-symbol "--category--")) - (--value--temp-- (make-symbol "--value--"))) - (list (list --category--temp--) ; temporary-variables - (list category) ; value-forms - (list --value--temp--) ; store-variables - (let* ((category --category--temp--) ; store-form - (value --value--temp--)) - (list (quote gnus-agent-cat-set-property) - category - (quote (quote ,prop-name)) - value)) - (list (quote ,name) --category--temp--) ; access-form - ))))) - -(defmacro gnus-agent-cat-name (category) - `(car ,category)) + `(progn (defmacro ,name (category) + (list (quote cdr) (list (quote assq) + (quote (quote ,prop-name)) category))) + + (define-setf-method ,name (category) + (let* ((--category--temp-- (make-symbol "--category--")) + (--value--temp-- (make-symbol "--value--"))) + (list (list --category--temp--) ; temporary-variables + (list category) ; value-forms + (list --value--temp--) ; store-variables + (let* ((category --category--temp--) ; store-form + (value --value--temp--)) + (list (quote gnus-agent-cat-set-property) + category + (quote (quote ,prop-name)) + value)) + (list (quote ,name) --category--temp--) ; access-form + ))))) + + (defmacro gnus-agent-cat-name (category) + `(car ,category)) + ) (gnus-agent-cat-defaccessor gnus-agent-cat-days-until-old agent-days-until-old) @@ -446,7 +446,8 @@ manipulated as follows: buffer)))) minor-mode-map-alist)) (when (eq major-mode 'gnus-group-mode) - (let ((init-plugged gnus-plugged)) + (let ((init-plugged gnus-plugged) + (gnus-agent-go-online nil)) ;; g-a-t-p does nothing when gnus-plugged isn't changed. ;; Therefore, make certain that the current value does not ;; match the desired initial value. @@ -931,28 +932,28 @@ article's mark is toggled." (cond ((< a h) ;; Ignore IDs in the alist that are not being ;; displayed in the summary. - (pop alist)) + (setq alist (cdr alist))) ((> a h) ;; Headers that are not in the alist should be ;; fictious (see nnagent-retrieve-headers); they ;; imply that this article isn't in the agent. (gnus-agent-append-to-list tail-undownloaded h) (gnus-agent-append-to-list tail-unfetched h) - (pop headers)) + (setq headers (cdr headers))) ((cdar alist) - (pop alist) - (pop headers) + (setq alist (cdr alist)) + (setq headers (cdr headers)) nil ; ignore already downloaded ) (t - (pop alist) - (pop headers) + (setq alist (cdr alist)) + (setq headers (cdr headers)) ;; This article isn't in the agent. Check to see ;; if it is in the cache. If it is, it's been ;; downloaded. (while (and cached (< (car cached) a)) - (pop cached)) + (setq cached (cdr cached))) (unless (equal a (car cached)) (gnus-agent-append-to-list tail-undownloaded a)))))) @@ -1342,7 +1343,7 @@ This can be added to `gnus-select-article-hook' or (gnus-agent-append-to-list tail-fetched-articles (caar pos))) (widen) - (pop pos)))) + (setq pos (cdr pos))))) (gnus-agent-save-alist group (cdr fetched-articles) date) (gnus-message 7 "")) @@ -1376,7 +1377,7 @@ This can be added to `gnus-select-article-hook' or (insert (string-to-number (cdar crosses))) (insert-buffer-substring gnus-agent-overview-buffer beg end) (gnus-agent-check-overview-buffer)) - (pop crosses)))) + (setq crosses (cdr crosses))))) (defun gnus-agent-backup-overview-buffer () (when gnus-newsgroup-name @@ -1444,7 +1445,7 @@ and that there are no duplicates." (gnus-agent-article-name ".overview" (caar gnus-agent-buffer-alist)) nil 'silent) - (pop gnus-agent-buffer-alist)) + (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist))) (while gnus-agent-group-alist (with-temp-file (gnus-agent-article-name ".agentview" (caar gnus-agent-group-alist)) @@ -1452,7 +1453,7 @@ and that there are no duplicates." (insert "\n") (princ 1 (current-buffer)) (insert "\n")) - (pop gnus-agent-group-alist)))) + (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) (defun gnus-agent-find-parameter (group symbol) "Search for GROUPs SYMBOL in the group's parameters, the group's @@ -1830,7 +1831,7 @@ FILE and places the combined headers into `nntp-server-buffer'." (error-message-string err))) (signal 'quit "Cannot fetch articles into the Gnus agent"))))))))) - (pop methods)) + (setq methods (cdr methods))) (gnus-run-hooks 'gnus-agent-fetched-hook) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) @@ -2973,7 +2974,7 @@ articles in every agentized group.")) (gnus-agent-append-to-list tail-unread candidate) nil) ((> candidate max) - (pop read))))))) + (setq read (cdr read)))))))) (while known (gnus-agent-append-to-list tail-unread (car (pop known)))) (cdr unread))) @@ -3001,14 +3002,14 @@ has been fetched." (v2 (caar ref))) (cond ((< v1 v2) ; v1 does not appear in the reference list (gnus-agent-append-to-list tail-uncached v1) - (pop arts)) + (setq arts (cdr arts))) ((= v1 v2) (unless (or cached-header (cdar ref)) ; v1 is already cached (gnus-agent-append-to-list tail-uncached v1)) - (pop arts) - (pop ref)) + (setq arts (cdr arts)) + (setq ref (cdr ref))) (t ; reference article (v2) preceeds the list being filtered - (pop ref))))) + (setq ref (cdr ref)))))) (while arts (gnus-agent-append-to-list tail-uncached (pop arts))) (cdr uncached)) @@ -3228,7 +3229,7 @@ If REREAD is not nil, downloaded articles are marked as unread." (gnus-message 4 "gnus-agent-regenerate-group: NOV\ entries contained duplicate of article %s. Duplicate deleted." l1) (gnus-delete-line) - (pop nov-arts))))) + (setq nov-arts (cdr nov-arts)))))) (t (gnus-message 1 "gnus-agent-regenerate-group: NOV\ entries contained line that did not begin with an article number. Deleted\ @@ -3274,12 +3275,12 @@ If REREAD is not nil, downloaded articles are marked as unread." (nth 5 (file-attributes (concat dir (number-to-string (car downloaded))))))) alist) - (pop downloaded) - (pop nov-arts)) + (setq downloaded (cdr downloaded)) + (setq nov-arts (cdr nov-arts))) (t ;; This entry in the overview has not been downloaded (push (cons (car nov-arts) nil) alist) - (pop nov-arts)))) + (setq nov-arts (cdr nov-arts))))) ;; When gnus-agent-consider-all-articles is set, ;; gnus-agent-regenerate-group should NOT remove article IDs from @@ -3303,15 +3304,15 @@ If REREAD is not nil, downloaded articles are marked as unread." (oID (caar o))) (cond ((not nID) (setq n (setcdr n (list (list oID)))) - (pop o)) + (setq o (cdr o))) ((< oID nID) (setcdr n (cons (list oID) (cdr n))) - (pop o)) + (setq o (cdr o))) ((= oID nID) - (pop o) - (pop n)) + (setq o (cdr o)) + (setq n (cdr n))) (t - (pop n))))) + (setq n (cdr n)))))) (setq alist (cdr merged))) ;; Restore the last article ID if it is not already in the new alist (let ((n (last alist)) @@ -3464,7 +3465,7 @@ If CLEAN, don't read existing active files." (caar days) group)) (throw 'found (cadar days))) - (pop days)) + (setq days (cdr days))) nil))) (when day (gnus-group-set-parameter group 'agent-days-until-old diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 835cb91..614bb89 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -195,18 +195,40 @@ If it is down, start it up (again)." "Open a connection to GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((elem (assoc gnus-command-method gnus-opened-servers))) - ;; If this method was previously denied, we just return nil. - (if (eq (nth 1 elem) 'denied) - (progn - (gnus-message 1 "Denied server") - nil) - ;; Open the server. - (let ((result - (condition-case err - (funcall (gnus-get-function gnus-command-method 'open-server) - (nth 1 gnus-command-method) - (nthcdr 2 gnus-command-method)) + + (let ((state (or (assoc gnus-command-method gnus-opened-servers) + (car (setq gnus-opened-servers + (cons (list gnus-command-method nil) + gnus-opened-servers)))))) + (cond ((eq (nth 1 state) 'denied) + ;; If this method was previously denied, we just return nil. + + (gnus-message 1 "Denied server") + nil) + ((eq (nth 1 state) 'offline) + ;; If this method was previously opened offline, we just return t. + t) + ((not gnus-plugged) + ;; I'm opening servers while unplugged. Set the status to + ;; either 'offline or 'denied without asking (I'm assuming + ;; that the user wants to go 'offline on every agentized + ;; server when opening while unplugged.) + (setcar (cdr state) (if (and gnus-agent + (gnus-agent-method-p gnus-command-method)) + (or gnus-server-unopen-status + 'offline) + 'denied)) + + (if (eq (nth 1 state) 'offline) + ;; Invoke the agent's backend to open the offline server. + (funcall (gnus-get-function gnus-command-method 'open-server) + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method)))) + ((condition-case err + ;; Open the server. + (funcall (gnus-get-function gnus-command-method 'open-server) + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method)) (error (gnus-message 1 (format "Unable to open server due to: %s" @@ -214,19 +236,15 @@ If it is down, start it up (again)." nil) (quit (gnus-message 1 "Quit trying to open server") - nil)))) - ;; If this hasn't been opened before, we add it to the list. - (unless elem - (setq elem (list gnus-command-method nil) - gnus-opened-servers (cons elem gnus-opened-servers))) - ;; Set the status of this server. - (setcar (cdr elem) - (if result - (if (eq (cadr elem) 'offline) - 'offline - 'ok) - (if (and gnus-agent - (not (eq (cadr elem) 'offline)) + nil)) + ;; I successfully opened the server. + (setcar (cdr state) 'ok)) + (t + ;; I couldn't open the server so decide whether to mark it + ;; 'denied or to open it 'offline. + (setcar (cdr state) + (if (and gnus-agent + (not (eq (cadr state) 'offline)) (gnus-agent-method-p gnus-command-method)) (or gnus-server-unopen-status (if (gnus-y-or-n-p @@ -235,19 +253,12 @@ If it is down, start it up (again)." (cadr gnus-command-method))) 'offline 'denied)) - 'denied))) - ;; Return the result from the "open" call. - (cond ((eq (cadr elem) 'offline) - ;; I'm avoiding infinite recursion by binding unopen - ;; status to denied (The logic of this routine - ;; guarantees that I can't get to this point with - ;; unopen status already bound to denied). - (unless (eq gnus-server-unopen-status 'denied) - (let ((gnus-server-unopen-status 'denied)) - (gnus-open-server gnus-command-method))) - t) - (t - result)))))) + 'denied)) + (if (eq (nth 1 state) 'offline) + ;; Invoke the agent's backend to open the offline server. + (funcall (gnus-get-function gnus-command-method 'open-server) + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method))))))) (defun gnus-close-server (gnus-command-method) "Close the connection to GNUS-COMMAND-METHOD."