Fix my last change.

[gnus] / lisp / gnus.el

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 27ae6ea..ea3723e 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -32,8 +32,6 @@
 (eval-when-compile (require 'cl))
 (require 'mm-util)
 
-(require 'message)
-
 (defgroup gnus nil
   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
   :group 'news
@@ -280,6 +278,8 @@ be set in `.emacs' instead."
   (defalias 'gnus-delete-overlay 'delete-overlay)
   (defalias 'gnus-overlay-put 'overlay-put)
   (defalias 'gnus-move-overlay 'move-overlay)
+  (defalias 'gnus-overlay-buffer 'overlay-buffer)
+  (defalias 'gnus-overlay-start 'overlay-start)
   (defalias 'gnus-overlay-end 'overlay-end)
   (defalias 'gnus-extent-detached-p 'ignore)
   (defalias 'gnus-extent-start-open 'ignore)
@@ -290,7 +290,28 @@ be set in `.emacs' instead."
   (defalias 'gnus-character-to-event 'identity)
   (defalias 'gnus-add-text-properties 'add-text-properties)
   (defalias 'gnus-put-text-property 'put-text-property)
-  (defalias 'gnus-mode-line-buffer-identification 'identity)
+  (defvar gnus-mode-line-image-cache t)
+  (if (fboundp 'find-image)
+      (defun gnus-mode-line-buffer-identification (line)
+       (let ((str (car-safe line)))
+         (if (and (stringp str)
+                  (string-match "^Gnus:" str))
+             (progn (add-text-properties
+                     0 5
+                     (list 'display
+                           (if (eq t gnus-mode-line-image-cache)
+                               (setq gnus-mode-line-image-cache
+                                     (find-image
+                                      '((:type xpm :file "gnus-pointer.xpm"
+                                               :ascent 80)
+                                        (:type xbm :file "gnus-pointer.xbm"
+                                               :ascent 80))))
+                             gnus-mode-line-image-cache)
+                           'help-echo "This is Gnus")
+                     str)
+                    (list str))
+           line)))
+    (defalias 'gnus-mode-line-buffer-identification 'identity))
   (defalias 'gnus-characterp 'numberp)
   (defalias 'gnus-deactivate-mark 'deactivate-mark)
   (defalias 'gnus-window-edges 'window-edges)
@@ -748,21 +769,24 @@ be set in `.emacs' instead."
   ;; Insert the message.
   (erase-buffer)
   (cond
-   ((and (fboundp 'find-image)
-        (display-graphic-p)
-        (let ((image (find-image '((:type xpm :file "gnus.xpm")
-                                   (:type xbm :file "gnus.xbm")))))
-          (when image
-            (newline)                  ; Have somewhere for cursor to
-                                       ; go, not stretched over image.
-            (insert-image image)
-            (goto-char (point-min))
-            (while (not (eobp))
-              (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
-                                   ?\ ))
-              (forward-line 1))
-            (setq gnus-simple-splash nil)
-            t))))
+   ((and
+     (fboundp 'find-image)
+     (display-graphic-p)
+     (let ((image (find-image
+                  `((:type xpm :file "gnus.xpm")
+                    (:type xbm :file "gnus.xbm"
+                           ;; Account for the xbm's blackground.
+                           :background ,(face-foreground 'gnus-splash-face)
+                           :foreground ,(face-background 'default))))))
+       (when image
+        (let ((size (image-size image)))
+          (insert-char ?\n (max 0 (round (- (window-height)
+                                            (or y (cdr size)) 1) 2)))
+          (insert-char ?\  (max 0 (round (- (window-width)
+                                            (or x (car size))) 2)))
+          (insert-image image))
+        (setq gnus-simple-splash nil)
+        t))))
    (t
     (insert
      (format "              %s
@@ -811,7 +835,6 @@ be set in `.emacs' instead."
 
 ;;; Do the rest.
 
-(require 'custom)
 (require 'gnus-util)
 (require 'nnheader)
 
@@ -915,13 +938,16 @@ see the manual for details."
   :type 'gnus-select-method)
 
 (defcustom gnus-message-archive-method
-  `(nnfolder
-    "archive"
-    (nnfolder-directory ,(nnheader-concat message-directory "archive"))
-    (nnfolder-active-file
-     ,(nnheader-concat message-directory "archive/active"))
-    (nnfolder-get-new-mail nil)
-    (nnfolder-inhibit-expiry t))
+  (progn
+    ;; Don't require it at top level to avoid circularity.
+    (require 'message)
+    `(nnfolder
+      "archive"
+      (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+      (nnfolder-active-file
+       ,(nnheader-concat message-directory "archive/active"))
+      (nnfolder-get-new-mail nil)
+      (nnfolder-inhibit-expiry t)))
   "*Method used for archiving messages you've sent.
 This should be a mail method.
 
@@ -1477,6 +1503,7 @@ If nil, no default charset is assumed when posting."
 \f
 ;;; Internal variables
 
+(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
 (defvar gnus-original-article-buffer " *Original Article*")
@@ -1486,6 +1513,9 @@ If nil, no default charset is assumed when posting."
 (defvar gnus-agent nil
   "Whether we want to use the Gnus agent or not.")
 
+(defvar gnus-agent-fetching nil
+  "Whether Gnus agent is in fetching mode.")
+
 (defvar gnus-command-method nil
   "Dynamically bound variable that says what the current backend is.")
 
@@ -2642,9 +2672,21 @@ just the host name."
                group (substring group (+ 1 colon))))
        (setq foreign (concat foreign ":")))
       ;; Collapse group name leaving LEVELS uncollapsed elements
-      (let* ((glist (split-string group "\\."))
-            (glen (length glist))
+      (let* ((slist (split-string group "/"))
+            (slen (length slist))
+            (dlist (split-string group "\\."))
+            (dlen (length dlist))
+            glist
+            glen
+            gsep
             res)
+       (if (> slen dlen)
+           (setq glist slist
+                 glen slen
+                 gsep "/")
+         (setq glist dlist
+               glen dlen
+               gsep "."))
        (setq levels (- glen levels))
        (dolist (g glist)
          (push (if (>= (decf levels) 0)
@@ -2653,7 +2695,7 @@ just the host name."
                      (substring g 0 1))
                  g)
                res))
-       (concat foreign (mapconcat 'identity (nreverse res) "."))))))
+       (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
 
 (defun gnus-narrow-to-body ()
   "Narrow to the body of an article."