X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=365b0ab4ba4a88d8fa4b4884d0f39f88fcb36e8f;hp=0c3346ac11565219801a3dbcf2f1c7af441a3ebf;hb=997404c721a1de533aa9f82d4d5bbc5447bfc23d;hpb=2479b2abf77e2b50a95ae8c9a231028e7d42a761 diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 0c3346ac1..365b0ab4b 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,6 +1,6 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996-2012 Free Software Foundation, Inc. +;; Copyright (C) 1996-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (defvar tool-bar-mode) @@ -571,7 +567,6 @@ simple manner.") "p" gnus-group-prev-unread-group "\177" gnus-group-prev-unread-group [delete] gnus-group-prev-unread-group - [backspace] gnus-group-prev-unread-group "N" gnus-group-next-group "P" gnus-group-prev-group "\M-n" gnus-group-next-unread-group-same-level @@ -1105,7 +1100,7 @@ When FORCE, rebuild the tool bar." (set (make-local-variable 'tool-bar-map) map)))) gnus-group-tool-bar-map) -(defun gnus-group-mode () +(define-derived-mode gnus-group-mode fundamental-mode "Group" "Major mode for reading news. All normal editing commands are switched off. @@ -1122,17 +1117,12 @@ For more in-depth information on this mode, read the manual (`\\[gnus-info-find- The following commands are available: \\{gnus-group-mode-map}" - (interactive) - (kill-all-local-variables) (when (gnus-visual-p 'group-menu 'menu) (gnus-group-make-menu-bar) (gnus-group-make-tool-bar)) (gnus-simplify-mode-line) - (setq major-mode 'gnus-group-mode) - (setq mode-name "Group") (gnus-group-set-mode-line) (setq mode-line-process nil) - (use-local-map gnus-group-mode-map) (buffer-disable-undo) (setq truncate-lines t) (setq buffer-read-only t @@ -1143,8 +1133,7 @@ The following commands are available: (when gnus-use-undo (gnus-undo-mode 1)) (when gnus-slave - (gnus-slave-mode)) - (gnus-run-mode-hooks 'gnus-group-mode-hook)) + (gnus-slave-mode))) (defun gnus-update-group-mark-positions () (save-excursion @@ -1193,7 +1182,7 @@ The following commands are available: (defun gnus-group-setup-buffer () (set-buffer (gnus-get-buffer-create gnus-group-buffer)) - (unless (eq major-mode 'gnus-group-mode) + (unless (derived-mode-p 'gnus-group-mode) (gnus-group-mode))) (defun gnus-group-name-charset (method group) @@ -1667,7 +1656,7 @@ and ends at END." (let ((face (cdar (gnus-group-update-eval-form group gnus-group-highlight)))) - (unless (eq face (get-text-property beg 'face)) + (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (let ((inhibit-read-only t)) (gnus-put-text-property-excluding-characters-with-faces beg end 'face @@ -2147,7 +2136,7 @@ be permanent." (defun gnus-group-name-at-point () "Return a group name from around point if it exists, or nil." - (if (eq major-mode 'gnus-group-mode) + (if (derived-mode-p 'gnus-group-mode) (let ((group (gnus-group-group-name))) (when group (gnus-group-decoded-name group))) @@ -2290,9 +2279,12 @@ Return the name of the group if selection was successful." ;; (gnus-read-group "Group name: ") (gnus-group-completing-read) (gnus-read-method "From method"))) - ;; Transform the select method into a unique server. (unless (gnus-alive-p) - (gnus-no-server)) + (nnheader-init-server-buffer) + ;; Necessary because of funky inlining. + (require 'gnus-cache) + (setq gnus-newsrc-hashtb (gnus-make-hashtable))) + ;; Transform the select method into a unique server. (when (stringp method) (setq method (gnus-server-to-method method))) (let ((address-slot @@ -2307,23 +2299,28 @@ Return the name of the group if selection was successful." (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name (gnus-group-real-name group) method)))) + (gnus-set-active group nil) (gnus-sethash group `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method ,(cons - (cond - (quit-config - (cons 'quit-config quit-config)) - ((assq gnus-current-window-configuration - gnus-buffer-configuration) - (cons 'quit-config + (cons 'quit-config + (cond + (quit-config + quit-config) + ((assq gnus-current-window-configuration + gnus-buffer-configuration) (cons gnus-summary-buffer - gnus-current-window-configuration)))) + gnus-current-window-configuration)) + (t + (cons (current-buffer) + (current-window-configuration))))) parameters))) gnus-newsrc-hashtb) (push method gnus-ephemeral-servers) - (set-buffer gnus-group-buffer) + (when (gnus-buffer-live-p gnus-group-buffer) + (set-buffer gnus-group-buffer)) (unless (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (when activate @@ -2381,7 +2378,7 @@ specified by `gnus-gmane-group-download-format'." group start (+ start range))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group - (format "%s.start-%s.range-%s" group start range) + (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range) `(nndoc ,tmpfile (nndoc-article-type mbox)))) (delete-file tmpfile))) @@ -2434,7 +2431,7 @@ Valid input formats include: (gnus-read-ephemeral-gmane-group group start range))) (defcustom gnus-bug-group-download-format-alist - '((emacs . "http://debbugs.gnu.org/%s;mboxmaint=yes;mboxstat=yes") + '((emacs . "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;mboxstat=yes") (debian . "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. @@ -2458,26 +2455,27 @@ the bug number, and browsing the URL must return mbox output." (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 - (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)) - nil window-conf)) + (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) + (let ((coding-system-for-write 'binary) + (coding-system-for-read 'binary)) + (with-temp-file tmpfile + (mm-enable-multibyte) + (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://" "") + "/.*$" "")))))) + (gnus-group-read-ephemeral-group + (format "nndoc+ephemeral:bug#%s" + (mapconcat 'number-to-string ids ",")) + `(nndoc ,tmpfile + (nndoc-article-type mbox)) + nil window-conf) (delete-file tmpfile))) (defun gnus-read-ephemeral-debian-bug-group (number) @@ -2726,7 +2724,7 @@ server." (interactive (list (gnus-read-group "Group name: ") - (gnus-read-method "From method"))) + (gnus-read-method "Select method for new group (use tab for completion)"))) (when (stringp method) (setq method (or (gnus-server-to-method method) method))) @@ -2787,14 +2785,21 @@ server." (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))) +(defun gnus-group-delete-articles (group &optional oldp) + "Delete all articles in the current group. +If OLDP (the prefix), only delete articles that are \"old\", +according to the expiry settings. Note that this will delete old +not-expirable articles, too." + (interactive (list (gnus-group-group-name) + current-prefix-arg)) (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)))) + (gnus-request-expire-articles articles group + (if current-prefix-arg + nil + 'force))))) (defun gnus-group-delete-group (group &optional force no-prompt) "Delete the current group. Only meaningful with editable groups. @@ -3098,7 +3103,7 @@ If SOLID (the prefix), create a solid group." (gnus-group-read-ephemeral-group group method t (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) + (if (derived-mode-p 'gnus-summary-mode) 'summary 'group)))))) (defvar nnrss-group-alist) (eval-when-compile @@ -3213,7 +3218,7 @@ mail messages or news articles in files that have numeric names." (unless (gnus-group-read-ephemeral-group name method t (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) + (if (derived-mode-p 'gnus-summary-mode) 'summary 'group))) (error "Couldn't enter %s" dir)))) @@ -3582,6 +3587,8 @@ Cross references (Xref: header) of articles are ignored." (interactive "P") (gnus-group-catchup-current n 'all)) +(declare-function gnus-sequence-of-unread-articles "gnus-sum" (group)) + (defun gnus-group-catchup (group &optional all) "Mark all articles in GROUP as read. If ALL is non-nil, all articles are marked as read. @@ -4036,7 +4043,8 @@ otherwise all levels below ARG will be scanned too." (unless gnus-slave (gnus-master-read-slave-newsrc)) - (gnus-get-unread-articles arg nil one-level) + (gnus-get-unread-articles (gnus-group-default-level arg t) + nil one-level) ;; If the user wants it, we scan for new groups. (when (eq gnus-check-new-newsgroups 'always) @@ -4300,7 +4308,7 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending." (unless (or (eq buf group-buf) (eq buf gnus-dribble-buffer) (with-current-buffer buf - (eq major-mode 'message-mode))) + (derived-mode-p 'message-mode))) (gnus-kill-buffer buf))) (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) @@ -4369,7 +4377,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (defun gnus-group-browse-foreign-server (method) "Browse a foreign news server. If called interactively, this function will ask for a select method - (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). + (nntp, nnspool, etc.) and a server address (e.g., nntp.some.where). If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive @@ -4385,7 +4393,12 @@ and the second element is the address." ;; Suggested by mapjph@bath.ac.uk. (gnus-completing-read "Address" - gnus-secondary-servers)) + ;; FIXME? gnus-secondary-servers is obsolete, + ;; and it is not obvious that there is anything + ;; sensible to use instead in this particular case. + (if (boundp 'gnus-secondary-servers) + gnus-secondary-servers + (cdr gnus-select-method)))) ;; We got a server name. how)))) (gnus-browse-foreign-server method)) @@ -4444,12 +4457,6 @@ and the second element is the address." (gnus-list-of-unread-articles (car info)))))) (error "No such group: %s" (gnus-info-group info)))))) -(defun gnus-group-set-method-info (group select-method) - (gnus-group-set-info select-method group '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) @@ -4491,6 +4498,8 @@ and the second element is the address." (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) +(declare-function gnus-summary-add-mark "gnus-sum" (article type)) + (defun gnus-add-mark (group mark article) "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." (let ((buffer (gnus-summary-buffer-name group))) @@ -4655,6 +4664,9 @@ you the groups that have both dormant articles and cached articles." (let ((gnus-group-list-option 'limit)) (gnus-group-list-plus args))) +(declare-function gnus-mark-article-as-read "gnus-sum" (article &optional mark)) +(declare-function gnus-group-make-articles-read "gnus-sum" (group articles)) + (defun gnus-group-mark-article-read (group article) "Mark ARTICLE read." (let ((buffer (gnus-summary-buffer-name group)) @@ -4670,6 +4682,8 @@ you the groups that have both dormant articles and cached articles." (setq mark gnus-expirable-mark)) (setq mark (gnus-request-update-mark group article mark)) + (gnus-request-set-mark + group (list (list (list article) 'add '(read)))) (gnus-mark-article-as-read article mark) (setq gnus-newsgroup-active (gnus-active group)) (when active