;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-start)
(require 'time-date)
(require 'gnus-ems)
+(eval-when-compile (require 'mm-url))
+
(defcustom gnus-group-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"*The address of the (ding) archives."
(function-item gnus-group-sort-by-rank)
(function :tag "other" nil))))
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l %O\n"
+(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%i Number of ticked and dormant (integer)
%T Number of ticked articles (integer)
%R Number of read articles (integer)
+%U Number of unseen articles (integer)
%t Estimated total number of articles (integer)
%y Number of unread, unticked articles (integer)
%G Group name (string)
%g Qualified group name (string)
%c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'.
+%C Group comment (string)
%D Group description (string)
%s Select method (string)
%o Moderated group (char, \"m\")
%p Process mark (char)
+%B Whether a summary buffer for the group is open (char, \"*\")
%O Moderated group (string, \"(m)\" or \"\")
%P Topic indentation (string)
%m Whether there is new(ish) mail in the group (char, \"%\")
%E Icon as defined by `gnus-group-icon-list'.
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed the
- current header as argument. The function should return a string, which
- will be inserted into the buffer just like information from any other
- group specifier.
+ where X is the letter following %u. The function will be passed a
+ single dummy parameter as argument.. The function should return a
+ string, which will be inserted into the buffer just like information
+ from any other group specifier.
Note that this format specification is not always respected. For
reasons of efficiency, when listing killed groups, this specification
of these specs, you must probably re-start Gnus to see them go into
effect.
-General format specifiers can also be used. See
-(gnus)Formatting Variables."
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-group-visual
:type 'string)
The icon from the file field after the first true form is used. You
can change how those group lines are displayed by editing the file
field. The File will either be found in the
-`gnus-group-glyph-directory' or by designating absolute path to the
+`gnus-group-glyph-directory' or by designating absolute name of the
file.
It is also possible to change and add form fields, but currently that
(defcustom gnus-group-name-charset-group-alist
(if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
- (and (fboundp 'coding-system-p) (coding-system-p 'utf-8)))
+ (mm-coding-system-p 'utf-8))
'((".*" . utf-8))
nil)
"Alist of group regexp and the charset for group names.
;;; Internal variables
+(defvar gnus-group-is-exiting-p nil)
+(defvar gnus-group-is-exiting-without-update-p nil)
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
"Function for sorting the group buffer.")
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number)) ?s)
(?R gnus-tmp-number-of-read ?s)
+ (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
(?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
(?c (gnus-short-group-name gnus-tmp-group) ?s)
+ (?C gnus-tmp-comment ?s)
(?D gnus-tmp-newsgroup-description ?s)
(?o gnus-tmp-moderated ?c)
(?O gnus-tmp-moderated-string ?s)
(?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
+ (?B gnus-tmp-summary-live ?c)
(?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
"f" gnus-group-make-doc-group
"w" gnus-group-make-web-group
"r" gnus-group-rename-group
+ "R" gnus-group-make-rss-group
"c" gnus-group-customize
"x" gnus-group-nnimap-expunge
"\177" gnus-group-delete-group
"l" gnus-group-sort-groups-by-level
"v" gnus-group-sort-groups-by-score
"r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method)
+ "m" gnus-group-sort-groups-by-method
+ "n" gnus-group-sort-groups-by-real-name)
(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
"s" gnus-group-sort-selected-groups
"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)
+ "m" gnus-group-sort-selected-groups-by-method
+ "n" gnus-group-sort-selected-groups-by-real-name)
(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
"k" gnus-group-list-killed
"f" gnus-score-flush-cache)
(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
+ "c" gnus-group-fetch-charter
+ "C" gnus-group-fetch-control
"d" gnus-group-describe-group
"f" gnus-group-fetch-faq
"v" gnus-version)
"\C-k" gnus-group-kill-level
"z" gnus-group-kill-all-zombies))
+(defun gnus-topic-mode-p ()
+ "Return non-nil in `gnus-topic-mode'."
+ (and (boundp 'gnus-topic-mode)
+ (symbol-value 'gnus-topic-mode)))
+
(defun gnus-group-make-menu-bar ()
(gnus-turn-off-edit-menu 'group)
(unless (boundp 'gnus-group-reading-menu)
(easy-menu-define
gnus-group-reading-menu gnus-group-mode-map ""
`("Group"
- ["Read" gnus-group-read-group (gnus-group-group-name)]
- ["Select" gnus-group-select-group (gnus-group-group-name)]
+ ["Read" gnus-group-read-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Read " gnus-topic-read-group
+ :included (gnus-topic-mode-p)]
+ ["Select" gnus-group-select-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Select " gnus-topic-select-group
+ :included (gnus-topic-mode-p)]
["See old articles" (gnus-group-select-group 'all)
:keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name)
+ ["Catch up" gnus-group-catchup-current
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Mark unread articles in the current group as read"))]
+ ["Catch up " gnus-topic-catchup-articles
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in the current group or topic as read"))]
["Catch up all articles" gnus-group-catchup-current-all
(gnus-group-group-name)]
["Check for new articles" gnus-group-get-new-news-this-group
+ :included (not (gnus-topic-mode-p))
:active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Check for new messages in current group"))]
+ ["Check for new articles " gnus-topic-get-new-news-this-topic
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Check for new messages in current group or topic"))]
["Toggle subscription" gnus-group-unsubscribe-current-group
(gnus-group-group-name)]
["Kill" gnus-group-kill-group :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
'(:help "Display description of the current group"))]
["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
+ ["Fetch charter" gnus-group-fetch-charter
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the charter of the current group"))]
+ ["Fetch control message" gnus-group-fetch-control
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the archived control message for the current group"))]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
- ["Expire articles" gnus-group-expire-articles
- (or (and (gnus-group-group-name)
- (gnus-check-backend-function
- 'request-expire-articles
- (gnus-group-group-name))) gnus-group-marked)]
- ["Set group level" gnus-group-set-current-level
+ ["Expire articles" gnus-group-expire-articles
+ :included (not (gnus-topic-mode-p))
+ :active (or (and (gnus-group-group-name)
+ (gnus-check-backend-function
+ 'request-expire-articles
+ (gnus-group-group-name))) gnus-group-marked)]
+ ["Expire articles " gnus-topic-expire-articles
+ :included (gnus-topic-mode-p)]
+ ["Set group level..." gnus-group-set-current-level
(gnus-group-group-name)]
["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
["Customize" gnus-group-customize (gnus-group-group-name)]
("Edit"
["Parameters" gnus-group-edit-group-parameters
- (gnus-group-group-name)]
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Parameters " gnus-topic-edit-parameters
+ :included (gnus-topic-mode-p)]
["Select method" gnus-group-edit-group-method
(gnus-group-group-name)]
["Info" gnus-group-edit-group (gnus-group-group-name)]
["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 by name" gnus-group-sort-groups-by-alphabet t]
+ ["Sort by real name" gnus-group-sort-groups-by-real-name t])
("Sort process/prefixed"
["Default sort" gnus-group-sort-selected-groups
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by method" gnus-group-sort-selected-groups-by-method
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by rank" gnus-group-sort-selected-groups-by-rank
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by score" gnus-group-sort-selected-groups-by-score
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by level" gnus-group-sort-selected-groups-by-level
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by unread" gnus-group-sort-selected-groups-by-unread
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by name" gnus-group-sort-selected-groups-by-alphabet
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
+ (not (gnus-topic-mode-p))]
+ ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
+ (not (gnus-topic-mode-p))])
("Mark"
["Mark group" gnus-group-mark-group
(and (gnus-group-group-name)
(memq (gnus-group-group-name) gnus-group-marked))]
["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
["Mark regexp..." gnus-group-mark-regexp t]
- ["Mark region" gnus-group-mark-region t]
+ ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
["Mark buffer" gnus-group-mark-buffer t]
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group" gnus-group-unsubscribe-group t]
- ["Kill all newsgroups in region" gnus-group-kill-region t]
+ ["Subscribe to a group..." gnus-group-unsubscribe-group t]
+ ["Kill all newsgroups in region" gnus-group-kill-region
+ :active (gnus-mark-active-p)]
["Kill all zombie groups" gnus-group-kill-all-zombies
gnus-zombie-list]
["Kill all groups on level..." gnus-group-kill-level t])
("Foreign groups"
- ["Make a foreign group" gnus-group-make-group t]
- ["Add a directory group" gnus-group-make-directory-group t]
+ ["Make a foreign group..." gnus-group-make-group t]
+ ["Add a directory group..." gnus-group-make-directory-group t]
["Add the help group" gnus-group-make-help-group t]
["Add the archive group" gnus-group-make-archive-group t]
- ["Make a doc group" gnus-group-make-doc-group t]
- ["Make a web group" gnus-group-make-web-group t]
- ["Make a kiboze group" gnus-group-make-kiboze-group t]
- ["Make a virtual group" gnus-group-make-empty-virtual t]
- ["Add a group to a virtual" gnus-group-add-to-virtual t]
- ["Rename group" gnus-group-rename-group
+ ["Make a doc group..." gnus-group-make-doc-group t]
+ ["Make a web group..." gnus-group-make-web-group t]
+ ["Make a kiboze group..." gnus-group-make-kiboze-group t]
+ ["Make a virtual group..." gnus-group-make-empty-virtual t]
+ ["Add a group to a virtual..." gnus-group-add-to-virtual t]
+ ["Rename group..." gnus-group-rename-group
(gnus-check-backend-function
'request-rename-group (gnus-group-group-name))]
["Delete group" gnus-group-delete-group
["Next unread same level" gnus-group-next-unread-group-same-level t]
["Previous unread same level"
gnus-group-prev-unread-group-same-level t]
- ["Jump to group" gnus-group-jump-to-group 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])
("Sieve"
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file t]
- ["Browse foreign server" gnus-group-browse-foreign-server t]
+ ["Browse foreign server..." gnus-group-browse-foreign-server t]
["Enter server buffer" gnus-group-enter-server-mode t]
["Expire all expirable articles" gnus-group-expire-all-groups t]
["Generate any kiboze groups" nnkiboze-generate-groups t]
;; Emacs 21 tool bar. Should be no-op otherwise.
(defun gnus-group-make-tool-bar ()
- (if (and (fboundp 'tool-bar-add-item-from-menu)
- (default-value 'tool-bar-mode)
- (not gnus-group-toolbar-map))
+ (if (and
+ (condition-case nil (require 'tool-bar) (error nil))
+ (fboundp 'tool-bar-add-item-from-menu)
+ (default-value 'tool-bar-mode)
+ (not gnus-group-toolbar-map))
(setq gnus-group-toolbar-map
(let ((tool-bar-map (make-sparse-keymap))
(load-path (mm-image-load-path)))
result)))
(defun gnus-group-name-decode (string charset)
- (if (and string charset (featurep 'mule)
- (not (mm-multibyte-string-p string)))
+ ;; Fixme: Don't decode in unibyte mode.
+ (if (and string charset (featurep 'mule))
(mm-decode-coding-string string charset)
string))
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (if not-in-list
- (setq not-in-list (delete group not-in-list)))
- (and
- (gnus-group-prepare-logic
- group
- (and unread ; This group might be unchecked
- (or (not (stringp regexp))
- (string-match regexp group))
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (cond
- ((functionp predicate)
- (funcall predicate info))
- (predicate t) ; We list all groups?
- (t
- (or
- (if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups
+ (when not-in-list
+ (setq not-in-list (delete group not-in-list)))
+ (when (gnus-group-prepare-logic
+ group
+ (and unread ; This group might be unchecked
+ (or (not (stringp regexp))
+ (string-match regexp group))
+ (<= (setq clevel (gnus-info-level info)) level)
+ (>= clevel lowest)
+ (cond
+ ((functionp predicate)
+ (funcall predicate info))
+ (predicate t) ; We list all groups?
+ (t
+ (or
+ (if (eq unread t) ; Unactivated?
+ gnus-group-list-inactive-groups
; We list unactivated
- (> unread 0))
+ (> unread 0))
; We list groups with unread articles
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
+ (and gnus-list-groups-with-ticked-articles
+ (cdr (assq 'tick (gnus-info-marks info))))
; And groups with tickeds
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups group))
- (memq 'visible params)
- (cdr (assq 'visible params)))))))
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info)))))
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups
+ group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))))))
+ (gnus-group-insert-group-line
+ group (gnus-info-level info)
+ (gnus-info-marks info) unread (gnus-info-method info)))))
;; List dead groups.
- (if (or gnus-group-listed-groups
- (and (>= level gnus-level-zombie)
- (<= lowest gnus-level-zombie)))
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
- (if not-in-list
- (dolist (group gnus-zombie-list)
- (setq not-in-list (delete group not-in-list))))
- (if (or gnus-group-listed-groups
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
- (gnus-group-prepare-flat-list-dead
- (gnus-union
- not-in-list
- (setq gnus-killed-list (sort gnus-killed-list 'string<)))
- gnus-level-killed ?K regexp))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-zombie)
+ (<= lowest gnus-level-zombie)))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ gnus-level-zombie ?Z
+ regexp))
+ (when not-in-list
+ (dolist (group gnus-zombie-list)
+ (setq not-in-list (delete group not-in-list))))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
+ (gnus-group-prepare-flat-list-dead
+ (gnus-union
+ not-in-list
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
+ gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
(setq gnus-group-list-mode (cons level predicate))
nil)
(gnus-method-simplify (gnus-find-method-for-group group))))))
+(defun gnus-number-of-unseen-articles-in-group (group)
+ (let* ((info (nth 2 (gnus-group-entry group)))
+ (marked (gnus-info-marks info))
+ (seen (cdr (assq 'seen marked)))
+ (active (gnus-active group)))
+ (if (not active)
+ 0
+ (length (gnus-uncompress-range
+ (gnus-range-difference
+ (gnus-range-difference (list active) (gnus-info-read info))
+ seen))))))
+
(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
gnus-tmp-marked number
gnus-tmp-method)
(gnus-tmp-qualified-group
(gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
group-name-charset))
+ (gnus-tmp-comment
+ (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
+ gnus-tmp-group))
(gnus-tmp-newsgroup-description
(if gnus-description-hashtb
(or (gnus-group-name-decode
(zerop number)
(cdr (assq 'tick gnus-tmp-marked)))
?* ? ))
+ (gnus-tmp-summary-live
+ (if (and (not gnus-group-is-exiting-p)
+ (gnus-buffer-live-p (gnus-summary-buffer-name
+ gnus-tmp-group)))
+ ?* ? ))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
"Highlight the current line according to `gnus-group-highlight'."
(let* ((list gnus-group-highlight)
(p (point))
- (end (progn (end-of-line) (point)))
+ (end (gnus-point-at-eol))
;; now find out where the line starts and leave point there.
(beg (progn (beginning-of-line) (point)))
(group (gnus-group-group-name))
(setq n (1- n))
(gnus-group-next-group way)))
(nreverse groups)))
- ((gnus-region-active-p)
+ ((and (gnus-region-active-p) (mark))
;; Work on the region between point and mark.
(let ((max (max (point) (mark)))
groups)
If ALL is non-nil, already read articles become readable.
If ALL is a number, fetch this number of articles."
(interactive "P")
+ (when (and (eobp) (not (gnus-group-group-name)))
+ (forward-line -1))
(gnus-group-read-group all t))
(defun gnus-group-quick-select-group (&optional all)
(gnus-group-prefixed-name group method) method)))
;;;###autoload
-(defun gnus-fetch-group (group)
+(defun gnus-fetch-group (group &optional articles)
"Start Gnus if necessary and enter GROUP.
Returns whether the fetching was successful or not."
(interactive (list (completing-read "Group name: " gnus-active-hashtb)))
(unless (get-buffer gnus-group-buffer)
(gnus-no-server))
- (gnus-group-read-group nil nil group))
+ (gnus-group-read-group articles nil group))
;;;###autoload
(defun gnus-fetch-group-other-frame (group)
;; if selection was successful.
(defun gnus-group-read-ephemeral-group (group method &optional activate
quit-config request-only
- select-articles)
+ select-articles
+ parameters)
"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.
+If PARAMETERS, use those as the group parameters.
Return the name of the group if selection was successful."
;; Transform the select method into a unique server.
(,(intern (format "%s-address" (car method))) ,(cadr method))
,@(cddr method)))
(let ((group (if (gnus-group-foreign-p group) group
- (gnus-group-prefixed-name (gnus-group-real-name group)
+ (gnus-group-prefixed-name (gnus-group-real-name group)
method))))
(gnus-sethash
group
`(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
- ((quit-config .
- ,(if quit-config quit-config
- (cons gnus-summary-buffer
- gnus-current-window-configuration))))))
+ ,(cons
+ (if quit-config
+ (cons 'quit-config quit-config)
+ (cons 'quit-config
+ (cons gnus-summary-buffer
+ gnus-current-window-configuration)))
+ parameters)))
gnus-newsrc-hashtb)
(push method gnus-ephemeral-servers)
(set-buffer gnus-group-buffer)
(defun gnus-group-jump-to-group (group)
"Jump to newsgroup GROUP."
(interactive
- (list (completing-read
- "Group: " gnus-active-hashtb nil
- (gnus-read-active-file-p)
- gnus-group-jump-to-group-prompt
- 'gnus-group-history)))
+ (list (mm-string-make-unibyte
+ (completing-read
+ "Group: " gnus-active-hashtb nil
+ (gnus-read-active-file-p)
+ gnus-group-jump-to-group-prompt
+ 'gnus-group-history))))
(when (equal group "")
(error "Empty group name"))
(forward-line 1))
(when best-point
(goto-char best-point))
- (gnus-summary-position-point)
+ (gnus-group-position-point)
(and best-point (gnus-group-group-name))))
(defun gnus-group-first-unread-group ()
(require backend))
(gnus-check-server meth)
(when (gnus-check-backend-function 'request-create-group nname)
- (gnus-request-create-group nname nil args))
+ (unless (gnus-request-create-group nname nil args)
+ (error "Could not create group on server: %s"
+ (nnheader-get-report backend))))
t))
(defun gnus-group-delete-groups (&optional arg)
(lambda (group)
(gnus-group-delete-group group nil t))))))
+(eval-when-compile (defvar gnus-cache-active-altered))
+
(defun gnus-group-delete-group (group &optional force no-prompt)
"Delete the current group. Only meaningful with editable groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-sethash group nil gnus-active-hashtb)
+ (if (boundp 'gnus-cache-active-hashtb)
+ (when gnus-cache-active-hashtb
+ (gnus-sethash group nil gnus-cache-active-hashtb)
+ (setq gnus-cache-active-altered t)))
t))
(gnus-group-position-point)))
(nnweb-type ,(intern type))
(nnweb-ephemeral-p t))))
(if solid
- (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))
+ (progn
+ (gnus-pull 'nnweb-ephemeral-p method)
+ (gnus-group-make-group group method))
(gnus-group-read-ephemeral-group
group method t
(cons (current-buffer)
(if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+(eval-when-compile (defvar nnrss-group-alist)
+ (defun nnrss-discover-feed (arg))
+ (defun nnrss-save-server-data (arg)))
+(defun gnus-group-make-rss-group (&optional url)
+ "Given a URL, discover if there is an RSS feed. If there is,
+use Gnus' to create an nnrss group"
+ (interactive)
+ (require 'nnrss)
+ (if (not url)
+ (setq url (read-from-minibuffer "URL to Search for RSS: ")))
+ (let ((feedinfo (nnrss-discover-feed url)))
+ (if feedinfo
+ (let ((title (read-from-minibuffer "Title: "
+ (cdr (assoc 'title
+ feedinfo))))
+ (desc (read-from-minibuffer "Description: "
+ (cdr (assoc 'description
+ feedinfo))))
+ (href (cdr (assoc 'href feedinfo))))
+ (push (list title href desc)
+ nnrss-group-alist)
+ (gnus-group-unsubscribe-group
+ (concat "nnrss:" title))
+ (nnrss-save-server-data nil))
+ (error "No feeds found for %s" url))))
+
(defvar nnwarchive-type-definition)
(defvar gnus-group-warchive-type-history nil)
(defvar gnus-group-warchive-login-history nil)
(interactive "P")
(gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
+(defun gnus-group-sort-groups-by-real-name (&optional reverse)
+ "Sort the group buffer alphabetically by real (unprefixed) group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
+
(defun gnus-group-sort-groups-by-unread (&optional reverse)
"Sort the group buffer by number of unread articles.
If REVERSE, sort in reverse order."
(interactive (gnus-interactive "P\ny"))
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
+(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
+ "Sort the group buffer alphabetically by real group name.
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
+
(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
"Sort the group buffer by number of unread articles.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
(defun gnus-group-sort-by-method (info1 info2)
"Sort alphabetically by backend name."
- (string< (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info1) info1)))
- (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info2) info2)))))
+ (string< (car (gnus-find-method-for-group
+ (gnus-info-group info1) info1))
+ (car (gnus-find-method-for-group
+ (gnus-info-group info2) info2))))
(defun gnus-group-sort-by-server (info1 info2)
"Sort alphabetically by server name."
num)))
(defun gnus-group-expire-articles (&optional n)
- "Expire all expirable articles in the current newsgroup."
+ "Expire all expirable articles in the current newsgroup.
+Uses the process/prefix convention."
(interactive "P")
(let ((groups (gnus-group-process-prefix n))
group)
;; Binding this variable will inhibit multiple fetchings
;; of the same mail source.
(nnmail-fetched-sources (list t)))
+ (gnus-run-hooks 'gnus-get-top-new-news-hook)
(gnus-run-hooks 'gnus-get-new-news-hook)
;; Read any slave files.
(gnus-group-group-name)
(when current-prefix-arg
(completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
+ "FAQ dir: " (and (listp gnus-group-faq-directory)
(mapcar #'list
gnus-group-faq-directory))))))
(unless group
(find-file file)
(setq found t))))))
+(defun gnus-group-fetch-charter (group)
+ "Fetch the charter for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (require 'mm-url)
+ (condition-case nil (require 'url-http) (error nil))
+ (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
+ url hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
+ (if (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p (eval url))
+ t))
+ (browse-url (eval url))
+ (setq url (concat "http://" hierarchy
+ ".news-admin.org/charters/" name))
+ (if (and (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p url))
+ (browse-url url)
+ (gnus-group-fetch-control group))))))
+
+(defun gnus-group-fetch-control (group)
+ "Fetch the archived control messages for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (let ((name (gnus-group-real-name group))
+ hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if gnus-group-fetch-control-use-browse-url
+ (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
+ hierarchy "/" name ".Z"))
+ (let ((enable-local-variables nil))
+ (gnus-group-read-ephemeral-group
+ group
+ `(nndoc ,group (nndoc-address
+ ,(find-file-noselect
+ (concat "/ftp@ftp.isc.org:/usenet/control/"
+ hierarchy "/" name ".Z")))
+ (nndoc-article-type mbox)) t nil nil))))))
+
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
(interactive (list current-prefix-arg (gnus-group-group-name)))
;; Kill Gnus buffers except for group mode buffer.
(let ((group-buf (get-buffer gnus-group-buffer)))
(mapcar (lambda (buf)
- (unless (member buf (list group-buf gnus-dribble-buffer))
+ (unless (or (member buf (list group-buf gnus-dribble-buffer))
+ (progn
+ (save-excursion
+ (set-buffer buf)
+ (eq major-mode 'message-mode))))
(gnus-kill-buffer buf)))
(gnus-buffers))
(gnus-kill-gnus-frames)
(defun gnus-group-mark-article-read (group article)
"Mark ARTICLE read."
- (gnus-activate-group group)
(let ((buffer (gnus-summary-buffer-name group))
- (mark gnus-read-mark))
- (unless
- (and
- (get-buffer buffer)
- (with-current-buffer buffer
- (when gnus-newsgroup-prepared
- (when (and gnus-newsgroup-auto-expire
- (memq mark gnus-auto-expirable-marks))
- (setq mark gnus-expirable-mark))
- (setq mark (gnus-request-update-mark
- group article mark))
- (gnus-mark-article-as-read article mark)
- (setq gnus-newsgroup-active (gnus-active group))
- t)))
- (gnus-group-make-articles-read group
- (list article))
+ (mark gnus-read-mark)
+ active n)
+ (if (get-buffer buffer)
+ (with-current-buffer buffer
+ (setq active gnus-newsgroup-active)
+ (gnus-activate-group group)
+ (when gnus-newsgroup-prepared
+ (when (and gnus-newsgroup-auto-expire
+ (memq mark gnus-auto-expirable-marks))
+ (setq mark gnus-expirable-mark))
+ (setq mark (gnus-request-update-mark
+ group article mark))
+ (gnus-mark-article-as-read article mark)
+ (setq gnus-newsgroup-active (gnus-active group))
+ (when active
+ (setq n (1+ (cdr active)))
+ (while (<= n (cdr gnus-newsgroup-active))
+ (unless (eq n article)
+ (push n gnus-newsgroup-unselected))
+ (setq n (1+ n)))
+ (setq gnus-newsgroup-unselected
+ (nreverse gnus-newsgroup-unselected)))))
+ (gnus-activate-group group)
+ (gnus-group-make-articles-read group (list article))
(when (gnus-group-auto-expirable-p group)
(gnus-add-marked-articles
group 'expire (list article))))))
projects / gnus / blobdiff