Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-group.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents 1917ad0d78d7
children e04119814345
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
263 (nntp-address "sunsite.auc.dk"))) 263 (nntp-address "sunsite.auc.dk")))
264 ("Gnus help group" 264 ("Gnus help group"
265 "gnus-help" 265 "gnus-help"
266 (nndoc "gnus-help" 266 (nndoc "gnus-help"
267 (nndoc-article-type mbox) 267 (nndoc-article-type mbox)
268 (eval `(nndoc-address 268 (eval `(nndoc-address
269 ,(let ((file (nnheader-find-etc-directory 269 ,(let ((file (nnheader-find-etc-directory
270 "gnus-tut.txt" t))) 270 "gnus-tut.txt" t)))
271 (unless file 271 (unless file
272 (error "Couldn't find doc group")) 272 (error "Couldn't find doc group"))
273 file)))))) 273 file))))))
310 gnus-group-mail-3-face) 310 gnus-group-mail-3-face)
311 ((= unread 0) . 311 ((= unread 0) .
312 gnus-group-mail-low-empty-face) 312 gnus-group-mail-low-empty-face)
313 (t . 313 (t .
314 gnus-group-mail-low-face)) 314 gnus-group-mail-low-face))
315 "Controls the highlighting of group buffer lines. 315 "Controls the highlighting of group buffer lines.
316 316
317 Below is a list of `Form'/`Face' pairs. When deciding how a a 317 Below is a list of `Form'/`Face' pairs. When deciding how a a
318 particular group line should be displayed, each form is 318 particular group line should be displayed, each form is
319 evaluated. The content of the face field after the first true form is 319 evaluated. The content of the face field after the first true form is
320 used. You can change how those group lines are displayed by 320 used. You can change how those group lines are displayed by
321 editing the face field. 321 editing the face field.
322 322
323 It is also possible to change and add form fields, but currently that 323 It is also possible to change and add form fields, but currently that
324 requires an understanding of Lisp expressions. Hopefully this will 324 requires an understanding of Lisp expressions. Hopefully this will
325 change in a future release. For now, you can use the following 325 change in a future release. For now, you can use the following
326 variables in the Lisp expression: 326 variables in the Lisp expression:
601 (gnus-group-group-name)] 601 (gnus-group-group-name)]
602 ["Info" gnus-group-edit-group (gnus-group-group-name)] 602 ["Info" gnus-group-edit-group (gnus-group-group-name)]
603 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] 603 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
604 ["Global kill file" gnus-group-edit-global-kill t]) 604 ["Global kill file" gnus-group-edit-global-kill t])
605 )) 605 ))
606 606
607 (easy-menu-define 607 (easy-menu-define
608 gnus-group-group-menu gnus-group-mode-map "" 608 gnus-group-group-menu gnus-group-mode-map ""
609 '("Groups" 609 '("Groups"
610 ("Listing" 610 ("Listing"
611 ["List unread subscribed groups" gnus-group-list-groups t] 611 ["List unread subscribed groups" gnus-group-list-groups t]
706 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] 706 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
707 ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) 707 ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
708 ["Send a bug report" gnus-bug t] 708 ["Send a bug report" gnus-bug t]
709 ["Send a mail" gnus-group-mail t] 709 ["Send a mail" gnus-group-mail t]
710 ["Post an article..." gnus-group-post-news t] 710 ["Post an article..." gnus-group-post-news t]
711 ["Check for new news" gnus-group-get-new-news t] 711 ["Check for new news" gnus-group-get-new-news t]
712 ["Activate all groups" gnus-activate-all-groups t] 712 ["Activate all groups" gnus-activate-all-groups t]
713 ["Restart Gnus" gnus-group-restart t] 713 ["Restart Gnus" gnus-group-restart t]
714 ["Read init file" gnus-group-read-init-file t] 714 ["Read init file" gnus-group-read-init-file t]
715 ["Browse foreign server" gnus-group-browse-foreign-server t] 715 ["Browse foreign server" gnus-group-browse-foreign-server t]
716 ["Enter server buffer" gnus-group-enter-server-mode t] 716 ["Enter server buffer" gnus-group-enter-server-mode t]
848 ;; No groups in the buffer. 848 ;; No groups in the buffer.
849 (gnus-message 5 gnus-no-groups-message)) 849 (gnus-message 5 gnus-no-groups-message))
850 ;; We have some groups displayed. 850 ;; We have some groups displayed.
851 (goto-char (point-max)) 851 (goto-char (point-max))
852 (when (or (not gnus-group-goto-next-group-function) 852 (when (or (not gnus-group-goto-next-group-function)
853 (not (funcall gnus-group-goto-next-group-function 853 (not (funcall gnus-group-goto-next-group-function
854 group props))) 854 group props)))
855 (cond 855 (cond
856 (empty 856 (empty
857 (goto-char (point-min))) 857 (goto-char (point-min)))
858 ((not group) 858 ((not group)
912 (string-match regexp group)) 912 (string-match regexp group))
913 (<= (setq clevel (gnus-info-level info)) level) 913 (<= (setq clevel (gnus-info-level info)) level)
914 (>= clevel lowest) 914 (>= clevel lowest)
915 (or all ; We list all groups? 915 (or all ; We list all groups?
916 (if (eq unread t) ; Unactivated? 916 (if (eq unread t) ; Unactivated?
917 gnus-group-list-inactive-groups ; We list unactivated 917 gnus-group-list-inactive-groups ; We list unactivated
918 (> unread 0)) ; We list groups with unread articles 918 (> unread 0)) ; We list groups with unread articles
919 (and gnus-list-groups-with-ticked-articles 919 (and gnus-list-groups-with-ticked-articles
920 (cdr (assq 'tick (gnus-info-marks info)))) 920 (cdr (assq 'tick (gnus-info-marks info))))
921 ; And groups with tickeds 921 ; And groups with tickeds
922 ;; Check for permanent visibility. 922 ;; Check for permanent visibility.
1013 0 1013 0
1014 (- (1+ (cdr active)) (car active))) 1014 (- (1+ (cdr active)) (car active)))
1015 nil) 1015 nil)
1016 nil)))) 1016 nil))))
1017 1017
1018 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level 1018 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1019 gnus-tmp-marked number 1019 gnus-tmp-marked number
1020 gnus-tmp-method) 1020 gnus-tmp-method)
1021 "Insert a group line in the group buffer." 1021 "Insert a group line in the group buffer."
1022 (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) 1022 (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
1023 (gnus-tmp-number-total 1023 (gnus-tmp-number-total
1116 (while (and list 1116 (while (and list
1117 (not (eval (caar list)))) 1117 (not (eval (caar list))))
1118 (setq list (cdr list))) 1118 (setq list (cdr list)))
1119 (let ((face (cdar list))) 1119 (let ((face (cdar list)))
1120 (unless (eq face (get-text-property beg 'face)) 1120 (unless (eq face (get-text-property beg 'face))
1121 (gnus-put-text-property 1121 (gnus-put-text-property
1122 beg end 'face 1122 beg end 'face
1123 (setq face (if (boundp face) (symbol-value face) face))) 1123 (setq face (if (boundp face) (symbol-value face) face)))
1124 (gnus-extent-start-open beg))) 1124 (gnus-extent-start-open beg)))
1125 (goto-char p))) 1125 (goto-char p)))
1126 1126
1127 (defun gnus-group-update-group (group &optional visible-only) 1127 (defun gnus-group-update-group (group &optional visible-only)
1141 found buffer-read-only) 1141 found buffer-read-only)
1142 ;; Enter the current status into the dribble buffer. 1142 ;; Enter the current status into the dribble buffer.
1143 (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) 1143 (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
1144 (when (and entry (not (gnus-ephemeral-group-p group))) 1144 (when (and entry (not (gnus-ephemeral-group-p group)))
1145 (gnus-dribble-enter 1145 (gnus-dribble-enter
1146 (concat "(gnus-group-set-info '" 1146 (concat "(gnus-group-set-info '"
1147 (gnus-prin1-to-string (nth 2 entry)) 1147 (gnus-prin1-to-string (nth 2 entry))
1148 ")")))) 1148 ")"))))
1149 ;; Find all group instances. If topics are in use, each group 1149 ;; Find all group instances. If topics are in use, each group
1150 ;; may be listed in more than once. 1150 ;; may be listed in more than once.
1151 (while (setq loc (text-property-any 1151 (while (setq loc (text-property-any
1202 (gnus-tmp-news-method (car gnus-select-method)) 1202 (gnus-tmp-news-method (car gnus-select-method))
1203 (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) 1203 (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
1204 (max-len 60) 1204 (max-len 60)
1205 gnus-tmp-header ;Dummy binding for user-defined formats 1205 gnus-tmp-header ;Dummy binding for user-defined formats
1206 ;; Get the resulting string. 1206 ;; Get the resulting string.
1207 (modified 1207 (modified
1208 (and gnus-dribble-buffer 1208 (and gnus-dribble-buffer
1209 (buffer-name gnus-dribble-buffer) 1209 (buffer-name gnus-dribble-buffer)
1210 (buffer-modified-p gnus-dribble-buffer) 1210 (buffer-modified-p gnus-dribble-buffer)
1211 (save-excursion 1211 (save-excursion
1212 (set-buffer gnus-dribble-buffer) 1212 (set-buffer gnus-dribble-buffer)
1217 (if modified "--**- " "----- ")) 1217 (if modified "--**- " "----- "))
1218 ;; If the line is too long, we chop it off. 1218 ;; If the line is too long, we chop it off.
1219 (when (> (length mode-string) max-len) 1219 (when (> (length mode-string) max-len)
1220 (setq mode-string (substring mode-string 0 (- max-len 4)))) 1220 (setq mode-string (substring mode-string 0 (- max-len 4))))
1221 (prog1 1221 (prog1
1222 (setq mode-line-buffer-identification 1222 (setq mode-line-buffer-identification
1223 (gnus-mode-line-buffer-identification 1223 (gnus-mode-line-buffer-identification
1224 (list mode-string))) 1224 (list mode-string)))
1225 (set-buffer-modified-p modified)))))) 1225 (set-buffer-modified-p modified))))))
1226 1226
1227 (defun gnus-group-group-name () 1227 (defun gnus-group-group-name ()
1479 (entry (car entry)) 1479 (entry (car entry))
1480 ((setq active (gnus-active group)) 1480 ((setq active (gnus-active group))
1481 (- (1+ (cdr active)) (car active))))) 1481 (- (1+ (cdr active)) (car active)))))
1482 (gnus-summary-read-group 1482 (gnus-summary-read-group
1483 group (or all (and (numberp number) 1483 group (or all (and (numberp number)
1484 (zerop (+ number (gnus-range-length 1484 (zerop (+ number (gnus-range-length
1485 (cdr (assq 'tick marked))) 1485 (cdr (assq 'tick marked)))
1486 (gnus-range-length 1486 (gnus-range-length
1487 (cdr (assq 'dormant marked))))))) 1487 (cdr (assq 'dormant marked)))))))
1488 no-article nil no-display))) 1488 no-article nil no-display)))
1489 1489
1516 (gnus-group-read-group all t))) 1516 (gnus-group-read-group all t)))
1517 1517
1518 (defun gnus-group-select-group-ephemerally () 1518 (defun gnus-group-select-group-ephemerally ()
1519 "Select the current group without doing any processing whatsoever. 1519 "Select the current group without doing any processing whatsoever.
1520 You will actually be entered into a group that's a copy of 1520 You will actually be entered into a group that's a copy of
1521 the current group; no changes you make while in this group will 1521 the current group; no changes you make while in this group will
1522 be permanent." 1522 be permanent."
1523 (interactive) 1523 (interactive)
1524 (require 'gnus-score) 1524 (require 'gnus-score)
1525 (let* (gnus-visual 1525 (let* (gnus-visual
1526 gnus-score-find-score-files-function gnus-apply-kill-hook 1526 gnus-score-find-score-files-function gnus-apply-kill-hook
1530 (method (gnus-find-method-for-group group))) 1530 (method (gnus-find-method-for-group group)))
1531 (setq method 1531 (setq method
1532 `(,(car method) ,(concat (cadr method) "-ephemeral") 1532 `(,(car method) ,(concat (cadr method) "-ephemeral")
1533 (,(intern (format "%s-address" (car method))) ,(cadr method)) 1533 (,(intern (format "%s-address" (car method))) ,(cadr method))
1534 ,@(cddr method))) 1534 ,@(cddr method)))
1535 (gnus-group-read-ephemeral-group 1535 (gnus-group-read-ephemeral-group
1536 (gnus-group-prefixed-name group method) method))) 1536 (gnus-group-prefixed-name group method) method)))
1537 1537
1538 ;;;###autoload 1538 ;;;###autoload
1539 (defun gnus-fetch-group (group) 1539 (defun gnus-fetch-group (group)
1540 "Start Gnus if necessary and enter GROUP. 1540 "Start Gnus if necessary and enter GROUP.
1546 1546
1547 (defvar gnus-ephemeral-group-server 0) 1547 (defvar gnus-ephemeral-group-server 0)
1548 1548
1549 ;; Enter a group that is not in the group buffer. Non-nil is returned 1549 ;; Enter a group that is not in the group buffer. Non-nil is returned
1550 ;; if selection was successful. 1550 ;; if selection was successful.
1551 (defun gnus-group-read-ephemeral-group (group method &optional activate 1551 (defun gnus-group-read-ephemeral-group (group method &optional activate
1552 quit-config request-only) 1552 quit-config request-only)
1553 "Read GROUP from METHOD as an ephemeral group. 1553 "Read GROUP from METHOD as an ephemeral group.
1554 If ACTIVATE, request the group first. 1554 If ACTIVATE, request the group first.
1555 If QUIT-CONFIG, use that window configuration when exiting from the 1555 If QUIT-CONFIG, use that window configuration when exiting from the
1556 ephemeral group. 1556 ephemeral group.
1566 (incf gnus-ephemeral-group-server)))) 1566 (incf gnus-ephemeral-group-server))))
1567 (let ((group (if (gnus-group-foreign-p group) group 1567 (let ((group (if (gnus-group-foreign-p group) group
1568 (gnus-group-prefixed-name group method)))) 1568 (gnus-group-prefixed-name group method))))
1569 (gnus-sethash 1569 (gnus-sethash
1570 group 1570 group
1571 `(-1 nil (,group 1571 `(-1 nil (,group
1572 ,gnus-level-default-subscribed nil nil ,method 1572 ,gnus-level-default-subscribed nil nil ,method
1573 ((quit-config . 1573 ((quit-config .
1574 ,(if quit-config quit-config 1574 ,(if quit-config quit-config
1575 (cons gnus-summary-buffer 1575 (cons gnus-summary-buffer
1576 gnus-current-window-configuration)))))) 1576 gnus-current-window-configuration))))))
1579 (unless (gnus-check-server method) 1579 (unless (gnus-check-server method)
1580 (error "Unable to contact server: %s" (gnus-status-message method))) 1580 (error "Unable to contact server: %s" (gnus-status-message method)))
1581 (when activate 1581 (when activate
1582 (gnus-activate-group group 'scan) 1582 (gnus-activate-group group 'scan)
1583 (unless (gnus-request-group group) 1583 (unless (gnus-request-group group)
1584 (error "Couldn't request group: %s" 1584 (error "Couldn't request group: %s"
1585 (nnheader-get-report (car method))))) 1585 (nnheader-get-report (car method)))))
1586 (if request-only 1586 (if request-only
1587 group 1587 group
1588 (condition-case () 1588 (condition-case ()
1589 (when (gnus-group-read-group t t group) 1589 (when (gnus-group-read-group t t group)
1616 "Goto to newsgroup GROUP. 1616 "Goto to newsgroup GROUP.
1617 If FAR, it is likely that the group is not on the current line." 1617 If FAR, it is likely that the group is not on the current line."
1618 (when group 1618 (when group
1619 (if far 1619 (if far
1620 (gnus-goto-char 1620 (gnus-goto-char
1621 (text-property-any 1621 (text-property-any
1622 (point-min) (point-max) 1622 (point-min) (point-max)
1623 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) 1623 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
1624 (beginning-of-line) 1624 (beginning-of-line)
1625 (cond 1625 (cond
1626 ;; It's quite likely that we are on the right line, so 1626 ;; It's quite likely that we are on the right line, so
1642 (forward-line 1) 1642 (forward-line 1)
1643 (point)) 1643 (point))
1644 (t 1644 (t
1645 ;; Search through the entire buffer. 1645 ;; Search through the entire buffer.
1646 (gnus-goto-char 1646 (gnus-goto-char
1647 (text-property-any 1647 (text-property-any
1648 (point-min) (point-max) 1648 (point-min) (point-max)
1649 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) 1649 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
1650 1650
1651 (defun gnus-group-next-group (n &optional silent) 1651 (defun gnus-group-next-group (n &optional silent)
1652 "Go to next N'th newsgroup. 1652 "Go to next N'th newsgroup.
1779 t) 1779 t)
1780 ;; Make it active. 1780 ;; Make it active.
1781 (gnus-set-active nname (cons 1 0)) 1781 (gnus-set-active nname (cons 1 0))
1782 (unless (gnus-ephemeral-group-p name) 1782 (unless (gnus-ephemeral-group-p name)
1783 (gnus-dribble-enter 1783 (gnus-dribble-enter
1784 (concat "(gnus-group-set-info '" 1784 (concat "(gnus-group-set-info '"
1785 (gnus-prin1-to-string (cdr info)) ")"))) 1785 (gnus-prin1-to-string (cdr info)) ")")))
1786 ;; Insert the line. 1786 ;; Insert the line.
1787 (gnus-group-insert-group-line-info nname) 1787 (gnus-group-insert-group-line-info nname)
1788 (forward-line -1) 1788 (forward-line -1)
1789 (gnus-group-position-point) 1789 (gnus-group-position-point)
1842 (gnus-read-group "Rename group to: " 1842 (gnus-read-group "Rename group to: "
1843 (gnus-group-real-name (gnus-group-group-name)))))) 1843 (gnus-group-real-name (gnus-group-group-name))))))
1844 1844
1845 (unless (gnus-check-backend-function 'request-rename-group group) 1845 (unless (gnus-check-backend-function 'request-rename-group group)
1846 (error "This backend does not support renaming groups")) 1846 (error "This backend does not support renaming groups"))
1847 (unless group 1847 (unless group
1848 (error "No group to rename")) 1848 (error "No group to rename"))
1849 (when (equal (gnus-group-real-name group) new-name) 1849 (when (equal (gnus-group-real-name group) new-name)
1850 (error "Can't rename to the same name")) 1850 (error "Can't rename to the same name"))
1851 1851
1852 ;; We find the proper prefixed name. 1852 ;; We find the proper prefixed name.
2028 nil t (cons (or (car gnus-group-web-type-history) 2028 nil t (cons (or (car gnus-group-web-type-history)
2029 (symbol-name (caar nnweb-type-definition))) 2029 (symbol-name (caar nnweb-type-definition)))
2030 0) 2030 0)
2031 'gnus-group-web-type-history)) 2031 'gnus-group-web-type-history))
2032 (search 2032 (search
2033 (read-string 2033 (read-string
2034 "Search string: " 2034 "Search string: "
2035 (cons (or (car gnus-group-web-search-history) "") 0) 2035 (cons (or (car gnus-group-web-search-history) "") 0)
2036 'gnus-group-web-search-history)) 2036 'gnus-group-web-search-history))
2037 (method 2037 (method
2038 `(nnweb ,group (nnweb-search ,search) 2038 `(nnweb ,group (nnweb-search ,search)
2039 (nnweb-type ,(intern type)) 2039 (nnweb-type ,(intern type))
2166 ;; Group sorting commands 2166 ;; Group sorting commands
2167 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. 2167 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
2168 2168
2169 (defun gnus-group-sort-groups (func &optional reverse) 2169 (defun gnus-group-sort-groups (func &optional reverse)
2170 "Sort the group buffer according to FUNC. 2170 "Sort the group buffer according to FUNC.
2171 If REVERSE, reverse the sorting order." 2171 When used interactively, the sorting function used will be
2172 determined by the `gnus-group-sort-function' variable.
2173 If REVERSE (the prefix), reverse the sorting order."
2172 (interactive (list gnus-group-sort-function current-prefix-arg)) 2174 (interactive (list gnus-group-sort-function current-prefix-arg))
2173 (funcall gnus-group-sort-alist-function 2175 (funcall gnus-group-sort-alist-function
2174 (gnus-make-sort-function func) reverse) 2176 (gnus-make-sort-function func) reverse)
2175 (gnus-group-list-groups)) 2177 (gnus-group-list-groups))
2176 2178
2355 (while (setq info (pop alist)) 2357 (while (setq info (pop alist))
2356 (when (gnus-group-native-p (gnus-info-group info)) 2358 (when (gnus-group-native-p (gnus-info-group info))
2357 (gnus-info-clear-data info))) 2359 (gnus-info-clear-data info)))
2358 (gnus-get-unread-articles) 2360 (gnus-get-unread-articles)
2359 (gnus-dribble-enter "") 2361 (gnus-dribble-enter "")
2360 (when (gnus-y-or-n-p 2362 (when (gnus-y-or-n-p
2361 "Move the cache away to avoid problems in the future? ") 2363 "Move the cache away to avoid problems in the future? ")
2362 (call-interactively 'gnus-cache-move-cache))))) 2364 (call-interactively 'gnus-cache-move-cache)))))
2363 2365
2364 (defun gnus-info-clear-data (info) 2366 (defun gnus-info-clear-data (info)
2365 "Clear all marks and read ranges from INFO." 2367 "Clear all marks and read ranges from INFO."
2474 (setcdr 2476 (setcdr
2475 expirable 2477 expirable
2476 (gnus-compress-sequence 2478 (gnus-compress-sequence
2477 (if expiry-wait 2479 (if expiry-wait
2478 ;; We set the expiry variables to the group 2480 ;; We set the expiry variables to the group
2479 ;; parameter. 2481 ;; parameter.
2480 (let ((nnmail-expiry-wait-function nil) 2482 (let ((nnmail-expiry-wait-function nil)
2481 (nnmail-expiry-wait expiry-wait)) 2483 (nnmail-expiry-wait expiry-wait))
2482 (gnus-request-expire-articles 2484 (gnus-request-expire-articles
2483 (gnus-uncompress-sequence (cdr expirable)) group)) 2485 (gnus-uncompress-sequence (cdr expirable)) group))
2484 ;; Just expire using the normal expiry values. 2486 ;; Just expire using the normal expiry values.
2485 (gnus-request-expire-articles 2487 (gnus-request-expire-articles
2486 (gnus-uncompress-sequence (cdr expirable)) group)))) 2488 (gnus-uncompress-sequence (cdr expirable)) group))))
2487 (gnus-close-group group)) 2489 (gnus-close-group group))
2488 (gnus-message 6 "Expiring articles in %s...done" group))) 2490 (gnus-message 6 "Expiring articles in %s...done" group)))
2491 (gnus-dribble-touch)
2489 (gnus-group-position-point)))) 2492 (gnus-group-position-point))))
2490 2493
2491 (defun gnus-group-expire-all-groups () 2494 (defun gnus-group-expire-all-groups ()
2492 "Expire all expirable articles in all newsgroups." 2495 "Expire all expirable articles in all newsgroups."
2493 (interactive) 2496 (interactive)
2546 (while groups 2549 (while groups
2547 (setq group (car groups) 2550 (setq group (car groups)
2548 groups (cdr groups)) 2551 groups (cdr groups))
2549 (gnus-group-remove-mark group) 2552 (gnus-group-remove-mark group)
2550 (gnus-group-unsubscribe-group 2553 (gnus-group-unsubscribe-group
2551 group 2554 group
2552 (cond 2555 (cond
2553 ((eq do-sub 'unsubscribe) 2556 ((eq do-sub 'unsubscribe)
2554 gnus-level-default-unsubscribed) 2557 gnus-level-default-unsubscribed)
2555 ((eq do-sub 'subscribe) 2558 ((eq do-sub 'subscribe)
2556 gnus-level-default-subscribed) 2559 gnus-level-default-subscribed)
2568 group line." 2571 group line."
2569 (interactive 2572 (interactive
2570 (list (completing-read 2573 (list (completing-read
2571 "Group: " gnus-active-hashtb nil 2574 "Group: " gnus-active-hashtb nil
2572 (gnus-read-active-file-p) 2575 (gnus-read-active-file-p)
2573 nil 2576 nil
2574 'gnus-group-history))) 2577 'gnus-group-history)))
2575 (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) 2578 (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
2576 (cond 2579 (cond
2577 ((string-match "^[ \t]$" group) 2580 ((string-match "^[ \t]$" group)
2578 (error "Empty group name")) 2581 (error "Empty group name"))
2579 (newsrc 2582 (newsrc
2580 ;; Toggle subscription flag. 2583 ;; Toggle subscription flag.
2581 (gnus-group-change-level 2584 (gnus-group-change-level
2582 newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) 2585 newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
2583 gnus-level-subscribed) 2586 gnus-level-subscribed)
2584 (1+ gnus-level-subscribed) 2587 (1+ gnus-level-subscribed)
2585 gnus-level-default-subscribed))) 2588 gnus-level-default-subscribed)))
2586 (unless silent 2589 (unless silent
2587 (gnus-group-update-group group))) 2590 (gnus-group-update-group group)))
2840 ;; Read any slave files. 2843 ;; Read any slave files.
2841 (unless gnus-slave 2844 (unless gnus-slave
2842 (gnus-master-read-slave-newsrc)) 2845 (gnus-master-read-slave-newsrc))
2843 2846
2844 ;; We might read in new NoCeM messages here. 2847 ;; We might read in new NoCeM messages here.
2845 (when (and gnus-use-nocem 2848 (when (and gnus-use-nocem
2846 (null arg)) 2849 (null arg))
2847 (gnus-nocem-scan-groups)) 2850 (gnus-nocem-scan-groups))
2848 ;; If ARG is not a number, then we read the active file. 2851 ;; If ARG is not a number, then we read the active file.
2849 (when (and arg (not (numberp arg))) 2852 (when (and arg (not (numberp arg)))
2850 (let ((gnus-read-active-file t)) 2853 (let ((gnus-read-active-file t))
2852 (setq arg nil) 2855 (setq arg nil)
2853 2856
2854 ;; If the user wants it, we scan for new groups. 2857 ;; If the user wants it, we scan for new groups.
2855 (when (eq gnus-check-new-newsgroups 'always) 2858 (when (eq gnus-check-new-newsgroups 'always)
2856 (gnus-find-new-newsgroups))) 2859 (gnus-find-new-newsgroups)))
2857 2860
2858 (setq arg (gnus-group-default-level arg t)) 2861 (setq arg (gnus-group-default-level arg t))
2859 (if (and gnus-read-active-file (not arg)) 2862 (if (and gnus-read-active-file (not arg))
2860 (progn 2863 (progn
2861 (gnus-read-active-file) 2864 (gnus-read-active-file)
2862 (gnus-get-unread-articles arg)) 2865 (gnus-get-unread-articles arg))
3034 (interactive "P\nsList newsgroups matching: ") 3037 (interactive "P\nsList newsgroups matching: ")
3035 ;; First make sure active file has been read. 3038 ;; First make sure active file has been read.
3036 (when (and level 3039 (when (and level
3037 (> (prefix-numeric-value level) gnus-level-killed)) 3040 (> (prefix-numeric-value level) gnus-level-killed))
3038 (gnus-get-killed-groups)) 3041 (gnus-get-killed-groups))
3039 (gnus-group-prepare-flat 3042 (gnus-group-prepare-flat
3040 (or level gnus-level-subscribed) all (or lowest 1) regexp) 3043 (or level gnus-level-subscribed) all (or lowest 1) regexp)
3041 (goto-char (point-min)) 3044 (goto-char (point-min))
3042 (gnus-group-position-point)) 3045 (gnus-group-position-point))
3043 3046
3044 (defun gnus-group-list-all-matching (level regexp &optional lowest) 3047 (defun gnus-group-list-all-matching (level regexp &optional lowest)
3130 3133
3131 (defun gnus-group-exit () 3134 (defun gnus-group-exit ()
3132 "Quit reading news after updating .newsrc.eld and .newsrc. 3135 "Quit reading news after updating .newsrc.eld and .newsrc.
3133 The hook `gnus-exit-gnus-hook' is called before actually exiting." 3136 The hook `gnus-exit-gnus-hook' is called before actually exiting."
3134 (interactive) 3137 (interactive)
3135 (when 3138 (when
3136 (or noninteractive ;For gnus-batch-kill 3139 (or noninteractive ;For gnus-batch-kill
3137 (not gnus-interactive-exit) ;Without confirmation 3140 (not gnus-interactive-exit) ;Without confirmation
3138 gnus-expert-user 3141 gnus-expert-user
3139 (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) 3142 (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
3140 (run-hooks 'gnus-exit-gnus-hook) 3143 (run-hooks 'gnus-exit-gnus-hook)