From: yamaoka Date: Thu, 31 Jan 2002 23:23:02 +0000 (+0000) Subject: Synch with Oort Gnus. X-Git-Tag: t-gnus-6_15_6-01-quimby~84 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b9831cf5cc94d4dfc14509b110d49e53cd43f535;p=elisp%2Fgnus.git- Synch with Oort Gnus. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 06c435c..ead3618 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,29 @@ 2002-01-31 ShengHuo ZHU + * nnfolder.el (nnfolder-request-replace-article): Unfold. Don't + use mail-header-unfold-field. + + * gnus-cache.el (gnus-summary-insert-cached-articles): Use + gnus-summary-limit. + + * gnus-range.el (gnus-add-to-sorted-list): New function. + * gnus-sum.el (gnus-mark-article-as-read): Use it. + (gnus-mark-article-as-unread): Ditto. + (gnus-summary-mark-article-as-unread): Ditto. + (gnus-build-get-header): Ditto. + (gnus-summary-prepare-threads): Ditto. + (gnus-summary-insert-pseudos): Ditto. + (gnus-articles-to-read): Use gnus-sorted-union and gnus-sorted-nunion. + (gnus-summary-insert-new-articles): Use gnus-sorted-nunion. + (gnus-summary-insert-old-articles): Ditto. + + * gnus-msg.el (gnus-posting-styles): Add new format of header. + (gnus-configure-posting-styles): Support the new format. + + * mail-source.el (mail-source-bind, mail-source-bind-common): Set + edebug-form-spec to (sexp body). + Suggested by Joe Wells . + * message.el (message-reply-headers): Add doc. 2002-01-30 ShengHuo ZHU diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index a7fc19c..1e68209 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,5 +1,5 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -368,10 +368,13 @@ Returns the list of articles removed." (interactive) (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>)) (gnus-verbose (max 6 gnus-verbose))) - (unless cached - (gnus-message 3 "No cached articles for this group")) - (while cached - (gnus-summary-goto-subject (pop cached) t)))) + (if (not cached) + (gnus-message 3 "No cached articles for this group") + (save-excursion + (while cached + (gnus-summary-goto-subject (pop cached) t))) + (gnus-summary-limit (append gnus-newsgroup-cached gnus-newsgroup-limit)) + (gnus-summary-position-point)))) (defun gnus-summary-limit-include-cached () "Limit the summary buffer to articles that are cached." diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 5f7c3e2..9dc4f01 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -121,8 +121,11 @@ the second with the current group name." See Info node `(gnus)Posting Styles'." :group 'gnus-message :type '(repeat (cons (choice (regexp) - (function) (variable) + (list (const header) + (string :tag "Header") + (regexp :tag "Regexp")) + (function) (sexp)) (repeat (list (choice (const signature) @@ -131,6 +134,7 @@ See Info node `(gnus)Posting Styles'." (const address) (const name) (const body) + (symbol) (string :tag "Header")) (choice (string) (function) @@ -139,6 +143,7 @@ See Info node `(gnus)Posting Styles'." (defcustom gnus-gcc-mark-as-read nil "If non-nil, automatically mark Gcc articles as read." + :version "21.1" :group 'gnus-message :type 'boolean) @@ -153,6 +158,7 @@ See Info node `(gnus)Posting Styles'." If it is `all', attach files as external parts; if a regexp and matches the Gcc group name, attach files as external parts; If nil, attach files as normal parts." + :version "21.1" :group 'gnus-message :type '(choice (const nil :tag "None") (const all :tag "Any") @@ -1727,6 +1733,7 @@ this is a reply." ;; Regexp string match on the group name. (string-match match group)) ((eq match 'header) + ;; Obsolete format of header match. (and (gnus-buffer-live-p gnus-article-copy) (with-current-buffer gnus-article-copy (let ((header (message-fetch-field (pop style)))) @@ -1742,8 +1749,17 @@ this is a reply." ;; Variable to be checked. (symbol-value match)))) ((listp match) - ;; This is a form to be evaled. - (eval match))) + (cond + ((eq (car match) 'header) + ;; New format of header match. + (and (gnus-buffer-live-p gnus-article-copy) + (with-current-buffer gnus-article-copy + (let ((header (message-fetch-field (nth 1 match)))) + (and header + (string-match (nth 2 match) header)))))) + (t + ;; This is a form to be evaled. + (eval match))))) ;; We have a match, so we set the variables. (dolist (attribute style) (setq element (pop attribute) diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 5dc271a..337e436 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -535,6 +535,18 @@ LIST is a sorted list." (if item (push item range)) (reverse range))) +;;;###autoload +(defun gnus-add-to-sorted-list (list num) + "Add NUM into sorted LIST by side effect." + (let* ((top (cons nil list)) + (prev top)) + (while (and list (< (car list) num)) + (setq prev list + list (cdr list))) + (unless (eq (car list) num) + (setcdr prev (cons num list))) + (cdr top))) + (provide 'gnus-range) ;;; gnus-range.el ends here diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 574a58a..77fe6f3 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -3775,7 +3775,9 @@ the id of the parent article (if any)." (push header gnus-newsgroup-headers) (if (memq number gnus-newsgroup-unselected) (progn - (push number gnus-newsgroup-unreads) + (setq gnus-newsgroup-unselected + (gnus-add-to-sorted-list gnus-newsgroup-unreads + number)) (setq gnus-newsgroup-unselected (delq number gnus-newsgroup-unselected))) (push number gnus-newsgroup-ancient))))))) @@ -4432,7 +4434,9 @@ or a straight list of headers." (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) + (setq gnus-newsgroup-expirable + (gnus-add-to-sorted-list + gnus-newsgroup-expirable number)) (push (cons number gnus-low-score-mark) gnus-newsgroup-reads)))) @@ -4887,9 +4891,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-uncompress-range (gnus-active group)) (gnus-cache-articles-in-group group)) ;; Select only the "normal" subset of articles. - (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked - (copy-sequence gnus-newsgroup-unreads)) - '<))) + (gnus-sorted-nunion + (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) + gnus-newsgroup-unreads))) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) (scored (length scored-list)) (number (length articles)) @@ -9296,11 +9300,17 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) + (setq gnus-newsgroup-marked + (gnus-add-to-sorted-list gnus-newsgroup-marked + article))) ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-dormant + (gnus-add-to-sorted-list gnus-newsgroup-dormant + article))) (t - (push article gnus-newsgroup-unreads))) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + article)))) (gnus-pull article gnus-newsgroup-reads) ;; See whether the article is to be put in the cache. @@ -9412,9 +9422,10 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." "Enter ARTICLE in the pertinent lists and remove it from others." ;; Make the article expirable. (let ((mark (or mark gnus-del-mark))) - (if (= mark gnus-expirable-mark) - (push article gnus-newsgroup-expirable) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) + (setq gnus-newsgroup-expirable + (if (= mark gnus-expirable-mark) + (gnus-add-to-sorted-list gnus-newsgroup-expirable article) + (delq article gnus-newsgroup-expirable))) ;; Remove from unread and marked lists. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) @@ -9442,11 +9453,14 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-dup-unsuppress-article article)) (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) + (setq gnus-newsgroup-marked + (gnus-add-to-sorted-list gnus-newsgroup-marked article))) ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-dormant + (gnus-add-to-sorted-list gnus-newsgroup-dormant article))) (t - (push article gnus-newsgroup-unreads))) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads article)))) (gnus-pull article gnus-newsgroup-reads) t))) @@ -10493,7 +10507,9 @@ If REVERSE, save parts that do not match TYPE." (gnus-data-enter after-article gnus-reffed-article-number gnus-unread-mark b (car pslist) 0 (- e b)) - (push gnus-reffed-article-number gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + gnus-reffed-article-number)) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) @@ -11152,7 +11168,7 @@ If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles." (interactive "P") (prog1 - (let ((old (mapcar 'car gnus-newsgroup-data)) + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) older len) (setq older (gnus-sorted-difference @@ -11182,14 +11198,14 @@ If ALL is a number, fetch this number of articles." (if (not older) (message "No old news.") (gnus-summary-insert-articles older) - (gnus-summary-limit (gnus-sorted-union older old)))) + (gnus-summary-limit (gnus-sorted-nunion old older)))) (gnus-summary-position-point))) (defun gnus-summary-insert-new-articles () "Insert all new articles in this group." (interactive) (prog1 - (let ((old (mapcar 'car gnus-newsgroup-data)) + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) (old-active gnus-newsgroup-active) (nnmail-fetched-sources (list t)) i new) @@ -11204,8 +11220,8 @@ If ALL is a number, fetch this number of articles." (setq new (nreverse new)) (gnus-summary-insert-articles new) (setq gnus-newsgroup-unreads - (append gnus-newsgroup-unreads new)) - (gnus-summary-limit (gnus-union old new)))) + (gnus-sorted-nunion gnus-newsgroup-unreads new)) + (gnus-summary-limit (gnus-sorted-nunion old new)))) (gnus-summary-position-point))) (gnus-summary-make-all-marking-commands) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 6cc9e78..2f11cd2 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -380,7 +380,7 @@ the `mail-source-keyword-map' variable." ,@body)) (put 'mail-source-bind 'lisp-indent-function 1) -(put 'mail-source-bind 'edebug-form-spec '(form body)) +(put 'mail-source-bind 'edebug-form-spec '(sexp body)) (defun mail-source-set-1 (source) (let* ((type (pop source)) @@ -423,7 +423,7 @@ See `mail-source-bind'." ,@body)) (put 'mail-source-bind-common 'lisp-indent-function 1) -(put 'mail-source-bind-common 'edebug-form-spec '(form body)) +(put 'mail-source-bind-common 'edebug-form-spec '(sexp body)) (defun mail-source-value (value) "Return the value of VALUE." diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 4974fd1..eaef42d 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -519,9 +519,11 @@ the group. Then the marks file will be regenerated properly by Gnus.") (goto-char (point-min)) (if (not (looking-at "X-From-Line: ")) (insert "From nobody " (current-time-string) "\n") - (save-match-data - (mail-header-unfold-field)) - (replace-match "From ")) + (replace-match "From ") + (forward-line 1) + (while (looking-at "[ \t]") + (delete-char -1) + (forward-line 1))) (nnfolder-normalize-buffer) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 4b79912..243c393 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -10324,21 +10324,22 @@ Gnus は外へ出て行く全てのメッセージに、一つかそれ以上のそのサーバーのグ それぞれの様式の最初の要素は @code{合致} (match) と呼ばれます。もしそれ が文字列であれば、gnus はそれをグループ名に正規表元現として合致操作を行 -います。シンボル @code{header} であれば、gnus は元の記事の中からその合致 -の中の次の要素に合致するヘッダーを探し、それをその合致の最後の正規表元現 -と比較します。もしそれが関数のシンボルであれば、その関数が引数無しで呼ば -れます。それが変数のシンボルであれば、その変数が参照されます。それがリス -トであれば、そのリストが @code{評価} されます。どの場合でも、これ -が @code{nil}でない値を帰せば、様式は @code{合致した} と言います。 +います。@code{(header 合致 正規表現)} という様式であれば、gnus は元の記 +事の中から名前が合致するヘッダーを探し、それを正規表元と比較します。合致 +と正規表現は文字列です。もしそれが関数のシンボルであれば、その関数が引数 +無しで呼ばれます。それが変数のシンボルであれば、その変数が参照されます。 +それがリストであれば、そのリストが @code{評価} されます。どの場合でも、 +これが @code{nil}でない値を帰せば、様式は @code{合致した} と言います。 それぞれの様式は任意の量の @dfn{属性} を持つ事ができます。それぞれの属性 は @code{(@var{name} @var{value})} の対により成り立っています。属性名 -は、@code{signature}, @code{signature-file}, @code{address} (ユーザーの -電子メールアドレス), @code{name} (ユーザーの名前) または @code{body} の -どれかである事ができます。属性名は文字列またはシンボルである事もできます。 -その場合は、これはヘッダー名として使われ、その値が記事のヘッダーに挿入さ -れます。もし属性名が @code{nil} だったらそのヘッダー名は削除されます。も -し属性名が @code{eval} だったらその様式が評価され、結果は捨てられます。 +は、@code{signature}, @code{signature-file}, @code{address} +(@code{user-mail-address} を上書きする), @code{name} +(@code{(user-full-name) を上書きする) または @code{body} のどれかである +事ができます。属性名は文字列またはシンボルである事もできます。その場合は、 +これはヘッダー名として使われ、その値が記事のヘッダーに挿入されます。もし +属性名が @code{nil} だったらそのヘッダー名は削除されます。もし属性名が +@code{eval} だったらその様式が評価され、結果は捨てられます。 属性値は文字列 (そのまま使われます)、引数の無い関数 (返り値が使われます)、 変数 (その値が使われます) またはリスト (それは @code{評価} されて、返り @@ -10369,16 +10370,16 @@ from date id references chars lines xref extra の各ヘッダーから成るベク (organization "People's Front Against MWM")) ("^rec.humor" (signature my-funny-signature-randomizer)) - ((equal (system-name) "gnarly") ;; s 式 + ((equal (system-name) "gnarly") ;; 様式 (signature my-quote-randomizer)) (message-news-p ;; 関数シンボル (signature my-news-signature)) (window-system ;; 変数シンボル ("X-Window-System" (format "%s" window-system))) - ;; Larsi さんに返事をするときは + ;; Lars さんに返事をするときは ;; Organization ヘッダーを付けよう。 - (header "to" "larsi.*org" - (Organization "Somewhere, Inc.")) + ((header "to" "larsi.*org") + (Organization "Somewhere, Inc.")) ((posting-from-work-p) ;; ユーザーが定義した関数 (signature-file "~/.work-signature") (address "user@@bar.foo") diff --git a/texi/gnus.texi b/texi/gnus.texi index a498d14..0b4be5a 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -10828,23 +10828,24 @@ signature and the @samp{What me?} @code{Organization} header. The first element in each style is called the @code{match}. If it's a string, then Gnus will try to regexp match it against the group name. -If it is the symbol @code{header}, then Gnus will look for header (the -next element in the match) in the original article , and compare that to -the last regexp in the match. If it's a function symbol, that function -will be called with no arguments. If it's a variable symbol, then the -variable will be referenced. If it's a list, then that list will be -@code{eval}ed. In any case, if this returns a non-@code{nil} value, -then the style is said to @dfn{match}. - -Each style may contain a arbitrary amount of @dfn{attributes}. Each +If it is the form @code{(header MATCH REGEXP)}, then Gnus will look in +the original article for a header whose name is MATCH and compare that +REGEXP. MATCH and REGEXP are strings. If it's a function symbol, that +function will be called with no arguments. If it's a variable symbol, +then the variable will be referenced. If it's a list, then that list +will be @code{eval}ed. In any case, if this returns a non-@code{nil} +value, then the style is said to @dfn{match}. + +Each style may contain an arbitrary amount of @dfn{attributes}. Each attribute consists of a @code{(@var{name} @var{value})} pair. The attribute name can be one of @code{signature}, @code{signature-file}, -@code{address} (user email address), @code{name} (user name) or -@code{body}. The attribute name can also be a string or a symbol. In -that case, this will be used as a header name, and the value will be -inserted in the headers of the article; if the value is @code{nil}, the -header name will be removed. If the attribute name is @code{eval}, the -form is evaluated, and the result is thrown away. +@code{address} (overriding @code{user-mail-address}), @code{name} +(overriding @code{(user-full-name)}) or @code{body}. The attribute name +can also be a string or a symbol. In that case, this will be used as a +header name, and the value will be inserted in the headers of the +article; if the value is @code{nil}, the header name will be removed. +If the attribute name is @code{eval}, the form is evaluated, and the +result is thrown away. The attribute value can be a string (used verbatim), a function with zero arguments (the return value will be used), a variable (its value @@ -10875,16 +10876,16 @@ So here's a new example: (organization "People's Front Against MWM")) ("^rec.humor" (signature my-funny-signature-randomizer)) - ((equal (system-name) "gnarly") ;; a sexp + ((equal (system-name) "gnarly") ;; A form (signature my-quote-randomizer)) - (message-news-p ;; a function symbol + (message-news-p ;; A function symbol (signature my-news-signature)) - (window-system ;; a value symbol + (window-system ;; A value symbol ("X-Window-System" (format "%s" window-system))) ;; If I'm replying to Larsi, set the Organization header. - (header "to" "larsi.*org" - (Organization "Somewhere, Inc.")) - ((posting-from-work-p) ;; a user defined function + ((header "to" "larsi.*org") + (Organization "Somewhere, Inc.")) + ((posting-from-work-p) ;; A user defined function (signature-file "~/.work-signature") (address "user@@bar.foo") (body "You are fired.\n\nSincerely, your boss.")