Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-sum.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents 8ff55ebd4be9
children fe104dbd9147
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
156 (const never) 156 (const never)
157 (sexp :menu-tag "on" t))) 157 (sexp :menu-tag "on" t)))
158 158
159 (defcustom gnus-summary-default-score 0 159 (defcustom gnus-summary-default-score 0
160 "*Default article score level. 160 "*Default article score level.
161 All scores generated by the score files will be added to this score.
161 If this variable is nil, scoring will be disabled." 162 If this variable is nil, scoring will be disabled."
162 :group 'gnus-score-default 163 :group 'gnus-score-default
163 :type '(choice (const :tag "disable") 164 :type '(choice (const :tag "disable")
164 integer)) 165 integer))
165 166
312 :group 'gnus-summary-mail 313 :group 'gnus-summary-mail
313 :type '(repeat (choice (list function) 314 :type '(repeat (choice (list function)
314 (cons regexp (repeat string)) 315 (cons regexp (repeat string))
315 sexp))) 316 sexp)))
316 317
317 ;; Mark variables suggested by Thomas Michanek
318 ;; <Thomas.Michanek@telelogic.se>.
319
320 (defcustom gnus-unread-mark ? 318 (defcustom gnus-unread-mark ?
321 "*Mark used for unread articles." 319 "*Mark used for unread articles."
322 :group 'gnus-summary-marks 320 :group 'gnus-summary-marks
323 :type 'character) 321 :type 'character)
324 322
611 It is meant to be used for highlighting the article in some way. It 609 It is meant to be used for highlighting the article in some way. It
612 is not run if `gnus-visual' is nil." 610 is not run if `gnus-visual' is nil."
613 :group 'gnus-summary-visual 611 :group 'gnus-summary-visual
614 :type 'hook) 612 :type 'hook)
615 613
616 (defcustom gnus-parse-headers-hook 614 (defcustom gnus-parse-headers-hook
617 (list 'gnus-decode-rfc1522) 615 (list 'gnus-decode-rfc1522)
618 "*A hook called before parsing the headers." 616 "*A hook called before parsing the headers."
619 :group 'gnus-various 617 :group 'gnus-various
620 :type 'hook) 618 :type 'hook)
621 619
655 (defcustom gnus-summary-selected-face 'gnus-summary-selected-face 653 (defcustom gnus-summary-selected-face 'gnus-summary-selected-face
656 "Face used for highlighting the current article in the summary buffer." 654 "Face used for highlighting the current article in the summary buffer."
657 :group 'gnus-summary-visual 655 :group 'gnus-summary-visual
658 :type 'face) 656 :type 'face)
659 657
660 (defcustom gnus-summary-highlight 658 (defcustom gnus-summary-highlight
661 '(((= mark gnus-canceled-mark) 659 '(((= mark gnus-canceled-mark)
662 . gnus-summary-cancelled-face) 660 . gnus-summary-cancelled-face)
663 ((and (> score default) 661 ((and (> score default)
664 (or (= mark gnus-dormant-mark) 662 (or (= mark gnus-dormant-mark)
665 (= mark gnus-ticked-mark))) 663 (= mark gnus-ticked-mark)))
681 . gnus-summary-high-unread-face) 679 . gnus-summary-high-unread-face)
682 ((and (< score default) (= mark gnus-unread-mark)) 680 ((and (< score default) (= mark gnus-unread-mark))
683 . gnus-summary-low-unread-face) 681 . gnus-summary-low-unread-face)
684 ((and (= mark gnus-unread-mark)) 682 ((and (= mark gnus-unread-mark))
685 . gnus-summary-normal-unread-face) 683 . gnus-summary-normal-unread-face)
686 ((> score default) 684 ((> score default)
687 . gnus-summary-high-read-face) 685 . gnus-summary-high-read-face)
688 ((< score default) 686 ((< score default)
689 . gnus-summary-low-read-face) 687 . gnus-summary-low-read-face)
690 (t 688 (t
691 . gnus-summary-normal-read-face)) 689 . gnus-summary-normal-read-face))
692 "Controls the highlighting of summary buffer lines. 690 "Controls the highlighting of summary buffer lines.
693 691
694 A list of (FORM . FACE) pairs. When deciding how a a particular 692 A list of (FORM . FACE) pairs. When deciding how a a particular
695 summary line should be displayed, each form is evaluated. The content 693 summary line should be displayed, each form is evaluated. The content
696 of the face field after the first true form is used. You can change 694 of the face field after the first true form is used. You can change
697 how those summary lines are displayed, by editing the face field. 695 how those summary lines are displayed, by editing the face field.
698 696
699 You can use the following variables in the FORM field. 697 You can use the following variables in the FORM field.
700 698
701 score: The articles score 699 score: The articles score
702 default: The default article score. 700 default: The default article score.
703 below: The score below which articles are automatically marked as read. 701 below: The score below which articles are automatically marked as read.
704 mark: The articles mark." 702 mark: The articles mark."
705 :group 'gnus-summary-visual 703 :group 'gnus-summary-visual
706 :type '(repeat (cons (sexp :tag "Form" nil) 704 :type '(repeat (cons (sexp :tag "Form" nil)
707 face))) 705 face)))
708 706
709 707
710 ;;; Internal variables 708 ;;; Internal variables
711 709
712 (defvar gnus-scores-exclude-files nil) 710 (defvar gnus-scores-exclude-files nil)
713 711
714 (defvar gnus-summary-display-table 712 (defvar gnus-summary-display-table
715 ;; Change the display table. Odd characters have a tendency to mess 713 ;; Change the display table. Odd characters have a tendency to mess
716 ;; up nicely formatted displays - we make all possible glyphs 714 ;; up nicely formatted displays - we make all possible glyphs
717 ;; display only a single character. 715 ;; display only a single character.
718 716
719 ;; We start from the standard display table, if any. 717 ;; We start from the standard display table, if any.
1233 "d" gnus-summary-down-thread 1231 "d" gnus-summary-down-thread
1234 "#" gnus-uu-mark-thread 1232 "#" gnus-uu-mark-thread
1235 "\M-#" gnus-uu-unmark-thread) 1233 "\M-#" gnus-uu-unmark-thread)
1236 1234
1237 (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) 1235 (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
1238 "g" gnus-summary-prepare 1236 "g" gnus-summary-prepare
1239 "c" gnus-summary-insert-cached-articles) 1237 "c" gnus-summary-insert-cached-articles)
1240 1238
1241 (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) 1239 (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
1242 "c" gnus-summary-catchup-and-exit 1240 "c" gnus-summary-catchup-and-exit
1243 "C" gnus-summary-catchup-all-and-exit 1241 "C" gnus-summary-catchup-all-and-exit
1381 ["Increase score..." gnus-summary-increase-score t] 1379 ["Increase score..." gnus-summary-increase-score t]
1382 ["Lower score..." gnus-summary-lower-score t])))) 1380 ["Lower score..." gnus-summary-lower-score t]))))
1383 1381
1384 '(("Default header" 1382 '(("Default header"
1385 ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) 1383 ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
1386 :style radio 1384 :style radio
1387 :selected (null gnus-score-default-header)] 1385 :selected (null gnus-score-default-header)]
1388 ["From" (gnus-score-set-default 'gnus-score-default-header 'a) 1386 ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
1389 :style radio 1387 :style radio
1390 :selected (eq gnus-score-default-header 'a)] 1388 :selected (eq gnus-score-default-header 'a)]
1391 ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) 1389 ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
1392 :style radio 1390 :style radio
1393 :selected (eq gnus-score-default-header 's)] 1391 :selected (eq gnus-score-default-header 's)]
1394 ["Article body" 1392 ["Article body"
1395 (gnus-score-set-default 'gnus-score-default-header 'b) 1393 (gnus-score-set-default 'gnus-score-default-header 'b)
1396 :style radio 1394 :style radio
1397 :selected (eq gnus-score-default-header 'b )] 1395 :selected (eq gnus-score-default-header 'b )]
1398 ["All headers" 1396 ["All headers"
1399 (gnus-score-set-default 'gnus-score-default-header 'h) 1397 (gnus-score-set-default 'gnus-score-default-header 'h)
1400 :style radio 1398 :style radio
1401 :selected (eq gnus-score-default-header 'h )] 1399 :selected (eq gnus-score-default-header 'h )]
1402 ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) 1400 ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i)
1403 :style radio 1401 :style radio
1404 :selected (eq gnus-score-default-header 'i )] 1402 :selected (eq gnus-score-default-header 'i )]
1405 ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) 1403 ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
1406 :style radio 1404 :style radio
1407 :selected (eq gnus-score-default-header 't )] 1405 :selected (eq gnus-score-default-header 't )]
1408 ["Crossposting" 1406 ["Crossposting"
1409 (gnus-score-set-default 'gnus-score-default-header 'x) 1407 (gnus-score-set-default 'gnus-score-default-header 'x)
1410 :style radio 1408 :style radio
1411 :selected (eq gnus-score-default-header 'x )] 1409 :selected (eq gnus-score-default-header 'x )]
1412 ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) 1410 ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
1413 :style radio 1411 :style radio
1414 :selected (eq gnus-score-default-header 'l )] 1412 :selected (eq gnus-score-default-header 'l )]
1415 ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) 1413 ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
1416 :style radio 1414 :style radio
1417 :selected (eq gnus-score-default-header 'd )] 1415 :selected (eq gnus-score-default-header 'd )]
1418 ["Followups to author" 1416 ["Followups to author"
1419 (gnus-score-set-default 'gnus-score-default-header 'f) 1417 (gnus-score-set-default 'gnus-score-default-header 'f)
1420 :style radio 1418 :style radio
1421 :selected (eq gnus-score-default-header 'f )]) 1419 :selected (eq gnus-score-default-header 'f )])
1422 ("Default type" 1420 ("Default type"
1423 ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) 1421 ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
1424 :style radio 1422 :style radio
1425 :selected (null gnus-score-default-type)] 1423 :selected (null gnus-score-default-type)]
1426 ;; The `:active' key is commented out in the following, 1424 ;; The `:active' key is commented out in the following,
1427 ;; because the GNU Emacs hack to support radio buttons use 1425 ;; because the GNU Emacs hack to support radio buttons use
1428 ;; active to indicate which button is selected. 1426 ;; active to indicate which button is selected.
1429 ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) 1427 ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
1430 :style radio 1428 :style radio
1431 ;; :active (not (memq gnus-score-default-header '(l d))) 1429 ;; :active (not (memq gnus-score-default-header '(l d)))
1432 :selected (eq gnus-score-default-type 's)] 1430 :selected (eq gnus-score-default-type 's)]
1433 ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) 1431 ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
1434 :style radio 1432 :style radio
1435 ;; :active (not (memq gnus-score-default-header '(l d))) 1433 ;; :active (not (memq gnus-score-default-header '(l d)))
1437 ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) 1435 ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
1438 :style radio 1436 :style radio
1439 ;; :active (not (memq gnus-score-default-header '(l d))) 1437 ;; :active (not (memq gnus-score-default-header '(l d)))
1440 :selected (eq gnus-score-default-type 'e)] 1438 :selected (eq gnus-score-default-type 'e)]
1441 ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) 1439 ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
1442 :style radio 1440 :style radio
1443 ;; :active (not (memq gnus-score-default-header '(l d))) 1441 ;; :active (not (memq gnus-score-default-header '(l d)))
1444 :selected (eq gnus-score-default-type 'f)] 1442 :selected (eq gnus-score-default-type 'f)]
1445 ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) 1443 ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
1446 :style radio 1444 :style radio
1447 ;; :active (eq (gnus-score-default-header 'd)) 1445 ;; :active (eq (gnus-score-default-header 'd))
1448 :selected (eq gnus-score-default-type 'b)] 1446 :selected (eq gnus-score-default-type 'b)]
1449 ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) 1447 ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
1450 :style radio 1448 :style radio
1451 ;; :active (eq (gnus-score-default-header 'd)) 1449 ;; :active (eq (gnus-score-default-header 'd))
1452 :selected (eq gnus-score-default-type 'n)] 1450 :selected (eq gnus-score-default-type 'n)]
1453 ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) 1451 ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
1454 :style radio 1452 :style radio
1455 ;; :active (eq (gnus-score-default-header 'd)) 1453 ;; :active (eq (gnus-score-default-header 'd))
1456 :selected (eq gnus-score-default-type 'a)] 1454 :selected (eq gnus-score-default-type 'a)]
1457 ["Less than number" 1455 ["Less than number"
1458 (gnus-score-set-default 'gnus-score-default-type '<) 1456 (gnus-score-set-default 'gnus-score-default-type '<)
1459 :style radio 1457 :style radio
1460 ;; :active (eq (gnus-score-default-header 'l)) 1458 ;; :active (eq (gnus-score-default-header 'l))
1461 :selected (eq gnus-score-default-type '<)] 1459 :selected (eq gnus-score-default-type '<)]
1462 ["Equal to number" 1460 ["Equal to number"
1463 (gnus-score-set-default 'gnus-score-default-type '=) 1461 (gnus-score-set-default 'gnus-score-default-type '=)
1464 :style radio 1462 :style radio
1465 ;; :active (eq (gnus-score-default-header 'l)) 1463 ;; :active (eq (gnus-score-default-header 'l))
1466 :selected (eq gnus-score-default-type '=)] 1464 :selected (eq gnus-score-default-type '=)]
1467 ["Greater than number" 1465 ["Greater than number"
1468 (gnus-score-set-default 'gnus-score-default-type '>) 1466 (gnus-score-set-default 'gnus-score-default-type '>)
1469 :style radio 1467 :style radio
1470 ;; :active (eq (gnus-score-default-header 'l)) 1468 ;; :active (eq (gnus-score-default-header 'l))
1471 :selected (eq gnus-score-default-type '>)]) 1469 :selected (eq gnus-score-default-type '>)])
1472 ["Default fold" gnus-score-default-fold-toggle 1470 ["Default fold" gnus-score-default-fold-toggle
1473 :style toggle 1471 :style toggle
1474 :selected gnus-score-default-fold] 1472 :selected gnus-score-default-fold]
1482 :selected (eq gnus-score-default-duration 'p)] 1480 :selected (eq gnus-score-default-duration 'p)]
1483 ["Temporary" 1481 ["Temporary"
1484 (gnus-score-set-default 'gnus-score-default-duration 't) 1482 (gnus-score-set-default 'gnus-score-default-duration 't)
1485 :style radio 1483 :style radio
1486 :selected (eq gnus-score-default-duration 't)] 1484 :selected (eq gnus-score-default-duration 't)]
1487 ["Immediate" 1485 ["Immediate"
1488 (gnus-score-set-default 'gnus-score-default-duration 'i) 1486 (gnus-score-set-default 'gnus-score-default-duration 'i)
1489 :style radio 1487 :style radio
1490 :selected (eq gnus-score-default-duration 'i)])) 1488 :selected (eq gnus-score-default-duration 'i)]))
1491 1489
1492 (easy-menu-define 1490 (easy-menu-define
1520 ["Emphasis" gnus-article-emphasize t] 1518 ["Emphasis" gnus-article-emphasize t]
1521 ["Word wrap" gnus-article-fill-cited-article t] 1519 ["Word wrap" gnus-article-fill-cited-article t]
1522 ["CR" gnus-article-remove-cr t] 1520 ["CR" gnus-article-remove-cr t]
1523 ["Show X-Face" gnus-article-display-x-face t] 1521 ["Show X-Face" gnus-article-display-x-face t]
1524 ["Quoted-Printable" gnus-article-de-quoted-unreadable t] 1522 ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
1523 ["UnHTMLize" gnus-article-treat-html t]
1525 ["Rot 13" gnus-summary-caesar-message t] 1524 ["Rot 13" gnus-summary-caesar-message t]
1526 ["Unix pipe" gnus-summary-pipe-message t] 1525 ["Unix pipe" gnus-summary-pipe-message t]
1527 ["Add buttons" gnus-article-add-buttons t] 1526 ["Add buttons" gnus-article-add-buttons t]
1528 ["Add buttons to head" gnus-article-add-buttons-to-head t] 1527 ["Add buttons to head" gnus-article-add-buttons-to-head t]
1529 ["Stop page breaking" gnus-summary-stop-page-breaking t] 1528 ["Stop page breaking" gnus-summary-stop-page-breaking t]
1658 ["Unread" gnus-summary-limit-to-unread t] 1657 ["Unread" gnus-summary-limit-to-unread t]
1659 ["Non-dormant" gnus-summary-limit-exclude-dormant t] 1658 ["Non-dormant" gnus-summary-limit-exclude-dormant t]
1660 ["Articles" gnus-summary-limit-to-articles t] 1659 ["Articles" gnus-summary-limit-to-articles t]
1661 ["Pop limit" gnus-summary-pop-limit t] 1660 ["Pop limit" gnus-summary-pop-limit t]
1662 ["Show dormant" gnus-summary-limit-include-dormant t] 1661 ["Show dormant" gnus-summary-limit-include-dormant t]
1663 ["Hide childless dormant" 1662 ["Hide childless dormant"
1664 gnus-summary-limit-exclude-childless-dormant t] 1663 gnus-summary-limit-exclude-childless-dormant t]
1665 ;;["Hide thread" gnus-summary-limit-exclude-thread t] 1664 ;;["Hide thread" gnus-summary-limit-exclude-thread t]
1666 ["Show expunged" gnus-summary-show-all-expunged t]) 1665 ["Show expunged" gnus-summary-show-all-expunged t])
1667 ("Process Mark" 1666 ("Process Mark"
1668 ["Set mark" gnus-summary-mark-as-processable t] 1667 ["Set mark" gnus-summary-mark-as-processable t]
1770 ("regexp" r)))) 1769 ("regexp" r))))
1771 (perms '(("temporary" (current-time-string)) 1770 (perms '(("temporary" (current-time-string))
1772 ("permanent" nil) 1771 ("permanent" nil)
1773 ("immediate" now))) 1772 ("immediate" now)))
1774 header) 1773 header)
1775 (list 1774 (list
1776 (apply 1775 (apply
1777 'nconc 1776 'nconc
1778 (list 1777 (list
1779 (if (eq type 'lower) 1778 (if (eq type 'lower)
1780 "Lower score" 1779 "Lower score"
1781 "Increase score")) 1780 "Increase score"))
1782 (let (outh) 1781 (let (outh)
1783 (while headers 1782 (while headers
1784 (setq header (car headers)) 1783 (setq header (car headers))
1785 (setq outh 1784 (setq outh
1786 (cons 1785 (cons
1787 (apply 1786 (apply
1788 'nconc 1787 'nconc
1789 (list (car header)) 1788 (list (car header))
1790 (let ((ts (cdr (assoc (nth 2 header) types))) 1789 (let ((ts (cdr (assoc (nth 2 header) types)))
1791 outt) 1790 outt)
1792 (while ts 1791 (while ts
1793 (setq outt 1792 (setq outt
1794 (cons 1793 (cons
1795 (apply 1794 (apply
1796 'nconc 1795 'nconc
1797 (list (caar ts)) 1796 (list (caar ts))
1798 (let ((ps perms) 1797 (let ((ps perms)
1799 outp) 1798 outp)
1800 (while ps 1799 (while ps
1808 (if (or (string= (nth 1 header) 1807 (if (or (string= (nth 1 header)
1809 "head") 1808 "head")
1810 (string= (nth 1 header) 1809 (string= (nth 1 header)
1811 "body")) 1810 "body"))
1812 "" 1811 ""
1813 (list 'gnus-summary-header 1812 (list 'gnus-summary-header
1814 (nth 1 header))) 1813 (nth 1 header)))
1815 (list 'quote (nth 1 (car ts))) 1814 (list 'quote (nth 1 (car ts)))
1816 (list 'gnus-score-default nil) 1815 (list 'gnus-score-default nil)
1817 (nth 1 (car ps)) 1816 (nth 1 (car ps))
1818 t) 1817 t)
2048 "Return a list of all children to NUMBER." 2047 "Return a list of all children to NUMBER."
2049 (let* ((data (gnus-data-find-list number)) 2048 (let* ((data (gnus-data-find-list number))
2050 (level (gnus-data-level (car data))) 2049 (level (gnus-data-level (car data)))
2051 children) 2050 children)
2052 (setq data (cdr data)) 2051 (setq data (cdr data))
2053 (while (and data 2052 (while (and data
2054 (= (gnus-data-level (car data)) (1+ level))) 2053 (= (gnus-data-level (car data)) (1+ level)))
2055 (push (gnus-data-number (car data)) children) 2054 (push (gnus-data-number (car data)) children)
2056 (setq data (cdr data))) 2055 (setq data (cdr data)))
2057 children)) 2056 children))
2058 2057
2320 (beginning-of-line) 2319 (beginning-of-line)
2321 (gnus-add-text-properties 2320 (gnus-add-text-properties
2322 (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) 2321 (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
2323 (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) 2322 (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
2324 2323
2325 (defun gnus-summary-insert-line (gnus-tmp-header 2324 (defun gnus-summary-insert-line (gnus-tmp-header
2326 gnus-tmp-level gnus-tmp-current 2325 gnus-tmp-level gnus-tmp-current
2327 gnus-tmp-unread gnus-tmp-replied 2326 gnus-tmp-unread gnus-tmp-replied
2328 gnus-tmp-expirable gnus-tmp-subject-or-nil 2327 gnus-tmp-expirable gnus-tmp-subject-or-nil
2329 &optional gnus-tmp-dummy gnus-tmp-score 2328 &optional gnus-tmp-dummy gnus-tmp-score
2330 gnus-tmp-process) 2329 gnus-tmp-process)
2331 (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) 2330 (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
2332 (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) 2331 (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
2333 (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) 2332 (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
2334 (gnus-tmp-score-char 2333 (gnus-tmp-score-char
2409 (run-hooks 'gnus-summary-update-hook))))) 2408 (run-hooks 'gnus-summary-update-hook)))))
2410 2409
2411 (defvar gnus-tmp-new-adopts nil) 2410 (defvar gnus-tmp-new-adopts nil)
2412 2411
2413 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) 2412 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
2414 "Return the number of articles in THREAD. 2413 "Return the number of articles in THREAD.
2415 This may be 0 in some cases -- if none of the articles in 2414 This may be 0 in some cases -- if none of the articles in
2416 the thread are to be displayed." 2415 the thread are to be displayed."
2417 (let* ((number 2416 (let* ((number
2418 ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>. 2417 ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
2419 (cond 2418 (cond
2532 (if gnus-show-threads 2531 (if gnus-show-threads
2533 (if show-all 2532 (if show-all
2534 (let ((gnus-newsgroup-dormant nil)) 2533 (let ((gnus-newsgroup-dormant nil))
2535 (gnus-summary-initial-limit show-all)) 2534 (gnus-summary-initial-limit show-all))
2536 (gnus-summary-initial-limit show-all)) 2535 (gnus-summary-initial-limit show-all))
2537 (setq gnus-newsgroup-limit 2536 (setq gnus-newsgroup-limit
2538 (mapcar 2537 (mapcar
2539 (lambda (header) (mail-header-number header)) 2538 (lambda (header) (mail-header-number header))
2540 gnus-newsgroup-headers))) 2539 gnus-newsgroup-headers)))
2541 ;; Generate the summary buffer. 2540 ;; Generate the summary buffer.
2542 (unless no-display 2541 (unless no-display
2543 (gnus-summary-prepare)) 2542 (gnus-summary-prepare))
2638 ((eq 'fuzzy gnus-summary-gather-subject-limit) 2637 ((eq 'fuzzy gnus-summary-gather-subject-limit)
2639 (gnus-simplify-subject-fuzzy subject)) 2638 (gnus-simplify-subject-fuzzy subject))
2640 ;; Just remove the leading "Re:". 2639 ;; Just remove the leading "Re:".
2641 (t 2640 (t
2642 (gnus-simplify-subject-re subject)))) 2641 (gnus-simplify-subject-re subject))))
2643 2642
2644 (if (and gnus-summary-gather-exclude-subject 2643 (if (and gnus-summary-gather-exclude-subject
2645 (string-match gnus-summary-gather-exclude-subject subject)) 2644 (string-match gnus-summary-gather-exclude-subject subject))
2646 nil ; This article shouldn't be gathered 2645 nil ; This article shouldn't be gathered
2647 subject)) 2646 subject))
2648 2647
2661 (prev threads) 2660 (prev threads)
2662 (result threads) 2661 (result threads)
2663 subject hthread whole-subject) 2662 subject hthread whole-subject)
2664 (while threads 2663 (while threads
2665 (setq subject (gnus-general-simplify-subject 2664 (setq subject (gnus-general-simplify-subject
2666 (setq whole-subject (mail-header-subject 2665 (setq whole-subject (mail-header-subject
2667 (caar threads))))) 2666 (caar threads)))))
2668 (when subject 2667 (when subject
2669 (if (setq hthread (gnus-gethash subject hashtb)) 2668 (if (setq hthread (gnus-gethash subject hashtb))
2670 (progn 2669 (progn
2671 ;; We enter a dummy root into the thread, if we 2670 ;; We enter a dummy root into the thread, if we
2764 (mapatoms 2763 (mapatoms
2765 (lambda (refs) 2764 (lambda (refs)
2766 ;; Deal with self-referencing References loops. 2765 ;; Deal with self-referencing References loops.
2767 (when (and (car (symbol-value refs)) 2766 (when (and (car (symbol-value refs))
2768 (not (zerop 2767 (not (zerop
2769 (apply 2768 (apply
2770 '+ 2769 '+
2771 (mapcar 2770 (mapcar
2772 (lambda (thread) 2771 (lambda (thread)
2773 (gnus-thread-loop-p 2772 (gnus-thread-loop-p
2774 (car (symbol-value refs)) thread)) 2773 (car (symbol-value refs)) thread))
2783 threads)) 2782 threads))
2784 2783
2785 (defun gnus-build-sparse-threads () 2784 (defun gnus-build-sparse-threads ()
2786 (let ((headers gnus-newsgroup-headers) 2785 (let ((headers gnus-newsgroup-headers)
2787 (deps gnus-newsgroup-dependencies) 2786 (deps gnus-newsgroup-dependencies)
2788 header references generation relations 2787 header references generation relations
2789 cthread subject child end pthread relation) 2788 cthread subject child end pthread relation)
2790 ;; First we create an alist of generations/relations, where 2789 ;; First we create an alist of generations/relations, where
2791 ;; generations is how much we trust the relation, and the relation 2790 ;; generations is how much we trust the relation, and the relation
2792 ;; is parent/child. 2791 ;; is parent/child.
2793 (gnus-message 7 "Making sparse threads...") 2792 (gnus-message 7 "Making sparse threads...")
2794 (save-excursion 2793 (save-excursion
2795 (nnheader-set-temp-buffer " *gnus sparse threads*") 2794 (nnheader-set-temp-buffer " *gnus sparse threads*")
2815 (while (setq relation (pop relations)) 2814 (while (setq relation (pop relations))
2816 (when (if (boundp (setq cthread (intern (cadr relation) deps))) 2815 (when (if (boundp (setq cthread (intern (cadr relation) deps)))
2817 (unless (car (symbol-value cthread)) 2816 (unless (car (symbol-value cthread))
2818 ;; Make this article the parent of these threads. 2817 ;; Make this article the parent of these threads.
2819 (setcar (symbol-value cthread) 2818 (setcar (symbol-value cthread)
2820 (vector gnus-reffed-article-number 2819 (vector gnus-reffed-article-number
2821 (cadddr relation) 2820 (cadddr relation)
2822 "" "" 2821 "" ""
2823 (cadr relation) 2822 (cadr relation)
2824 (or (caddr relation) "") 0 0 ""))) 2823 (or (caddr relation) "") 0 0 "")))
2825 (set cthread (list (vector gnus-reffed-article-number 2824 (set cthread (list (vector gnus-reffed-article-number
2918 ;; from the previous Subject string. 2917 ;; from the previous Subject string.
2919 (unless (gnus-subject-equal 2918 (unless (gnus-subject-equal
2920 (condition-case () 2919 (condition-case ()
2921 (mail-header-subject 2920 (mail-header-subject
2922 (gnus-data-header 2921 (gnus-data-header
2923 (cadr 2922 (cadr
2924 (gnus-data-find-list 2923 (gnus-data-find-list
2925 article 2924 article
2926 (gnus-data-list t))))) 2925 (gnus-data-list t)))))
2927 (error "")) 2926 (error ""))
2928 (mail-header-subject header)) 2927 (mail-header-subject header))
2930 nil (cdr (assq article gnus-newsgroup-scored)) 2929 nil (cdr (assq article gnus-newsgroup-scored))
2931 (memq article gnus-newsgroup-processable)) 2930 (memq article gnus-newsgroup-processable))
2932 (when length 2931 (when length
2933 (gnus-data-update-list 2932 (gnus-data-update-list
2934 (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) 2933 (cdr datal) (- length (- (gnus-data-pos data) (point))))))))
2935 2934
2936 (defun gnus-summary-update-article (article &optional iheader) 2935 (defun gnus-summary-update-article (article &optional iheader)
2937 "Update ARTICLE in the summary buffer." 2936 "Update ARTICLE in the summary buffer."
2938 (set-buffer gnus-summary-buffer) 2937 (set-buffer gnus-summary-buffer)
2939 (let* ((header (or iheader (gnus-summary-article-header article))) 2938 (let* ((header (or iheader (gnus-summary-article-header article)))
2940 (id (mail-header-id header)) 2939 (id (mail-header-id header))
2941 (data (gnus-data-find article)) 2940 (data (gnus-data-find article))
2942 (thread (gnus-id-to-thread id)) 2941 (thread (gnus-id-to-thread id))
2943 (references (mail-header-references header)) 2942 (references (mail-header-references header))
2944 (parent 2943 (parent
2945 (gnus-id-to-thread 2944 (gnus-id-to-thread
2946 (or (gnus-parent-id 2945 (or (gnus-parent-id
2947 (when (and references 2946 (when (and references
2948 (not (equal "" references))) 2947 (not (equal "" references)))
2949 references)) 2948 references))
2950 "none"))) 2949 "none")))
2951 (buffer-read-only nil) 2950 (buffer-read-only nil)
3014 (when headers 3013 (when headers
3015 (car headers)))) 3014 (car headers))))
3016 3015
3017 (defun gnus-parent-headers (headers &optional generation) 3016 (defun gnus-parent-headers (headers &optional generation)
3018 "Return the headers of the GENERATIONeth parent of HEADERS." 3017 "Return the headers of the GENERATIONeth parent of HEADERS."
3019 (unless generation 3018 (unless generation
3020 (setq generation 1)) 3019 (setq generation 1))
3021 (let (references parent) 3020 (let (references parent)
3022 (while (and headers (not (zerop generation))) 3021 (while (and headers (not (zerop generation)))
3023 (setq references (mail-header-references headers)) 3022 (setq references (mail-header-references headers))
3024 (when (and references 3023 (when (and references
3045 (defun gnus-article-displayed-root-p (article) 3044 (defun gnus-article-displayed-root-p (article)
3046 "Say whether ARTICLE is a root(ish) article." 3045 "Say whether ARTICLE is a root(ish) article."
3047 (let ((level (gnus-summary-thread-level article)) 3046 (let ((level (gnus-summary-thread-level article))
3048 (refs (mail-header-references (gnus-summary-article-header article))) 3047 (refs (mail-header-references (gnus-summary-article-header article)))
3049 particle) 3048 particle)
3050 (cond 3049 (cond
3051 ((null level) nil) 3050 ((null level) nil)
3052 ((zerop level) t) 3051 ((zerop level) t)
3053 ((null refs) t) 3052 ((null refs) t)
3054 ((null (gnus-parent-id refs)) t) 3053 ((null (gnus-parent-id refs)) t)
3055 ((and (= 1 level) 3054 ((and (= 1 level)
3058 (null (gnus-summary-thread-level particle))))))) 3057 (null (gnus-summary-thread-level particle)))))))
3059 3058
3060 (defun gnus-root-id (id) 3059 (defun gnus-root-id (id)
3061 "Return the id of the root of the thread where ID appears." 3060 "Return the id of the root of the thread where ID appears."
3062 (let (last-id prev) 3061 (let (last-id prev)
3063 (while (and id (setq prev (car (gnus-gethash 3062 (while (and id (setq prev (car (gnus-gethash
3064 id gnus-newsgroup-dependencies)))) 3063 id gnus-newsgroup-dependencies))))
3065 (setq last-id id 3064 (setq last-id id
3066 id (gnus-parent-id (mail-header-references prev)))) 3065 id (gnus-parent-id (mail-header-references prev))))
3067 last-id)) 3066 last-id))
3068 3067
3127 (setq thread (reverse thread)) 3126 (setq thread (reverse thread))
3128 (while thread 3127 (while thread
3129 (gnus-remove-thread-1 (pop thread))) 3128 (gnus-remove-thread-1 (pop thread)))
3130 (when (setq d (gnus-data-find number)) 3129 (when (setq d (gnus-data-find number))
3131 (goto-char (gnus-data-pos d)) 3130 (goto-char (gnus-data-pos d))
3132 (gnus-data-remove 3131 (gnus-data-remove
3133 number 3132 number
3134 (- (gnus-point-at-bol) 3133 (- (gnus-point-at-bol)
3135 (prog1 3134 (prog1
3136 (1+ (gnus-point-at-eol)) 3135 (1+ (gnus-point-at-eol))
3137 (gnus-delete-line))))))) 3136 (gnus-delete-line)))))))
3149 "Sort ARTICLES." 3148 "Sort ARTICLES."
3150 (when gnus-article-sort-functions 3149 (when gnus-article-sort-functions
3151 (gnus-message 7 "Sorting articles...") 3150 (gnus-message 7 "Sorting articles...")
3152 (prog1 3151 (prog1
3153 (setq gnus-newsgroup-headers 3152 (setq gnus-newsgroup-headers
3154 (sort articles (gnus-make-sort-function 3153 (sort articles (gnus-make-sort-function
3155 gnus-article-sort-functions))) 3154 gnus-article-sort-functions)))
3156 (gnus-message 7 "Sorting articles...done")))) 3155 (gnus-message 7 "Sorting articles...done"))))
3157 3156
3158 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. 3157 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
3159 (defmacro gnus-thread-header (thread) 3158 (defmacro gnus-thread-header (thread)
3562 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) 3561 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
3563 (info (nth 2 entry)) 3562 (info (nth 2 entry))
3564 articles fetched-articles cached) 3563 articles fetched-articles cached)
3565 3564
3566 (unless (gnus-check-server 3565 (unless (gnus-check-server
3567 (setq gnus-current-select-method 3566 (setq gnus-current-select-method
3568 (gnus-find-method-for-group group))) 3567 (gnus-find-method-for-group group)))
3569 (error "Couldn't open server")) 3568 (error "Couldn't open server"))
3570 3569
3571 (or (and entry (not (eq (car entry) t))) ; Either it's active... 3570 (or (and entry (not (eq (car entry) t))) ; Either it's active...
3572 (gnus-activate-group group) ; Or we can activate it... 3571 (gnus-activate-group group) ; Or we can activate it...
3602 (setq gnus-newsgroup-processable nil) 3601 (setq gnus-newsgroup-processable nil)
3603 3602
3604 (gnus-update-read-articles group gnus-newsgroup-unreads) 3603 (gnus-update-read-articles group gnus-newsgroup-unreads)
3605 (unless (gnus-ephemeral-group-p gnus-newsgroup-name) 3604 (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
3606 (gnus-group-update-group group)) 3605 (gnus-group-update-group group))
3607 3606
3608 (setq articles (gnus-articles-to-read group read-all)) 3607 (setq articles (gnus-articles-to-read group read-all))
3609 3608
3610 (cond 3609 (cond
3611 ((null articles) 3610 ((null articles)
3612 ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") 3611 ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
3628 (and gnus-fetch-old-headers 3627 (and gnus-fetch-old-headers
3629 (or (and 3628 (or (and
3630 (not (eq gnus-fetch-old-headers 'some)) 3629 (not (eq gnus-fetch-old-headers 'some))
3631 (not (numberp gnus-fetch-old-headers))) 3630 (not (numberp gnus-fetch-old-headers)))
3632 (> (length articles) 1)))))) 3631 (> (length articles) 1))))))
3633 (gnus-get-newsgroup-headers-xover 3632 (gnus-get-newsgroup-headers-xover
3634 articles nil nil gnus-newsgroup-name t) 3633 articles nil nil gnus-newsgroup-name t)
3635 (gnus-get-newsgroup-headers))) 3634 (gnus-get-newsgroup-headers)))
3636 (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) 3635 (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
3637 3636
3638 ;; Kludge to avoid having cached articles nixed out in virtual groups. 3637 ;; Kludge to avoid having cached articles nixed out in virtual groups.
3826 (setq symbol 3825 (setq symbol
3827 (intern (format "gnus-newsgroup-%s" 3826 (intern (format "gnus-newsgroup-%s"
3828 (car type)))))) 3827 (car type))))))
3829 (push (cons (cdr type) 3828 (push (cons (cdr type)
3830 (if (memq (cdr type) uncompressed) list 3829 (if (memq (cdr type) uncompressed) list
3831 (gnus-compress-sequence 3830 (gnus-compress-sequence
3832 (set symbol (sort list '<)) t))) 3831 (set symbol (sort list '<)) t)))
3833 newmarked))) 3832 newmarked)))
3834 3833
3835 ;; Enter these new marks into the info of the group. 3834 ;; Enter these new marks into the info of the group.
3836 (if (nthcdr 3 info) 3835 (if (nthcdr 3 info)
3903 (concat (gnus-truncate-string mode-string (- max-len 3)) 3902 (concat (gnus-truncate-string mode-string (- max-len 3))
3904 "..."))) 3903 "...")))
3905 ;; Pad the mode string a bit. 3904 ;; Pad the mode string a bit.
3906 (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) 3905 (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
3907 ;; Update the mode line. 3906 ;; Update the mode line.
3908 (setq mode-line-buffer-identification 3907 (setq mode-line-buffer-identification
3909 (gnus-mode-line-buffer-identification (list mode-string))) 3908 (gnus-mode-line-buffer-identification (list mode-string)))
3910 (set-buffer-modified-p t)))) 3909 (set-buffer-modified-p t))))
3911 3910
3912 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) 3911 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
3913 "Go through the HEADERS list and add all Xrefs to a hash table. 3912 "Go through the HEADERS list and add all Xrefs to a hash table.
4158 ;; done in case an article has arrived before the article 4157 ;; done in case an article has arrived before the article
4159 ;; which it refers to. 4158 ;; which it refers to.
4160 (if (boundp (setq id-dep (intern id dependencies))) 4159 (if (boundp (setq id-dep (intern id dependencies)))
4161 (if (and (car (symbol-value id-dep)) 4160 (if (and (car (symbol-value id-dep))
4162 (not force-new)) 4161 (not force-new))
4163 ;; An article with this Message-ID has already 4162 ;; An article with this Message-ID has already been seen,
4164 ;; been seen, so we ignore this one, except we add 4163 ;; so we rename the Message-ID.
4165 ;; any additional Xrefs (in case the two articles
4166 ;; came from different servers).
4167 (progn 4164 (progn
4168 (mail-header-set-xref 4165 (set
4169 (car (symbol-value id-dep)) 4166 (setq id-dep (intern (setq id (nnmail-message-id))
4170 (concat (or (mail-header-xref 4167 dependencies))
4171 (car (symbol-value id-dep))) 4168 (list header))
4172 "") 4169 (mail-header-set-id header id))
4173 (or (mail-header-xref header) "")))
4174 (setq header nil))
4175 (setcar (symbol-value id-dep) header)) 4170 (setcar (symbol-value id-dep) header))
4176 (set id-dep (list header))) 4171 (set id-dep (list header)))
4177 (when header 4172 (when header
4178 (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) 4173 (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
4179 (setcdr (symbol-value ref-dep) 4174 (setcdr (symbol-value ref-dep)
4240 (gnus-nov-field)) ; refs 4235 (gnus-nov-field)) ; refs
4241 (gnus-nov-read-integer) ; chars 4236 (gnus-nov-read-integer) ; chars
4242 (gnus-nov-read-integer) ; lines 4237 (gnus-nov-read-integer) ; lines
4243 (if (= (following-char) ?\n) 4238 (if (= (following-char) ?\n)
4244 nil 4239 nil
4245 (gnus-nov-field)) ; misc 4240 (gnus-nov-field))))) ; misc
4246 )))
4247 4241
4248 (widen)) 4242 (widen))
4249 4243
4250 ;; We build the thread tree. 4244 ;; We build the thread tree.
4251 (when (equal id ref) 4245 (when (equal id ref)
4253 (setq ref nil)) 4247 (setq ref nil))
4254 (if (boundp (setq id-dep (intern id dependencies))) 4248 (if (boundp (setq id-dep (intern id dependencies)))
4255 (if (and (car (symbol-value id-dep)) 4249 (if (and (car (symbol-value id-dep))
4256 (not force-new)) 4250 (not force-new))
4257 ;; An article with this Message-ID has already been seen, 4251 ;; An article with this Message-ID has already been seen,
4258 ;; so we ignore this one, except we add any additional 4252 ;; so we rename the Message-ID.
4259 ;; Xrefs (in case the two articles came from different
4260 ;; servers.
4261 (progn 4253 (progn
4262 (mail-header-set-xref 4254 (set
4263 (car (symbol-value id-dep)) 4255 (setq id-dep (intern (setq id (nnmail-message-id))
4264 (concat (or (mail-header-xref 4256 dependencies))
4265 (car (symbol-value id-dep))) 4257 (list header))
4266 "") 4258 (mail-header-set-id header id))
4267 (or (mail-header-xref header) "")))
4268 (setq header nil))
4269 (setcar (symbol-value id-dep) header)) 4259 (setcar (symbol-value id-dep) header))
4270 (set id-dep (list header))) 4260 (set id-dep (list header)))
4271 (when header 4261 (when header
4272 (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) 4262 (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
4273 (setcdr (symbol-value ref-dep) 4263 (setcdr (symbol-value ref-dep)
4275 (list (symbol-value id-dep)))) 4265 (list (symbol-value id-dep))))
4276 (set ref-dep (list nil (symbol-value id-dep))))) 4266 (set ref-dep (list nil (symbol-value id-dep)))))
4277 header)) 4267 header))
4278 4268
4279 ;; Goes through the xover lines and returns a list of vectors 4269 ;; Goes through the xover lines and returns a list of vectors
4280 (defun gnus-get-newsgroup-headers-xover (sequence &optional 4270 (defun gnus-get-newsgroup-headers-xover (sequence &optional
4281 force-new dependencies 4271 force-new dependencies
4282 group also-fetch-heads) 4272 group also-fetch-heads)
4283 "Parse the news overview data in the server buffer, and return a 4273 "Parse the news overview data in the server buffer, and return a
4284 list of headers that match SEQUENCE (see `nntp-retrieve-headers')." 4274 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
4285 ;; Get the Xref when the users reads the articles since most/some 4275 ;; Get the Xref when the users reads the articles since most/some
4362 ;; article we have fetched. 4352 ;; article we have fetched.
4363 (when (and (not gnus-show-threads) 4353 (when (and (not gnus-show-threads)
4364 old-header) 4354 old-header)
4365 (when (setq d (gnus-data-find (mail-header-number old-header))) 4355 (when (setq d (gnus-data-find (mail-header-number old-header)))
4366 (goto-char (gnus-data-pos d)) 4356 (goto-char (gnus-data-pos d))
4367 (gnus-data-remove 4357 (gnus-data-remove
4368 number 4358 number
4369 (- (gnus-point-at-bol) 4359 (- (gnus-point-at-bol)
4370 (prog1 4360 (prog1
4371 (1+ (gnus-point-at-eol)) 4361 (1+ (gnus-point-at-eol))
4372 (gnus-delete-line)))))) 4362 (gnus-delete-line))))))
4589 ;; Only do recentering when the article buffer is displayed, 4579 ;; Only do recentering when the article buffer is displayed,
4590 ;; Set the window start to either `bottom', which is the biggest 4580 ;; Set the window start to either `bottom', which is the biggest
4591 ;; possible valid number, or the second line from the top, 4581 ;; possible valid number, or the second line from the top,
4592 ;; whichever is the least. 4582 ;; whichever is the least.
4593 (set-window-start 4583 (set-window-start
4594 window (min bottom (save-excursion 4584 window (min bottom (save-excursion
4595 (forward-line (- top)) (point))))) 4585 (forward-line (- top)) (point)))))
4596 ;; Do horizontal recentering while we're at it. 4586 ;; Do horizontal recentering while we're at it.
4597 (when (and (get-buffer-window (current-buffer) t) 4587 (when (and (get-buffer-window (current-buffer) t)
4598 (not (eq gnus-auto-center-summary 'vertical))) 4588 (not (eq gnus-auto-center-summary 'vertical)))
4599 (let ((selected (selected-window))) 4589 (let ((selected (selected-window)))
4712 (error "Ephemeral groups can't be reselected")) 4702 (error "Ephemeral groups can't be reselected"))
4713 (let ((current-subject (gnus-summary-article-number)) 4703 (let ((current-subject (gnus-summary-article-number))
4714 (group gnus-newsgroup-name)) 4704 (group gnus-newsgroup-name))
4715 (setq gnus-newsgroup-begin nil) 4705 (setq gnus-newsgroup-begin nil)
4716 (gnus-summary-exit) 4706 (gnus-summary-exit)
4717 ;; We have to adjust the point of group mode buffer because 4707 ;; We have to adjust the point of group mode buffer because
4718 ;; point was moved to the next unread newsgroup by exiting. 4708 ;; point was moved to the next unread newsgroup by exiting.
4719 (gnus-summary-jump-to-group group) 4709 (gnus-summary-jump-to-group group)
4720 (when rescan 4710 (when rescan
4721 (save-excursion 4711 (save-excursion
4722 (gnus-group-get-new-news-this-group 1))) 4712 (gnus-group-get-new-news-this-group 1)))
5361 (push (cdr keve) unread-command-events)))))) 5351 (push (cdr keve) unread-command-events))))))
5362 5352
5363 (defun gnus-summary-next-unread-article () 5353 (defun gnus-summary-next-unread-article ()
5364 "Select unread article after current one." 5354 "Select unread article after current one."
5365 (interactive) 5355 (interactive)
5366 (gnus-summary-next-article 5356 (gnus-summary-next-article
5367 (or (not (eq gnus-summary-goto-unread 'never)) 5357 (or (not (eq gnus-summary-goto-unread 'never))
5368 (gnus-summary-last-article-p (gnus-summary-article-number))) 5358 (gnus-summary-last-article-p (gnus-summary-article-number)))
5369 (and gnus-auto-select-same 5359 (and gnus-auto-select-same
5370 (gnus-summary-article-subject)))) 5360 (gnus-summary-article-subject))))
5371 5361
5592 (defun gnus-summary-pop-limit (&optional total) 5582 (defun gnus-summary-pop-limit (&optional total)
5593 "Restore the previous limit. 5583 "Restore the previous limit.
5594 If given a prefix, remove all limits." 5584 If given a prefix, remove all limits."
5595 (interactive "P") 5585 (interactive "P")
5596 (gnus-set-global-variables) 5586 (gnus-set-global-variables)
5597 (when total 5587 (when total
5598 (setq gnus-newsgroup-limits 5588 (setq gnus-newsgroup-limits
5599 (list (mapcar (lambda (h) (mail-header-number h)) 5589 (list (mapcar (lambda (h) (mail-header-number h))
5600 gnus-newsgroup-headers)))) 5590 gnus-newsgroup-headers))))
5601 (unless gnus-newsgroup-limits 5591 (unless gnus-newsgroup-limits
5602 (error "No limit to pop")) 5592 (error "No limit to pop"))
5622 "Limit the summary buffer to articles that have authors that match a regexp." 5612 "Limit the summary buffer to articles that have authors that match a regexp."
5623 (interactive "sLimit to author (regexp): ") 5613 (interactive "sLimit to author (regexp): ")
5624 (gnus-summary-limit-to-subject from "from")) 5614 (gnus-summary-limit-to-subject from "from"))
5625 5615
5626 (defun gnus-summary-limit-to-age (age &optional younger-p) 5616 (defun gnus-summary-limit-to-age (age &optional younger-p)
5627 "Limit the summary buffer to articles that are older than (or equal) AGE days. 5617 "Limit the summary buffer to articles that are older than (or equal) AGE days.
5628 If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to 5618 If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
5629 articles that are younger than AGE days." 5619 articles that are younger than AGE days."
5630 (interactive "nTime in days: \nP") 5620 (interactive "nTime in days: \nP")
5631 (prog1 5621 (prog1
5632 (let ((data gnus-newsgroup-data) 5622 (let ((data gnus-newsgroup-data)
5672 If REVERSE, limit the summary buffer to articles that are marked 5662 If REVERSE, limit the summary buffer to articles that are marked
5673 with MARKS. MARKS can either be a string of marks or a list of marks. 5663 with MARKS. MARKS can either be a string of marks or a list of marks.
5674 Returns how many articles were removed." 5664 Returns how many articles were removed."
5675 (interactive "sMarks: ") 5665 (interactive "sMarks: ")
5676 (gnus-summary-limit-to-marks marks t)) 5666 (gnus-summary-limit-to-marks marks t))
5677 5667
5678 (defun gnus-summary-limit-to-marks (marks &optional reverse) 5668 (defun gnus-summary-limit-to-marks (marks &optional reverse)
5679 "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). 5669 "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
5680 If REVERSE (the prefix), limit the summary buffer to articles that are 5670 If REVERSE (the prefix), limit the summary buffer to articles that are
5681 not marked with MARKS. MARKS can either be a string of marks or a 5671 not marked with MARKS. MARKS can either be a string of marks or a
5682 list of marks. 5672 list of marks.
5740 articles d children) 5730 articles d children)
5741 ;; Find all articles that are either not dormant or have 5731 ;; Find all articles that are either not dormant or have
5742 ;; children. 5732 ;; children.
5743 (while (setq d (pop data)) 5733 (while (setq d (pop data))
5744 (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) 5734 (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
5745 (and (setq children 5735 (and (setq children
5746 (gnus-article-children (gnus-data-number d))) 5736 (gnus-article-children (gnus-data-number d)))
5747 (let (found) 5737 (let (found)
5748 (while children 5738 (while children
5749 (when (memq (car children) articles) 5739 (when (memq (car children) articles)
5750 (setq children nil 5740 (setq children nil
5957 ;; Check NoCeM things. 5947 ;; Check NoCeM things.
5958 (if (and gnus-use-nocem 5948 (if (and gnus-use-nocem
5959 (gnus-nocem-unwanted-article-p 5949 (gnus-nocem-unwanted-article-p
5960 (mail-header-id (car thread)))) 5950 (mail-header-id (car thread))))
5961 (progn 5951 (progn
5962 (setq gnus-newsgroup-reads 5952 (setq gnus-newsgroup-reads
5963 (delq number gnus-newsgroup-unreads)) 5953 (delq number gnus-newsgroup-unreads))
5964 t)))) 5954 t))))
5965 ;; Nope, invisible article. 5955 ;; Nope, invisible article.
5966 0 5956 0
5967 ;; Ok, this article is to be visible, so we add it to the limit 5957 ;; Ok, this article is to be visible, so we add it to the limit
6062 (setq message-id (concat "<" message-id))) 6052 (setq message-id (concat "<" message-id)))
6063 (unless (string-match ">$" message-id) 6053 (unless (string-match ">$" message-id)
6064 (setq message-id (concat message-id ">"))) 6054 (setq message-id (concat message-id ">")))
6065 (let* ((header (gnus-id-to-header message-id)) 6055 (let* ((header (gnus-id-to-header message-id))
6066 (sparse (and header 6056 (sparse (and header
6067 (gnus-summary-article-sparse-p 6057 (gnus-summary-article-sparse-p
6068 (mail-header-number header))))) 6058 (mail-header-number header)))))
6069 (if header 6059 (if header
6070 (prog1 6060 (prog1
6071 ;; The article is present in the buffer, to we just go to it. 6061 ;; The article is present in the buffer, to we just go to it.
6072 (gnus-summary-goto-article 6062 (gnus-summary-goto-article
6073 (mail-header-number header) nil header) 6063 (mail-header-number header) nil header)
6074 (when sparse 6064 (when sparse
6075 (gnus-summary-update-article (mail-header-number header)))) 6065 (gnus-summary-update-article (mail-header-number header))))
6076 ;; We fetch the article 6066 ;; We fetch the article
6077 (let ((gnus-override-method 6067 (let ((gnus-override-method
6078 (and (gnus-news-group-p gnus-newsgroup-name) 6068 (and (gnus-news-group-p gnus-newsgroup-name)
6079 gnus-refer-article-method)) 6069 gnus-refer-article-method))
6080 number) 6070 number)
6081 ;; Start the special refer-article method, if necessary. 6071 ;; Start the special refer-article method, if necessary.
6082 (when (and gnus-refer-article-method 6072 (when (and gnus-refer-article-method
6121 (delete-matching-lines "^\\(Path\\):\\|^From ") 6111 (delete-matching-lines "^\\(Path\\):\\|^From ")
6122 (widen)) 6112 (widen))
6123 (unwind-protect 6113 (unwind-protect
6124 (if (gnus-group-read-ephemeral-group 6114 (if (gnus-group-read-ephemeral-group
6125 name `(nndoc ,name (nndoc-address ,(get-buffer dig)) 6115 name `(nndoc ,name (nndoc-address ,(get-buffer dig))
6126 (nndoc-article-type 6116 (nndoc-article-type
6127 ,(if force 'digest 'guess))) t) 6117 ,(if force 'digest 'guess))) t)
6128 ;; Make all postings to this group go to the parent group. 6118 ;; Make all postings to this group go to the parent group.
6129 (nconc (gnus-info-params (gnus-get-info name)) 6119 (nconc (gnus-info-params (gnus-get-info name))
6130 params) 6120 params)
6131 ;; Couldn't select this doc group. 6121 ;; Couldn't select this doc group.
6182 `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) 6172 `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
6183 t 6173 t
6184 (cons (current-buffer) 'summary))) 6174 (cons (current-buffer) 'summary)))
6185 (t 6175 (t
6186 (error "Couldn't select virtual nndoc group"))))) 6176 (error "Couldn't select virtual nndoc group")))))
6187 6177
6188 (defun gnus-summary-isearch-article (&optional regexp-p) 6178 (defun gnus-summary-isearch-article (&optional regexp-p)
6189 "Do incremental search forward on the current article. 6179 "Do incremental search forward on the current article.
6190 If REGEXP-P (the prefix) is non-nil, do regexp isearch." 6180 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
6191 (interactive "P") 6181 (interactive "P")
6192 (gnus-set-global-variables) 6182 (gnus-set-global-variables)
6487 (when (gnus-visual-p 'page-marker) 6477 (when (gnus-visual-p 'page-marker)
6488 (let ((buffer-read-only nil)) 6478 (let ((buffer-read-only nil))
6489 (gnus-remove-text-with-property 'gnus-prev) 6479 (gnus-remove-text-with-property 'gnus-prev)
6490 (gnus-remove-text-with-property 'gnus-next))))) 6480 (gnus-remove-text-with-property 'gnus-next)))))
6491 6481
6492 (defun gnus-summary-move-article (&optional n to-newsgroup 6482 (defun gnus-summary-move-article (&optional n to-newsgroup
6493 select-method action) 6483 select-method action)
6494 "Move the current article to a different newsgroup. 6484 "Move the current article to a different newsgroup.
6495 If N is a positive number, move the N next articles. 6485 If N is a positive number, move the N next articles.
6496 If N is a negative number, move the N previous articles. 6486 If N is a negative number, move the N previous articles.
6497 If N is nil and any articles have been marked with the process mark, 6487 If N is nil and any articles have been marked with the process mark,
6537 (gnus-read-move-group-name 6527 (gnus-read-move-group-name
6538 (cadr (assq action names)) 6528 (cadr (assq action names))
6539 (symbol-value (intern (format "gnus-current-%s-group" action))) 6529 (symbol-value (intern (format "gnus-current-%s-group" action)))
6540 articles prefix)) 6530 articles prefix))
6541 (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) 6531 (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
6542 (setq to-method (or select-method 6532 (setq to-method (or select-method
6543 (gnus-group-name-to-method to-newsgroup))) 6533 (gnus-group-name-to-method to-newsgroup)))
6544 ;; Check the method we are to move this article to... 6534 ;; Check the method we are to move this article to...
6545 (unless (gnus-check-backend-function 6535 (unless (gnus-check-backend-function
6546 'request-accept-article (car to-method)) 6536 'request-accept-article (car to-method))
6547 (error "%s does not support article copying" (car to-method))) 6537 (error "%s does not support article copying" (car to-method)))
6548 (unless (gnus-check-server to-method) 6538 (unless (gnus-check-server to-method)
6549 (error "Can't open server %s" (car to-method))) 6539 (error "Can't open server %s" (car to-method)))
6550 (gnus-message 6 "%s to %s: %s..." 6540 (gnus-message 6 "%s to %s: %s..."
6578 (let ((xref (message-tokenize-header 6568 (let ((xref (message-tokenize-header
6579 (mail-header-xref (gnus-summary-article-header article)) 6569 (mail-header-xref (gnus-summary-article-header article))
6580 " "))) 6570 " ")))
6581 (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) 6571 (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
6582 ":" article)) 6572 ":" article))
6583 (unless xref 6573 (unless xref
6584 (setq xref (list (system-name)))) 6574 (setq xref (list (system-name))))
6585 (setq new-xref 6575 (setq new-xref
6586 (concat 6576 (concat
6587 (mapconcat 'identity 6577 (mapconcat 'identity
6588 (delete "Xref:" (delete new-xref xref)) 6578 (delete "Xref:" (delete new-xref xref))
6589 " ") 6579 " ")
6590 new-xref)) 6580 " " new-xref))
6591 (save-excursion 6581 (save-excursion
6592 (set-buffer copy-buf) 6582 (set-buffer copy-buf)
6583 ;; First put the article in the destination group.
6593 (gnus-request-article-this-buffer article gnus-newsgroup-name) 6584 (gnus-request-article-this-buffer article gnus-newsgroup-name)
6594 (nnheader-replace-header "xref" new-xref) 6585 (setq art-group
6595 (gnus-request-accept-article 6586 (gnus-request-accept-article
6596 to-newsgroup select-method (not articles))))))) 6587 to-newsgroup select-method (not articles)))
6588 (setq new-xref (concat new-xref " " (car art-group)
6589 ":" (cdr art-group)))
6590 ;; Now we have the new Xrefs header, so we insert
6591 ;; it and replace the new article.
6592 (nnheader-replace-header "Xref" new-xref)
6593 (gnus-request-replace-article
6594 (cdr art-group) to-newsgroup (current-buffer))
6595 art-group)))))
6597 (if (not art-group) 6596 (if (not art-group)
6598 (gnus-message 1 "Couldn't %s article %s" 6597 (gnus-message 1 "Couldn't %s article %s"
6599 (cadr (assq action names)) article) 6598 (cadr (assq action names)) article)
6600 (let* ((entry 6599 (let* ((entry
6601 (or 6600 (or
6602 (gnus-gethash (car art-group) gnus-newsrc-hashtb) 6601 (gnus-gethash (car art-group) gnus-newsrc-hashtb)
6603 (gnus-gethash 6602 (gnus-gethash
6604 (gnus-group-prefixed-name 6603 (gnus-group-prefixed-name
6605 (car art-group) 6604 (car art-group)
6606 (or select-method 6605 (or select-method
6607 (gnus-find-method-for-group to-newsgroup))) 6606 (gnus-find-method-for-group to-newsgroup)))
6608 gnus-newsrc-hashtb))) 6607 gnus-newsrc-hashtb)))
6609 (info (nth 2 entry)) 6608 (info (nth 2 entry))
6610 (to-group (gnus-info-group info))) 6609 (to-group (gnus-info-group info)))
6611 ;; Update the group that has been moved to. 6610 ;; Update the group that has been moved to.
6639 (not (memq article gnus-newsgroup-unreads))) 6638 (not (memq article gnus-newsgroup-unreads)))
6640 ;; Mark this article as read in this group. 6639 ;; Mark this article as read in this group.
6641 (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) 6640 (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
6642 (setcdr (gnus-active to-group) to-article) 6641 (setcdr (gnus-active to-group) to-article)
6643 (setcdr gnus-newsgroup-active to-article)) 6642 (setcdr gnus-newsgroup-active to-article))
6644 6643
6645 (while marks 6644 (while marks
6646 (when (memq article (symbol-value 6645 (when (memq article (symbol-value
6647 (intern (format "gnus-newsgroup-%s" 6646 (intern (format "gnus-newsgroup-%s"
6648 (caar marks))))) 6647 (caar marks)))))
6649 ;; If the other group is the same as this group, 6648 ;; If the other group is the same as this group,
6663 ;; the new crossposted article we have just created. 6662 ;; the new crossposted article we have just created.
6664 (when (eq action 'crosspost) 6663 (when (eq action 'crosspost)
6665 (save-excursion 6664 (save-excursion
6666 (set-buffer copy-buf) 6665 (set-buffer copy-buf)
6667 (gnus-request-article-this-buffer article gnus-newsgroup-name) 6666 (gnus-request-article-this-buffer article gnus-newsgroup-name)
6668 (nnheader-replace-header 6667 (nnheader-replace-header "Xref" new-xref)
6669 "xref" (concat new-xref " " (car art-group)
6670 ":" (cdr art-group)))
6671 (gnus-request-replace-article 6668 (gnus-request-replace-article
6672 article gnus-newsgroup-name (current-buffer))))) 6669 article gnus-newsgroup-name (current-buffer)))))
6673 6670
6674 (gnus-summary-goto-subject article) 6671 (gnus-summary-goto-subject article)
6675 (when (eq action 'move) 6672 (when (eq action 'move)
6676 (gnus-summary-mark-article article gnus-canceled-mark))) 6673 (gnus-summary-mark-article article gnus-canceled-mark)))
6677 (gnus-summary-remove-process-mark article)) 6674 (gnus-summary-remove-process-mark article))
6678 ;; Re-activate all groups that have been moved to. 6675 ;; Re-activate all groups that have been moved to.
6679 (while to-groups 6676 (while to-groups
6680 (gnus-activate-group (pop to-groups))) 6677 (gnus-activate-group (pop to-groups)))
6681 6678
6682 (gnus-kill-buffer copy-buf) 6679 (gnus-kill-buffer copy-buf)
6683 (gnus-summary-position-point) 6680 (gnus-summary-position-point)
6684 (gnus-set-mode-line 'summary))) 6681 (gnus-set-mode-line 'summary)))
6685 6682
6686 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) 6683 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
6695 "Crosspost the current article to some other group." 6692 "Crosspost the current article to some other group."
6696 (interactive "P") 6693 (interactive "P")
6697 (gnus-summary-move-article n nil nil 'crosspost)) 6694 (gnus-summary-move-article n nil nil 'crosspost))
6698 6695
6699 (defcustom gnus-summary-respool-default-method nil 6696 (defcustom gnus-summary-respool-default-method nil
6700 "Default method for respooling an article. 6697 "Default method for respooling an article.
6701 If nil, use to the current newsgroup method." 6698 If nil, use to the current newsgroup method."
6702 :type 'gnus-select-method-name 6699 :type 'gnus-select-method-name
6703 :group 'gnus-summary-mail) 6700 :group 'gnus-summary-mail)
6704 6701
6705 (defun gnus-summary-respool-article (&optional n method) 6702 (defun gnus-summary-respool-article (&optional n method)
6714 6711
6715 Respooling can be done both from mail groups and \"real\" newsgroups. 6712 Respooling can be done both from mail groups and \"real\" newsgroups.
6716 In the former case, the articles in question will be moved from the 6713 In the former case, the articles in question will be moved from the
6717 current group into whatever groups they are destined to. In the 6714 current group into whatever groups they are destined to. In the
6718 latter case, they will be copied into the relevant groups." 6715 latter case, they will be copied into the relevant groups."
6719 (interactive 6716 (interactive
6720 (list current-prefix-arg 6717 (list current-prefix-arg
6721 (let* ((methods (gnus-methods-using 'respool)) 6718 (let* ((methods (gnus-methods-using 'respool))
6722 (methname 6719 (methname
6723 (symbol-name (or gnus-summary-respool-default-method 6720 (symbol-name (or gnus-summary-respool-default-method
6724 (car (gnus-find-method-for-group 6721 (car (gnus-find-method-for-group
6725 gnus-newsgroup-name))))) 6722 gnus-newsgroup-name)))))
6726 (method 6723 (method
6727 (gnus-completing-read 6724 (gnus-completing-read
6728 methname "What backend do you want to use when respooling?" 6725 methname "What backend do you want to use when respooling?"
6729 methods nil t nil 'gnus-mail-method-history)) 6726 methods nil t nil 'gnus-mail-method-history))
6730 ms) 6727 ms)
6731 (cond 6728 (cond
6732 ((zerop (length (setq ms (gnus-servers-using-backend 6729 ((zerop (length (setq ms (gnus-servers-using-backend
6733 (intern method))))) 6730 (intern method)))))
6734 (list (intern method) "")) 6731 (list (intern method) ""))
6735 ((= 1 (length ms)) 6732 ((= 1 (length ms))
6736 (car ms)) 6733 (car ms))
6737 (t 6734 (t
6887 (gnus-summary-remove-process-mark (car articles)) 6884 (gnus-summary-remove-process-mark (car articles))
6888 ;; The backend might not have been able to delete the article 6885 ;; The backend might not have been able to delete the article
6889 ;; after all. 6886 ;; after all.
6890 (unless (memq (car articles) not-deleted) 6887 (unless (memq (car articles) not-deleted)
6891 (gnus-summary-mark-article (car articles) gnus-canceled-mark)) 6888 (gnus-summary-mark-article (car articles) gnus-canceled-mark))
6892 (setq articles (cdr articles)))) 6889 (setq articles (cdr articles)))
6890 (when not-deleted
6891 (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
6893 (gnus-summary-position-point) 6892 (gnus-summary-position-point)
6894 (gnus-set-mode-line 'summary) 6893 (gnus-set-mode-line 'summary)
6895 not-deleted)) 6894 not-deleted))
6896 6895
6897 (defun gnus-summary-edit-article (&optional force) 6896 (defun gnus-summary-edit-article (&optional force)
6898 "Edit the current article. 6897 "Edit the current article.
6899 This will have permanent effect only in mail groups. 6898 This will have permanent effect only in mail groups.
6900 If FORCE is non-nil, allow editing of articles even in read-only 6899 If FORCE is non-nil, allow editing of articles even in read-only
6901 groups." 6900 groups."
6902 (interactive "P") 6901 (interactive "P")
6903 (save-excursion 6902 (save-excursion
6904 (set-buffer gnus-summary-buffer) 6903 (set-buffer gnus-summary-buffer)
6905 (gnus-set-global-variables) 6904 (gnus-set-global-variables)
6906 (when (and (not force) 6905 (when (and (not force)
6970 (when (gnus-visual-p 'summary-highlight 'highlight) 6969 (when (gnus-visual-p 'summary-highlight 'highlight)
6971 (run-hooks 'gnus-visual-mark-article-hook)))) 6970 (run-hooks 'gnus-visual-mark-article-hook))))
6972 6971
6973 (defun gnus-summary-edit-wash (key) 6972 (defun gnus-summary-edit-wash (key)
6974 "Perform editing command in the article buffer." 6973 "Perform editing command in the article buffer."
6975 (interactive 6974 (interactive
6976 (list 6975 (list
6977 (progn 6976 (progn
6978 (message "%s" (concat (this-command-keys) "- ")) 6977 (message "%s" (concat (this-command-keys) "- "))
6979 (read-char)))) 6978 (read-char))))
6980 (message "") 6979 (message "")
6989 (interactive) 6988 (interactive)
6990 (gnus-set-global-variables) 6989 (gnus-set-global-variables)
6991 (let (gnus-mark-article-hook) 6990 (let (gnus-mark-article-hook)
6992 (gnus-summary-select-article) 6991 (gnus-summary-select-article)
6993 (save-excursion 6992 (save-excursion
6994 (set-buffer gnus-article-buffer) 6993 (set-buffer gnus-original-article-buffer)
6995 (save-restriction 6994 (save-restriction
6996 (gnus-narrow-to-body) 6995 (message-narrow-to-head)
6997 (message "This message would go to %s" 6996 (message "This message would go to %s"
6998 (mapconcat 'car (nnmail-article-group 'identity) ", ")))))) 6997 (mapconcat 'car (nnmail-article-group 'identity) ", "))))))
6999 6998
7000 ;; Summary marking commands. 6999 ;; Summary marking commands.
7001 7000
7510 (prefix-numeric-value score) 7509 (prefix-numeric-value score)
7511 (or gnus-summary-default-score 0))) 7510 (or gnus-summary-default-score 0)))
7512 (save-excursion 7511 (save-excursion
7513 (set-buffer gnus-summary-buffer) 7512 (set-buffer gnus-summary-buffer)
7514 (goto-char (point-min)) 7513 (goto-char (point-min))
7515 (while 7514 (while
7516 (progn 7515 (progn
7517 (and (< (gnus-summary-article-score) score) 7516 (and (< (gnus-summary-article-score) score)
7518 (gnus-summary-mark-article nil mark)) 7517 (gnus-summary-mark-article nil mark))
7519 (gnus-summary-find-next))))) 7518 (gnus-summary-find-next)))))
7520 7519
7576 (gnus-summary-position-point) 7575 (gnus-summary-position-point)
7577 t)))) 7576 t))))
7578 7577
7579 (defun gnus-summary-catchup (&optional all quietly to-here not-mark) 7578 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
7580 "Mark all unread articles in this newsgroup as read. 7579 "Mark all unread articles in this newsgroup as read.
7581 If prefix argument ALL is non-nil, ticked and dormant articles will 7580 If prefix argument ALL is non-nil, ticked and dormant articles will
7582 also be marked as read. 7581 also be marked as read.
7583 If QUIETLY is non-nil, no questions will be asked. 7582 If QUIETLY is non-nil, no questions will be asked.
7584 If TO-HERE is non-nil, it should be a point in the buffer. All 7583 If TO-HERE is non-nil, it should be a point in the buffer. All
7585 articles before this point will be marked as read. 7584 articles before this point will be marked as read.
7586 Note that this function will only catch up the unread article 7585 Note that this function will only catch up the unread article
7737 (if (eq (forward-line -1) 0) 7736 (if (eq (forward-line -1) 0)
7738 (gnus-summary-article-number) 7737 (gnus-summary-article-number)
7739 (error "Beginning of summary buffer.")))))) 7738 (error "Beginning of summary buffer."))))))
7740 (unless (not (eq current-article parent-article)) 7739 (unless (not (eq current-article parent-article))
7741 (error "An article may not be self-referential.")) 7740 (error "An article may not be self-referential."))
7742 (let ((message-id (mail-header-id 7741 (let ((message-id (mail-header-id
7743 (gnus-summary-article-header parent-article)))) 7742 (gnus-summary-article-header parent-article))))
7744 (unless (and message-id (not (equal message-id ""))) 7743 (unless (and message-id (not (equal message-id "")))
7745 (error "No message-id in desired parent.")) 7744 (error "No message-id in desired parent."))
7746 (gnus-summary-select-article t t nil current-article) 7745 (gnus-summary-select-article t t nil current-article)
7747 (set-buffer gnus-original-article-buffer) 7746 (set-buffer gnus-original-article-buffer)
7870 (let ((backward (< n 0)) 7869 (let ((backward (< n 0))
7871 (n (abs n))) 7870 (n (abs n)))
7872 (while (and (> n 0) 7871 (while (and (> n 0)
7873 (gnus-summary-go-to-next-thread backward)) 7872 (gnus-summary-go-to-next-thread backward))
7874 (decf n)) 7873 (decf n))
7875 (unless silent 7874 (unless silent
7876 (gnus-summary-position-point)) 7875 (gnus-summary-position-point))
7877 (when (and (not silent) (/= 0 n)) 7876 (when (and (not silent) (/= 0 n))
7878 (gnus-message 7 "No more threads")) 7877 (gnus-message 7 "No more threads"))
7879 n)) 7878 n))
7880 7879
8039 save those articles instead. 8038 save those articles instead.
8040 The variable `gnus-default-article-saver' specifies the saver function." 8039 The variable `gnus-default-article-saver' specifies the saver function."
8041 (interactive "P") 8040 (interactive "P")
8042 (gnus-set-global-variables) 8041 (gnus-set-global-variables)
8043 (let* ((articles (gnus-summary-work-articles n)) 8042 (let* ((articles (gnus-summary-work-articles n))
8044 (save-buffer (save-excursion 8043 (save-buffer (save-excursion
8045 (nnheader-set-temp-buffer " *Gnus Save*"))) 8044 (nnheader-set-temp-buffer " *Gnus Save*")))
8046 (num (length articles)) 8045 (num (length articles))
8047 header article file) 8046 header article file)
8048 (while articles 8047 (while articles
8049 (setq header (gnus-summary-article-header 8048 (setq header (gnus-summary-article-header
8219 gnus-active-hashtb 8218 gnus-active-hashtb
8220 'gnus-valid-move-group-p 8219 'gnus-valid-move-group-p
8221 nil nil 8220 nil nil
8222 'gnus-group-history)) 8221 'gnus-group-history))
8223 (t 8222 (t
8224 (gnus-completing-read nil prom 8223 (gnus-completing-read nil prom
8225 (mapcar (lambda (el) (list el)) 8224 (mapcar (lambda (el) (list el))
8226 (nreverse split-name)) 8225 (nreverse split-name))
8227 nil nil nil 8226 nil nil nil
8228 'gnus-group-history))))) 8227 'gnus-group-history)))))
8229 (when to-newsgroup 8228 (when to-newsgroup
8230 (if (or (string= to-newsgroup "") 8229 (if (or (string= to-newsgroup "")
8231 (string= to-newsgroup prefix)) 8230 (string= to-newsgroup prefix))
8232 (setq to-newsgroup (or default ""))) 8231 (setq to-newsgroup default))
8232 (unless to-newsgroup
8233 (error "No group name entered"))
8233 (or (gnus-active to-newsgroup) 8234 (or (gnus-active to-newsgroup)
8234 (gnus-activate-group to-newsgroup) 8235 (gnus-activate-group to-newsgroup)
8235 (if (gnus-y-or-n-p (format "No such group: %s. Create it? " 8236 (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
8236 to-newsgroup)) 8237 to-newsgroup))
8237 (or (and (gnus-request-create-group 8238 (or (and (gnus-request-create-group
8238 to-newsgroup (gnus-group-name-to-method to-newsgroup)) 8239 to-newsgroup (gnus-group-name-to-method to-newsgroup))
8239 (gnus-activate-group to-newsgroup nil nil 8240 (gnus-activate-group to-newsgroup nil nil
8240 (gnus-group-name-to-method 8241 (gnus-group-name-to-method
8241 to-newsgroup))) 8242 to-newsgroup)))
8242 (error "Couldn't create group %s" to-newsgroup))) 8243 (error "Couldn't create group %s" to-newsgroup)))
8325 (gnus-article-setup-buffer) 8326 (gnus-article-setup-buffer)
8326 (set-buffer gnus-article-buffer) 8327 (set-buffer gnus-article-buffer)
8327 (setq buffer-read-only nil) 8328 (setq buffer-read-only nil)
8328 (let ((command (if automatic command (read-string "Command: " command))) 8329 (let ((command (if automatic command (read-string "Command: " command)))
8329 ;; Just binding this here doesn't help, because there might 8330 ;; Just binding this here doesn't help, because there might
8330 ;; be output from the process after exiting the scope of 8331 ;; be output from the process after exiting the scope of
8331 ;; this `let'. 8332 ;; this `let'.
8332 ;; (buffer-read-only nil) 8333 ;; (buffer-read-only nil)
8333 ) 8334 )
8334 (erase-buffer) 8335 (erase-buffer)
8335 (insert "$ " command "\n\n") 8336 (insert "$ " command "\n\n")
8359 ;;; Header reading. 8360 ;;; Header reading.
8360 8361
8361 (defun gnus-read-header (id &optional header) 8362 (defun gnus-read-header (id &optional header)
8362 "Read the headers of article ID and enter them into the Gnus system." 8363 "Read the headers of article ID and enter them into the Gnus system."
8363 (let ((group gnus-newsgroup-name) 8364 (let ((group gnus-newsgroup-name)
8364 (gnus-override-method 8365 (gnus-override-method
8365 (and (gnus-news-group-p gnus-newsgroup-name) 8366 (and (gnus-news-group-p gnus-newsgroup-name)
8366 gnus-refer-article-method)) 8367 gnus-refer-article-method))
8367 where) 8368 where)
8368 ;; First we check to see whether the header in question is already 8369 ;; First we check to see whether the header in question is already
8369 ;; fetched. 8370 ;; fetched.
8436 (let* ((beg (progn (beginning-of-line) (point))) 8437 (let* ((beg (progn (beginning-of-line) (point)))
8437 (end (progn (end-of-line) (point))) 8438 (end (progn (end-of-line) (point)))
8438 ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. 8439 ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
8439 (from (if (get-text-property beg gnus-mouse-face-prop) 8440 (from (if (get-text-property beg gnus-mouse-face-prop)
8440 beg 8441 beg
8441 (or (next-single-property-change 8442 (or (next-single-property-change
8442 beg gnus-mouse-face-prop nil end) 8443 beg gnus-mouse-face-prop nil end)
8443 beg))) 8444 beg)))
8444 (to 8445 (to
8445 (if (= from end) 8446 (if (= from end)
8446 (- from 2) 8447 (- from 2)
8480 (while (and list 8481 (while (and list
8481 (not (eval (caar list)))) 8482 (not (eval (caar list))))
8482 (setq list (cdr list)))) 8483 (setq list (cdr list))))
8483 (let ((face (cdar list))) 8484 (let ((face (cdar list)))
8484 (unless (eq face (get-text-property beg 'face)) 8485 (unless (eq face (get-text-property beg 'face))
8485 (gnus-put-text-property 8486 (gnus-put-text-property
8486 beg end 'face 8487 beg end 'face
8487 (setq face (if (boundp face) (symbol-value face) face))) 8488 (setq face (if (boundp face) (symbol-value face) face)))
8488 (when gnus-summary-highlight-line-function 8489 (when gnus-summary-highlight-line-function
8489 (funcall gnus-summary-highlight-line-function article face)))) 8490 (funcall gnus-summary-highlight-line-function article face))))
8490 (goto-char p))) 8491 (goto-char p)))
8491 8492