projects / gnus / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
*** empty log message ***
[gnus] / lisp / gnus.el
diff --git a/lisp/gnus.el b/lisp/gnus.el
index d69a237..11230d4 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -1,5 +1,5 @@
 ;;; gnus.el --- a newsreader for GNU Emacs
 ;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -29,6 +29,7 @@
 (eval '(run-hooks 'gnus-load-hook))
 
 (eval-when-compile (require 'cl))
 (eval '(run-hooks 'gnus-load-hook))
 
 (eval-when-compile (require 'cl))
+(require 'mm-util)
 
 (require 'custom)
 (eval-and-compile
 
 (require 'custom)
 (eval-and-compile
@@ -41,6 +42,11 @@
   :group 'news
   :group 'mail)
 
   :group 'news
   :group 'mail)
 
+(defgroup gnus-charset nil
+  "Group character set issues."
+  :link '(custom-manual "(gnus)Charsets")
+  :group 'gnus)
+
 (defgroup gnus-cache nil
   "Cache interface."
   :group 'gnus)
 (defgroup gnus-cache nil
   "Cache interface."
   :group 'gnus)
@@ -254,7 +260,7 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
-(defconst gnus-version-number "0.43"
+(defconst gnus-version-number "0.89"
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
@@ -292,7 +298,6 @@ be set in `.emacs' instead."
   (defalias 'gnus-deactivate-mark 'deactivate-mark)
   (defalias 'gnus-window-edges 'window-edges)
   (defalias 'gnus-key-press-event-p 'numberp)
   (defalias 'gnus-deactivate-mark 'deactivate-mark)
   (defalias 'gnus-window-edges 'window-edges)
   (defalias 'gnus-key-press-event-p 'numberp)
-  (defalias 'gnus-annotation-in-region-p 'ignore)
   (defalias 'gnus-decode-rfc1522 'ignore))
 
 ;; We define these group faces here to avoid the display
   (defalias 'gnus-decode-rfc1522 'ignore))
 
 ;; We define these group faces here to avoid the display
@@ -855,17 +860,16 @@ used to 899, you would say something along these lines:
             (insert-file-contents gnus-nntpserver-file)
             (let ((name (buffer-string)))
               (prog1
             (insert-file-contents gnus-nntpserver-file)
             (let ((name (buffer-string)))
               (prog1
-                  (if (string-match "^[ \t\n]*$" name)
+                  (if (string-match "\\'[ \t\n]*$" name)
                       nil
                     name)
                 (kill-buffer (current-buffer))))))))
 
 (defcustom gnus-select-method
                       nil
                     name)
                 (kill-buffer (current-buffer))))))))
 
 (defcustom gnus-select-method
-  (condition-case nil
+  (ignore-errors
     (nconc
     (nconc
-     (list 'nntp (or (condition-case nil
-                        (gnus-getenv-nntpserver)
-                      (error nil))
+     (list 'nntp (or (ignore-errors
+                      (gnus-getenv-nntpserver))
                     (when (and gnus-default-nntp-server
                                (not (string= gnus-default-nntp-server "")))
                       gnus-default-nntp-server)
                     (when (and gnus-default-nntp-server
                                (not (string= gnus-default-nntp-server "")))
                       gnus-default-nntp-server)
@@ -873,8 +877,7 @@ used to 899, you would say something along these lines:
      (if (or (null gnus-nntp-service)
             (equal gnus-nntp-service "nntp"))
         nil
      (if (or (null gnus-nntp-service)
             (equal gnus-nntp-service "nntp"))
         nil
-       (list gnus-nntp-service)))
-    (error nil))
+       (list gnus-nntp-service))))
   "*Default method for selecting a newsgroup.
 This variable should be a list, where the first element is how the
 news is to be fetched, the second is the address.
   "*Default method for selecting a newsgroup.
 This variable should be a list, where the first element is how the
 news is to be fetched, the second is the address.
@@ -935,6 +938,7 @@ that case, just return a fully prefixed name of the group --
 \"nnml+private:mail.misc\", for instance."
   :group 'gnus-message
   :type '(choice (const :tag "none" nil)
 \"nnml+private:mail.misc\", for instance."
   :group 'gnus-message
   :type '(choice (const :tag "none" nil)
+                function
                 sexp
                 string))
 
                 sexp
                 string))
 
@@ -1150,18 +1154,13 @@ articles.  This is not a good idea."
   :group 'gnus-meta
   :type 'boolean)
 
   :group 'gnus-meta
   :type 'boolean)
 
-(defcustom gnus-use-demon nil
-  "If non-nil, Gnus might use some demons."
-  :group 'gnus-meta
-  :type 'boolean)
-
 (defcustom gnus-use-scoring t
   "*If non-nil, enable scoring."
   :group 'gnus-meta
   :type 'boolean)
 
 (defcustom gnus-use-picons nil
 (defcustom gnus-use-scoring t
   "*If non-nil, enable scoring."
   :group 'gnus-meta
   :type 'boolean)
 
 (defcustom gnus-use-picons nil
-  "*If non-nil, display picons."
+  "*If non-nil, display picons in a frame of their own."
   :group 'gnus-meta
   :type 'boolean)
 
   :group 'gnus-meta
   :type 'boolean)
 
@@ -1350,7 +1349,7 @@ following hook:
 (defcustom gnus-group-change-level-function nil
   "Function run when a group level is changed.
 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
 (defcustom gnus-group-change-level-function nil
   "Function run when a group level is changed.
 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
-  :group 'gnus-group-level
+  :group 'gnus-group-levels
   :type 'function)
 
 ;;; Face thingies.
   :type 'function)
 
 ;;; Face thingies.
@@ -1412,59 +1411,6 @@ face."
   :group 'gnus-visual
   :type 'face)
 
   :group 'gnus-visual
   :type 'face)
 
-(defcustom gnus-article-display-hook
-  (if (and (string-match "XEmacs" emacs-version)
-          (featurep 'xface))
-      '(gnus-article-hide-headers-if-wanted
-       gnus-article-hide-boring-headers
-       gnus-article-treat-overstrike
-       gnus-article-maybe-highlight
-       gnus-article-display-x-face)
-    '(gnus-article-hide-headers-if-wanted
-      gnus-article-hide-boring-headers
-      gnus-article-treat-overstrike
-      gnus-article-maybe-highlight))
-  "*Controls how the article buffer will look.
-
-If you leave the list empty, the article will appear exactly as it is
-stored on the disk.  The list entries will hide or highlight various
-parts of the article, making it easier to find the information you
-want."
-  :group 'gnus-article-highlight
-  :group 'gnus-visual
-  :type 'hook
-  :options '(gnus-article-add-buttons
-            gnus-article-add-buttons-to-head
-            gnus-article-emphasize
-            gnus-article-fill-cited-article
-            gnus-article-remove-cr
-            gnus-article-de-quoted-unreadable
-            gnus-summary-stop-page-breaking
-            ;; gnus-summary-caesar-message
-            ;; gnus-summary-verbose-headers
-            gnus-article-hide
-            gnus-article-hide-headers
-            gnus-article-hide-boring-headers
-            gnus-article-hide-signature
-            gnus-article-hide-citation
-            gnus-article-hide-pgp
-            gnus-article-hide-pem
-            gnus-article-highlight
-            gnus-article-highlight-headers
-            gnus-article-highlight-citation
-            gnus-article-highlight-signature
-            gnus-article-date-ut
-            gnus-article-date-local
-            gnus-article-date-lapsed
-            gnus-article-date-original
-            gnus-article-remove-trailing-blank-lines
-            gnus-article-strip-leading-blank-lines
-            gnus-article-strip-multiple-blank-lines
-            gnus-article-strip-blank-lines
-            gnus-article-treat-overstrike
-            gnus-article-display-x-face
-            gnus-smiley-display))
-
 (defcustom gnus-article-save-directory gnus-directory
   "*Name of the directory articles will be saved in (default \"~/News\")."
   :group 'gnus-article-saving
 (defcustom gnus-article-save-directory gnus-directory
   "*Name of the directory articles will be saved in (default \"~/News\")."
   :group 'gnus-article-saving
@@ -1473,6 +1419,23 @@ want."
 (defvar gnus-plugged t
   "Whether Gnus is plugged or not.")
 
 (defvar gnus-plugged t
   "Whether Gnus is plugged or not.")
 
+(defcustom gnus-default-charset 'iso-8859-1
+  "Default charset assumed to be used when viewing non-ASCII characters.
+This variable is overridden on a group-to-group basis by the
+gnus-group-charset-alist variable and is only used on groups not
+covered by that variable."
+  :type 'symbol
+  :group 'gnus-charset)
+
+(defcustom gnus-default-posting-charset nil
+  "Default charset assumed to be used when posting non-ASCII characters.
+This variable is overridden on a group-to-group basis by the
+gnus-group-posting-charset-alist variable and is only used on groups not
+covered by that variable.
+If nil, no default charset is assumed when posting."
+  :type 'symbol
+  :group 'gnus-charset)
+
 \f
 ;;; Internal variables
 
 \f
 ;;; Internal variables
 
@@ -1524,7 +1487,7 @@ want."
       ,(nnheader-concat gnus-cache-directory "active"))))
   "List of predefined (convenience) servers.")
 
       ,(nnheader-concat gnus-cache-directory "active"))))
   "List of predefined (convenience) servers.")
 
-(defvar gnus-topic-indentation "") ;; Obsolete variable.
+(defvar gnus-topic-indentation "");; Obsolete variable.
 
 (defconst gnus-article-mark-lists
   '((marked . tick) (replied . reply)
 
 (defconst gnus-article-mark-lists
   '((marked . tick) (replied . reply)
@@ -1648,7 +1611,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
      ("rmailout" rmail-output rmail-output-to-rmail-file)
      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
      ("rmailout" rmail-output rmail-output-to-rmail-file)
      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
-      rmail-show-message)
+      rmail-show-message rmail-summary-exists
+      rmail-select-summary rmail-update-summary)
      ("gnus-audio" :interactive t gnus-audio-play)
      ("gnus-xmas" gnus-xmas-splash)
      ("gnus-soup" :interactive t
      ("gnus-audio" :interactive t gnus-audio-play)
      ("gnus-xmas" gnus-xmas-splash)
      ("gnus-soup" :interactive t
@@ -1735,6 +1699,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
      ("gnus-picon" :interactive t gnus-article-display-picons
       gnus-group-display-picons gnus-picons-article-display-x-face
       gnus-picons-display-x-face)
      ("gnus-picon" :interactive t gnus-article-display-picons
       gnus-group-display-picons gnus-picons-article-display-x-face
       gnus-picons-display-x-face)
+     ("gnus-picon" gnus-picons-buffer-name)
      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
       gnus-grouplens-mode)
      ("smiley" :interactive t gnus-smiley-display)
      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
       gnus-grouplens-mode)
      ("smiley" :interactive t gnus-smiley-display)
@@ -1750,8 +1715,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
       gnus-group-setup-buffer gnus-group-get-new-news
       gnus-group-make-help-group gnus-group-update-group
       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
       gnus-group-setup-buffer gnus-group-get-new-news
       gnus-group-make-help-group gnus-group-update-group
-      gnus-clear-inboxes-moved gnus-group-iterate
-      gnus-group-group-name)
+      gnus-group-iterate gnus-group-group-name)
      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
       gnus-backlog-remove-article)
      ("gnus-art" gnus-article-read-summary-keys gnus-article-save
      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
       gnus-backlog-remove-article)
      ("gnus-art" gnus-article-read-summary-keys gnus-article-save
@@ -1759,10 +1723,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-article-next-page gnus-article-prev-page
       gnus-request-article-this-buffer gnus-article-mode
       gnus-article-setup-buffer gnus-narrow-to-page
       gnus-article-next-page gnus-article-prev-page
       gnus-request-article-this-buffer gnus-article-mode
       gnus-article-setup-buffer gnus-narrow-to-page
-      gnus-article-delete-invisible-text)
+      gnus-article-delete-invisible-text gnus-treat-article)
      ("gnus-art" :interactive t
       gnus-article-hide-headers gnus-article-hide-boring-headers
      ("gnus-art" :interactive t
       gnus-article-hide-headers gnus-article-hide-boring-headers
-      gnus-article-treat-overstrike gnus-article-word-wrap
+      gnus-article-treat-overstrike 
       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
       gnus-article-display-x-face gnus-article-de-quoted-unreadable
       gnus-article-hide-pgp
       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
       gnus-article-display-x-face gnus-article-de-quoted-unreadable
       gnus-article-hide-pgp
@@ -1853,7 +1817,7 @@ such area.
 The %U (status), %R (replied) and %z (zcore) specs have to be handled
 with care.  For reasons of efficiency, Gnus will compute what column
 these characters will end up in, and \"hard-code\" that.  This means that
 The %U (status), %R (replied) and %z (zcore) specs have to be handled
 with care.  For reasons of efficiency, Gnus will compute what column
 these characters will end up in, and \"hard-code\" that.  This means that
-it is illegal to have these specs after a variable-length spec.         Well,
+it is invalid to have these specs after a variable-length spec.         Well,
 you might not be arrested, but your summary buffer will look strange,
 which is bad enough.
 
 you might not be arrested, but your summary buffer will look strange,
 which is bad enough.
 
@@ -2364,7 +2328,14 @@ that that variable is buffer-local to the summary buffers."
                 (not (equal server (format "%s:%s" (caaar opened)
                                            (cadaar opened)))))
        (pop opened))
                 (not (equal server (format "%s:%s" (caaar opened)
                                            (cadaar opened)))))
        (pop opened))
-     (caar 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))))
 
 (defmacro gnus-method-equal (ss1 ss2)
   "Say whether two servers are equal."
 
 (defmacro gnus-method-equal (ss1 ss2)
   "Say whether two servers are equal."
@@ -2377,6 +2348,15 @@ that that variable is buffer-local to the summary buffers."
                  (setq s1 (cdr s1)))
                (null s1))))))
 
                  (setq s1 (cdr s1)))
                (null s1))))))
 
+(defun gnus-methods-equal-p (m1 m2)
+  (let ((m1 (or m1 gnus-select-method))
+       (m2 (or m2 gnus-select-method)))
+    (or (equal m1 m2)
+       (and (eq (car m1) (car m2))
+            (or (not (memq 'address (assoc (symbol-name (car m1))
+                                           gnus-valid-select-methods)))
+                (equal (nth 1 m1) (nth 1 m2)))))))
+
 (defun gnus-server-equal (m1 m2)
   "Say whether two methods are equal."
   (let ((m1 (cond ((null m1) gnus-select-method)
 (defun gnus-server-equal (m1 m2)
   "Say whether two methods are equal."
   (let ((m1 (cond ((null m1) gnus-select-method)
@@ -2458,16 +2438,32 @@ You should probably use `gnus-find-method-for-group' instead."
            possible
            (list backend server))))))
 
            possible
            (list backend server))))))
 
+(defsubst gnus-native-method-p (method)
+  "Return whether METHOD is the native select method."
+  (gnus-method-equal method gnus-select-method))
+
 (defsubst gnus-secondary-method-p (method)
   "Return whether METHOD is a secondary select method."
   (let ((methods gnus-secondary-select-methods)
        (gmethod (gnus-server-get-method nil method)))
     (while (and methods
 (defsubst gnus-secondary-method-p (method)
   "Return whether METHOD is a secondary select method."
   (let ((methods gnus-secondary-select-methods)
        (gmethod (gnus-server-get-method nil method)))
     (while (and methods
-               (not (equal (gnus-server-get-method nil (car methods))
-                           gmethod)))
+               (not (gnus-method-equal
+                     (gnus-server-get-method nil (car methods))
+                     gmethod)))
       (setq methods (cdr methods)))
     methods))
 
       (setq methods (cdr methods)))
     methods))
 
+(defun gnus-method-simplify (method)
+  "Return the shortest uniquely identifying string or method for METHOD."
+  (cond ((stringp method)
+        method)
+       ((gnus-native-method-p method)
+        nil)
+       ((gnus-secondary-method-p method)
+        (format "%s:%s" (nth 0 method) (nth 1 method)))
+       (t
+        method)))
+
 (defun gnus-groups-from-server (server)
   "Return a list of all groups that are fetched from SERVER."
   (let ((alist (cdr gnus-newsrc-alist))
 (defun gnus-groups-from-server (server)
   "Return a list of all groups that are fetched from SERVER."
   (let ((alist (cdr gnus-newsrc-alist))
@@ -2567,7 +2563,6 @@ If SCORE is nil, add 1 to the score of GROUP."
     (when info
       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
 
     (when info
       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
 
-;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
 (defun gnus-short-group-name (group &optional levels)
   "Collapse GROUP name LEVELS.
 Select methods are stripped and any remote host name is stripped down to
 (defun gnus-short-group-name (group &optional levels)
   "Collapse GROUP name LEVELS.
 Select methods are stripped and any remote host name is stripped down to
@@ -2577,6 +2572,7 @@ just the host name."
         (depth 0)
         (skip 1)
         (levels (or levels
         (depth 0)
         (skip 1)
         (levels (or levels
+                    gnus-group-uncollapsed-levels
                     (progn
                       (while (string-match "\\." group skip)
                         (setq skip (match-end 0)
                     (progn
                       (while (string-match "\\." group skip)
                         (setq skip (match-end 0)
@@ -2684,6 +2680,7 @@ If NEWSGROUP is nil, return the global kill file name instead."
   (let ((opened gnus-opened-servers))
     (while (and method opened)
       (when (and (equal (cadr method) (cadaar opened))
   (let ((opened gnus-opened-servers))
     (while (and method opened)
       (when (and (equal (cadr method) (cadaar opened))
+                (equal (car method) (caaar opened))
                 (not (equal method (caar opened))))
        (setq method nil))
       (pop opened))
                 (not (equal method (caar opened))))
        (setq method nil))
       (pop opened))
@@ -2752,7 +2749,7 @@ If NEWSGROUP is nil, return the global kill file name instead."
 
 (defun gnus-read-group (prompt &optional default)
   "Prompt the user for a group name.
 
 (defun gnus-read-group (prompt &optional default)
   "Prompt the user for a group name.
-Disallow illegal group names."
+Disallow invalid group names."
   (let ((prefix "")
        group)
     (while (not group)
   (let ((prefix "")
        group)
     (while (not group)
@@ -2761,7 +2758,7 @@ Disallow illegal group names."
             (setq group (read-string (concat prefix prompt)
                                      (cons (or default "") 0)
                                      'gnus-group-history)))
             (setq group (read-string (concat prefix prompt)
                                      (cons (or default "") 0)
                                      'gnus-group-history)))
-       (setq prefix (format "Illegal group name: \"%s\".  " group)
+       (setq prefix (format "Invalid group name: \"%s\".  " group)
              group nil)))
     group))
 
              group nil)))
     group))
 
@@ -2822,8 +2819,6 @@ As opposed to `gnus', this command will not connect to the local server."
   (let ((window (get-buffer-window gnus-group-buffer)))
     (cond (window
           (select-frame (window-frame window)))
   (let ((window (get-buffer-window gnus-group-buffer)))
     (cond (window
           (select-frame (window-frame window)))
-         ((= (length (frame-list)) 1)
-          (select-frame (make-frame)))
          (t
           (other-frame 1))))
   (gnus arg))
          (t
           (other-frame 1))))
   (gnus arg))
Steve's SXEmacs-friendly Gnus repo