;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Code:
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(autoload 'gnus-agent-total-fetched-for "gnus-agent")
(autoload 'gnus-cache-total-fetched-for "gnus-cache")
-(defcustom gnus-group-archive-directory
- "/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/"
- "*The address of the most recent (ding) articles."
- :group 'gnus-group-foreign
- :type 'directory)
+(autoload 'gnus-group-make-nnir-group "nnir")
-(defcustom gnus-no-groups-message "No Gnus is good news"
+(defcustom gnus-no-groups-message "No news is good news"
"*Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'string)
:type 'boolean)
(defcustom gnus-group-default-list-level gnus-level-subscribed
- "*Default listing level.
+ "Default listing level.
Ignored if `gnus-group-use-permanent-levels' is non-nil."
:group 'gnus-group-listing
- :type 'integer)
+ :type '(choice (integer :tag "Level")
+ (function :tag "Function returning level")))
(defcustom gnus-group-list-inactive-groups t
"*If non-nil, inactive groups will be listed."
gnus-group-news-low))
"*Controls the highlighting of group buffer lines.
-Below is a list of `Form'/`Face' pairs. When deciding how a a
+Below is a list of `Form'/`Face' pairs. When deciding how a
particular group line should be displayed, each form is
evaluated. The content of the face field after the first true form is
used. You can change how those group lines are displayed by
(defvar gnus-group-list-mode nil)
-(defvar gnus-group-icon-cache nil)
-
(defvar gnus-group-listed-groups nil)
(defvar gnus-group-list-option nil)
"d" gnus-group-make-directory-group
"h" gnus-group-make-help-group
"u" gnus-group-make-useful-group
- "a" gnus-group-make-archive-group
"l" gnus-group-nnimap-edit-acl
"m" gnus-group-make-group
"E" gnus-group-edit-group
"D" gnus-group-enter-directory
"f" gnus-group-make-doc-group
"w" gnus-group-make-web-group
+ "G" gnus-group-make-nnir-group
"M" gnus-group-read-ephemeral-group
"r" gnus-group-rename-group
"R" gnus-group-make-rss-group
"M" gnus-group-list-all-matching
"l" gnus-group-list-level
"c" gnus-group-list-cached
- "?" gnus-group-list-dormant)
+ "?" gnus-group-list-dormant
+ "!" gnus-group-list-ticked)
(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
"k" gnus-group-list-limit
"M" gnus-group-list-limit
"l" gnus-group-list-limit
"c" gnus-group-list-limit
- "?" gnus-group-list-limit)
+ "?" gnus-group-list-limit
+ "!" gnus-group-list-limit)
(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
"k" gnus-group-list-flush
"M" gnus-group-list-flush
"l" gnus-group-list-flush
"c" gnus-group-list-flush
- "?" gnus-group-list-flush)
+ "?" gnus-group-list-flush
+ "!" gnus-group-list-flush)
(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
"k" gnus-group-list-plus
"M" gnus-group-list-plus
"l" gnus-group-list-plus
"c" gnus-group-list-plus
- "?" gnus-group-list-plus)
+ "?" gnus-group-list-plus
+ "!" gnus-group-list-plus)
(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
"f" gnus-score-flush-cache
"e" gnus-score-edit-all-score)
(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)
(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
(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
["Describe" gnus-group-describe-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
["List all groups matching..." gnus-group-list-all-matching t]
["List active file" gnus-group-list-active t]
["List groups with cached" gnus-group-list-cached t]
- ["List groups with dormant" gnus-group-list-dormant t])
+ ["List groups with dormant" gnus-group-list-dormant t]
+ ["List groups with ticked" gnus-group-list-ticked t])
("Sort"
["Default sort" gnus-group-sort-groups t]
["Sort by method" gnus-group-sort-groups-by-method 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 search group..." gnus-group-make-nnir-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t]
["Add a group to a virtual..." gnus-group-add-to-virtual t]
["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
'gnus-group-tool-bar-retro)
"Specifies the Gnus group tool bar.
-It can be either a list or a symbol refering to a list. See
+It can be either a list or a symbol referring to a list. See
`gmm-tool-bar-from-list' for the format of the list. The
default key map is `gnus-group-mode-map'.
'((gnus-group-post-news "mail/compose")
;; Some useful agent icons? I don't use the agent so agent users should
;; suggest useful commands:
- (gnus-agent-toggle-plugged "disconnect" t
+ (gnus-agent-toggle-plugged "unplugged" t
:help "Gnus is currently unplugged. Click to work online."
:visible (and gnus-agent (not gnus-plugged)))
- (gnus-agent-toggle-plugged "connect" t
+ (gnus-agent-toggle-plugged "plugged" t
:help "Gnus is currently plugged. Click to work offline."
:visible (and gnus-agent gnus-plugged))
;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
(when (and (not (featurep 'xemacs))
(boundp 'tool-bar-mode)
tool-bar-mode
- ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
- ;; Why? --rsteib
+ (display-graphic-p)
(or (not gnus-group-tool-bar-map) force))
(let* ((load-path
(gmm-image-load-path-for-library "gnus"
(mouse-set-point e)
(gnus-group-read-group nil))
+(defun gnus-group-default-list-level ()
+ "Return the real value for `gnus-group-default-list-level'."
+ (if (functionp gnus-group-default-list-level)
+ (funcall gnus-group-default-list-level)
+ gnus-group-default-list-level))
+
;; Look at LEVEL and find out what the level is really supposed to be.
;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
;; will depend on whether `gnus-group-use-permanent-levels' is used.
(or (setq gnus-group-use-permanent-levels
(or level (if (numberp gnus-group-use-permanent-levels)
gnus-group-use-permanent-levels
- (or gnus-group-default-list-level
+ (or (gnus-group-default-list-level)
gnus-level-subscribed))))
- gnus-group-default-list-level gnus-level-subscribed))
+ (gnus-group-default-list-level) gnus-level-subscribed))
(number-or-nil
level)
(t
- (or level gnus-group-default-list-level gnus-level-subscribed))))
+ (or level (gnus-group-default-list-level) gnus-level-subscribed))))
(defun gnus-group-setup-buffer ()
(set-buffer (gnus-get-buffer-create gnus-group-buffer))
(unless (eq major-mode 'gnus-group-mode)
- (gnus-group-mode)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'group))))
+ (gnus-group-mode)))
(defun gnus-group-name-charset (method group)
- (if (null method)
- (setq method (gnus-find-method-for-group group)))
- (let ((item (or (assoc method gnus-group-name-charset-method-alist)
- (and (consp method)
- (assoc (list (car method) (cadr method))
- gnus-group-name-charset-method-alist))))
- (alist gnus-group-name-charset-group-alist)
- result)
- (if item
- (cdr item)
- (while (setq item (pop alist))
- (if (string-match (car item) group)
- (setq alist nil
- result (cdr item))))
- result)))
+ (unless method
+ (setq method (gnus-find-method-for-group group)))
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (if (eq (car method) 'nnimap)
+ ;; IMAP groups should not be encoded, since they do the encoding
+ ;; in utf7 in the protocol.
+ 'utf-8
+ (let ((item (or (assoc method gnus-group-name-charset-method-alist)
+ (and (consp method)
+ (assoc (list (car method) (cadr method))
+ gnus-group-name-charset-method-alist))))
+ (alist gnus-group-name-charset-group-alist)
+ result)
+ (if item
+ (cdr item)
+ (while (setq item (pop alist))
+ (if (string-match (car item) group)
+ (setq alist nil
+ result (cdr item))))
+ result))))
(defun gnus-group-name-decode (string charset)
;; Fixme: Don't decode in unibyte mode.
(prefix-numeric-value current-prefix-arg)
(or
(gnus-group-default-level nil t)
- gnus-group-default-list-level
+ (gnus-group-default-list-level)
gnus-level-subscribed))))
(unless level
(setq level (car gnus-group-list-mode)
(predicate t) ; We list all groups?
(t
(or
- (if (eq unread t) ; Unactivated?
+ (if (eq unread t) ; Inactive?
gnus-group-list-inactive-groups
- ; We list unactivated
+ ; We list inactive
(and (numberp unread) (> unread 0)))
; We list groups with unread articles
(and gnus-list-groups-with-ticked-articles
(cdr (assq 'tick (gnus-info-marks info))))
- ; And groups with tickeds
+ ; And groups with ticked articles
;; Check for permanent visibility.
(and gnus-permanently-visible-groups
(string-match gnus-permanently-visible-groups
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string (nth 2 entry))
- ")")))
+ ")")
+ (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))
(setq gnus-group-indentation (gnus-group-group-indentation))
(gnus-delete-line)
(gnus-group-insert-group-line-info group)
(and (not (featurep 'xemacs))
(boundp 'tool-bar-mode)
tool-bar-mode
- ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might
+ ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might
;; be confusing, so maybe we shouldn't call it by default.
(fboundp 'force-window-update))
"Force updating the group buffer tool bar."
?m ? ))
(gnus-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" ""))
- (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-qualified-group))
+ (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group))
(gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
(gnus-tmp-news-method (or (car gnus-tmp-method) ""))
(gnus-tmp-news-method-string
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(gnus-group-highlight-line gnus-tmp-group beg end))
(gnus-run-hooks 'gnus-group-update-hook)
- (forward-line)
- ;; Allow XEmacs to remove front-sticky text properties.
- (gnus-group-remove-excess-properties)))
+ (forward-line)))
(defun gnus-group-update-eval-form (group list)
"Eval `car' of each element of LIST, and return the first that return t.
" "))
" "))
-(defun gnus-group-update-group (group &optional visible-only)
+
+(defun gnus-group-refresh-group (group)
+ (gnus-activate-group group)
+ (gnus-get-unread-articles-in-group (gnus-get-info group)
+ (gnus-active group))
+ (gnus-group-update-group group))
+
+(defun gnus-group-update-group (group &optional visible-only
+ info-unchanged)
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
-already."
+already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(with-current-buffer gnus-group-buffer
(save-excursion
;; The buffer may be narrowed.
(let ((ident (gnus-intern-safe group gnus-active-hashtb))
(loc (point-min))
found buffer-read-only)
- ;; Enter the current status into the dribble buffer.
- (let ((entry (gnus-group-entry group)))
- (when (and entry
- (not (gnus-ephemeral-group-p group)))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (nth 2 entry))
- ")"))))
+ (unless info-unchanged
+ ;; Enter the current status into the dribble buffer.
+ (let ((entry (gnus-group-entry group)))
+ (when (and entry
+ (not (gnus-ephemeral-group-p group)))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (nth 2 entry))
+ ")")
+ (concat "^(gnus-group-set-info '(\""
+ (regexp-quote group) "\"")))))
;; Find all group instances. If topics are in use, each group
;; may be listed in more than once.
(while (setq loc (text-property-any
(unless no-advance
(gnus-group-next-group 1))
(decf n))
- (gnus-summary-position-point)
+ (gnus-group-position-point)
n))
(defun gnus-group-unmark-group (n)
group)))
(goto-char start)))))
-(defun gnus-group-completing-read (prompt &optional collection predicate
- require-match initial-input hist def
- &rest args)
+(defun gnus-group-completing-read (&optional prompt collection
+ require-match initial-input hist
+ def)
"Read a group name with completion. Non-ASCII group names are allowed.
The arguments are the same as `completing-read' except that COLLECTION
and HIST default to `gnus-active-hashtb' and `gnus-group-history'
-respectively if they are omitted."
- (let ((completion-styles (and (boundp 'completion-styles)
- completion-styles))
- group)
- (push 'substring completion-styles)
- (mapatoms (lambda (symbol)
- (setq group (symbol-name symbol))
- (set (intern (if (string-match "[^\000-\177]" group)
- (gnus-group-decoded-name group)
- group)
- collection)
- group))
- (prog1
- (or collection
- (setq collection (or gnus-active-hashtb [0])))
- (setq collection (gnus-make-hashtable (length collection)))))
- (setq group (apply 'completing-read prompt collection predicate
- require-match initial-input
- (or hist 'gnus-group-history)
- def args))
- (or (prog1
- (symbol-value (intern-soft group collection))
- (setq collection nil))
- (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
+respectively if they are omitted. Regards COLLECTION as a hash table
+if it is not a list."
+ (or collection (setq collection gnus-active-hashtb))
+ (let (choices group)
+ (if (listp collection)
+ (dolist (symbol collection)
+ (setq group (symbol-name symbol))
+ (push (if (string-match "[^\000-\177]" group)
+ (gnus-group-decoded-name group)
+ group)
+ choices))
+ (mapatoms (lambda (symbol)
+ (setq group (symbol-name symbol))
+ (push (if (string-match "[^\000-\177]" group)
+ (gnus-group-decoded-name group)
+ group)
+ choices))
+ collection))
+ (setq group (gnus-completing-read (or prompt "Group") (nreverse choices)
+ require-match initial-input
+ (or hist 'gnus-group-history)
+ def))
+ (unless (if (listp collection)
+ (member group (mapcar 'symbol-name collection))
+ (symbol-value (intern-soft group collection)))
+ (setq group
+ (mm-encode-coding-string
+ group (gnus-group-name-charset nil group))))
+ (gnus-replace-in-string group "\n" "")))
;;;###autoload
(defun gnus-fetch-group (group &optional articles)
"Start Gnus if necessary and enter GROUP.
If ARTICLES, display those articles.
Returns whether the fetching was successful or not."
- (interactive (list (gnus-group-completing-read "Group name: "
- nil nil nil
+ (interactive (list (gnus-group-completing-read nil
+ nil nil
(gnus-group-name-at-point))))
(unless (gnus-alive-p)
(gnus-no-server))
(other-frame 1))))
(gnus-fetch-group group))
-(defvar gnus-ephemeral-group-server 0)
-
(defcustom gnus-large-ephemeral-newsgroup 200
"The number of articles which indicates a large ephemeral newsgroup.
Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
number)
"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 QUIT-CONFIG, use that Gnus window configuration name 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.
(interactive
(list
;; (gnus-read-group "Group name: ")
- (gnus-group-completing-read "Group: ")
- (gnus-read-method "From method: ")))
+ (gnus-group-completing-read)
+ (gnus-read-method "From method")))
;; Transform the select method into a unique server.
+ (unless (gnus-alive-p)
+ (gnus-no-server))
(when (stringp method)
(setq method (gnus-server-to-method method)))
(setq method
`(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
,(cons
- (if quit-config
- (cons 'quit-config quit-config)
+ (cond
+ (quit-config
+ (cons 'quit-config quit-config))
+ ((assq gnus-current-window-configuration
+ gnus-buffer-configuration)
(cons 'quit-config
(cons gnus-summary-buffer
- gnus-current-window-configuration)))
+ gnus-current-window-configuration))))
parameters)))
gnus-newsrc-hashtb)
(push method gnus-ephemeral-servers)
gnus-fetch-old-ephemeral-headers))
(gnus-group-read-group (or number t) t group select-articles))
group)
- ;;(error nil)
(quit
- (message "Quit reading the ephemeral group")
+ (if debug-on-quit
+ (debug "Quit")
+ (message "Quit reading the ephemeral group"))
nil)))))
(defcustom gnus-gmane-group-download-format
;; See <http://gmane.org/export.php> for more information.
(interactive
(list
- (gnus-group-completing-read "Gmane group: ")
+ (gnus-group-completing-read "Gmane group")
(read-number "Start article number: ")
(read-number "How many articles: ")))
(unless range (setq range 500))
;; prompt the user to decide: "View via `browse-url' or in Gnus? "
;; (`gnus-read-ephemeral-gmane-group-url')
(interactive
- (list (gnus-group-completing-read "Gmane URL: ")))
+ (list (gnus-group-completing-read "Gmane URL")))
(let (group start range)
(cond
;; URLs providing `group', `start' and `range':
(gnus-read-ephemeral-gmane-group group start range)))
(defcustom gnus-bug-group-download-format-alist
- '((emacs . "http://debbugs.gnu.org/%s;mbox=yes")
+ '((emacs . "http://debbugs.gnu.org/%s;mboxmaint=yes;mboxstat=yes")
(debian
- . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes"))
+ . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes"))
"Alist of symbols for bug trackers and the corresponding URL format string.
The URL format string must contain a single \"%s\", specifying
the bug number, and browsing the URL must return mbox output."
:group 'gnus-group-foreign
- :version "23.2" ;; No Gnus
+ ;; Added mboxmaint=yes. This gets the version with the messages as
+ ;; they went out, not as they came in.
+ ;; Eg bug-gnu-emacs is replaced by ###@debbugs.
+ :version "24.1"
:type '(repeat (cons (symbol) (string :tag "URL format string"))))
-(defun gnus-read-ephemeral-bug-group (number mbox-url)
+(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf)
"Browse bug NUMBER as ephemeral group."
(interactive (list (read-string "Enter bug number: "
(thing-at-point 'word) nil)
;; FIXME: Add completing-read from
;; `gnus-emacs-bug-group-download-format' ...
(cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
- (when (stringp number)
- (setq number (string-to-number number)))
- (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")))
+ (when (stringp ids)
+ (setq ids (string-to-number ids)))
+ (unless (listp ids)
+ (setq ids (list ids)))
+ (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))
+ (coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
(with-temp-file tmpfile
- (url-insert-file-contents (format mbox-url number))
+ (dolist (id ids)
+ (url-insert-file-contents (format mbox-url id)))
+ (goto-char (point-min))
+ ;; Add the debbugs address so that we can respond to reports easily.
+ (while (re-search-forward "^To: " nil t)
+ (end-of-line)
+ (insert (format ", %s@%s" (car ids)
+ (gnus-replace-in-string
+ (gnus-replace-in-string mbox-url "^http://" "")
+ "/.*$" ""))))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
"gnus-read-ephemeral-bug"
`(nndoc ,tmpfile
- (nndoc-article-type mbox))))
+ (nndoc-article-type mbox))
+ nil window-conf))
(delete-file tmpfile)))
(defun gnus-read-ephemeral-debian-bug-group (number)
number
(cdr (assoc 'debian gnus-bug-group-download-format-alist))))
-(defun gnus-read-ephemeral-emacs-bug-group (number)
- "Browse Emacs bug NUMBER as ephemeral group."
- (interactive (list (read-string "Enter bug number: "
- (thing-at-point 'word) nil)))
+(defvar debbugs-gnu-bug-number) ; debbugs-gnu
+
+(defun gnus-read-ephemeral-emacs-bug-group (ids &optional window-conf)
+ "Browse Emacs bugs IDS as an ephemeral group."
+ (interactive (list (string-to-number
+ (read-string "Enter bug number: "
+ (thing-at-point 'word) nil))))
+ (unless (listp ids)
+ (setq ids (list ids)))
(gnus-read-ephemeral-bug-group
- number
- (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
+ ids
+ (cdr (assoc 'emacs gnus-bug-group-download-format-alist))
+ window-conf)
+ (when (fboundp 'debbugs-gnu-summary-mode)
+ (with-current-buffer (window-buffer (selected-window))
+ (debbugs-gnu-summary-mode 1)
+ (set (make-local-variable 'debbugs-gnu-bug-number) (car ids)))))
(defun gnus-group-jump-to-group (group &optional prompt)
"Jump to newsgroup GROUP.
`gnus-group-jump-to-group-prompt'."
(interactive
(list (gnus-group-completing-read
- "Group: " nil nil (gnus-read-active-file-p)
- (if current-prefix-arg
- (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
- (or (and (stringp gnus-group-jump-to-group-prompt)
- gnus-group-jump-to-group-prompt)
- (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
- (and (stringp p) p)))))))
+ nil nil nil
+ (if current-prefix-arg
+ (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
+ (or (and (stringp gnus-group-jump-to-group-prompt)
+ gnus-group-jump-to-group-prompt)
+ (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
+ (and (stringp p) p)))))))
(when (equal group "")
(error "Empty group name"))
(defun gnus-group-make-group-simple (&optional group)
"Add a new newsgroup.
The user will be prompted for GROUP."
- (interactive (list (gnus-group-completing-read "Group: ")))
+ (interactive (list (gnus-group-completing-read)))
(gnus-group-make-group (gnus-group-real-name group)
(gnus-group-server group)
nil nil t))
"Add a new newsgroup.
The user will be prompted for a NAME, for a select METHOD, and an
ADDRESS. NAME should be a human-readable string (i.e., not be encoded
-even if it contains non-ASCII characters) unless ENCODED is non-nil."
+even if it contains non-ASCII characters) unless ENCODED is non-nil.
+
+If the backend supports it, the group will also be created on the
+server."
(interactive
(list
(gnus-read-group "Group name: ")
- (gnus-read-method "From method: ")))
+ (gnus-read-method "From method")))
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
(unless (gnus-ephemeral-group-p name)
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (cdr info)) ")")))
+ (gnus-prin1-to-string (cdr info)) ")")
+ (concat "^(gnus-group-set-info '(\"" (regexp-quote name) "\"")))
;; Insert the line.
(gnus-group-insert-group-line-info nname)
(forward-line -1)
(lambda (group)
(gnus-group-delete-group group nil t))))))
+(defun gnus-group-delete-articles (group)
+ "Delete all articles in the current group."
+ (interactive (list (gnus-group-group-name)))
+ (let ((articles (gnus-uncompress-range (gnus-active group))))
+ (when (gnus-yes-or-no-p
+ (format "Do you really want to delete these %d articles forever? "
+ (length articles)))
+ (gnus-request-expire-articles articles group 'force))))
+
(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
(defun gnus-group-make-useful-group (group method)
"Create one of the groups described in `gnus-useful-groups'."
(interactive
- (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
- nil t)
+ (let ((entry (assoc (gnus-completing-read "Create group"
+ (mapcar 'car gnus-useful-groups)
+ t)
gnus-useful-groups)))
(list (cadr entry)
;; Don't use `caddr' here since macros within the `interactive'
(symbol-name (caar nnweb-type-definition))))
(type
(gnus-string-or
- (completing-read
- (format "Search engine type (default %s): " default-type)
- (mapcar (lambda (elem) (list (symbol-name (car elem))))
+ (gnus-completing-read
+ "Search engine type"
+ (mapcar (lambda (elem) (symbol-name (car elem)))
nnweb-type-definition)
- nil t nil 'gnus-group-web-type-history)
+ t nil 'gnus-group-web-type-history)
default-type))
(search
(read-string
(nnweb-ephemeral-p t))))
(if solid
(progn
- (gnus-pull 'nnweb-ephemeral-p method)
+ (gnus-alist-pull 'nnweb-ephemeral-p method)
(gnus-group-make-group group method))
(gnus-group-read-ephemeral-group
group method t
(nnrss-save-server-data nil))
(error "No feeds found for %s" url))))
-(defun gnus-group-make-archive-group (&optional all)
- "Create the (ding) Gnus archive group of the most recent articles.
-Given a prefix, create a full group."
- (interactive "P")
- (let ((group (gnus-group-prefixed-name
- (if all "ding.archives" "ding.recent") '(nndir ""))))
- (when (gnus-group-entry group)
- (error "Archive group already exists"))
- (gnus-group-make-group
- (gnus-group-real-name group)
- (list 'nndir (if all "hpc" "edu")
- (list 'nndir-directory
- (if all gnus-group-archive-directory
- gnus-group-recent-archive-directory))))
- (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org"))))
-
(defun gnus-group-make-directory-group (dir)
"Create an nndir group.
The user will be prompted for a directory. The contents of this
directory will be used as a newsgroup. The directory should contain
mail messages or news articles in files that have numeric names."
(interactive
- (list (read-file-name "Create group from directory: ")))
+ (list (read-directory-name "Create group from directory: ")))
(unless (file-exists-p dir)
(error "No such directory"))
(unless (file-directory-p dir)
"Add the current group to a virtual group."
(interactive
(list current-prefix-arg
- (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
- "nnvirtual:")))
+ (gnus-group-completing-read "Add to virtual group"
+ nil t "nnvirtual:")))
(unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
(error "%s is not an nnvirtual group" vgroup))
(gnus-close-group vgroup)
"Clear all marks and read ranges from the current group.
Obeys the process/prefix convention."
(interactive "P")
- (gnus-group-iterate arg
- (lambda (group)
- (let (info)
- (gnus-info-clear-data (setq info (gnus-get-info group)))
- (gnus-get-unread-articles-in-group info (gnus-active group) t)
- (when (gnus-group-goto-group group)
- (gnus-group-update-group-line))))))
+ (when (gnus-y-or-n-p "Really clear data? ")
+ (gnus-group-iterate arg
+ (lambda (group)
+ (let (info)
+ (gnus-info-clear-data (setq info (gnus-get-info group)))
+ (gnus-get-unread-articles-in-group info (gnus-active group) t)
+ (when (gnus-group-goto-group group)
+ (gnus-group-update-group-line)))))))
(defun gnus-group-clear-data-on-native-groups ()
"Clear all marks and read ranges from all native groups."
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
- (when (gnus-group-auto-expirable-p group)
+ (when (and (gnus-group-auto-expirable-p group)
+ (not (gnus-group-read-only-p group)))
(gnus-range-map
(lambda (article)
(gnus-add-marked-articles group 'expire (list article))
Killed newsgroups are subscribed. If SILENT, don't try to update the
group line."
(interactive (list (gnus-group-completing-read
- "Group: " nil nil (gnus-read-active-file-p))))
+ nil nil (gnus-read-active-file-p))))
(let ((newsrc (gnus-group-entry group)))
(cond
((string-match "^[ \t]*$" group)
gnus-list-of-killed-groups))
(gnus-group-change-level
(if entry entry group) gnus-level-killed (if entry nil level))
+ (when (numberp (gnus-group-unread group))
+ (gnus-request-update-group-status group 'unsubscribe))
(message "Killed group %s" (gnus-group-decoded-name group)))
;; If there are lots and lots of groups to be killed, we use
;; this thing instead.
(setq gnus-zombie-list (delete group gnus-zombie-list))))
;; There may be more than one instance displayed.
(while (gnus-group-goto-group group)
- (gnus-delete-line)))
+ (gnus-delete-line))
+ (when (numberp (gnus-group-unread group))
+ (gnus-request-update-group-status group 'unsubscribe)))
(gnus-make-hashtable-from-newsrc-alist))
(gnus-group-position-point)
(and prev (gnus-group-entry prev))
t)
(gnus-group-insert-group-line-info group)
+ (gnus-request-update-group-status group 'subscribe)
(gnus-undo-register
`(when (gnus-group-goto-group ,group)
(gnus-group-kill-group 1))))
(gnus-activate-foreign-newsgroups level))
(gnus-group-get-new-news)))
-(defun gnus-group-get-new-news (&optional arg)
+(defun gnus-group-get-new-news (&optional arg one-level)
"Get newly arrived articles.
If ARG is a number, it specifies which levels you are interested in
re-scanning. If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
+\"hard\" re-reading of the active files from all servers.
+If ONE-LEVEL is not nil, then re-scan only the specified level,
+otherwise all levels below ARG will be scanned too."
(interactive "P")
(require 'nnmail)
(let ((gnus-inhibit-demon t)
(unless gnus-slave
(gnus-master-read-slave-newsrc))
- ;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
- (or (and (numberp gnus-use-nocem)
- (numberp arg)
- (>= arg gnus-use-nocem))
- (not arg)))
- (gnus-nocem-scan-groups))
-
- (gnus-get-unread-articles arg)
+ (gnus-get-unread-articles arg nil one-level)
;; If the user wants it, we scan for new groups.
(when (eq gnus-check-new-newsgroups 'always)
(let* ((groups (gnus-group-process-prefix n))
(ret (if (numberp n) (- n (length groups)) 0))
(beg (unless n
- (point)))
+ (point-marker)))
group method
(gnus-inhibit-demon t)
;; Binding this variable will inhibit multiple fetchings
(when gnus-agent
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
- (gnus-group-update-group group))
- (if (eq (gnus-server-status (gnus-find-method-for-group group))
- 'denied)
- (gnus-error 3 "Server denied access")
- (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
+ (gnus-group-update-group group nil t))
+ (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
(when beg
(goto-char beg))
(when gnus-goto-next-group-when-activating
(gnus-group-next-unread-group 1 t))
- (gnus-summary-position-point)
+ (gnus-group-position-point)
ret))
-(defun gnus-group-fetch-faq (group &optional faq-dir)
- "Fetch the FAQ for the current group.
-If given a prefix argument, prompt for the FAQ dir
-to use."
- (interactive
- (list
- (gnus-group-group-name)
- (when current-prefix-arg
- (completing-read
- "FAQ dir: " (and (listp gnus-group-faq-directory)
- (mapcar #'list
- gnus-group-faq-directory))))))
- (unless group
- (error "No group name given"))
- (let ((dirs (or faq-dir gnus-group-faq-directory))
- dir found file)
- (unless (listp dirs)
- (setq dirs (list dirs)))
- (while (and (not found)
- (setq dir (pop dirs)))
- (let ((name (gnus-group-real-name group)))
- (setq file (expand-file-name name dir)))
- (if (not (file-exists-p file))
- (gnus-message 1 "No such file: %s" file)
- (let ((enable-local-variables nil))
- (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
- (gnus-group-completing-read "Group: "))
- (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
- (gnus-group-completing-read "Group: "))
- (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 ".gz"))
- (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 ".gz")))
- (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)))
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))
+ (let ((new-groups (gnus-find-new-newsgroups (or arg 1)))
+ current-group)
+ (gnus-group-list-groups)
+ (setq current-group (gnus-group-group-name))
+ (dolist (group new-groups)
+ (gnus-group-jump-to-group group))
+ (when current-group
+ (gnus-group-jump-to-group current-group))))
(defun gnus-group-edit-global-kill (&optional article group)
"Edit the global kill file.
If not, METHOD should be a list where the first element is the method
and the second element is the address."
(interactive
- (list (let ((how (completing-read
- "Which back end: "
- (append gnus-valid-select-methods gnus-server-alist)
- nil t (cons "nntp" 0) 'gnus-method-history)))
+ (list (let ((how (gnus-completing-read
+ "Which back end"
+ (mapcar 'car (append gnus-valid-select-methods
+ gnus-server-alist))
+ t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a back end name or a virtual server name.
;; If the first, we also need an address.
(if (assoc how gnus-valid-select-methods)
(list (intern how)
;; Suggested by mapjph@bath.ac.uk.
- (completing-read
- "Address: "
- (mapcar 'list gnus-secondary-servers)))
+ (gnus-completing-read
+ "Address"
+ gnus-secondary-servers))
;; We got a server name.
how))))
(gnus-browse-foreign-server method))
(defun gnus-group-set-params-info (group params)
(gnus-group-set-info params group 'params))
+;; Ad-hoc function for inserting data from a different newsrc.eld
+;; file. Use with caution, if at all.
+(defun gnus-import-other-newsrc-file (file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let (form)
+ (while (ignore-errors
+ (setq form (read (current-buffer))))
+ (when (and (consp form)
+ (eq (cadr form) 'gnus-newsrc-alist))
+ (let ((infos (cadr (nth 2 form))))
+ (dolist (info infos)
+ (when (gnus-get-info (car info))
+ (gnus-set-info (car info) info)))))))))
+
(defun gnus-add-marked-articles (group type articles &optional info force)
;; Add ARTICLES of TYPE to the info of GROUP.
;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
(goto-char (point-min))
(gnus-group-position-point))
+(defun gnus-group-list-ticked (level &optional lowest)
+ "List all groups with ticked articles.
+If the prefix LEVEL is non-nil, it should be a number that says which
+level to cut off listing groups.
+If LOWEST, don't list groups with level lower than LOWEST.
+
+This command may read the active file."
+ (interactive "P")
+ (when level
+ (setq level (prefix-numeric-value level)))
+ (when (or (not level) (>= level gnus-level-zombie))
+ (gnus-cache-open))
+ (funcall gnus-group-prepare-function
+ (or level gnus-level-subscribed)
+ #'(lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'tick marks)))
+ lowest
+ 'ignore)
+ (goto-char (point-min))
+ (gnus-group-position-point))
+
(defun gnus-group-listed-groups ()
"Return a list of listed groups."
(let (point groups)
(gnus-group-list-plus args)))
(defun gnus-group-list-limit (&optional args)
- "List groups limited within the current selection."
+ "List groups limited within the current selection.
+If you've limited the groups, you can further limit the selection
+with this command. If you've first limited to groups with
+dormant articles with `A ?', you can then further limit with
+`A / c', which will then limit to groups with cached articles, giving
+you the groups that have both dormant articles and cached articles."
(interactive "P")
(let ((gnus-group-list-option 'limit))
(gnus-group-list-plus args)))
(push n gnus-newsgroup-unselected))
(setq n (1+ n)))
(setq gnus-newsgroup-unselected
- (nreverse gnus-newsgroup-unselected)))))
+ (sort gnus-newsgroup-unselected '<)))))
(gnus-activate-group group)
(gnus-group-make-articles-read group (list article))
- (when (gnus-group-auto-expirable-p group)
+ (when (and (gnus-group-auto-expirable-p group)
+ (not (gnus-group-read-only-p group)))
(gnus-add-marked-articles
group 'expire (list article))))))
projects / gnus / blobdiff