Synch with Oort Gnus.
authoryamaoka <yamaoka>
Fri, 11 Jan 2002 03:56:03 +0000 (03:56 +0000)
committeryamaoka <yamaoka>
Fri, 11 Jan 2002 03:56:03 +0000 (03:56 +0000)
lisp/ChangeLog
lisp/Makefile.in
lisp/gnus-agent.el
lisp/gnus-int.el
lisp/gnus-srvr.el
lisp/gnus-start.el
lisp/gnus.el
lisp/mm-util.el
lisp/nnagent.el

index 5cbef65..7afb59b 100644 (file)
@@ -1,5 +1,36 @@
 2002-01-10  ShengHuo ZHU  <zsh@cs.rochester.edu>
 
+       * mm-util.el (mm-charset-to-coding-system): Change charset to cs.
+       From: Torsten Hilbrich <email@myrkr.in-berlin.de>
+
+       * 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  <zsh@cs.rochester.edu>
+
        * nnkiboze.el (nnkiboze-request-article): Use
        gnus-agent-request-article.
 
index e6112f8..ca38edb 100644 (file)
@@ -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..."; \
index e96308e..80f70dc 100644 (file)
@@ -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."
 
 \f
 
-(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))
index f1dec1a..cf9b67e 100644 (file)
@@ -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 <larsi@gnus.org>
   :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
index 6222153..9d6b543 100644 (file)
@@ -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)
index 61bec7d..acf810b 100644 (file)
@@ -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)
index 076002a..d3aa8e3 100644 (file)
@@ -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
index a6aa5b4..7c98056 100644 (file)
@@ -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).
index 3d7ac9a..c77b91f 100644 (file)
@@ -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 <larsi@gnus.org>
 
 (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)
                     "%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)