*** empty log message ***
[gnus] / lisp / gnus-group.el
index e6333eb..404b9ad 100644 (file)
@@ -137,7 +137,7 @@ output may end up looking strange when listing both alive and killed
 groups.
 
 If you use %o or %O, reading the active file will be slower and quite
-a bit of extra memory will be used. %D will also worsen performance.
+a bit of extra memory will be used.  %D will also worsen performance.
 Also note that if you change the format specification to include any
 of these specs, you must probably re-start Gnus to see them go into
 effect.")
@@ -194,8 +194,94 @@ The default function `gnus-group-highlight-line' will
 highlight the line according to the `gnus-group-highlight'
 variable.")
 
+(defvar gnus-useful-groups
+  `(("(ding) mailing list mirrored at sunsite.auc.dk"
+     "emacs.ding"
+     (nntp "sunsite.auc.dk"
+                       (nntp-address "sunsite.auc.dk")))
+    ("Gnus help group"
+     "gnus-help"
+     (nndoc "gnus-help"
+           (nndoc-article-type mbox)
+           (eval `(nndoc-address 
+                   ,(let ((file (nnheader-find-etc-directory
+                                 "gnus-tut.txt" t)))
+                      (unless file
+                        (error "Couldn't find doc group"))
+                      file))))))
+  "Alist of useful group-server pairs.")
+
+(defvar gnus-group-highlight
+  (cond 
+   ((not (eq gnus-display-type 'color))
+    '((mailp . bold)
+      ((= unread 0) . italic)))
+   ((eq gnus-background-mode 'dark)
+    `(((and (not mailp) (eq level 1)) .
+       ,(custom-face-lookup "PaleTurquoise" nil nil t))
+      ((and (not mailp) (eq level 2)) .
+       ,(custom-face-lookup "turquoise" nil nil t))
+      ((and (not mailp) (eq level 3)) .
+       ,(custom-face-lookup "MediumTurquoise" nil nil t))
+      ((and (not mailp) (>= level 4)) .
+       ,(custom-face-lookup "DarkTurquoise" nil nil t))
+      ((and mailp (eq level 1)) .
+       ,(custom-face-lookup "aquamarine1" nil nil t))
+      ((and mailp (eq level 2)) .
+       ,(custom-face-lookup "aquamarine2" nil nil t))
+      ((and mailp (eq level 3)) .
+       ,(custom-face-lookup "aquamarine3" nil nil t))
+      ((and mailp (>= level 4)) .
+       ,(custom-face-lookup "aquamarine4" nil nil t))
+      ))
+   (t
+    `(((and (not mailp) (<= level 3)) .
+       ,(custom-face-lookup "ForestGreen" nil nil t))
+      ((and (not mailp) (eq level 4)) .
+       ,(custom-face-lookup "DarkGreen" nil nil t))
+      ((and (not mailp) (eq level 5)) .
+       ,(custom-face-lookup "CadetBlue4" nil nil t))
+      ((and mailp (eq level 1)) .
+       ,(custom-face-lookup "DeepPink3" nil nil t))
+      ((and mailp (eq level 2)) .
+       ,(custom-face-lookup "HotPink3" nil nil t))
+      ((and mailp (eq level 3)) .
+       ,(custom-face-lookup "dark magenta" nil nil t))
+      ((and mailp (eq level 4)) .
+       ,(custom-face-lookup "DeepPink4" nil nil t))
+      ((and mailp (> level 4)) .
+       ,(custom-face-lookup "DarkOrchid4" nil nil t))
+      )))
+  "Controls the highlighting of group buffer lines. 
+
+Below is a list of `Form'/`Face' pairs.  When deciding how a a
+particular group line should be displayed, each form is
+evaluated.  The content of the face field after the first true form is
+used.  You can change how those group lines are displayed by
+editing the face field.  
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions.  Hopefully this will
+change in a future release.  For now, you can use the following
+variables in the Lisp expression:
+
+group: The name of the group.
+unread: The number of unread articles in the group.
+method: The select method used.
+mailp: Whether it's a mail group or not.
+level: The level of the group.
+score: The score of the group.
+ticked: The number of ticked articles.")
+
+
 ;;; Internal variables
 
+(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
+  "Function for sorting the group buffer.")
+
+(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
+  "Function for sorting the selected groups in the group buffer.")
+
 (defvar gnus-group-indentation-function nil)
 (defvar gnus-goto-missing-group-function nil)
 (defvar gnus-group-update-group-function nil)
@@ -335,6 +421,7 @@ variable.")
   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
     "d" gnus-group-make-directory-group
     "h" gnus-group-make-help-group
+    "u" gnus-group-make-useful-group
     "a" gnus-group-make-archive-group
     "k" gnus-group-make-kiboze-group
     "m" gnus-group-make-group
@@ -366,6 +453,15 @@ variable.")
     "r" gnus-group-sort-groups-by-rank
     "m" gnus-group-sort-groups-by-method)
 
+  (gnus-define-keys (gnus-group-sort-map "P" gnus-group-group-map)
+    "s" gnus-group-sort-selected-groups
+    "a" gnus-group-sort-selected-groups-by-alphabet
+    "u" gnus-group-sort-selected-groups-by-unread
+    "l" gnus-group-sort-selected-groups-by-level
+    "v" gnus-group-sort-selected-groups-by-score
+    "r" gnus-group-sort-selected-groups-by-rank
+    "m" gnus-group-sort-selected-groups-by-method)
+
   (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
     "k" gnus-group-list-killed
     "z" gnus-group-list-zombies
@@ -446,19 +542,27 @@ variable.")
        ["List all groups matching..." gnus-group-list-all-matching t]
        ["List active file" gnus-group-list-active t])
        ("Sort"
-       ["Default sort" gnus-group-sort-groups
+       ["Default sort" gnus-group-sort-groups t]
+       ["Sort by method" gnus-group-sort-groups-by-method t]
+       ["Sort by rank" gnus-group-sort-groups-by-rank t]
+       ["Sort by score" gnus-group-sort-groups-by-score t]
+       ["Sort by level" gnus-group-sort-groups-by-level t]
+       ["Sort by unread" gnus-group-sort-groups-by-unread t]
+       ["Sort by name" gnus-group-sort-groups-by-alphabet t])
+       ("Sort process/prefixed"
+       ["Default sort" gnus-group-sort-selected-groups
         (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-       ["Sort by method" gnus-group-sort-groups-by-method
+       ["Sort by method" gnus-group-sort-selected-groups-by-method
         (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-       ["Sort by rank" gnus-group-sort-groups-by-rank
+       ["Sort by rank" gnus-group-sort-selected-groups-by-rank
         (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-       ["Sort by score" gnus-group-sort-groups-by-score
+       ["Sort by score" gnus-group-sort-selected-groups-by-score
         (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-       ["Sort by level" gnus-group-sort-groups-by-level
+       ["Sort by level" gnus-group-sort-selected-groups-by-level
         (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-       ["Sort by unread" gnus-group-sort-groups-by-unread
+       ["Sort by unread" gnus-group-sort-selected-groups-by-unread
         (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-       ["Sort by name" gnus-group-sort-groups-by-alphabet
+       ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
         (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
        ("Mark"
        ["Mark group" gnus-group-mark-group
@@ -509,7 +613,7 @@ variable.")
        ["Previous unread" gnus-group-prev-unread-group t]
        ["Next unread same level" gnus-group-next-unread-group-same-level t]
        ["Previous unread same level"
-        gnus-group-previous-unread-group-same-level t]
+        gnus-group-prev-unread-group-same-level t]
        ["Jump to group" gnus-group-jump-to-group t]
        ["First unread group" gnus-group-first-unread-group t]
        ["Best unread group" gnus-group-best-unread-group t])
@@ -524,7 +628,6 @@ variable.")
        ["Send a bug report" gnus-bug t]
        ["Send a mail" gnus-group-mail t]
        ["Post an article..." gnus-group-post-news t]
-       ["Customize score file" gnus-score-customize t]
        ["Check for new news" gnus-group-get-new-news t]     
        ["Activate all groups" gnus-activate-all-groups t]
        ["Delete bogus groups" gnus-group-check-bogus-groups t]
@@ -660,7 +763,7 @@ listed."
          unread (cdr gnus-group-list-mode)))
   (setq level (gnus-group-default-level level))
   (gnus-group-setup-buffer)            ;May call from out of group buffer
-  (gnus-update-format-specifications)
+  (gnus-update-format-specifications nil 'group 'group-mode)
   (let ((case-fold-search nil)
        (props (text-properties-at (gnus-point-at-bol)))
        (group (gnus-group-group-name)))
@@ -885,12 +988,12 @@ If REGEXP, only list groups matching REGEXP."
        ;; Insert the text.
        (eval gnus-group-line-format-spec))
      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
-       gnus-unread ,(if (numberp number)
-                       (string-to-int gnus-tmp-number-of-unread)
-                     t)
-       gnus-marked ,gnus-tmp-marked-mark
-       gnus-indentation ,gnus-group-indentation
-       gnus-level ,gnus-tmp-level))
+                 gnus-unread ,(if (numberp number)
+                                  (string-to-int gnus-tmp-number-of-unread)
+                                t)
+                 gnus-marked ,gnus-tmp-marked-mark
+                 gnus-indentation ,gnus-group-indentation
+                 gnus-level ,gnus-tmp-level))
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
       (forward-line -1)
       (run-hooks 'gnus-group-update-hook)
@@ -1177,7 +1280,7 @@ Return nil if the group isn't displayed."
     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
 
 (defun gnus-group-universal-argument (arg &optional groups func)
-  "Perform any command on all groups accoring to the process/prefix convention."
+  "Perform any command on all groups according to the process/prefix convention."
   (interactive "P")
   (let ((groups (or groups (gnus-group-process-prefix arg)))
        func)
@@ -1367,7 +1470,7 @@ Return the name of the group is selection was successful."
          (goto-char b)
        ;; ... or insert the line.
        (or
-        t ;; Don't activate group.
+        t;; Don't activate group.
         (gnus-active group)
         (gnus-activate-group group)
         (error "%s error: %s" group (gnus-status-message group)))
@@ -1584,7 +1687,7 @@ doing the deletion."
                (format
                 "Do you really want to delete %s%s? "
                 group (if force " and all its contents" ""))))
-         () ; Whew!
+         ()                            ; Whew!
        (gnus-message 6 "Deleting group %s..." group)
        (if (not (gnus-request-delete-group group force))
            (gnus-error 3 "Couldn't delete group %s" group)
@@ -1715,6 +1818,18 @@ and NEW-NAME will be prompted for."
     (gnus-group-update-group (or new-group group))
     (gnus-group-position-point)))
 
+(defun gnus-group-make-useful-group (group method)
+  (interactive
+   (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
+                                       nil t)
+                      gnus-useful-groups)))
+     (list (cadr entry) (caddr entry))))
+  (setq method (gnus-copy-sequence method))
+  (let (entry)
+    (while (setq entry (memq (assq 'eval method) method))
+      (setcar entry (eval (cadar entry)))))
+  (gnus-group-make-group group method))
+
 (defun gnus-group-make-help-group ()
   "Create the Gnus documentation group."
   (interactive)
@@ -1742,7 +1857,7 @@ and NEW-NAME will be prompted for."
          char found)
       (while (not found)
        (message
-        "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
+        "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: "
         err)
        (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
                          ((= char ?b) 'babyl)
@@ -1917,27 +2032,23 @@ score file entries for articles to include in the group."
 (defun gnus-group-sort-groups (func &optional reverse)
   "Sort the group buffer according to FUNC.
 If REVERSE, reverse the sorting order."
-  (interactive (list gnus-group-sort-function
-                    current-prefix-arg))
-  (let ((func (cond 
-              ((not (listp func)) func)
-              ((null func) func)
-              ((= 1 (length func)) (car func))
-              (t `(lambda (t1 t2)
-                    ,(gnus-make-sort-function 
-                      (reverse func)))))))
-    ;; We peel off the dummy group from the alist.
-    (when func
-      (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
-       (pop gnus-newsrc-alist))
-      ;; Do the sorting.
-      (setq gnus-newsrc-alist
-           (sort gnus-newsrc-alist func))
-      (when reverse
-       (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
-      ;; Regenerate the hash table.
-      (gnus-make-hashtable-from-newsrc-alist)
-      (gnus-group-list-groups))))
+  (interactive (list gnus-group-sort-function current-prefix-arg))
+  (funcall gnus-group-sort-alist-function
+          (gnus-make-sort-function func) reverse)
+  (gnus-group-list-groups))
+
+(defun gnus-group-sort-flat (func reverse)
+  ;; We peel off the dummy group from the alist.
+  (when func
+    (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
+      (pop gnus-newsrc-alist))
+    ;; Do the sorting.
+    (setq gnus-newsrc-alist
+         (sort gnus-newsrc-alist func))
+    (when reverse
+      (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
+    ;; Regenerate the hash table.
+    (gnus-make-hashtable-from-newsrc-alist)))
 
 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
   "Sort the group buffer alphabetically by group name.
@@ -1975,6 +2086,77 @@ If REVERSE, sort in reverse order."
   (interactive "P")
   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
 
+;;; Selected group sorting.
+
+(defun gnus-group-sort-selected-groups (n func &optional reverse)
+  "Sort the process/prefixed groups."
+  (interactive (list current-prefix-arg gnus-group-sort-function))
+  (let ((groups (gnus-group-process-prefix n)))
+    (funcall gnus-group-sort-selected-function
+            groups (gnus-make-sort-function func) reverse)
+    (gnus-group-list-groups)))
+
+(defun gnus-group-sort-selected-flat (groups func reverse)
+  (let (entries infos)
+    ;; First find all the group entries for these groups.
+    (while groups
+      (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb))
+           entries))
+    ;; Then sort the infos.
+    (setq infos
+         (sort
+          (mapcar
+           (lambda (entry) (car entry))
+           (setq entries (nreverse entries)))
+          func))
+    (when reverse
+      (setq infos (nreverse infos)))
+    ;; Go through all the infos and replace the old entries
+    ;; with the new infos.
+    (while infos
+      (setcar entries (pop infos))
+      (pop entries))
+    ;; Update the hashtable.
+    (gnus-make-hashtable-from-newsrc-alist)))
+
+(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse)
+  "Sort the group buffer alphabetically by group name.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-group-sort-selected-groups-by-unread (&optional reverse)
+  "Sort the group buffer by number of unread articles.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-group-sort-selected-groups-by-level (&optional reverse)
+  "Sort the group buffer by group level.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-group-sort-selected-groups-by-score (&optional reverse)
+  "Sort the group buffer by group score.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-group-sort-selected-groups-by-rank (&optional reverse)
+  "Sort the group buffer by group rank.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-group-sort-selected-groups-by-method (&optional reverse)
+  "Sort the group buffer alphabetically by backend name.
+If REVERSE, sort in reverse order."
+  (interactive "P")
+  (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse))
+
+;;; Sorting predicates.
+
 (defun gnus-group-sort-by-alphabet (info1 info2)
   "Sort alphabetically."
   (string< (gnus-info-group info1) (gnus-info-group info2)))
@@ -2146,7 +2328,7 @@ or nil if no action could be taken."
             expirable
             (gnus-compress-sequence
              (if expiry-wait
-                 ;; We set the expiry variables to the groupp
+                 ;; We set the expiry variables to the group
                  ;; parameter. 
                  (let ((nnmail-expiry-wait-function nil)
                        (nnmail-expiry-wait expiry-wait))
@@ -2317,8 +2499,8 @@ of groups killed."
                     (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
            (gnus-undo-register
              `(progn
-               (gnus-group-goto-group ,(gnus-group-group-name))
-               (gnus-group-yank-group)))
+                (gnus-group-goto-group ,(gnus-group-group-name))
+                (gnus-group-yank-group)))
            (push (cons (car entry) (nth 2 entry))
                  gnus-list-of-killed-groups))
          (gnus-group-change-level
@@ -2373,7 +2555,7 @@ is returned."
       (gnus-group-insert-group-line-info group)
       (gnus-undo-register
        `(when (gnus-group-goto-group ,group)
-         (gnus-group-kill-group 1))))
+          (gnus-group-kill-group 1))))
     (forward-line -1)
     (gnus-group-position-point)
     (if (< (length out) 2) (car out) (nreverse out))))
@@ -2482,6 +2664,11 @@ re-scanning.  If ARG is non-nil and not a number, this will force
 \"hard\" re-reading of the active files from all servers."
   (interactive "P")
   (run-hooks 'gnus-get-new-news-hook)
+
+  ;; Read any slave files.
+  (unless gnus-slave
+    (gnus-master-read-slave-newsrc))
+
   ;; We might read in new NoCeM messages here.
   (when (and gnus-use-nocem 
             (null arg))
@@ -2576,8 +2763,8 @@ to use."
             (setq desc (gnus-group-get-description group))
             (gnus-read-descriptions-file method))
         (gnus-message 1
-         (or desc (gnus-gethash group gnus-description-hashtb)
-             "No description available")))))
+                      (or desc (gnus-gethash group gnus-description-hashtb)
+                          "No description available")))))
 
 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
 (defun gnus-group-describe-all-groups (&optional force)