Merge from emacs--devo--0, emacs--rel--22
[gnus] / lisp / gnus-group.el
index 0aaab33..5843214 100644 (file)
@@ -28,8 +28,8 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'cl)
-  (defvar tool-bar-mode))
+  (require 'cl))
+(defvar tool-bar-mode)
 
 (require 'gnus)
 (require 'gnus-start)
@@ -382,6 +382,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 +420,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.
@@ -1653,6 +1655,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 lists until we find a match.
     (while (and list
                (not (eval (caar list))))
@@ -2611,14 +2631,19 @@ be removed from the server, even when it's empty."
 When used interactively, GROUP is the group under point
 and NEW-NAME will be prompted for."
   (interactive
-   (list
-    (gnus-group-group-name)
-    (progn
-      (unless (gnus-check-backend-function
-              'request-rename-group (gnus-group-group-name))
-       (error "This back end does not support renaming groups"))
-      (gnus-read-group "Rename group to: "
-                      (gnus-group-real-name (gnus-group-group-name))))))
+   (let ((group (gnus-group-group-name))
+        method new-name)
+     (unless (gnus-check-backend-function 'request-rename-group group)
+       (error "This back end does not support renaming groups"))
+     (setq new-name (gnus-read-group
+                    "Rename group to: "
+                    (gnus-group-real-name (gnus-group-decoded-name group)))
+          method (gnus-info-method (gnus-get-info group)))
+     (list group (mm-encode-coding-string
+                 new-name
+                 (gnus-group-name-charset
+                  method
+                  (gnus-group-prefixed-name new-name method))))))
 
   (unless (gnus-check-backend-function 'request-rename-group group)
     (error "This back end does not support renaming groups"))
@@ -2637,29 +2662,34 @@ and NEW-NAME will be prompted for."
           (gnus-group-real-name new-name)
           (gnus-info-method (gnus-get-info group)))))
 
-  (when (gnus-active new-name)
-    (error "The group %s already exists" new-name))
+  (let ((decoded-group (gnus-group-decoded-name group))
+       (decoded-new-name (gnus-group-decoded-name new-name)))
+    (when (gnus-active new-name)
+      (error "The group %s already exists" decoded-new-name))
 
-  (gnus-message 6 "Renaming group %s to %s..." group new-name)
-  (prog1
-      (if (progn
-           (gnus-group-goto-group group)
-           (not (when (< (gnus-group-group-level) gnus-level-zombie)
-                  (gnus-request-rename-group group new-name))))
-         (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
-       ;; We rename the group internally by killing it...
-       (gnus-group-kill-group)
-       ;; ... changing its name ...
-       (setcar (cdar gnus-list-of-killed-groups) new-name)
-       ;; ... and then yanking it.  Magic!
-       (gnus-group-yank-group)
-       (gnus-set-active new-name (gnus-active group))
-       (gnus-message 6 "Renaming group %s to %s...done" group new-name)
-       new-name)
-    (setq gnus-killed-list (delete group gnus-killed-list))
-    (gnus-set-active group nil)
-    (gnus-dribble-touch)
-    (gnus-group-position-point)))
+    (gnus-message 6 "Renaming group %s to %s..."
+                 decoded-group decoded-new-name)
+    (prog1
+       (if (progn
+             (gnus-group-goto-group group)
+             (not (when (< (gnus-group-group-level) gnus-level-zombie)
+                    (gnus-request-rename-group group new-name))))
+           (gnus-error 3 "Couldn't rename group %s to %s"
+                       decoded-group decoded-new-name)
+         ;; We rename the group internally by killing it...
+         (gnus-group-kill-group)
+         ;; ... changing its name ...
+         (setcar (cdar gnus-list-of-killed-groups) new-name)
+         ;; ... and then yanking it.  Magic!
+         (gnus-group-yank-group)
+         (gnus-set-active new-name (gnus-active group))
+         (gnus-message 6 "Renaming group %s to %s...done"
+                       decoded-group decoded-new-name)
+         new-name)
+      (setq gnus-killed-list (delete group gnus-killed-list))
+      (gnus-set-active group nil)
+      (gnus-dribble-touch)
+      (gnus-group-position-point))))
 
 (defun gnus-group-edit-group (group &optional part)
   "Edit the group on the current line."
@@ -2863,8 +2893,8 @@ If SOLID (the prefix), create a solid group."
        (cons (current-buffer)
             (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
 
+(defvar nnrss-group-alist)
 (eval-when-compile
-  (defvar nnrss-group-alist)
   (defun nnrss-discover-feed (arg))
   (defun nnrss-save-server-data (arg)))
 (defun gnus-group-make-rss-group (&optional url)