Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-sum.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents d95e72db5c07
children 4103f0995bd7
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
643 :type 'hook) 643 :type 'hook)
644 644
645 (defcustom gnus-group-no-more-groups-hook nil 645 (defcustom gnus-group-no-more-groups-hook nil
646 "*A hook run when returning to group mode having no more (unread) groups." 646 "*A hook run when returning to group mode having no more (unread) groups."
647 :group 'gnus-group-select 647 :group 'gnus-group-select
648 :type 'hook)
649
650 (defcustom gnus-ps-print-hook nil
651 "*A hook run before ps-printing something from Gnus."
652 :group 'gnus-summary
648 :type 'hook) 653 :type 'hook)
649 654
650 (defcustom gnus-summary-selected-face 'gnus-summary-selected-face 655 (defcustom gnus-summary-selected-face 'gnus-summary-selected-face
651 "Face used for highlighting the current article in the summary buffer." 656 "Face used for highlighting the current article in the summary buffer."
652 :group 'gnus-summary-visual 657 :group 'gnus-summary-visual
698 below: The score below which articles are automatically marked as read. 703 below: The score below which articles are automatically marked as read.
699 mark: The articles mark." 704 mark: The articles mark."
700 :group 'gnus-summary-visual 705 :group 'gnus-summary-visual
701 :type '(repeat (cons (sexp :tag "Form" nil) 706 :type '(repeat (cons (sexp :tag "Form" nil)
702 face))) 707 face)))
708
703 709
704 ;;; Internal variables 710 ;;; Internal variables
705 711
706 (defvar gnus-scores-exclude-files nil) 712 (defvar gnus-scores-exclude-files nil)
707 713
1886 (gnus-set-default-directory) 1892 (gnus-set-default-directory)
1887 (setq gnus-newsgroup-name group) 1893 (setq gnus-newsgroup-name group)
1888 (make-local-variable 'gnus-summary-line-format) 1894 (make-local-variable 'gnus-summary-line-format)
1889 (make-local-variable 'gnus-summary-line-format-spec) 1895 (make-local-variable 'gnus-summary-line-format-spec)
1890 (make-local-variable 'gnus-summary-mark-positions) 1896 (make-local-variable 'gnus-summary-mark-positions)
1891 (gnus-make-local-hook 'post-command-hook) 1897 (make-local-hook 'post-command-hook)
1892 (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) 1898 (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
1893 (run-hooks 'gnus-summary-mode-hook) 1899 (run-hooks 'gnus-summary-mode-hook)
1894 (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) 1900 (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
1895 (gnus-update-summary-mark-positions)) 1901 (gnus-update-summary-mark-positions))
1896 1902
3528 3534
3529 (defun gnus-summary-prepare-unthreaded (headers) 3535 (defun gnus-summary-prepare-unthreaded (headers)
3530 "Generate an unthreaded summary buffer based on HEADERS." 3536 "Generate an unthreaded summary buffer based on HEADERS."
3531 (let (header number mark) 3537 (let (header number mark)
3532 3538
3539 (beginning-of-line)
3540
3533 (while headers 3541 (while headers
3534 ;; We may have to root out some bad articles... 3542 ;; We may have to root out some bad articles...
3535 (when (memq (setq number (mail-header-number 3543 (when (memq (setq number (mail-header-number
3536 (setq header (pop headers)))) 3544 (setq header (pop headers))))
3537 gnus-newsgroup-limit) 3545 gnus-newsgroup-limit)
3602 (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) 3610 (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
3603 gnus-newsgroup-dormant)) 3611 gnus-newsgroup-dormant))
3604 3612
3605 (setq gnus-newsgroup-processable nil) 3613 (setq gnus-newsgroup-processable nil)
3606 3614
3615 (gnus-update-read-articles group gnus-newsgroup-unreads)
3616 (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
3617 (gnus-group-update-group group))
3618
3607 (setq articles (gnus-articles-to-read group read-all)) 3619 (setq articles (gnus-articles-to-read group read-all))
3608 3620
3609 (cond 3621 (cond
3610 ((null articles) 3622 ((null articles)
3611 ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") 3623 ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
4405 (if backward 4417 (if backward
4406 (gnus-summary-find-prev nil article) 4418 (gnus-summary-find-prev nil article)
4407 (gnus-summary-find-next nil article))) 4419 (gnus-summary-find-next nil article)))
4408 (decf n))) 4420 (decf n)))
4409 (nreverse articles))) 4421 (nreverse articles)))
4410 ((and (boundp 'transient-mark-mode) 4422 ((gnus-region-active-p)
4411 transient-mark-mode
4412 (boundp 'mark-active)
4413 mark-active)
4414 ;; Work on the region between point and mark. 4423 ;; Work on the region between point and mark.
4415 (let ((max (max (point) (mark))) 4424 (let ((max (max (point) (mark)))
4416 articles article) 4425 articles article)
4417 (save-excursion 4426 (save-excursion
4418 (goto-char (min (point) (mark))) 4427 (goto-char (min (point) (mark)))
5419 (defun gnus-summary-prev-page (&optional lines) 5428 (defun gnus-summary-prev-page (&optional lines)
5420 "Show previous page of selected article. 5429 "Show previous page of selected article.
5421 Argument LINES specifies lines to be scrolled down." 5430 Argument LINES specifies lines to be scrolled down."
5422 (interactive "P") 5431 (interactive "P")
5423 (gnus-set-global-variables) 5432 (gnus-set-global-variables)
5424 (let ((article (gnus-summary-article-number))) 5433 (let ((article (gnus-summary-article-number))
5434 (article-window (get-buffer-window gnus-article-buffer)))
5425 (gnus-configure-windows 'article) 5435 (gnus-configure-windows 'article)
5426 (if (or (null gnus-current-article) 5436 (if (or (null gnus-current-article)
5427 (null gnus-article-current) 5437 (null gnus-article-current)
5428 (/= article (cdr gnus-article-current)) 5438 (/= article (cdr gnus-article-current))
5429 (not (equal (car gnus-article-current) gnus-newsgroup-name))) 5439 (not (equal (car gnus-article-current) gnus-newsgroup-name)))
5430 ;; Selected subject is different from current article's. 5440 ;; Selected subject is different from current article's.
5431 (gnus-summary-display-article article) 5441 (gnus-summary-display-article article)
5432 (gnus-summary-recenter) 5442 (gnus-summary-recenter)
5433 (gnus-eval-in-buffer-window gnus-article-buffer 5443 (when article-window
5434 (gnus-article-prev-page lines)))) 5444 (gnus-eval-in-buffer-window gnus-article-buffer
5445 (gnus-article-prev-page lines)))))
5435 (gnus-summary-position-point)) 5446 (gnus-summary-position-point))
5436 5447
5437 (defun gnus-summary-scroll-up (lines) 5448 (defun gnus-summary-scroll-up (lines)
5438 "Scroll up (or down) one line current article. 5449 "Scroll up (or down) one line current article.
5439 Argument LINES specifies lines to be scrolled up (or down if negative)." 5450 Argument LINES specifies lines to be scrolled up (or down if negative)."
6365 (unwind-protect 6376 (unwind-protect
6366 (progn 6377 (progn
6367 (copy-to-buffer buffer (point-min) (point-max)) 6378 (copy-to-buffer buffer (point-min) (point-max))
6368 (set-buffer buffer) 6379 (set-buffer buffer)
6369 (gnus-article-delete-invisible-text) 6380 (gnus-article-delete-invisible-text)
6381 (run-hooks 'gnus-ps-print-hook)
6370 (ps-print-buffer-with-faces filename)) 6382 (ps-print-buffer-with-faces filename))
6371 (kill-buffer buffer))))) 6383 (kill-buffer buffer)))))
6372 6384
6373 (defun gnus-summary-show-article (&optional arg) 6385 (defun gnus-summary-show-article (&optional arg)
6374 "Force re-fetching of the current article. 6386 "Force re-fetching of the current article.
6620 header) 6632 header)
6621 (memq article gnus-newsgroup-marked) 6633 (memq article gnus-newsgroup-marked)
6622 (memq article gnus-newsgroup-dormant) 6634 (memq article gnus-newsgroup-dormant)
6623 (memq article gnus-newsgroup-unreads))) 6635 (memq article gnus-newsgroup-unreads)))
6624 6636
6637 (when (and (equal to-group gnus-newsgroup-name)
6638 (not (memq article gnus-newsgroup-unreads)))
6639 ;; Mark this article as read in this group.
6640 (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
6641 (setcdr (gnus-active to-group) to-article)
6642 (setcdr gnus-newsgroup-active to-article))
6643
6625 (while marks 6644 (while marks
6626 (when (memq article (symbol-value 6645 (when (memq article (symbol-value
6627 (intern (format "gnus-newsgroup-%s" 6646 (intern (format "gnus-newsgroup-%s"
6628 (caar marks))))) 6647 (caar marks)))))
6629 ;; If the other group is the same as this group, 6648 ;; If the other group is the same as this group,
6632 (set (intern (format "gnus-newsgroup-%s" (caar marks))) 6651 (set (intern (format "gnus-newsgroup-%s" (caar marks)))
6633 (cons to-article 6652 (cons to-article
6634 (symbol-value 6653 (symbol-value
6635 (intern (format "gnus-newsgroup-%s" 6654 (intern (format "gnus-newsgroup-%s"
6636 (caar marks))))))) 6655 (caar marks)))))))
6637 ;; Copy mark to other group. 6656 ;; Copy the marks to other group.
6638 (gnus-add-marked-articles 6657 (gnus-add-marked-articles
6639 to-group (cdar marks) (list to-article) info)) 6658 to-group (cdar marks) (list to-article) info))
6640 (setq marks (cdr marks))))) 6659 (setq marks (cdr marks)))))
6641 6660
6642 ;; Update the Xref header in this article to point to 6661 ;; Update the Xref header in this article to point to
6940 (set-buffer (or buffer gnus-summary-buffer)) 6959 (set-buffer (or buffer gnus-summary-buffer))
6941 (gnus-summary-update-article (cdr gnus-article-current))) 6960 (gnus-summary-update-article (cdr gnus-article-current)))
6942 ;; Prettify the article buffer again. 6961 ;; Prettify the article buffer again.
6943 (save-excursion 6962 (save-excursion
6944 (set-buffer gnus-article-buffer) 6963 (set-buffer gnus-article-buffer)
6945 (run-hooks 'gnus-article-display-hook)) 6964 (run-hooks 'gnus-article-display-hook)
6965 (set-buffer gnus-original-article-buffer)
6966 (gnus-request-article
6967 (cdr gnus-article-current) (car gnus-article-current) (current-buffer)))
6946 ;; Prettify the summary buffer line. 6968 ;; Prettify the summary buffer line.
6947 (when (gnus-visual-p 'summary-highlight 'highlight) 6969 (when (gnus-visual-p 'summary-highlight 'highlight)
6948 (run-hooks 'gnus-visual-mark-article-hook)))) 6970 (run-hooks 'gnus-visual-mark-article-hook))))
6949 6971
6950 (defun gnus-summary-edit-wash (key) 6972 (defun gnus-summary-edit-wash (key)
8365 ((cdr where) (cdr where)) 8387 ((cdr where) (cdr where))
8366 (header (mail-header-number header)) 8388 (header (mail-header-number header))
8367 (t gnus-reffed-article-number)) 8389 (t gnus-reffed-article-number))
8368 (current-buffer)) 8390 (current-buffer))
8369 (insert " Article retrieved.\n")) 8391 (insert " Article retrieved.\n"))
8370 (if (not (setq header (car (gnus-get-newsgroup-headers nil t)))) 8392 (if (or (not where)
8393 (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
8371 () ; Malformed head. 8394 () ; Malformed head.
8372 (unless (gnus-summary-article-sparse-p (mail-header-number header)) 8395 (unless (gnus-summary-article-sparse-p (mail-header-number header))
8373 (when (and (stringp id) 8396 (when (and (stringp id)
8374 (not (string= (gnus-group-real-name group) 8397 (not (string= (gnus-group-real-name group)
8375 (car where)))) 8398 (car where))))