From: yamaoka Date: Fri, 11 Jan 2002 03:56:03 +0000 (+0000) Subject: Synch with Oort Gnus. X-Git-Tag: t-gnus-6_15_5-02-quimby~17 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a11d0d4325eca973c6565284bed620128a63fcef;p=elisp%2Fgnus.git- Synch with Oort Gnus. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5cbef65..7afb59b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,36 @@ 2002-01-10 ShengHuo ZHU + * mm-util.el (mm-charset-to-coding-system): Change charset to cs. + From: Torsten Hilbrich + + * gnus.el (gnus-agent-covered-methods): Move here. + (gnus-online): New function. + (gnus-agent-method-p): Move here. + + * nnagent.el (nnagent-retrieve-headers): Check whether arts is + nil. Remove articles-alist. + + * gnus-start.el (gnus-get-unread-articles): Check online. + (gnus-groups-to-gnus-format): Ditto. + (gnus-active-to-gnus-format): Ditto. + + * gnus-agent.el (gnus-agent-get-function): Use it. + (gnus-agent-get-undownloaded-list): Ditto. + (gnus-agent-fetch-session): Only fetch online methods. + + * gnus-srvr.el (gnus-server-make-menu-bar): Add offline. + (gnus-server-mode-map): Ditto. + (gnus-server-offline-face): New face. + (gnus-server-offline-face): New variable. + (gnus-server-font-lock-keywords): Add offline. + (gnus-server-insert-server-line): Ditto. + (gnus-server-offline-server): New function. + + * gnus-int.el (gnus-open-server): Turn to offline. + (gnus-server-unopen-status): New variable. + +2002-01-10 ShengHuo ZHU + * nnkiboze.el (nnkiboze-request-article): Use gnus-agent-request-article. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index e6112f8..ca38edb 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -33,7 +33,7 @@ warn: clean-some gnus-load.el # The "clever" rule is unsafe, since redefined macros are loaded from # .elc files, and not the .el file. -clever some: gnus-load.el +clever some l: gnus-load.el @if test -f $(srcdir)/gnus.elc; then \ echo \ "checking whether the all elc files should be recompiled..."; \ diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index e96308e..80f70dc 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -136,7 +136,6 @@ If this is `ask' the hook will query the user." (defvar gnus-agent-buffer-alist nil) (defvar gnus-agent-article-alist nil) (defvar gnus-agent-group-alist nil) -(defvar gnus-agent-covered-methods nil) (defvar gnus-category-alist nil) (defvar gnus-agent-current-history nil) (defvar gnus-agent-overview-buffer nil) @@ -680,7 +679,7 @@ the actual number of articles toggled is returned." (defun gnus-agent-get-undownloaded-list () "Mark all unfetched articles as read." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (and (not gnus-plugged) + (when (and (not (gnus-online gnus-command-method)) (gnus-agent-method-p gnus-command-method)) (gnus-agent-load-alist gnus-newsgroup-name) ;; First mark all undownloaded articles as undownloaded. @@ -819,17 +818,11 @@ the actual number of articles toggled is returned." -(defun gnus-agent-method-p (method) - "Say whether METHOD is covered by the agent." - (member method gnus-agent-covered-methods)) - (defun gnus-agent-get-function (method) - (if (and (not gnus-plugged) - (gnus-agent-method-p method)) - (progn - (require 'nnagent) - 'nnagent) - (car method))) + (if (gnus-online method) + (car method) + (require 'nnagent) + 'nnagent)) ;;; History functions @@ -1162,8 +1155,9 @@ the actual number of articles toggled is returned." (condition-case err (progn (setq gnus-command-method (car methods)) - (when (or (gnus-server-opened gnus-command-method) - (gnus-open-server gnus-command-method)) + (when (and (or (gnus-server-opened gnus-command-method) + (gnus-open-server gnus-command-method)) + (gnus-online gnus-command-method)) (setq groups (gnus-groups-from-server (car methods))) (gnus-agent-with-fetch (while (setq group (pop groups)) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index f1dec1a..cf9b67e 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,5 +1,5 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,6 +36,13 @@ :group 'gnus-start :type 'hook) +(defvar gnus-server-unopen-status nil + "The default status if the server is not able to open. +If the server is covered by Gnus agent, the possible values are +`denied', set the server denied; `offline', set the server offline; +`nil', ask user. If the server is not covered by Gnus agent, set the +server denied.") + ;;; ;;; Server Communication ;;; @@ -196,9 +203,25 @@ If it is down, start it up (again)." (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 'ok 'denied)) + (setcar (cdr elem) + (if result + (if (eq (cadr elem) 'offline) + 'offline + 'ok) + (if (and gnus-agent + (not (eq (cadr elem) 'offline)) + (gnus-agent-method-p gnus-command-method)) + (or gnus-server-unopen-status + (if (gnus-y-or-n-p + (format "Unable to open %s:%s, go offline? " + (car gnus-command-method) + (cadr gnus-command-method))) + 'offline + 'denied)) + 'denied))) ;; Return the result from the "open" call. - result)))) + (or (eq (cadr elem) 'offline) + result))))) (defun gnus-close-server (gnus-command-method) "Close the connection to GNUS-COMMAND-METHOD." @@ -304,7 +327,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (cond ((and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group fetch-old)) - ((and gnus-agent gnus-agent-cache gnus-plugged + ((and gnus-agent gnus-agent-cache (gnus-online gnus-command-method) (gnus-agent-method-p gnus-command-method)) (gnus-agent-retrieve-headers articles group fetch-old)) (t diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 6222153..9d6b543 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -121,6 +121,7 @@ If nil, a faster, but more primitive, buffer is used instead." '("Connections" ["Open" gnus-server-open-server t] ["Close" gnus-server-close-server t] + ["Offline" gnus-server-offline-server t] ["Deny" gnus-server-deny-server t] "---" ["Open All" gnus-server-open-all-servers t] @@ -154,6 +155,7 @@ If nil, a faster, but more primitive, buffer is used instead." "C" gnus-server-close-server "\M-c" gnus-server-close-all-servers "D" gnus-server-deny-server + "L" gnus-server-offline-server "R" gnus-server-remove-denials "n" next-line @@ -193,6 +195,13 @@ If nil, a faster, but more primitive, buffer is used instead." "Face used for displaying DENIED servers" :group 'gnus-server-visual) +(defface gnus-server-offline-face + '((((class color) (background light)) (:foreground "Orange" :bold t)) + (((class color) (background dark)) (:foreground "Yellow" :bold t)) + (t (:inverse-video t :bold t))) + "Face used for displaying OFFLINE servers" + :group 'gnus-server-visual) + (defcustom gnus-server-agent-face 'gnus-server-agent-face "Face name to use on AGENTIZED servers." :group 'gnus-server-visual @@ -213,11 +222,17 @@ If nil, a faster, but more primitive, buffer is used instead." :group 'gnus-server-visual :type 'face) +(defcustom gnus-server-offline-face 'gnus-server-offline-face + "Face name to use on OFFLINE servers." + :group 'gnus-server-visual + :type 'face) + (defvar gnus-server-font-lock-keywords (list '("(\\(agent\\))" 1 gnus-server-agent-face) '("(\\(opened\\))" 1 gnus-server-opened-face) '("(\\(closed\\))" 1 gnus-server-closed-face) + '("(\\(offline\\))" 1 gnus-server-offline-face) '("(\\(denied\\))" 1 gnus-server-denied-face))) (defun gnus-server-mode () @@ -255,14 +270,16 @@ The following commands are available: (gnus-tmp-where (nth 1 method)) (elem (assoc method gnus-opened-servers)) (gnus-tmp-status - (if (eq (nth 1 elem) 'denied) - "(denied)" + (cond + ((eq (nth 1 elem) 'denied) "(denied)") + ((eq (nth 1 elem) 'offline) "(offline)") + (t (condition-case nil (if (or (gnus-server-opened method) (eq (nth 1 elem) 'ok)) "(opened)" "(closed)") - ((error) "(error)")))) + ((error) "(error)"))))) (gnus-tmp-agent (if (and gnus-agent (member method gnus-agent-covered-methods)) @@ -481,6 +498,18 @@ The following commands are available: (gnus-server-update-server server) (gnus-server-position-point)))) +(defun gnus-server-offline-server (server) + "Set SERVER to offline." + (interactive (list (gnus-server-server-name))) + (let ((method (gnus-server-to-method server))) + (unless method + (error "No such server: %s" server)) + (prog1 + (gnus-close-server method) + (gnus-server-set-status method 'offline) + (gnus-server-update-server server) + (gnus-server-position-point)))) + (defun gnus-server-close-all-servers () "Close all servers." (interactive) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 61bec7d..acf810b 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1615,7 +1615,7 @@ newsgroup." (when (and (<= (gnus-info-level info) foreign-level) (setq active (gnus-activate-group group 'scan))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent gnus-plugged active) + (when (and gnus-agent active (gnus-online method)) (gnus-agent-save-group-info method (gnus-group-real-name group) active)) (unless (inline (gnus-virtual-group-p group)) @@ -1922,7 +1922,7 @@ newsgroup." (insert ?\\))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active gnus-plugged) + (when (and gnus-agent real-active (gnus-online method)) (gnus-agent-save-active method)) ;; If these are groups from a foreign select method, we insert the @@ -1998,7 +1998,7 @@ newsgroup." ;; Let the Gnus agent save the active file. (if (and gnus-agent real-active - gnus-plugged + (gnus-online method) (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) diff --git a/lisp/gnus.el b/lisp/gnus.el index 076002a..d3aa8e3 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1826,6 +1826,8 @@ covered by that variable." (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") +(defvar gnus-agent-covered-methods nil) + (defvar gnus-command-method nil "Dynamically bound variable that says what the current backend is.") @@ -3328,6 +3330,18 @@ Allow completion over sensible values." (t (list (intern method) ""))))) +;;; Agent functions + +(defun gnus-agent-method-p (method) + "Say whether METHOD is covered by the agent." + (member method gnus-agent-covered-methods)) + +(defun gnus-online (method) + (not + (if gnus-plugged + (eq (cadr (assoc method gnus-opened-servers)) 'offline) + (gnus-agent-method-p method)))) + ;;; User-level commands. ;;;###autoload diff --git a/lisp/mm-util.el b/lisp/mm-util.el index a6aa5b4..7c98056 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -339,7 +339,7 @@ used as the line break code type of the coding system." charset) ;; Translate invalid charsets. ((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) - (and cs (mm-coding-system-p charset) cs))) + (and cs (mm-coding-system-p cs) cs))) ;; Last resort: search the coding system list for entries which ;; have the right mime-charset in case the canonical name isn't ;; defined (though it should be). diff --git a/lisp/nnagent.el b/lisp/nnagent.el index 3d7ac9a..c77b91f 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -1,6 +1,6 @@ ;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -130,8 +130,11 @@ (deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) (let ((file (gnus-agent-article-name ".overview" group)) - (arts articles) n) + arts n) (save-excursion + (gnus-agent-load-alist group) + (setq arts (gnus-set-difference articles + (mapcar 'car gnus-agent-article-alist))) (set-buffer nntp-server-buffer) (erase-buffer) (nnheader-insert-file-contents file) @@ -147,7 +150,7 @@ "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" (car arts) (car arts))) (pop arts)) - (if (= n (car arts)) + (if (and arts (= n (car arts))) (pop arts)))) (forward-line 1)) (while (and arts)