Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-sum.el @ 169:15872534500d r20-3b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b11
author cvs
date Mon, 13 Aug 2007 09:46:53 +0200
parents 85ec50267440
children 8eaf7971accc
comparison
equal deleted inserted replaced
168:9851d5c6556e 169:15872534500d
3824 (while articles 3824 (while articles
3825 (when (or (< (setq article (pop articles)) min) (> article max)) 3825 (when (or (< (setq article (pop articles)) min) (> article max))
3826 (set var (delq article (symbol-value var)))))) 3826 (set var (delq article (symbol-value var))))))
3827 ;; Adjust assocs. 3827 ;; Adjust assocs.
3828 ((memq mark uncompressed) 3828 ((memq mark uncompressed)
3829 (when (not (listp (car (symbol-value var))))) 3829 (when (not (listp (cdr (symbol-value var))))
3830 (set var (list (symbol-value var))) 3830 (set var (list (symbol-value var))))
3831 (when (not (listp (cdr articles))) 3831 (when (not (listp (cdr articles)))
3832 (setq articles (list articles))) 3832 (setq articles (list articles)))
3833 (while articles 3833 (while articles
3834 (when (or (not (consp (setq article (pop articles)))) 3834 (when (or (not (consp (setq article (pop articles))))
3835 (< (car article) min) 3835 (< (car article) min)
4999 (unless gnus-dead-summary-mode-map 4999 (unless gnus-dead-summary-mode-map
5000 (setq gnus-dead-summary-mode-map (make-keymap)) 5000 (setq gnus-dead-summary-mode-map (make-keymap))
5001 (suppress-keymap gnus-dead-summary-mode-map) 5001 (suppress-keymap gnus-dead-summary-mode-map)
5002 (substitute-key-definition 5002 (substitute-key-definition
5003 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) 5003 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
5004 (let ((keys '("\C-d" "\r" "\177"))) 5004 (let ((keys '("\C-d" "\r" "\177" [delete])))
5005 (while keys 5005 (while keys
5006 (define-key gnus-dead-summary-mode-map 5006 (define-key gnus-dead-summary-mode-map
5007 (pop keys) 'gnus-summary-wake-up-the-dead)))) 5007 (pop keys) 'gnus-summary-wake-up-the-dead))))
5008 5008
5009 (defvar gnus-dead-summary-mode nil 5009 (defvar gnus-dead-summary-mode nil
5297 (all-headers (not (not all-headers))) ;Must be T or NIL. 5297 (all-headers (not (not all-headers))) ;Must be T or NIL.
5298 gnus-summary-display-article-function 5298 gnus-summary-display-article-function
5299 did) 5299 did)
5300 (and (not pseudo) 5300 (and (not pseudo)
5301 (gnus-summary-article-pseudo-p article) 5301 (gnus-summary-article-pseudo-p article)
5302 (error "This is a pseudo-article.")) 5302 (error "This is a pseudo-article"))
5303 (prog1 5303 (prog1
5304 (save-excursion 5304 (save-excursion
5305 (set-buffer gnus-summary-buffer) 5305 (set-buffer gnus-summary-buffer)
5306 (if (or (and gnus-single-article-buffer 5306 (if (or (and gnus-single-article-buffer
5307 (or (null gnus-current-article) 5307 (or (null gnus-current-article)
7003 delete these instead." 7003 delete these instead."
7004 (interactive "P") 7004 (interactive "P")
7005 (gnus-set-global-variables) 7005 (gnus-set-global-variables)
7006 (unless (gnus-check-backend-function 'request-expire-articles 7006 (unless (gnus-check-backend-function 'request-expire-articles
7007 gnus-newsgroup-name) 7007 gnus-newsgroup-name)
7008 (error "The current newsgroup does not support article deletion.")) 7008 (error "The current newsgroup does not support article deletion"))
7009 ;; Compute the list of articles to delete. 7009 ;; Compute the list of articles to delete.
7010 (let ((articles (gnus-summary-work-articles n)) 7010 (let ((articles (gnus-summary-work-articles n))
7011 not-deleted) 7011 not-deleted)
7012 (if (and gnus-novice-user 7012 (if (and gnus-novice-user
7013 (not (gnus-yes-or-no-p 7013 (not (gnus-yes-or-no-p
7041 (save-excursion 7041 (save-excursion
7042 (set-buffer gnus-summary-buffer) 7042 (set-buffer gnus-summary-buffer)
7043 (gnus-set-global-variables) 7043 (gnus-set-global-variables)
7044 (when (and (not force) 7044 (when (and (not force)
7045 (gnus-group-read-only-p)) 7045 (gnus-group-read-only-p))
7046 (error "The current newsgroup does not support article editing.")) 7046 (error "The current newsgroup does not support article editing"))
7047 ;; Select article if needed. 7047 ;; Select article if needed.
7048 (unless (eq (gnus-summary-article-number) 7048 (unless (eq (gnus-summary-article-number)
7049 gnus-current-article) 7049 gnus-current-article)
7050 (gnus-summary-select-article t)) 7050 (gnus-summary-select-article t))
7051 (gnus-article-edit-article 7051 (gnus-article-edit-article
7062 ;; Replace the article. 7062 ;; Replace the article.
7063 (if (and (not read-only) 7063 (if (and (not read-only)
7064 (not (gnus-request-replace-article 7064 (not (gnus-request-replace-article
7065 (cdr gnus-article-current) (car gnus-article-current) 7065 (cdr gnus-article-current) (car gnus-article-current)
7066 (current-buffer)))) 7066 (current-buffer))))
7067 (error "Couldn't replace article.") 7067 (error "Couldn't replace article")
7068 ;; Update the summary buffer. 7068 ;; Update the summary buffer.
7069 (if (and references 7069 (if (and references
7070 (equal (message-tokenize-header references " ") 7070 (equal (message-tokenize-header references " ")
7071 (message-tokenize-header 7071 (message-tokenize-header
7072 (or (message-fetch-field "references") "") " "))) 7072 (or (message-fetch-field "references") "") " ")))
7710 (< (cdar scored) gnus-summary-expunge-below) 7710 (< (cdar scored) gnus-summary-expunge-below)
7711 (push h headers))) 7711 (push h headers)))
7712 (setq scored (cdr scored))) 7712 (setq scored (cdr scored)))
7713 (if (not headers) 7713 (if (not headers)
7714 (when (not no-error) 7714 (when (not no-error)
7715 (error "No expunged articles hidden.")) 7715 (error "No expunged articles hidden"))
7716 (goto-char (point-min)) 7716 (goto-char (point-min))
7717 (gnus-summary-prepare-unthreaded (nreverse headers)) 7717 (gnus-summary-prepare-unthreaded (nreverse headers))
7718 (goto-char (point-min)) 7718 (goto-char (point-min))
7719 (gnus-summary-position-point) 7719 (gnus-summary-position-point)
7720 t)))) 7720 t))))
7865 7865
7866 Note that the re-threading will only work if `gnus-thread-ignore-subject' 7866 Note that the re-threading will only work if `gnus-thread-ignore-subject'
7867 is non-nil or the Subject: of both articles are the same." 7867 is non-nil or the Subject: of both articles are the same."
7868 (interactive) 7868 (interactive)
7869 (unless (not (gnus-group-read-only-p)) 7869 (unless (not (gnus-group-read-only-p))
7870 (error "The current newsgroup does not support article editing.")) 7870 (error "The current newsgroup does not support article editing"))
7871 (unless (<= (length gnus-newsgroup-processable) 1) 7871 (unless (<= (length gnus-newsgroup-processable) 1)
7872 (error "No more than one article may be marked.")) 7872 (error "No more than one article may be marked"))
7873 (save-window-excursion 7873 (save-window-excursion
7874 (let ((gnus-article-buffer " *reparent*") 7874 (let ((gnus-article-buffer " *reparent*")
7875 (current-article (gnus-summary-article-number)) 7875 (current-article (gnus-summary-article-number))
7876 ;; First grab the marked article, otherwise one line up. 7876 ;; First grab the marked article, otherwise one line up.
7877 (parent-article (if (not (null gnus-newsgroup-processable)) 7877 (parent-article (if (not (null gnus-newsgroup-processable))
7878 (car gnus-newsgroup-processable) 7878 (car gnus-newsgroup-processable)
7879 (save-excursion 7879 (save-excursion
7880 (if (eq (forward-line -1) 0) 7880 (if (eq (forward-line -1) 0)
7881 (gnus-summary-article-number) 7881 (gnus-summary-article-number)
7882 (error "Beginning of summary buffer.")))))) 7882 (error "Beginning of summary buffer"))))))
7883 (unless (not (eq current-article parent-article)) 7883 (unless (not (eq current-article parent-article))
7884 (error "An article may not be self-referential.")) 7884 (error "An article may not be self-referential"))
7885 (let ((message-id (mail-header-id 7885 (let ((message-id (mail-header-id
7886 (gnus-summary-article-header parent-article)))) 7886 (gnus-summary-article-header parent-article))))
7887 (unless (and message-id (not (equal message-id ""))) 7887 (unless (and message-id (not (equal message-id "")))
7888 (error "No message-id in desired parent.")) 7888 (error "No message-id in desired parent"))
7889 (gnus-summary-select-article t t nil current-article) 7889 (gnus-summary-select-article t t nil current-article)
7890 (set-buffer gnus-original-article-buffer) 7890 (set-buffer gnus-original-article-buffer)
7891 (let ((buf (format "%s" (buffer-string)))) 7891 (let ((buf (format "%s" (buffer-string))))
7892 (nnheader-temp-write nil 7892 (nnheader-temp-write nil
7893 (insert buf) 7893 (insert buf)
7896 (insert message-id " " ) 7896 (insert message-id " " )
7897 (insert "References: " message-id "\n")) 7897 (insert "References: " message-id "\n"))
7898 (unless (gnus-request-replace-article 7898 (unless (gnus-request-replace-article
7899 current-article (car gnus-article-current) 7899 current-article (car gnus-article-current)
7900 (current-buffer)) 7900 (current-buffer))
7901 (error "Couldn't replace article.")))) 7901 (error "Couldn't replace article"))))
7902 (set-buffer gnus-summary-buffer) 7902 (set-buffer gnus-summary-buffer)
7903 (gnus-summary-unmark-all-processable) 7903 (gnus-summary-unmark-all-processable)
7904 (gnus-summary-rethread-current) 7904 (gnus-summary-rethread-current)
7905 (gnus-message 3 "Article %d is now the child of article %d." 7905 (gnus-message 3 "Article %d is now the child of article %d"
7906 current-article parent-article))))) 7906 current-article parent-article)))))
7907 7907
7908 (defun gnus-summary-toggle-threads (&optional arg) 7908 (defun gnus-summary-toggle-threads (&optional arg)
7909 "Toggle showing conversation threads. 7909 "Toggle showing conversation threads.
7910 If ARG is positive number, turn showing conversation threads on." 7910 If ARG is positive number, turn showing conversation threads on."