X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=3adc20bf15e0aa547881e94c6f3268c1e12b7ac7;hb=9954729d205c97242f0787c79dc23e7b051a6201;hp=e6623ba13a213ec586c0bfec2b2525ff28b07de5;hpb=3f8dcafe9860c534c8c066e6ddad362ea0aa0c7a;p=gnus

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index e6623ba13..3adc20bf1 100644
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -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.
@@ -37,13 +37,13 @@
 (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,13 +773,14 @@ 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)))
+	  (gnus-active-hashtb (make-vector 10 0))
+	  (topic ""))
       (gnus-set-active "dummy.group" '(0 . 0))
       (gnus-set-work-buffer)
       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
@@ -947,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)
@@ -1089,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)))
@@ -1112,7 +1117,7 @@ If REGEXP, only list groups matching REGEXP."
 	 (mailp (memq 'mail (assoc (symbol-name
 				    (car (or method gnus-select-method)))
 				   gnus-valid-select-methods)))
-	 (level (or (gnus-info-level info) 9))
+	 (level (or (gnus-info-level info) gnus-level-killed))
 	 (score (or (gnus-info-score info) 0))
 	 (ticked (gnus-range-length (cdr (assq 'tick marked))))
 	 (group-age (gnus-group-timestamp-delta group))
@@ -1123,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)))
@@ -1162,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
@@ -1184,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)))
@@ -1230,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."
@@ -1255,8 +1261,8 @@ already."
 (defun gnus-group-level (group)
   "Return the estimated level of GROUP."
   (or (gnus-info-level (gnus-get-info group))
-      (and (member group gnus-zombie-list) 8)
-      9))
+      (and (member group gnus-zombie-list) gnus-level-zombie)
+      gnus-level-killed))
 
 (defun gnus-group-search-forward (&optional backward all level first-too)
   "Find the next newsgroup with unread articles.
@@ -1445,6 +1451,8 @@ Take into consideration N (the prefix) and the list of marked groups."
     (let ((group (gnus-group-group-name)))
       (and group (list group))))))
 
+;;; !!!Surely gnus-group-iterate should be a macro instead?  I can't
+;;; imagine why I went through these contortions...
 (eval-and-compile
   (let ((function (make-symbol "gnus-group-iterate-function"))
 	(window (make-symbol "gnus-group-iterate-window"))
@@ -1469,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
@@ -1500,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.
@@ -1546,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)))
 
