Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-group.el @ 104:cf808b4c4290 r20-1b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b4
author cvs
date Mon, 13 Aug 2007 09:16:51 +0200
parents 4be1180a9e89
children 360340f9fd5f
comparison
equal deleted inserted replaced
103:30eda07fe280 104:cf808b4c4290
1126 1126
1127 (defun gnus-group-update-group (group &optional visible-only) 1127 (defun gnus-group-update-group (group &optional visible-only)
1128 "Update all lines where GROUP appear. 1128 "Update all lines where GROUP appear.
1129 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't 1129 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
1130 already." 1130 already."
1131 (save-excursion 1131 ;; Can't use `save-excursion' here, so we do it manually.
1132 (let ((buf (current-buffer))
1133 mark)
1132 (set-buffer gnus-group-buffer) 1134 (set-buffer gnus-group-buffer)
1135 (setq mark (point-marker))
1133 ;; The buffer may be narrowed. 1136 ;; The buffer may be narrowed.
1134 (save-restriction 1137 (save-restriction
1135 (widen) 1138 (widen)
1136 (let ((ident (gnus-intern-safe group gnus-active-hashtb)) 1139 (let ((ident (gnus-intern-safe group gnus-active-hashtb))
1137 (loc (point-min)) 1140 (loc (point-min))
1177 (save-excursion 1180 (save-excursion
1178 (forward-line -1) 1181 (forward-line -1)
1179 (run-hooks 'gnus-group-update-group-hook)))) 1182 (run-hooks 'gnus-group-update-group-hook))))
1180 (when gnus-group-update-group-function 1183 (when gnus-group-update-group-function
1181 (funcall gnus-group-update-group-function group)) 1184 (funcall gnus-group-update-group-function group))
1182 (gnus-group-set-mode-line))))) 1185 (gnus-group-set-mode-line)))
1186 (goto-char mark)
1187 (set-marker mark nil)
1188 (set-buffer buf)))
1183 1189
1184 (defun gnus-group-set-mode-line () 1190 (defun gnus-group-set-mode-line ()
1185 "Update the mode line in the group buffer." 1191 "Update the mode line in the group buffer."
1186 (when (memq 'group gnus-updated-mode-lines) 1192 (when (memq 'group gnus-updated-mode-lines)
1187 ;; Yes, we want to keep this mode line updated. 1193 ;; Yes, we want to keep this mode line updated.
1536 (interactive "sGroup name: ") 1542 (interactive "sGroup name: ")
1537 (unless (get-buffer gnus-group-buffer) 1543 (unless (get-buffer gnus-group-buffer)
1538 (gnus)) 1544 (gnus))
1539 (gnus-group-read-group nil nil group)) 1545 (gnus-group-read-group nil nil group))
1540 1546
1547 (defvar gnus-ephemeral-group-server 0)
1548
1541 ;; 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
1542 ;; if selection was successful. 1550 ;; if selection was successful.
1543 (defun gnus-group-read-ephemeral-group (group method &optional activate 1551 (defun gnus-group-read-ephemeral-group (group method &optional activate
1544 quit-config request-only) 1552 quit-config request-only)
1545 "Read GROUP from METHOD as an ephemeral group. 1553 "Read GROUP from METHOD as an ephemeral group.
1547 If QUIT-CONFIG, use that window configuration when exiting from the 1555 If QUIT-CONFIG, use that window configuration when exiting from the
1548 ephemeral group. 1556 ephemeral group.
1549 If REQUEST-ONLY, don't actually read the group; just request it. 1557 If REQUEST-ONLY, don't actually read the group; just request it.
1550 1558
1551 Return the name of the group is selection was successful." 1559 Return the name of the group is selection was successful."
1560 ;; Transform the select method into a unique server.
1561 (let ((saddr (intern (format "%s-address" (car method)))))
1562 (setq method (gnus-copy-sequence method))
1563 (unless (assq saddr method)
1564 (nconc method `((,saddr ,(cadr method)))))
1565 (setf (cadr method) (format "%s-%d" (cadr method)
1566 (incf gnus-ephemeral-group-server))))
1552 (let ((group (if (gnus-group-foreign-p group) group 1567 (let ((group (if (gnus-group-foreign-p group) group
1553 (gnus-group-prefixed-name group method)))) 1568 (gnus-group-prefixed-name group method))))
1554 (gnus-sethash 1569 (gnus-sethash
1555 group 1570 group
1556 `(-1 nil (,group 1571 `(-1 nil (,group
1834 (when (equal (gnus-group-real-name group) new-name) 1849 (when (equal (gnus-group-real-name group) new-name)
1835 (error "Can't rename to the same name")) 1850 (error "Can't rename to the same name"))
1836 1851
1837 ;; We find the proper prefixed name. 1852 ;; We find the proper prefixed name.
1838 (setq new-name 1853 (setq new-name
1839 (if (equal (gnus-group-real-name new-name) new-name) 1854 (if (gnus-group-native-p group)
1840 ;; Native group. 1855 ;; Native group.
1841 new-name 1856 new-name
1842 ;; Foreign group. 1857 ;; Foreign group.
1843 (gnus-group-prefixed-name 1858 (gnus-group-prefixed-name
1844 (gnus-group-real-name new-name) 1859 (gnus-group-real-name new-name)
2846 (gnus-read-active-file) 2861 (gnus-read-active-file)
2847 (gnus-get-unread-articles arg)) 2862 (gnus-get-unread-articles arg))
2848 (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) 2863 (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
2849 (gnus-get-unread-articles arg))) 2864 (gnus-get-unread-articles arg)))
2850 (run-hooks 'gnus-after-getting-new-news-hook) 2865 (run-hooks 'gnus-after-getting-new-news-hook)
2851 (gnus-group-list-groups)) 2866 (gnus-group-list-groups (and (numberp arg)
2867 (max (car gnus-group-list-mode) arg))))
2852 2868
2853 (defun gnus-group-get-new-news-this-group (&optional n) 2869 (defun gnus-group-get-new-news-this-group (&optional n)
2854 "Check for newly arrived news in the current group (and the N-1 next groups). 2870 "Check for newly arrived news in the current group (and the N-1 next groups).
2855 The difference between N and the number of newsgroup checked is returned. 2871 The difference between N and the number of newsgroup checked is returned.
2856 If N is negative, this group and the N-1 previous groups will be checked." 2872 If N is negative, this group and the N-1 previous groups will be checked."