"*Function used for sorting the group buffer.
This function will be called with group info entries as the arguments
for the groups to be sorted. Pre-made functions include
-`gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
-`gnus-group-sort-by-level', `gnus-group-sort-by-score',
-`gnus-group-sort-by-method', and `gnus-group-sort-by-rank'.
+`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
+`gnus-group-sort-by-unread', `gnus-group-sort-by-level',
+`gnus-group-sort-by-score', `gnus-group-sort-by-method', and
+`gnus-group-sort-by-rank'.
This variable can also be a list of sorting functions. In that case,
the most significant sort function should be the last function in the
(defvar gnus-group-mode-hook nil
"*A hook for Gnus group mode.")
+(defvar gnus-group-menu-hook nil
+ "*Hook run after the creation of the group mode menu.")
+
(defvar gnus-group-catchup-group-hook nil
"*A hook run when catching up a group from the group buffer.")
"V" gnus-group-make-empty-virtual
"D" gnus-group-enter-directory
"f" gnus-group-make-doc-group
+ "n" gnus-group-make-web-group
"r" gnus-group-rename-group
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
"\C-k" gnus-group-kill-level
"z" gnus-group-kill-all-zombies))
+
+(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)]
+ ["See old articles" (gnus-group-select-group 'all)
+ :keys "C-u SPC" :active (gnus-group-group-name)]
+ ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
+ ["Catch up all articles" gnus-group-catchup-current-all
+ (gnus-group-group-name)]
+ ["Check for new articles" gnus-group-get-new-news-this-group
+ (gnus-group-group-name)]
+ ["Toggle subscription" gnus-group-unsubscribe-current-group
+ (gnus-group-group-name)]
+ ["Kill" gnus-group-kill-group (gnus-group-group-name)]
+ ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
+ ["Describe" gnus-group-describe-group (gnus-group-group-name)]
+ ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
+ ["Edit kill file" gnus-group-edit-local-kill
+ (gnus-group-group-name)]
+ ;; 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
+ (gnus-group-group-name)]
+ ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
+ ))
+
+ (easy-menu-define
+ gnus-group-group-menu gnus-group-mode-map ""
+ '("Groups"
+ ("Listing"
+ ["List unread subscribed groups" gnus-group-list-groups t]
+ ["List (un)subscribed groups" gnus-group-list-all-groups t]
+ ["List killed groups" gnus-group-list-killed gnus-killed-list]
+ ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
+ ["List level..." gnus-group-list-level t]
+ ["Describe all groups" gnus-group-describe-all-groups t]
+ ["Group apropos..." gnus-group-apropos t]
+ ["Group and description apropos..." gnus-group-description-apropos t]
+ ["List groups matching..." gnus-group-list-matching t]
+ ["List all groups matching..." gnus-group-list-all-matching t]
+ ["List active file" gnus-group-list-active t])
+ ("Sort"
+ ["Default sort" gnus-group-sort-groups
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by method" gnus-group-sort-groups-by-method
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by rank" gnus-group-sort-groups-by-rank
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by score" gnus-group-sort-groups-by-score
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by level" gnus-group-sort-groups-by-level
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by unread" gnus-group-sort-groups-by-unread
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by name" gnus-group-sort-groups-by-alphabet
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
+ ("Mark"
+ ["Mark group" gnus-group-mark-group
+ (and (gnus-group-group-name)
+ (not (memq (gnus-group-group-name) gnus-group-marked)))]
+ ["Unmark group" gnus-group-unmark-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 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]
+ ["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]
+ ["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 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
+ (gnus-check-backend-function
+ 'request-delete-group (gnus-group-group-name))])
+ ("Editing groups"
+ ["Parameters" gnus-group-edit-group-parameters
+ (gnus-group-group-name)]
+ ["Select method" gnus-group-edit-group-method
+ (gnus-group-group-name)]
+ ["Info" gnus-group-edit-group (gnus-group-group-name)])
+ ("Score file"
+ ["Flush cache" gnus-score-flush-cache t])
+ ("Move"
+ ["Next" gnus-group-next-group t]
+ ["Previous" gnus-group-prev-group t]
+ ["Next unread" gnus-group-next-unread-group t]
+ ["Previous unread" gnus-group-prev-unread-group t]
+ ["Next unread same level" gnus-group-next-unread-group-same-level t]
+ ["Previous unread same level"
+ gnus-group-previous-unread-group-same-level 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])
+ ["Transpose" gnus-group-transpose-groups
+ (gnus-group-group-name)]
+ ["Read a directory as a group..." gnus-group-enter-directory t]
+ ))
+
+ (easy-menu-define
+ gnus-group-misc-menu gnus-group-mode-map ""
+ '("Misc"
+ ["Send a bug report" gnus-bug t]
+ ["Send a mail" gnus-group-mail t]
+ ["Post an article..." gnus-group-post-news t]
+ ["Customize score file" gnus-score-customize t]
+ ["Check for new news" gnus-group-get-new-news t]
+ ["Activate all groups" gnus-activate-all-groups t]
+ ["Delete bogus groups" gnus-group-check-bogus-groups t]
+ ["Find new newsgroups" gnus-find-new-newsgroups 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]
+ ["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]
+ ["Gnus version" gnus-version t]
+ ["Save .newsrc files" gnus-group-save-newsrc t]
+ ["Suspend Gnus" gnus-group-suspend t]
+ ["Clear dribble buffer" gnus-group-clear-dribble t]
+ ["Edit global kill file" gnus-group-edit-global-kill t]
+ ["Read manual" gnus-info-find-node t]
+ ["Toggle topics" gnus-topic-mode t]
+ ("SOUP"
+ ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
+ ["Send replies" gnus-soup-send-replies
+ (fboundp 'gnus-soup-pack-packet)]
+ ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
+ ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
+ ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
+ ["Exit from Gnus" gnus-group-exit t]
+ ["Exit without saving" gnus-group-quit t]
+ ))
+
+ (run-hooks 'gnus-group-menu-hook)
+ ))
+
(defun gnus-group-mode ()
"Major mode for reading news.
(buffer-disable-undo (current-buffer))
(setq truncate-lines t)
(setq buffer-read-only t)
+ (gnus-set-default-directory)
(gnus-update-format-specifications nil 'group 'group-mode)
(gnus-update-group-mark-positions)
(gnus-make-local-hook 'post-command-hook)
Default is all subscribed groups.
If argument UNREAD is non-nil, groups with no unread articles are also
listed."
- (interactive (list (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- (or
- (gnus-group-default-level nil t)
- gnus-group-default-list-level
- gnus-level-subscribed))))
- (or level
- (setq level (car gnus-group-list-mode)
- unread (cdr gnus-group-list-mode)))
+ (interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ (or
+ (gnus-group-default-level nil t)
+ gnus-group-default-list-level
+ gnus-level-subscribed))))
+ (unless level
+ (setq level (car gnus-group-list-mode)
+ unread (cdr gnus-group-list-mode)))
(setq level (gnus-group-default-level level))
(gnus-group-setup-buffer) ;May call from out of group buffer
(gnus-update-format-specifications)
;; has disappeared in the new listing, try to find the next
;; one. If no next one can be found, just leave point at the
;; first newsgroup in the buffer.
- (if (not (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
- (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
- (while (and newsrc
- (not (gnus-goto-char
- (text-property-any
- (point-min) (point-max) 'gnus-group
- (gnus-intern-safe
- (caar newsrc) gnus-active-hashtb)))))
- (setq newsrc (cdr newsrc)))
- (or newsrc (progn (goto-char (point-max))
- (forward-line -1)))))))
+ (when (not (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe
+ group gnus-active-hashtb))))
+ (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
+ (while (and newsrc
+ (not (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max) 'gnus-group
+ (gnus-intern-safe
+ (caar newsrc) gnus-active-hashtb)))))
+ (setq newsrc (cdr newsrc)))
+ (unless newsrc
+ (goto-char (point-max))
+ (forward-line -1))))))
;; Adjust cursor point.
(gnus-group-position-point))))
(not (gnus-ephemeral-group-p group))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
- (prin1-to-string (nth 2 entry)) ")")))
+ (gnus-prin1-to-string (nth 2 entry)) ")")))
(setq gnus-group-indentation (gnus-group-group-indentation))
(gnus-delete-line)
(gnus-group-insert-group-line-info group)
;; Allow XEmacs to remove front-sticky text properties.
(gnus-group-remove-excess-properties)))
+(defun gnus-group-highlight-line ()
+ "Highlight the current line according to `gnus-group-highlight'."
+ (let* ((list gnus-group-highlight)
+ (p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point)))
+ (group (gnus-group-group-name))
+ (entry (gnus-group-entry group))
+ (unread (if (numberp (car entry)) (car entry) 0))
+ (active (gnus-active group))
+ (total (if active (1+ (- (cdr active) (car active))) 0))
+ (info (nth 2 entry))
+ (method (gnus-server-get-method group (gnus-info-method info)))
+ (marked (gnus-info-marks info))
+ (mailp (memq 'mail (assoc (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ (level (or (gnus-info-level info) 9))
+ (score (or (gnus-info-score info) 0))
+ (ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (inhibit-read-only t))
+ ;; Eval the cars of the lists until we find a match.
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list)))
+ (let ((face (cdar list)))
+ (unless (eq face (get-text-property beg 'face))
+ (gnus-put-text-property
+ beg end 'face
+ (setq face (if (boundp face) (symbol-value face) face)))
+ (gnus-extent-start-open beg)))
+ (goto-char p)))
+
(defun gnus-group-update-group (group &optional visible-only)
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
(let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
(if (and entry (not (gnus-ephemeral-group-p group)))
(gnus-dribble-enter
- (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (nth 2 entry))
")"))))
;; Find all group instances. If topics are in use, each group
;; may be listed in more than once.
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
-(defun gnus-group-read-ephemeral-group
- (group method &optional activate quit-config request-only)
+(defun gnus-group-read-ephemeral-group (group method &optional activate
+ quit-config request-only)
"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 QUIT-CONFIG, use that window configuration when exiting from the
+ephemeral group.
+If REQUEST-ONLY, don't actually read the group; just request it.
Return the name of the group is selection was successful."
(let ((group (if (gnus-group-foreign-p group) group
(error "Unable to contact server: %s" (gnus-status-message method)))
(when activate
(unless (gnus-request-group group)
- (error "Couldn't request group")))
+ (error "Couldn't request group: %s"
+ (nnheader-get-report (car method)))))
(if request-only
group
(condition-case ()
(gnus-set-active nname (cons 1 0))
(or (gnus-ephemeral-group-p name)
(gnus-dribble-enter
- (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (cdr info)) ")")))
;; Insert the line.
(gnus-group-insert-group-line-info nname)
(forward-line -1)
(list 'nndoc-address file)
(list 'nndoc-article-type (or type 'guess))))))
+(defvar nnweb-type-definition)
+(defvar gnus-group-web-type-history nil)
+(defvar gnus-group-web-search-history nil)
+(defun gnus-group-make-web-group (&optional solid)
+ "Create an ephemeral nnweb group.
+If SOLID (the prefix), create a solid group."
+ (interactive "P")
+ (require 'nnweb)
+ (let* ((group
+ (if solid (read-string "Group name: ") (message-unique-id)))
+ (type
+ (completing-read
+ "Search engine type: "
+ (mapcar (lambda (elem) (list (symbol-name (car elem))))
+ nnweb-type-definition)
+ nil t (cons (or (car gnus-group-web-type-history)
+ (symbol-name (caar nnweb-type-definition)))
+ 0)
+ 'gnus-group-web-type-history))
+ (search
+ (read-string
+ "Search string: "
+ (cons (or (car gnus-group-web-search-history) "") 0)
+ 'gnus-group-web-search-history))
+ (method
+ `(nnweb ,group (nnweb-search ,search)
+ (nnweb-type ,(intern type)))))
+ (if solid
+ (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))))))
+
(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."
(defun gnus-group-enter-directory (dir)
"Enter an ephemeral nneething group."
(interactive "DDirectory to read: ")
- (let* ((method (list 'nneething dir))
+ (let* ((method (list 'nneething dir '(nneething-read-only t)))
(leaf (gnus-group-prefixed-name
(file-name-nondirectory (directory-file-name dir))
method))
(name (gnus-generate-new-group-name leaf)))
- (let ((nneething-read-only t))
- (or (gnus-group-read-ephemeral-group
- name method t
- (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
- 'summary 'group)))
- (error "Couldn't enter %s" dir)))))
+ (unless (gnus-group-read-ephemeral-group
+ name method t
+ (cons (current-buffer)
+ (if (eq major-mode 'gnus-summary-mode)
+ 'summary 'group)))
+ (error "Couldn't enter %s" dir))))
;; Group sorting commands
;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
"Sort alphabetically."
(string< (gnus-info-group info1) (gnus-info-group info2)))
+(defun gnus-group-sort-by-real-name (info1 info2)
+ "Sort alphabetically on real (unprefixed) names."
+ (string< (gnus-group-real-name (gnus-info-group info1))
+ (gnus-group-real-name (gnus-info-group info2))))
+
(defun gnus-group-sort-by-unread (info1 info2)
"Sort by number of unread articles."
(let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
re-scanning. If ARG is non-nil and not a number, this will force
\"hard\" re-reading of the active files from all servers."
(interactive "P")
- (save-excursion
- (set-buffer gnus-group-buffer)
- (run-hooks 'gnus-get-new-news-hook)
- ;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
- (null arg))
- (gnus-nocem-scan-groups))
- ;; If ARG is not a number, then we read the active file.
- (when (and arg (not (numberp arg)))
- (let ((gnus-read-active-file t))
- (gnus-read-active-file))
- (setq arg nil))
-
- (setq arg (gnus-group-default-level arg t))
- (if (and gnus-read-active-file (not arg))
- (progn
- (gnus-read-active-file)
- (gnus-get-unread-articles arg))
- (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
- (gnus-get-unread-articles arg)))
- (run-hooks 'gnus-after-getting-new-news-hook)
- (gnus-group-list-groups)))
+ (run-hooks 'gnus-get-new-news-hook)
+ ;; We might read in new NoCeM messages here.
+ (when (and gnus-use-nocem
+ (null arg))
+ (gnus-nocem-scan-groups))
+ ;; If ARG is not a number, then we read the active file.
+ (when (and arg (not (numberp arg)))
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file))
+ (setq arg nil))
+
+ (setq arg (gnus-group-default-level arg t))
+ (if (and gnus-read-active-file (not arg))
+ (progn
+ (gnus-read-active-file)
+ (gnus-get-unread-articles arg))
+ (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
+ (gnus-get-unread-articles arg)))
+ (run-hooks 'gnus-after-getting-new-news-hook)
+ (gnus-group-list-groups))
(defun gnus-group-get-new-news-this-group (&optional n)
"Check for newly arrived news in the current group (and the N-1 next groups).
group)
(while (setq group (pop groups))
(gnus-group-remove-mark group)
+ ;; Bypass any previous denials from the server.
+ (gnus-remove-denial (gnus-find-method-for-group group))
(if (gnus-activate-group group 'scan)
(progn
(gnus-get-unread-articles-in-group
(gnus-group-update-group group))
(if (eq (gnus-server-status (gnus-find-method-for-group group))
'denied)
- (gnus-error "Server denied access")
+ (gnus-error 3 "Server denied access")
(gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
(when beg (goto-char beg))
(when gnus-goto-next-group-when-activating
ret))
(defun gnus-group-fetch-faq (group &optional faq-dir)
- "Fetch the FAQ for the current group."
+ "Fetch the FAQ for the current group.
+If given a prefix argument, prompt for the FAQ dir
+to use."
(interactive
(list
- (and (gnus-group-group-name)
- (gnus-group-real-name (gnus-group-group-name)))
+ (gnus-group-group-name)
(cond (current-prefix-arg
(completing-read
"Faq dir: " (and (listp gnus-group-faq-directory)
(mapcar (lambda (file) (list file))
gnus-group-faq-directory)))))))
- (or faq-dir
- (setq faq-dir (if (listp gnus-group-faq-directory)
- (car gnus-group-faq-directory)
- gnus-group-faq-directory)))
- (or group (error "No group name given"))
- (let ((file (concat (file-name-as-directory faq-dir)
- (gnus-group-real-name group))))
- (if (not (file-exists-p file))
- (error "No such file: %s" file)
- (find-file file))))
+ (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)))
+ (setq file (concat (file-name-as-directory dir)
+ (gnus-group-real-name group)))
+ (if (not (file-exists-p file))
+ (gnus-message 1 "No such file: %s" file)
+ (find-file file)
+ (setq found t)))))
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
"Force Gnus to read the .newsrc file."
(interactive "P")
(when (gnus-yes-or-no-p
- (format "Are you sure you want to read %s? "
- gnus-current-startup-file))
+ (format "Are you sure you want to restart Gnus? "))
(gnus-save-newsrc-file)
(gnus-setup-news 'force)
(gnus-group-list-groups arg)))
projects / gnus / blobdiff