Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-sum.el @ 114:8619ce7e4c50 r20-1b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b9
author cvs
date Mon, 13 Aug 2007 09:21:54 +0200
parents 48d667d6f17f
children 9f59509498e1
comparison
equal deleted inserted replaced
113:2ec2fe4a4c89 114:8619ce7e4c50
286 "*If non-nil, don't hide any headers." 286 "*If non-nil, don't hide any headers."
287 :group 'gnus-article-hiding 287 :group 'gnus-article-hiding
288 :group 'gnus-article-headers 288 :group 'gnus-article-headers
289 :type 'boolean) 289 :type 'boolean)
290 290
291 (defcustom gnus-summary-ignore-duplicates nil
292 "*If non-nil, ignore articles with identical Message-ID headers."
293 :group 'gnus-summary
294 :type 'boolean)
295
291 (defcustom gnus-single-article-buffer t 296 (defcustom gnus-single-article-buffer t
292 "*If non-nil, display all articles in the same buffer. 297 "*If non-nil, display all articles in the same buffer.
293 If nil, each group will get its own article buffer." 298 If nil, each group will get its own article buffer."
294 :group 'gnus-article-various 299 :group 'gnus-article-various
295 :type 'boolean) 300 :type 'boolean)
1310 1315
1311 (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) 1316 (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
1312 "t" gnus-article-remove-trailing-blank-lines 1317 "t" gnus-article-remove-trailing-blank-lines
1313 "l" gnus-article-strip-leading-blank-lines 1318 "l" gnus-article-strip-leading-blank-lines
1314 "m" gnus-article-strip-multiple-blank-lines 1319 "m" gnus-article-strip-multiple-blank-lines
1315 "a" gnus-article-strip-blank-lines) 1320 "a" gnus-article-strip-blank-lines
1321 "s" gnus-article-strip-leading-space)
1316 1322
1317 (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) 1323 (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
1318 "v" gnus-version 1324 "v" gnus-version
1319 "f" gnus-summary-fetch-faq 1325 "f" gnus-summary-fetch-faq
1320 "d" gnus-summary-describe-group 1326 "d" gnus-summary-describe-group
1512 ("Washing" 1518 ("Washing"
1513 ("Remove Blanks" 1519 ("Remove Blanks"
1514 ["Leading" gnus-article-strip-leading-blank-lines t] 1520 ["Leading" gnus-article-strip-leading-blank-lines t]
1515 ["Multiple" gnus-article-strip-multiple-blank-lines t] 1521 ["Multiple" gnus-article-strip-multiple-blank-lines t]
1516 ["Trailing" gnus-article-remove-trailing-blank-lines t] 1522 ["Trailing" gnus-article-remove-trailing-blank-lines t]
1517 ["All of the above" gnus-article-strip-blank-lines t]) 1523 ["All of the above" gnus-article-strip-blank-lines t]
1524 ["Leading space" gnus-article-strip-leading-space t])
1518 ["Overstrike" gnus-article-treat-overstrike t] 1525 ["Overstrike" gnus-article-treat-overstrike t]
1519 ["Emphasis" gnus-article-emphasize t] 1526 ["Emphasis" gnus-article-emphasize t]
1520 ["Word wrap" gnus-article-fill-cited-article t] 1527 ["Word wrap" gnus-article-fill-cited-article t]
1521 ["CR" gnus-article-remove-cr t] 1528 ["CR" gnus-article-remove-cr t]
1522 ["Show X-Face" gnus-article-display-x-face t] 1529 ["Show X-Face" gnus-article-display-x-face t]
2458 kill-buffer no-display) 2465 kill-buffer no-display)
2459 "Start reading news in newsgroup GROUP. 2466 "Start reading news in newsgroup GROUP.
2460 If SHOW-ALL is non-nil, already read articles are also listed. 2467 If SHOW-ALL is non-nil, already read articles are also listed.
2461 If NO-ARTICLE is non-nil, no article is selected initially. 2468 If NO-ARTICLE is non-nil, no article is selected initially.
2462 If NO-DISPLAY, don't generate a summary buffer." 2469 If NO-DISPLAY, don't generate a summary buffer."
2470 (let (result)
2471 (while (and group
2472 (null (setq result
2473 (let ((gnus-auto-select-next nil))
2474 (gnus-summary-read-group-1
2475 group show-all no-article
2476 kill-buffer no-display))))
2477 (eq gnus-auto-select-next 'quietly))
2478 (set-buffer gnus-group-buffer)
2479 (if (not (equal group (gnus-group-group-name)))
2480 (setq group (gnus-group-group-name))
2481 (setq group nil)))
2482 result))
2483
2484 (defun gnus-summary-read-group-1 (group show-all no-article
2485 kill-buffer no-display)
2463 ;; Killed foreign groups can't be entered. 2486 ;; Killed foreign groups can't be entered.
2464 (when (and (not (gnus-group-native-p group)) 2487 (when (and (not (gnus-group-native-p group))
2465 (not (gnus-gethash group gnus-newsrc-hashtb))) 2488 (not (gnus-gethash group gnus-newsrc-hashtb)))
2466 (error "Dead non-native groups can't be entered")) 2489 (error "Dead non-native groups can't be entered"))
2467 (gnus-message 5 "Retrieving newsgroup: %s..." group) 2490 (gnus-message 5 "Retrieving newsgroup: %s..." group)
2558 (run-hooks 'gnus-apply-kill-hook) 2581 (run-hooks 'gnus-apply-kill-hook)
2559 (if (and (zerop (buffer-size)) 2582 (if (and (zerop (buffer-size))
2560 (not no-display)) 2583 (not no-display))
2561 (progn 2584 (progn
2562 ;; This newsgroup is empty. 2585 ;; This newsgroup is empty.
2563 (gnus-summary-catchup-and-exit nil t) ;Without confirmations. 2586 (gnus-summary-catchup-and-exit nil t)
2564 (gnus-message 6 "No unread news") 2587 (gnus-message 6 "No unread news")
2565 (when kill-buffer 2588 (when kill-buffer
2566 (gnus-kill-or-deaden-summary kill-buffer)) 2589 (gnus-kill-or-deaden-summary kill-buffer))
2567 ;; Return nil from this function. 2590 ;; Return nil from this function.
2568 nil) 2591 nil)
2594 ;; the current buffer ain't the displayed window. 2617 ;; the current buffer ain't the displayed window.
2595 (let ((owin (selected-window))) 2618 (let ((owin (selected-window)))
2596 (select-window (get-buffer-window gnus-group-buffer t)) 2619 (select-window (get-buffer-window gnus-group-buffer t))
2597 (when (gnus-group-goto-group group) 2620 (when (gnus-group-goto-group group)
2598 (recenter)) 2621 (recenter))
2599 (select-window owin)))) 2622 (select-window owin)))
2600 ;; Mark this buffer as "prepared". 2623 ;; Mark this buffer as "prepared".
2601 (setq gnus-newsgroup-prepared t) 2624 (setq gnus-newsgroup-prepared t)
2602 t)))) 2625 t)))))
2603 2626
2604 (defun gnus-summary-prepare () 2627 (defun gnus-summary-prepare ()
2605 "Generate the summary buffer." 2628 "Generate the summary buffer."
2606 (interactive) 2629 (interactive)
2607 (let ((buffer-read-only nil)) 2630 (let ((buffer-read-only nil))
2867 (let ((deps gnus-newsgroup-dependencies) 2890 (let ((deps gnus-newsgroup-dependencies)
2868 found header) 2891 found header)
2869 (prog1 2892 (prog1
2870 (save-excursion 2893 (save-excursion
2871 (set-buffer nntp-server-buffer) 2894 (set-buffer nntp-server-buffer)
2872 (goto-char (point-min)) 2895 (let ((case-fold-search nil))
2873 (while (and (not found) (search-forward id nil t)) 2896 (goto-char (point-min))
2874 (beginning-of-line) 2897 (while (and (not found)
2875 (setq found (looking-at 2898 (search-forward id nil t))
2876 (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" 2899 (beginning-of-line)
2877 (regexp-quote id)))) 2900 (setq found (looking-at
2878 (or found (beginning-of-line 2))) 2901 (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
2879 (when found 2902 (regexp-quote id))))
2880 (beginning-of-line) 2903 (or found (beginning-of-line 2)))
2881 (and 2904 (when found
2882 (setq header (gnus-nov-parse-line 2905 (beginning-of-line)
2883 (read (current-buffer)) deps)) 2906 (and
2884 (gnus-parent-id (mail-header-references header))))) 2907 (setq header (gnus-nov-parse-line
2908 (read (current-buffer)) deps))
2909 (gnus-parent-id (mail-header-references header))))))
2885 (when header 2910 (when header
2886 (let ((number (mail-header-number header))) 2911 (let ((number (mail-header-number header)))
2887 (push number gnus-newsgroup-limit) 2912 (push number gnus-newsgroup-limit)
2888 (push header gnus-newsgroup-headers) 2913 (push header gnus-newsgroup-headers)
2889 (if (memq number gnus-newsgroup-unselected) 2914 (if (memq number gnus-newsgroup-unselected)
2914 header level nil (gnus-article-mark article) 2939 header level nil (gnus-article-mark article)
2915 (memq article gnus-newsgroup-replied) 2940 (memq article gnus-newsgroup-replied)
2916 (memq article gnus-newsgroup-expirable) 2941 (memq article gnus-newsgroup-expirable)
2917 ;; Only insert the Subject string when it's different 2942 ;; Only insert the Subject string when it's different
2918 ;; from the previous Subject string. 2943 ;; from the previous Subject string.
2919 (unless (gnus-subject-equal 2944 (if (gnus-subject-equal
2920 (condition-case () 2945 (condition-case ()
2921 (mail-header-subject 2946 (mail-header-subject
2922 (gnus-data-header 2947 (gnus-data-header
2923 (cadr 2948 (cadr
2924 (gnus-data-find-list 2949 (gnus-data-find-list
2925 article 2950 article
2926 (gnus-data-list t))))) 2951 (gnus-data-list t)))))
2927 (error "")) 2952 (error ""))
2928 (mail-header-subject header)) 2953 (mail-header-subject header))
2929 (mail-header-subject header)) 2954 (mail-header-subject header)
2955 "")
2930 nil (cdr (assq article gnus-newsgroup-scored)) 2956 nil (cdr (assq article gnus-newsgroup-scored))
2931 (memq article gnus-newsgroup-processable)) 2957 (memq article gnus-newsgroup-processable))
2932 (when length 2958 (when length
2933 (gnus-data-update-list 2959 (gnus-data-update-list
2934 (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) 2960 (cdr datal) (- length (- (gnus-data-pos data) (point))))))))
3830 ;; default score. 3856 ;; default score.
3831 (when (and (eq (cdr type) 'score) 3857 (when (and (eq (cdr type) 'score)
3832 gnus-save-score 3858 gnus-save-score
3833 list) 3859 list)
3834 (let* ((arts list) 3860 (let* ((arts list)
3835 (prev (cons nil articles)) 3861 (prev (cons nil list))
3836 (all prev)) 3862 (all prev))
3837 (while arts 3863 (while arts
3838 (if (or (not (consp (car arts))) 3864 (if (or (not (consp (car arts)))
3839 (= (cdar arts) gnus-summary-default-score)) 3865 (= (cdar arts) gnus-summary-default-score))
3840 (setcdr prev (cdr arts)) 3866 (setcdr prev (cdr arts))
4176 ;; done in case an article has arrived before the article 4202 ;; done in case an article has arrived before the article
4177 ;; which it refers to. 4203 ;; which it refers to.
4178 (if (boundp (setq id-dep (intern id dependencies))) 4204 (if (boundp (setq id-dep (intern id dependencies)))
4179 (if (and (car (symbol-value id-dep)) 4205 (if (and (car (symbol-value id-dep))
4180 (not force-new)) 4206 (not force-new))
4181 ;; An article with this Message-ID has already been seen, 4207 ;; An article with this Message-ID has already been seen.
4182 ;; so we rename the Message-ID. 4208 (if gnus-summary-ignore-duplicates
4183 (progn 4209 ;; We ignore this one, except we add
4210 ;; any additional Xrefs (in case the two articles
4211 ;; came from different servers).
4212 (progn
4213 (mail-header-set-xref
4214 (car (symbol-value id-dep))
4215 (concat (or (mail-header-xref
4216 (car (symbol-value id-dep)))
4217 "")
4218 (or (mail-header-xref header) "")))
4219 (setq header nil))
4220 ;; We rename the Message-ID.
4184 (set 4221 (set
4185 (setq id-dep (intern (setq id (nnmail-message-id)) 4222 (setq id-dep (intern (setq id (nnmail-message-id))
4186 dependencies)) 4223 dependencies))
4187 (list header)) 4224 (list header))
4188 (mail-header-set-id header id)) 4225 (mail-header-set-id header id))
4265 ;; This article refers back to itself. Naughty, naughty. 4302 ;; This article refers back to itself. Naughty, naughty.
4266 (setq ref nil)) 4303 (setq ref nil))
4267 (if (boundp (setq id-dep (intern id dependencies))) 4304 (if (boundp (setq id-dep (intern id dependencies)))
4268 (if (and (car (symbol-value id-dep)) 4305 (if (and (car (symbol-value id-dep))
4269 (not force-new)) 4306 (not force-new))
4270 ;; An article with this Message-ID has already been seen, 4307 ;; An article with this Message-ID has already been seen.
4271 ;; so we rename the Message-ID. 4308 (if gnus-summary-ignore-duplicates
4272 (progn 4309 ;; We ignore this one, except we add any additional
4310 ;; Xrefs (in case the two articles came from different
4311 ;; servers.
4312 (progn
4313 (mail-header-set-xref
4314 (car (symbol-value id-dep))
4315 (concat (or (mail-header-xref
4316 (car (symbol-value id-dep)))
4317 "")
4318 (or (mail-header-xref header) "")))
4319 (setq header nil))
4320 ;; We rename the Message-ID.
4273 (set 4321 (set
4274 (setq id-dep (intern (setq id (nnmail-message-id)) 4322 (setq id-dep (intern (setq id (nnmail-message-id))
4275 dependencies)) 4323 dependencies))
4276 (list header)) 4324 (list header))
4277 (mail-header-set-id header id)) 4325 (mail-header-set-id header id))