2009-10-14 Reiner Steib <Reiner.Steib@gmx.de>
[gnus] / lisp / gnus-group.el
index 545df6d..4a7f068 100644 (file)
@@ -1,35 +1,37 @@
 ;;; gnus-group.el --- group mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; Code:
 
+;; For Emacs < 22.2.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-mode))
+  (require 'cl))
+(defvar tool-bar-mode)
 
 (require 'gnus)
 (require 'gnus-start)
@@ -108,6 +110,18 @@ If nil, no groups are permanently visible."
   :group 'gnus-group-listing
   :type '(choice regexp (const nil)))
 
+(defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
+  "Groups in which links in html articles are considered all safe.
+The value may be a regexp matching those groups, a list of group names,
+or nil.  This overrides `mm-w3m-safe-url-regexp' (which see).  This is
+effective only when emacs-w3m renders html articles, i.e., in the case
+`mm-text-html-renderer' is set to `w3m'."
+  :version "23.2"
+  :group 'gnus-group-various
+  :type '(choice regexp
+                (repeat :tag "List of group names" (string :tag "Group"))
+                (const nil)))
+
 (defcustom gnus-list-groups-with-ticked-articles t
   "*If non-nil, list groups that have only ticked articles.
 If nil, only list groups that have unread articles."
@@ -135,7 +149,7 @@ for the groups to be sorted.  Pre-made functions include
 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
 
-This variable can also be a list of sorting functions. In that case,
+This variable can also be a list of sorting functions.  In that case,
 the most significant sort function should be the last function in the
 list."
   :group 'gnus-group-listing
@@ -197,7 +211,7 @@ with some simple extensions.
 
 Note that this format specification is not always respected.  For
 reasons of efficiency, when listing killed groups, this specification
-is ignored altogether. If the spec is changed considerably, your
+is ignored altogether.  If the spec is changed considerably, your
 output may end up looking strange when listing both alive and killed
 groups.
 
@@ -382,6 +396,7 @@ score: The score of the group.
 ticked: The number of ticked articles."
   :group 'gnus-group-visual
   :type '(repeat (cons (sexp :tag "Form") face)))
+(put 'gnus-group-highlight 'risky-local-variable t)
 
 (defcustom gnus-new-mail-mark ?%
   "Mark used for groups with new mail."
@@ -419,6 +434,7 @@ score: The score of the group.
 ticked: The number of ticked articles."
   :group 'gnus-group-icons
   :type '(repeat (cons (sexp :tag "Form") file)))
+(put 'gnus-group-icon-list 'risky-local-variable t)
 
 (defcustom gnus-group-name-charset-method-alist nil
   "Alist of method and the charset for group names.
@@ -999,25 +1015,6 @@ simple manner.")
 
 (defvar gnus-group-tool-bar-map nil)
 
-;; Work around for Emacs not updating the tool bar, see
-; http://www.google.com/groups?as_umsgid=v9u0an3hti.fsf@marauder.physik.uni-ulm.de
-(defvar gnus-group-redraw-when-idle 2
-  "When non-nil, redraw the Group buffer frame when idle.
-Internal variable.")
-;; Don't make this customizable yet.
-
-(defun gnus-group-redraw-check ()
-  "Check if we need to redraw the frame."
-  (when (and gnus-group-redraw-when-idle
-            (not (featurep 'xemacs))
-            (boundp 'tool-bar-mode)
-            tool-bar-mode)
-    ;;(run-with-idle-timer gnus-group-redraw-when-idle
-    ;;                  nil 'redraw-frame (selected-frame))
-    (run-with-idle-timer gnus-group-redraw-when-idle
-                        nil 'force-window-update)
-    t))
-
 (defun gnus-group-tool-bar-update (&optional symbol value)
   "Update group buffer toolbar.
 Setter function for custom variables."
@@ -1029,8 +1026,9 @@ Setter function for custom variables."
     (with-current-buffer gnus-group-buffer
       (gnus-group-make-tool-bar t))))
 
-;; The default will be changed when the new icons have been checked in:
-(defcustom gnus-group-tool-bar 'gnus-group-tool-bar-retro
+(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+                                  'gnus-group-tool-bar-gnome
+                                'gnus-group-tool-bar-retro)
   "Specifies the Gnus group tool bar.
 
 It can be either a list or a symbol refering to a list.  See
@@ -1043,7 +1041,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
                 (const :tag "Retro look" gnus-group-tool-bar-retro)
                 (repeat :tag "User defined list" gmm-tool-bar-item)
                 (symbol))
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :initialize 'custom-initialize-default
   :set 'gnus-group-tool-bar-update
   :group 'gnus-group)
@@ -1052,9 +1050,11 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
   '((gnus-group-post-news "mail/compose")
     ;; Some useful agent icons?  I don't use the agent so agent users should
     ;; suggest useful commands:
-    (gnus-agent-toggle-plugged "connect" t
-                              :visible (and gnus-agent (not gnus-plugged)))
     (gnus-agent-toggle-plugged "disconnect" t
+                              :help "Gnus is currently unplugged.  Click to work online."
+                              :visible (and gnus-agent (not gnus-plugged)))
+    (gnus-agent-toggle-plugged "connect" t
+                              :help "Gnus is currently plugged.  Click to work offline."
                               :visible (and gnus-agent gnus-plugged))
     ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
     ;; should have a better help text.
@@ -1065,8 +1065,12 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
                             :visible (or (not gnus-agent)
                                          gnus-plugged))
     ;; FIXME: gnus-*-read-group should have a better help text.
-    (gnus-topic-read-group "open" nil :visible gnus-topic-mode)
-    (gnus-group-read-group "open" nil :visible (not gnus-topic-mode))
+    (gnus-topic-read-group "open" nil
+                          :visible (and (boundp 'gnus-topic-mode)
+                                        gnus-topic-mode))
+    (gnus-group-read-group "open" nil
+                          :visible (not (and (boundp 'gnus-topic-mode)
+                                             gnus-topic-mode)))
     ;; (gnus-group-find-new-groups "???" nil)
     (gnus-group-save-newsrc "save")
     (gnus-group-describe-group "describe")
@@ -1074,12 +1078,13 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
     (gnus-group-prev-unread-group "left-arrow")
     (gnus-group-next-unread-group "right-arrow")
     (gnus-group-exit "exit")
+    (gmm-customize-mode "preferences" t :help "Edit mode preferences")
     (gnus-info-find-node "help"))
   "List of functions for the group tool bar (GNOME style).
 
 See `gmm-tool-bar-from-list' for the format of the list."
   :type '(repeat gmm-tool-bar-item)
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :initialize 'custom-initialize-default
   :set 'gnus-group-tool-bar-update
   :group 'gnus-group)
@@ -1098,33 +1103,25 @@ See `gmm-tool-bar-from-list' for the format of the list."
 
 See `gmm-tool-bar-from-list' for the format of the list."
   :type '(repeat gmm-tool-bar-item)
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :initialize 'custom-initialize-default
   :set 'gnus-group-tool-bar-update
   :group 'gnus-group)
 
-;; FIXME: Moving through the Group buffer (in topic mode) e.g. with C-n
-;; doesn't update the state (enabled/disabled) of the icon
-;; `gnus-group-describe-group'.  After `C-l' the state is correct.
-;; See the following report on emacs-devel
-;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
-;; From: Reiner Steib
-;; Subject: tool bar icons not updated according to :active condition
-;; Newsgroups: gmane.emacs.devel
-;; Date: Mon, 23 Jan 2006 19:59:13 +0100
-;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
-
 (defcustom gnus-group-tool-bar-zap-list t
   "List of icon items from the global tool bar.
 These items are not displayed in the Gnus group mode tool bar.
 
 See `gmm-tool-bar-from-list' for the format of the list."
   :type 'gmm-tool-bar-zap-list
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :initialize 'custom-initialize-default
   :set 'gnus-group-tool-bar-update
   :group 'gnus-group)
 
+(defvar image-load-path)
+(defvar tool-bar-map)
+
 (defun gnus-group-make-tool-bar (&optional force)
   "Make a group mode tool bar from `gnus-group-tool-bar'.
 When FORCE, rebuild the tool bar."
@@ -1134,15 +1131,13 @@ When FORCE, rebuild the tool bar."
             ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
             ;; Why?  --rsteib
             (or (not gnus-group-tool-bar-map) force))
-    (when gnus-group-redraw-when-idle
-      (add-to-list (make-local-variable 'post-command-hook)
-                  'gnus-group-redraw-check))
     (let* ((load-path
-           (gmm-image-load-path "gnus" "gnus/toggle-subscription.xpm"
-                                'load-path))
-          (image-load-path
-           (gmm-image-load-path "gnus" "gnus/toggle-subscription.xpm"
-                                'image-load-path))
+           (gmm-image-load-path-for-library "gnus"
+                                            "gnus/toggle-subscription.xpm"
+                                            nil t))
+           (image-load-path (cons (car load-path)
+                                  (when (boundp 'image-load-path)
+                                    image-load-path)))
           (map (gmm-tool-bar-from-list gnus-group-tool-bar
                                        gnus-group-tool-bar-zap-list
                                        'gnus-group-mode-map)))
@@ -1155,7 +1150,7 @@ When FORCE, rebuild the tool bar."
 
 All normal editing commands are switched off.
 \\<gnus-group-mode-map>
-The group buffer lists (some of) the groups available. For instance,
+The group buffer lists (some of) the groups available.  For instance,
 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
 lists all zombie groups.
 
@@ -1204,8 +1199,8 @@ The following commands are available:
       (goto-char (point-min))
       (setq gnus-group-mark-positions
            (list (cons 'process (and (search-forward
-                                      (mm-string-as-multibyte "\200") nil t)
-                                     (- (point) 2))))))))
+                                      (mm-string-to-multibyte "\200") nil t)
+                                     (- (point) (point-min) 1))))))))
 
 (defun gnus-mouse-pick-group (e)
   "Enter the group under the mouse pointer."
@@ -1240,7 +1235,10 @@ The following commands are available:
 (defun gnus-group-name-charset (method group)
   (if (null method)
       (setq method (gnus-find-method-for-group group)))
-  (let ((item (assoc method gnus-group-name-charset-method-alist))
+  (let ((item (or (assoc method gnus-group-name-charset-method-alist)
+                 (and (consp method)
+                      (assoc (list (car method) (cadr method))
+                             gnus-group-name-charset-method-alist))))
        (alist gnus-group-name-charset-group-alist)
        result)
     (if item
@@ -1520,6 +1518,36 @@ if it is a string, only list groups matching REGEXP."
                (gnus-range-difference (list active) (gnus-info-read info))
                seen))))))
 
+;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
+;; update the state (enabled/disabled) of the icon `gnus-group-describe-group'
+;; automatically.  After `C-l' the state is correct.  See the following report
+;; on emacs-devel
+;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
+;; From: Reiner Steib
+;; Subject: tool bar icons not updated according to :active condition
+;; Newsgroups: gmane.emacs.devel
+;; Date: Mon, 23 Jan 2006 19:59:13 +0100
+;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
+
+(defcustom gnus-group-update-tool-bar
+  (and (not (featurep 'xemacs))
+       (boundp 'tool-bar-mode)
+       tool-bar-mode
+       ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might
+       ;; be confusing, so maybe we shouldn't call it by default.
+       (fboundp 'force-window-update))
+  "Force updating the group buffer tool bar."
+  :group 'gnus-group
+  :version "22.1"
+  :initialize 'custom-initialize-default
+  :set (lambda (symbol value)
+        (set-default symbol value)
+        (when (gnus-alive-p)
+          (with-current-buffer gnus-group-buffer
+            ;; FIXME: Is there a better way to redraw the group buffer?
+            (gnus-group-get-new-news 0))))
+  :type 'boolean)
+
 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
                                                    gnus-tmp-marked number
                                                    gnus-tmp-method)
@@ -1584,8 +1612,10 @@ if it is a string, only list groups matching REGEXP."
          (if (member gnus-tmp-group gnus-group-marked)
              gnus-process-mark ? ))
         (buffer-read-only nil)
+        beg end
         header gnus-tmp-header)        ; passed as parameter to user-funcs.
     (beginning-of-line)
+    (setq beg (point))
     (gnus-add-text-properties
      (point)
      (prog1 (1+ (point))
@@ -1600,6 +1630,12 @@ if it is a string, only list groups matching REGEXP."
                  gnus-marked ,gnus-tmp-marked-mark
                  gnus-indentation ,gnus-group-indentation
                  gnus-level ,gnus-tmp-level))
+    (setq end (point))
+    (when gnus-group-update-tool-bar
+      (gnus-put-text-property beg end 'point-entered
+                             'gnus-tool-bar-update)
+      (gnus-put-text-property beg end 'point-left
+                             'gnus-tool-bar-update))
     (forward-line -1)
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
       (gnus-run-hooks 'gnus-group-update-hook))
@@ -1634,6 +1670,24 @@ if it is a string, only list groups matching REGEXP."
         (ticked (gnus-range-length (cdr (assq 'tick marked))))
         (group-age (gnus-group-timestamp-delta group))
         (inhibit-read-only t))
+    ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
+    ;; ======================================================================
+    ;; From: Richard Stallman
+    ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
+    ;; Cc: ding@gnus.org
+    ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
+    ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
+    ;;
+    ;; [...]
+    ;; The kludge is that the alist elements contain expressions that refer
+    ;; to local variables with short names.  Perhaps write your own tiny
+    ;; evaluator that handles just `and', `or', and numeric comparisons
+    ;; and just a few specific variables.
+    ;; ======================================================================
+    ;;
+    ;; Similar for other evaluated variables.  Grep for risky-local-variable
+    ;; to find them!  -- rsteib
+    ;;
     ;; Eval the cars of the&