Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-sum.el @ 26:441bb1e64a06 r19-15b96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents 4103f0995bd7
children 1917ad0d78d7
comparison
equal deleted inserted replaced
25:383a494979f8 26:441bb1e64a06
3871 max-len 3871 max-len
3872 gnus-tmp-header);; passed as argument to any user-format-funcs 3872 gnus-tmp-header);; passed as argument to any user-format-funcs
3873 (setq mode-string (eval mformat)) 3873 (setq mode-string (eval mformat))
3874 (setq max-len (max 4 (if gnus-mode-non-string-length 3874 (setq max-len (max 4 (if gnus-mode-non-string-length
3875 (- (window-width) 3875 (- (window-width)
3876 gnus-mode-non-string-length) 3876 gnus-mode-non-string-length
3877 (if (string-match "%%b" mode-string)
3878 (length (buffer-name))
3879 0))
3877 (length mode-string)))) 3880 (length mode-string))))
3878 ;; We might have to chop a bit of the string off... 3881 ;; We might have to chop a bit of the string off...
3879 (when (> (length mode-string) max-len) 3882 (when (> (length mode-string) max-len)
3880 (setq mode-string 3883 (setq mode-string
3881 (concat (gnus-truncate-string mode-string (- max-len 3)) 3884 (concat (gnus-truncate-string mode-string (- max-len 3))
4297 ;; article may not have been generated yet, so this may fail. 4300 ;; article may not have been generated yet, so this may fail.
4298 ;; We work around this problem by retrieving the last few 4301 ;; We work around this problem by retrieving the last few
4299 ;; headers using HEAD. 4302 ;; headers using HEAD.
4300 (if (or (not also-fetch-heads) 4303 (if (or (not also-fetch-heads)
4301 (not sequence)) 4304 (not sequence))
4305 ;; We (probably) got all the headers.
4302 (nreverse headers) 4306 (nreverse headers)
4303 (let ((gnus-nov-is-evil t) 4307 (let ((gnus-nov-is-evil t))
4304 (nntp-nov-is-evil t))
4305 (nconc 4308 (nconc
4306 (nreverse headers) 4309 (nreverse headers)
4307 (when (gnus-retrieve-headers sequence group) 4310 (when (gnus-retrieve-headers sequence group)
4308 (gnus-get-newsgroup-headers)))))))) 4311 (gnus-get-newsgroup-headers))))))))
4309 4312
5258 ;; Go to next/previous group. 5261 ;; Go to next/previous group.
5259 (t 5262 (t
5260 (unless (gnus-ephemeral-group-p gnus-newsgroup-name) 5263 (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
5261 (gnus-summary-jump-to-group gnus-newsgroup-name)) 5264 (gnus-summary-jump-to-group gnus-newsgroup-name))
5262 (let ((cmd last-command-char) 5265 (let ((cmd last-command-char)
5266 (point
5267 (save-excursion
5268 (set-buffer gnus-group-buffer)
5269 (point)))
5263 (group 5270 (group
5264 (if (eq gnus-keep-same-level 'best) 5271 (if (eq gnus-keep-same-level 'best)
5265 (gnus-summary-best-group gnus-newsgroup-name) 5272 (gnus-summary-best-group gnus-newsgroup-name)
5266 (gnus-summary-search-group backward gnus-keep-same-level)))) 5273 (gnus-summary-search-group backward gnus-keep-same-level))))
5267 ;; For some reason, the group window gets selected. We change 5274 ;; For some reason, the group window gets selected. We change
5286 "exiting")) 5293 "exiting"))
5287 (gnus-summary-next-group nil group backward))) 5294 (gnus-summary-next-group nil group backward)))
5288 (t 5295 (t
5289 (when (gnus-key-press-event-p last-input-event) 5296 (when (gnus-key-press-event-p last-input-event)
5290 (gnus-summary-walk-group-buffer 5297 (gnus-summary-walk-group-buffer
5291 gnus-newsgroup-name cmd unread backward)))))))) 5298 gnus-newsgroup-name cmd unread backward point))))))))
5292 5299
5293 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward) 5300 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
5294 (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) 5301 (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
5295 (?\C-p (gnus-group-prev-unread-group 1)))) 5302 (?\C-p (gnus-group-prev-unread-group 1))))
5296 (cursor-in-echo-area t) 5303 (cursor-in-echo-area t)
5297 keve key group ended) 5304 keve key group ended)
5298 (save-excursion 5305 (save-excursion
5299 (set-buffer gnus-group-buffer) 5306 (set-buffer gnus-group-buffer)
5300 (gnus-summary-jump-to-group from-group) 5307 (goto-char start)
5301 (setq group 5308 (setq group
5302 (if (eq gnus-keep-same-level 'best) 5309 (if (eq gnus-keep-same-level 'best)
5303 (gnus-summary-best-group gnus-newsgroup-name) 5310 (gnus-summary-best-group gnus-newsgroup-name)
5304 (gnus-summary-search-group backward gnus-keep-same-level)))) 5311 (gnus-summary-search-group backward gnus-keep-same-level))))
5305 (while (not ended) 5312 (while (not ended)
7692 (error "No article on the current line")) 7699 (error "No article on the current line"))
7693 (gnus-rebuild-thread id) 7700 (gnus-rebuild-thread id)
7694 (gnus-summary-goto-subject article))) 7701 (gnus-summary-goto-subject article)))
7695 7702
7696 (defun gnus-summary-reparent-thread () 7703 (defun gnus-summary-reparent-thread ()
7697 "Make current article child of the marked (or previous) article. 7704 "Make the current article child of the marked (or previous) article.
7698 7705
7699 Note that the re-threading will only work if `gnus-thread-ignore-subject' 7706 Note that the re-threading will only work if `gnus-thread-ignore-subject'
7700 is non-nil or the Subject: of both articles are the same." 7707 is non-nil or the Subject: of both articles are the same."
7701 (interactive) 7708 (interactive)
7702 (unless (not (gnus-group-read-only-p)) 7709 (unless (not (gnus-group-read-only-p))
7704 (unless (<= (length gnus-newsgroup-processable) 1) 7711 (unless (<= (length gnus-newsgroup-processable) 1)
7705 (error "No more than one article may be marked.")) 7712 (error "No more than one article may be marked."))
7706 (save-window-excursion 7713 (save-window-excursion
7707 (let ((gnus-article-buffer " *reparent*") 7714 (let ((gnus-article-buffer " *reparent*")
7708 (current-article (gnus-summary-article-number)) 7715 (current-article (gnus-summary-article-number))
7709 ; first grab the marked article, otherwise one line up. 7716 ;; First grab the marked article, otherwise one line up.
7710 (parent-article (if (not (null gnus-newsgroup-processable)) 7717 (parent-article (if (not (null gnus-newsgroup-processable))
7711 (car gnus-newsgroup-processable) 7718 (car gnus-newsgroup-processable)
7712 (save-excursion 7719 (save-excursion
7713 (if (eq (forward-line -1) 0) 7720 (if (eq (forward-line -1) 0)
7714 (gnus-summary-article-number) 7721 (gnus-summary-article-number)
7718 (let ((message-id (mail-header-id 7725 (let ((message-id (mail-header-id
7719 (gnus-summary-article-header parent-article)))) 7726 (gnus-summary-article-header parent-article))))
7720 (unless (and message-id (not (equal message-id ""))) 7727 (unless (and message-id (not (equal message-id "")))
7721 (error "No message-id in desired parent.")) 7728 (error "No message-id in desired parent."))
7722 (gnus-summary-select-article t t nil current-article) 7729 (gnus-summary-select-article t t nil current-article)
7723 (set-buffer gnus-article-buffer) 7730 (set-buffer gnus-original-article-buffer)
7724 (setq buffer-read-only nil)
7725 (let ((buf (format "%s" (buffer-string)))) 7731 (let ((buf (format "%s" (buffer-string))))
7726 (erase-buffer) 7732 (nnheader-temp-write nil
7727 (insert buf)) 7733 (insert buf)
7728 (goto-char (point-min)) 7734 (goto-char (point-min))
7729 (if (search-forward-regexp "^References: " nil t) 7735 (if (search-forward-regexp "^References: " nil t)
7730 (insert message-id " " ) 7736 (insert message-id " " )
7731 (insert "References: " message-id "\n")) 7737 (insert "References: " message-id "\n"))
7732 (unless (gnus-request-replace-article current-article 7738 (unless (gnus-request-replace-article
7733 (car gnus-article-current) 7739 current-article (car gnus-article-current)
7734 gnus-article-buffer) 7740 (current-buffer))
7735 (error "Couldn't replace article.")) 7741 (error "Couldn't replace article."))))
7736 (set-buffer gnus-summary-buffer) 7742 (set-buffer gnus-summary-buffer)
7737 (gnus-summary-unmark-all-processable) 7743 (gnus-summary-unmark-all-processable)
7738 (gnus-summary-rethread-current) 7744 (gnus-summary-rethread-current)
7739 (gnus-message 3 "Article %d is now the child of article %d." 7745 (gnus-message 3 "Article %d is now the child of article %d."
7740 current-article parent-article))))) 7746 current-article parent-article)))))