Mercurial > emacs

comparison lisp/gnus.el @ 13694:73433c3071a5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* gnus.el (gnus-parse-headers-hook): New hook. (gnus-get-newsgroup-headers): Call it. (gnus-get-newsgroup-headers-xover): Call it. (gnus-group-mode-map): Moved `gnus-group-fetch-faq' from `M-f' to `H f'. (gnus-summary-copy-article): Allow respooling to any backend. (gnus-summary-set-process-mark): Make sure each article can only be process marked once. (gnus-summary-remove-lines-marked-with): Put point on a valid article after removing lines. (gnus-summary-sort-by-author): Didn't allow sorting when pseudo-articles were present. (gnus-summary-sort-by-subject): Ditto.
author Lars Magne Ingebrigtsen <larsi@gnus.org>
date Wed, 06 Dec 1995 21:19:47 +0000
parents 9426437410bf
children e8358f30c41c
comparison
equal deleted inserted replaced
13693:40766c32c127 13694:73433c3071a5
1191 (defvar gnus-visual-mark-article-hook 1191 (defvar gnus-visual-mark-article-hook
1192 (list 'gnus-highlight-selected-summary) 1192 (list 'gnus-highlight-selected-summary)
1193 "*Hook run after selecting an article in the summary buffer. 1193 "*Hook run after selecting an article in the summary buffer.
1194 It is meant to be used for highlighting the article in some way. It 1194 It is meant to be used for highlighting the article in some way. It
1195 is not run if `gnus-visual' is nil.") 1195 is not run if `gnus-visual' is nil.")
1196
1197 (defun gnus-parse-headers-hook nil
1198 "*A hook called before parsing the headers.")
1196 1199
1197 (defvar gnus-exit-group-hook nil 1200 (defvar gnus-exit-group-hook nil
1198 "*A hook called when exiting (not quitting) summary mode.") 1201 "*A hook called when exiting (not quitting) summary mode.")
1199 1202
1200 (defvar gnus-suspend-gnus-hook nil 1203 (defvar gnus-suspend-gnus-hook nil
3073 3076
3074 (defvar gnus-group-mode-map nil) 3077 (defvar gnus-group-mode-map nil)
3075 (defvar gnus-group-group-map nil) 3078 (defvar gnus-group-group-map nil)
3076 (defvar gnus-group-mark-map nil) 3079 (defvar gnus-group-mark-map nil)
3077 (defvar gnus-group-list-map nil) 3080 (defvar gnus-group-list-map nil)
3081 (defvar gnus-group-help-map nil)
3078 (defvar gnus-group-sub-map nil) 3082 (defvar gnus-group-sub-map nil)
3079 (put 'gnus-group-mode 'mode-class 'special) 3083 (put 'gnus-group-mode 'mode-class 'special)
3080 3084
3081 (if gnus-group-mode-map 3085 (if gnus-group-mode-map
3082 nil 3086 nil
3129 (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc) 3133 (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc)
3130 (define-key gnus-group-mode-map "z" 'gnus-group-suspend) 3134 (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
3131 (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble) 3135 (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble)
3132 (define-key gnus-group-mode-map "q" 'gnus-group-exit) 3136 (define-key gnus-group-mode-map "q" 'gnus-group-exit)
3133 (define-key gnus-group-mode-map "Q" 'gnus-group-quit) 3137 (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
3134 (define-key gnus-group-mode-map "\M-f" 'gnus-group-fetch-faq)
3135 (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly) 3138 (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
3136 (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node) 3139 (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
3137 (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method) 3140 (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method)
3138 (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode) 3141 (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode)
3139 (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group) 3142 (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group)
3178 (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups) 3181 (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups)
3179 (define-key gnus-group-list-map "a" 'gnus-group-apropos) 3182 (define-key gnus-group-list-map "a" 'gnus-group-apropos)
3180 (define-key gnus-group-list-map "d" 'gnus-group-description-apropos) 3183 (define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
3181 (define-key gnus-group-list-map "m" 'gnus-group-list-matching) 3184 (define-key gnus-group-list-map "m" 'gnus-group-list-matching)
3182 (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching) 3185 (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
3186
3187 (define-prefix-command 'gnus-group-help-map)
3188 (define-key gnus-group-mode-map "H" 'gnus-group-help-map)
3189 (define-key gnus-group-help-map "f" 'gnus-group-fetch-faq)
3183 3190
3184 (define-prefix-command 'gnus-group-sub-map) 3191 (define-prefix-command 'gnus-group-sub-map)
3185 (define-key gnus-group-mode-map "S" 'gnus-group-sub-map) 3192 (define-key gnus-group-mode-map "S" 'gnus-group-sub-map)
3186 (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level) 3193 (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level)
3187 (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group) 3194 (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group)
7173 (let ((cur nntp-server-buffer) 7180 (let ((cur nntp-server-buffer)
7174 (dependencies gnus-newsgroup-dependencies) 7181 (dependencies gnus-newsgroup-dependencies)
7175 headers id dep end ref) 7182 headers id dep end ref)
7176 (save-excursion 7183 (save-excursion
7177 (set-buffer nntp-server-buffer) 7184 (set-buffer nntp-server-buffer)
7185 ;; Allow the user to mangle the headers before parsing them.
7186 (run-hooks 'gnus-parse-headers-hook)
7178 (goto-char (point-min)) 7187 (goto-char (point-min))
7179 ;; Search to the beginning of the next header. Error messages 7188 ;; Search to the beginning of the next header. Error messages
7180 ;; do not begin with 2 or 3. 7189 ;; do not begin with 2 or 3.
7181 (while (re-search-forward "^[23][0-9]+ " nil t) 7190 (while (re-search-forward "^[23][0-9]+ " nil t)
7182 (let ((header (make-vector 9 nil)) 7191 (let ((header (make-vector 9 nil))
7310 (let ((cur nntp-server-buffer) 7319 (let ((cur nntp-server-buffer)
7311 (dependencies gnus-newsgroup-dependencies) 7320 (dependencies gnus-newsgroup-dependencies)
7312 number headers header) 7321 number headers header)
7313 (save-excursion 7322 (save-excursion
7314 (set-buffer nntp-server-buffer) 7323 (set-buffer nntp-server-buffer)
7324 ;; Allow the user to mangle the headers before parsing them.
7325 (run-hooks 'gnus-parse-headers-hook)
7315 (goto-char (point-min)) 7326 (goto-char (point-min))
7316 (while (and sequence (not (eobp))) 7327 (while (and sequence (not (eobp)))
7317 (setq number (read cur)) 7328 (setq number (read cur))
7318 (while (and sequence (< (car sequence) number)) 7329 (while (and sequence (< (car sequence) number))
7319 (setq sequence (cdr sequence))) 7330 (setq sequence (cdr sequence)))
8957 (save-excursion 8968 (save-excursion
8958 (set-buffer copy-buf) 8969 (set-buffer copy-buf)
8959 (gnus-request-article-this-buffer 8970 (gnus-request-article-this-buffer
8960 (car articles) gnus-newsgroup-name) 8971 (car articles) gnus-newsgroup-name)
8961 (gnus-request-accept-article 8972 (gnus-request-accept-article
8962 (if select-method (quote select-method) to-newsgroup) 8973 (if select-method (list 'quote select-method) to-newsgroup)
8963 (not (cdr articles))))) 8974 (not (cdr articles)))))
8964 (let* ((entry 8975 (let* ((entry
8965 (or 8976 (or
8966 (gnus-gethash (car art-group) gnus-newsrc-hashtb) 8977 (gnus-gethash (car art-group) gnus-newsrc-hashtb)
8967 (gnus-gethash 8978 (gnus-gethash
9429 (interactive "p") 9440 (interactive "p")
9430 (gnus-summary-mark-forward n gnus-dormant-mark)) 9441 (gnus-summary-mark-forward n gnus-dormant-mark))
9431 9442
9432 (defun gnus-summary-set-process-mark (article) 9443 (defun gnus-summary-set-process-mark (article)
9433 "Set the process mark on ARTICLE and update the summary line." 9444 "Set the process mark on ARTICLE and update the summary line."
9434 (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable)) 9445 (setq gnus-newsgroup-processable
9446 (cons article
9447 (delq article gnus-newsgroup-processable)))
9435 (let ((buffer-read-only nil)) 9448 (let ((buffer-read-only nil))
9436 (if (gnus-summary-goto-subject article) 9449 (if (gnus-summary-goto-subject article)
9437 (progn 9450 (progn
9438 (gnus-summary-show-thread) 9451 (gnus-summary-show-thread)
9439 (and (eq (gnus-summary-article-mark) gnus-dummy-mark) 9452 (and (eq (gnus-summary-article-mark) gnus-dummy-mark)
9755 "Remove lines that are marked with MARKS (e.g. \"DK\")." 9768 "Remove lines that are marked with MARKS (e.g. \"DK\")."
9756 (interactive "sMarks: ") 9769 (interactive "sMarks: ")
9757 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>. 9770 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
9758 (gnus-set-global-variables) 9771 (gnus-set-global-variables)
9759 (let ((buffer-read-only nil) 9772 (let ((buffer-read-only nil)
9760 (orig-article (gnus-summary-article-number)) 9773 (orig-article
9774 (progn
9775 (gnus-summary-search-forward t)
9776 (gnus-summary-article-number)))
9761 (marks (concat "^[" marks "]"))) 9777 (marks (concat "^[" marks "]")))
9762 (goto-char (point-min)) 9778 (goto-char (point-min))
9763 (if gnus-newsgroup-adaptive 9779 (if gnus-newsgroup-adaptive
9764 (gnus-score-remove-lines-adaptive marks) 9780 (gnus-score-remove-lines-adaptive marks)
9765 (while (re-search-forward marks nil t) 9781 (while (re-search-forward marks nil t)
10229 (gnus-set-global-variables) 10245 (gnus-set-global-variables)
10230 (gnus-summary-sort 10246 (gnus-summary-sort
10231 (cons 10247 (cons
10232 (lambda () 10248 (lambda ()
10233 (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) 10249 (let* ((header (gnus-get-header-by-num (gnus-summary-article-number)))
10234 (extract (funcall 10250 extract)
10235 gnus-extract-address-components 10251 (if (not (vectorp header))
10236 (mail-header-from header)))) 10252 ""
10237 (concat (or (car extract) (cdr extract)) 10253 (setq extract (funcall gnus-extract-address-components
10238 "\r" (int-to-string (mail-header-number header)) 10254 (mail-header-from header)))
10239 "\r" (mail-header-subject header)))) 10255 (concat (or (car extract) (cdr extract))
10256 "\r" (int-to-string (mail-header-number header))
10257 "\r" (mail-header-subject header)))))
10240 'gnus-thread-sort-by-author) 10258 'gnus-thread-sort-by-author)
10241 reverse)) 10259 reverse))
10242 10260
10243 (defun gnus-summary-sort-by-subject (&optional reverse) 10261 (defun gnus-summary-sort-by-subject (&optional reverse)
10244 "Sort summary buffer by subject alphabetically. `Re:'s are ignored. 10262 "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
10248 (gnus-set-global-variables) 10266 (gnus-set-global-variables)
10249 (gnus-summary-sort 10267 (gnus-summary-sort
10250 (cons 10268 (cons
10251 (lambda () 10269 (lambda ()
10252 (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) 10270 (let* ((header (gnus-get-header-by-num (gnus-summary-article-number)))
10253 (extract (funcall 10271 extract)
10254 gnus-extract-address-components 10272 (if (not (vectorp header))
10255 (mail-header-from header)))) 10273 ""
10256 (concat 10274 (setq extract (funcall gnus-extract-address-components
10257 (downcase (gnus-simplify-subject (gnus-summary-subject-string) t)) 10275 (mail-header-from header)))
10258 "\r" (int-to-string (mail-header-number header)) 10276 (concat
10259 "\r" (or (car extract) (cdr extract))))) 10277 (downcase (gnus-simplify-subject (gnus-summary-subject-string) t))
10278 "\r" (int-to-string (mail-header-number header))
10279 "\r" (or (car extract) (cdr extract))))))
10260 'gnus-thread-sort-by-subject) 10280 'gnus-thread-sort-by-subject)
10261 reverse)) 10281 reverse))
10262 10282
10263 (defun gnus-summary-sort-by-date (&optional reverse) 10283 (defun gnus-summary-sort-by-date (&optional reverse)
10264 "Sort summary buffer by date. 10284 "Sort summary buffer by date.
10851 (if (or (stringp article) (numberp article)) 10871 (if (or (stringp article) (numberp article))
10852 (progn 10872 (progn
10853 (erase-buffer) 10873 (erase-buffer)
10854 ;; There may be some overlays that we have to kill... 10874 ;; There may be some overlays that we have to kill...
10855 (insert "i") 10875 (insert "i")
10856 (let ((overlays (overlays-at (point-min)))) 10876 (let ((overlays (and (fboundp 'overlays-at)
10877 (overlays-at (point-min)))))
10857 (while overlays 10878 (while overlays
10858 (delete-overlay (car overlays)) 10879 (delete-overlay (car overlays))
10859 (setq overlays (cdr overlays)))) 10880 (setq overlays (cdr overlays))))
10860 (erase-buffer) 10881 (erase-buffer)
10861 (let ((gnus-override-method 10882 (let ((gnus-override-method
12054 12075
12055 (gnus-update-format-specifications) 12076 (gnus-update-format-specifications)
12056 12077
12057 ;; Find new newsgroups and treat them. 12078 ;; Find new newsgroups and treat them.
12058 (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level) 12079 (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
12059 (gnus-server-opened gnus-select-method)) 12080 (gnus-check-server gnus-select-method))
12060 (gnus-find-new-newsgroups)) 12081 (gnus-find-new-newsgroups))
12061 12082
12062 ;; Find the number of unread articles in each non-dead group. 12083 ;; Find the number of unread articles in each non-dead group.
12063 (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) 12084 (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
12064 (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))) 12085 (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))