*** empty log message ***
[gnus] / lisp / gnus-group.el
index fa20954..3adc20b 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 (require 'gnus-undo)
 
 (defcustom gnus-group-archive-directory
-  "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
+  "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
   "*The address of the (ding) archives."
   :group 'gnus-group-foreign
   :type 'directory)
 
 (defcustom gnus-group-recent-archive-directory
-  "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
+  "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
   "*The address of the most recent (ding) articles."
   :group 'gnus-group-foreign
   :type 'directory)
@@ -261,10 +261,13 @@ variable."
   :type 'hook)
 
 (defcustom gnus-useful-groups
-  `(("(ding) mailing list mirrored at sunsite.auc.dk"
+  '(("(ding) mailing list mirrored at sunsite.auc.dk"
      "emacs.ding"
      (nntp "sunsite.auc.dk"
-                       (nntp-address "sunsite.auc.dk")))
+          (nntp-address "sunsite.auc.dk")))
+    ("gnus-bug archive"
+     "gnus-bug"
+     (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/"))
     ("Gnus help group"
      "gnus-help"
      (nndoc "gnus-help"
@@ -275,7 +278,7 @@ variable."
                       (unless file
                         (error "Couldn't find doc group"))
                       file))))))
-  "Alist of useful group-server pairs."
+  "*Alist of useful group-server pairs."
   :group 'gnus-group-listing
   :type '(repeat (list (string :tag "Description")
                       (string :tag "Name")
@@ -316,7 +319,7 @@ variable."
      gnus-group-mail-low-empty-face)
     (t .
      gnus-group-mail-low-face))
-  "Controls the highlighting of group buffer lines.
+  "*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
@@ -708,7 +711,7 @@ ticked: The number of ticked articles."
         (fboundp 'gnus-soup-pack-packet)]
        ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
        ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
-       ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
+       ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
        ["Send a bug report" gnus-bug t]
        ["Send a mail" gnus-group-mail t]
        ["Post an article..." gnus-group-post-news t]
@@ -727,10 +730,11 @@ ticked: The number of ticked articles."
        ["Read manual" gnus-info-find-node t]
        ["Flush score cache" gnus-score-flush-cache t]
        ["Toggle topics" gnus-topic-mode t]
+       ["Send a bug report" gnus-bug t]
        ["Exit from Gnus" gnus-group-exit t]
        ["Exit without saving" gnus-group-quit t]))
 
-    (run-hooks 'gnus-group-menu-hook)))
+    (gnus-run-hooks 'gnus-group-menu-hook)))
 
 (defun gnus-group-mode ()
   "Major mode for reading news.
@@ -769,11 +773,11 @@ The following commands are available:
   (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
   (when gnus-use-undo
     (gnus-undo-mode 1))
-  (run-hooks 'gnus-group-mode-hook))
+  (gnus-run-hooks 'gnus-group-mode-hook))
 
 (defun gnus-update-group-mark-positions ()
   (save-excursion
-    (let ((gnus-process-mark 128)
+    (let ((gnus-process-mark ?\200)
          (gnus-group-marked '("dummy.group"))
          (gnus-active-hashtb (make-vector 10 0))
          (topic ""))
@@ -948,7 +952,7 @@ If REGEXP, only list groups matching REGEXP."
 
     (gnus-group-set-mode-line)
     (setq gnus-group-list-mode (cons level all))
-    (run-hooks 'gnus-group-prepare-hook)
+    (gnus-run-hooks 'gnus-group-prepare-hook)
     t))
 
 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
@@ -1090,7 +1094,7 @@ If REGEXP, only list groups matching REGEXP."
                  gnus-level ,gnus-tmp-level))
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
       (forward-line -1)
-      (run-hooks 'gnus-group-update-hook)
+      (gnus-run-hooks 'gnus-group-update-hook)
       (forward-line))
     ;; Allow XEmacs to remove front-sticky text properties.
     (gnus-group-remove-excess-properties)))
@@ -1124,7 +1128,7 @@ If REGEXP, only list groups matching REGEXP."
       (setq list (cdr list)))
     (let ((face (cdar list)))
       (unless (eq face (get-text-property beg 'face))
-       (gnus-put-text-property
+       (gnus-put-text-property-excluding-characters-with-faces
         beg end 'face
         (setq face (if (boundp face) (symbol-value face) face)))
        (gnus-extent-start-open beg)))
@@ -1163,7 +1167,7 @@ already."
            (gnus-group-insert-group-line-info group)
            (save-excursion
              (forward-line -1)
-             (run-hooks 'gnus-group-update-group-hook)))
+             (gnus-run-hooks 'gnus-group-update-group-hook)))
          (setq loc (1+ loc)))
        (unless (or found visible-only)
          ;; No such line in the buffer, find out where it's supposed to
@@ -1185,7 +1189,7 @@ already."
            (gnus-group-insert-group-line-info group)
            (save-excursion
              (forward-line -1)
-             (run-hooks 'gnus-group-update-group-hook))))
+             (gnus-run-hooks 'gnus-group-update-group-hook))))
        (when gnus-group-update-group-function
          (funcall gnus-group-update-group-function group))
        (gnus-group-set-mode-line)))
@@ -1231,7 +1235,8 @@ already."
 (defun gnus-group-group-name ()
   "Get the name of the newsgroup on the current line."
   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
-    (and group (symbol-name group))))
+    (when group
+      (symbol-name group))))
 
 (defun gnus-group-group-level ()
   "Get the level of the newsgroup on the current line."
@@ -1472,7 +1477,7 @@ and with point over the group in question."
 
 ;; Selecting groups.
 
-(defun gnus-group-read-group (&optional all no-article group)
+(defun gnus-group-read-group (&optional all no-article group select-articles)
   "Read news in this newsgroup.
 If the prefix argument ALL is non-nil, already read articles become
 readable.  IF ALL is a number, fetch this number of articles.  If the
@@ -1503,7 +1508,7 @@ group."
                                          (cdr (assq 'tick marked)))
                                  (gnus-range-length
                                   (cdr (assq 'dormant marked)))))))
-     no-article nil no-display)))
+     no-article nil no-display nil select-articles)))
 
 (defun gnus-group-select-group (&optional all)
   "Select this newsgroup.
@@ -1549,10 +1554,6 @@ be permanent."
         gnus-summary-mode-hook gnus-select-group-hook
         (group (gnus-group-group-name))
         (method (gnus-find-method-for-group group)))
-    (setq method
-         `(,(car method) ,(concat (cadr method) "-ephemeral")
-           (,(intern (format "%s-address" (car method))) ,(cadr method))
-           ,@(cddr method)))
     (gnus-group-read-ephemeral-group
      (gnus-group-prefixed-name group method) method)))
 
@@ -1570,25 +1571,23 @@ Returns whether the fetching was successful or not."
 ;; Enter a group that is not in the group buffer.  Non-nil is returned
 ;; if selection was successful.
 (defun gnus-group-read-ephemeral-group (group method &optional activate
-                                             quit-config request-only)
+                                             quit-config request-only
+                                             select-articles)
   "Read GROUP from METHOD as an ephemeral group.
 If ACTIVATE, request the group first.
 If QUIT-CONFIG, use that window configuration when exiting from the
 ephemeral group.
 If REQUEST-ONLY, don't actually read the group; just request it.
+If SELECT-ARTICLES, only select those articles.
 
 Return the name of the group is selection was successful."
   ;; Transform the select method into a unique server.
   (when (stringp method)
     (setq method (gnus-server-to-method method)))
-  (let ((saddr (intern (format "%s-address" (car method)))))
-    (setq method (gnus-copy-sequence method))
-    (require (car method))
-    (when (boundp saddr)
-      (unless (assq saddr method)
-       (nconc method `((,saddr ,(cadr method))))
-       (setf (cadr method) (format "%s-%d" (cadr method)
-                                   (incf gnus-ephemeral-group-server))))))
+  (setq method
+       `(,(car method) ,(concat (cadr method) "-ephemeral")
+         (,(intern (format "%s-address" (car method))) ,(cadr method))
+         ,@(cddr method)))
   (let ((group (if (gnus-group-foreign-p group) group
                 (gnus-group-prefixed-name group method))))
     (gnus-sethash
@@ -1600,6 +1599,7 @@ Return the name of the group is selection was successful."
                                (cons gnus-summary-buffer
                                      gnus-current-window-configuration))))))
      gnus-newsrc-hashtb)
+    (push method gnus-ephemeral-servers)
     (set-buffer gnus-group-buffer)
     (unless (gnus-check-server method)
       (error "Unable to contact server: %s" (gnus-status-message method)))
@@ -1611,7 +1611,7 @@ Return the name of the group is selection was successful."
     (if request-only
        group
       (condition-case ()
-         (when (gnus-group-read-group t t group)
+         (when (gnus-group-read-group t t group select-articles)
            group)
        ;;(error nil)
        (quit nil)))))
@@ -1786,6 +1786,8 @@ ADDRESS."
     (gnus-read-group "Group name: ")
     (gnus-read-method "From method: ")))
 
+  (when (stringp method)
+    (setq method (gnus-server-to-method method)))
   (let* ((meth (when (and method
                          (not (gnus-server-equal method gnus-select-method)))
                 (if address (list (intern method) address)
@@ -1898,6 +1900,9 @@ and NEW-NAME will be prompted for."
        (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-