@@ -1567,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
@@ -1597,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)))
@@ -1608,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)))))
@@ -1783,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)
@@ -1895,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-active group nil)
+    (gnus-dribble-touch)
     (gnus-group-position-point)))
 
 (defun gnus-group-edit-group (group &optional part)
@@ -2476,7 +2484,7 @@ or nil if no action could be taken."
 	  (gnus-add-marked-articles group 'tick nil nil 'force)
 	  (gnus-add-marked-articles group 'dormant nil nil 'force))
 	(let ((gnus-newsgroup-name group))
-	  (run-hooks 'gnus-group-catchup-group-hook))
+	  (gnus-run-hooks 'gnus-group-catchup-group-hook))
 	num))))
 
 (defun gnus-group-expire-articles (&optional n)
@@ -2600,7 +2608,7 @@ group line."
 	  'gnus-group-history)))
   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
     (cond
-     ((string-match "^[ \t]$" group)
+     ((string-match "^[ \t]*$" group)
       (error "Empty group name"))
      (newsrc
       ;; Toggle subscription flag.
@@ -2709,7 +2717,8 @@ of groups killed."
 		(delq (assoc group gnus-newsrc-alist)
 		      gnus-newsrc-alist))
 	  (when gnus-group-change-level-function
-	    (funcall gnus-group-change-level-function group 9 3))
+	    (funcall gnus-group-change-level-function
+		     group gnus-level-killed 3))
 	  (cond
 	   ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
 	    (push (cons (car entry) (nth 2 entry))
@@ -2726,11 +2735,10 @@ of groups killed."
     (if (< (length out) 2) (car out) (nreverse out))))
 
 (defun gnus-group-yank-group (&optional arg)
-  "Yank the last newsgroups killed with \\[gnus-group-kill-group],
-inserting it before the current newsgroup.  The numeric ARG specifies
-how many newsgroups are to be yanked.  The name of the newsgroup yanked
-is returned, or (if several groups are yanked) a list of yanked groups
-is returned."
+  "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup.
+The numeric ARG specifies how many newsgroups are to be yanked.  The
+name of the newsgroup yanked is returned, or (if several groups are
+yanked) a list of yanked groups is returned."
   (interactive "p")
   (setq arg (or arg 1))
   (let (info group prev out)
@@ -2854,7 +2862,7 @@ entail asking the server for the groups."
 
 (defun gnus-activate-all-groups (level)
   "Activate absolutely all groups."
-  (interactive (list 7))
+  (interactive (list gnus-level-unsubscribed))
   (let ((gnus-activate-level level)
 	(gnus-activate-foreign-newsgroups level))
     (gnus-group-get-new-news)))
@@ -2866,7 +2874,7 @@ 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")
   (let ((gnus-inhibit-demon t))
-    (run-hooks 'gnus-get-new-news-hook)
+    (gnus-run-hooks 'gnus-get-new-news-hook)
 
     ;; Read any slave files.
     (unless gnus-slave
@@ -2893,7 +2901,7 @@ re-scanning.  If ARG is non-nil and not a number, this will force
 	  (gnus-get-unread-articles arg))
       (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
 	(gnus-get-unread-articles arg)))
-    (run-hooks 'gnus-after-getting-new-news-hook)
+    (gnus-run-hooks 'gnus-after-getting-new-news-hook)
     (gnus-group-list-groups (and (numberp arg)
 				 (max (car gnus-group-list-mode) arg)))))
 
@@ -2949,8 +2957,8 @@ to use."
       (setq dirs (list dirs)))
     (while (and (not found)
 		(setq dir (pop dirs)))
-      (setq file (concat (file-name-as-directory dir)
-			 (gnus-group-real-name group)))
+      (let ((name (gnus-group-real-name group)))
+	(setq file (concat (file-name-as-directory dir) name)))
       (if (not (file-exists-p file))
 	  (gnus-message 1 "No such file: %s" file)
 	(let ((enable-local-variables nil))
@@ -3115,10 +3123,12 @@ group."
 (defun gnus-group-find-new-groups (&optional arg)
   "Search for new groups and add them.
 Each new group will be treated with `gnus-subscribe-newsgroup-method.'
-If ARG (the prefix), use the `ask-server' method to query
-the server for new groups."
-  (interactive "P")
-  (gnus-find-new-newsgroups arg)
+With 1 C-u, use the `ask-server' method to query the server for new
+groups.
+With 2 C-u's, use most complete method possible to query the server
+for new groups, and subscribe the new groups as zombies."
+  (interactive "p")
+  (gnus-find-new-newsgroups (or arg 1))
   (gnus-group-list-groups))
   
 (defun gnus-group-edit-global-kill (&optional article group)
@@ -3148,7 +3158,7 @@ If GROUP, edit that local kill file instead."
 In fact, cleanup buffers except for group mode buffer.
 The hook gnus-suspend-gnus-hook is called before actually suspending."
   (interactive)
-  (run-hooks 'gnus-suspend-gnus-hook)
+  (gnus-run-hooks 'gnus-suspend-gnus-hook)
   ;; Kill Gnus buffers except for group mode buffer.
   (let* ((group-buf (get-buffer gnus-group-buffer))
 	 ;; Do this on a separate list in case the user does a ^G before we finish
@@ -3178,7 +3188,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
 	  (not gnus-interactive-exit)	;Without confirmation
 	  gnus-expert-user
 	  (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
-    (run-hooks 'gnus-exit-gnus-hook)
+    (gnus-run-hooks 'gnus-exit-gnus-hook)
     ;; Offer to save data from non-quitted summary buffers.
     (gnus-offer-save-summaries)
     ;; Save the newsrc file(s).
@@ -3188,7 +3198,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
     ;; Reset everything.
     (gnus-clear-system)
     ;; Allow the user to do things after cleaning up.
-    (run-hooks 'gnus-after-exiting-gnus-hook)))
+    (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
 
 (defun gnus-group-quit ()
   "Quit reading news without updating .newsrc.eld or .newsrc.
@@ -3202,14 +3212,14 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
 	    (gnus-yes-or-no-p
 	     (format "Quit reading news without saving %s? "
 		     (file-name-nondirectory gnus-current-startup-file))))
-    (run-hooks 'gnus-exit-gnus-hook)
+    (gnus-run-hooks 'gnus-exit-gnus-hook)
     (gnus-configure-windows 'group t)
     (gnus-dribble-save)
     (gnus-close-backends)
     (gnus-clear-system)
     (gnus-kill-buffer gnus-group-buffer)
     ;; Allow the user to do things after cleaning up.
-    (run-hooks 'gnus-after-exiting-gnus-hook)))
+    (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
 
 (defun gnus-group-describe-briefly ()
   "Give a one line description of the group mode commands."
@@ -3322,7 +3332,7 @@ and the second element is the address."
 	(if force
 	    (if (null articles)
 		(setcar (nthcdr 3 info)
-			(delq (assq type (car marked)) (car marked)))
+			(gnus-delete-alist type (car marked)))
 	      (setcdr m (gnus-compress-sequence articles t)))
 	  (setcdr m (gnus-compress-sequence
 		     (sort (nconc (gnus-uncompress-range (cdr m))
@@ -3343,7 +3353,7 @@ or `gnus-group-catchup-group-hook'."
 
 (defsubst gnus-group-timestamp (group)
   "Return the timestamp for GROUP."
-  (gnus-group-get-parameter group 'timestamp))
+  (gnus-group-get-parameter group 'timestamp t))
 
 (defun gnus-group-timestamp-delta (group)
   "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."