From 8103bf58f5b1be8cdd775bf19a0675b013821e28 Mon Sep 17 00:00:00 2001 From: keiichi Date: Mon, 16 Nov 1998 03:16:51 +0000 Subject: [PATCH] Sync up with gnus-6_8. --- README-gnus-bbdb.en | 104 ++++++++++++++++++++++++++++++++ README-gnus-bbdb.ja | 104 ++++++++++++++++++++++++++++++++ README.branch | 109 ++++++++++++++++++++++++++++++++++ README.branch.ja | 110 ++++++++++++++++++++++++++++++++++ README.semi | 13 ++-- README.semi.ja | 107 +++++++++++++++++++++++++++++++++ TODO.ja | 13 ++-- lisp/gnus-art.el | 163 +++++++++++++++++++++++++++++++++++++++++++++------ lisp/gnus-msg.el | 17 +++--- lisp/message.el | 21 +++++++ lisp/pop3-fma.el | 3 +- 11 files changed, 725 insertions(+), 39 deletions(-) create mode 100644 README-gnus-bbdb.en create mode 100644 README-gnus-bbdb.ja create mode 100644 README.branch create mode 100644 README.branch.ja create mode 100644 README.semi.ja diff --git a/README-gnus-bbdb.en b/README-gnus-bbdb.en new file mode 100644 index 0000000..b99d805 --- /dev/null +++ b/README-gnus-bbdb.en @@ -0,0 +1,104 @@ +-*- mode: text; fill-column: 70; -*- + +--- + If BBDB is used then, bbdb-gnus.elc can't be shared with them before +Semi-gnus 6.8.X. It is necessary to byte-compile it again. + +;; It is a simple way that only bbdb-gnus.el is byte-compiled after +;; gnus starts. + +--- +gnus-bbdb.el + + This is the BBDB API module for Semi-gnus. `mime-bbdb' should not be +necessary for Semi-gnus, if that module were used. + + You need FLIM 1.11.3 or later. + + If you are using bbdb-auto-notes-hook, the patch listed at the end +of this file should be applied. If not, it might not. + + EXAMPLE: + +;; You need to set nothing for `mime-bbdb'. +;(setq mime-bbdb/use-mail-extr nil) +;(eval-after-load "mail-extr" '(require 'mime-bbdb)) + +(require 'bbdb) +(require 'gnus-bbdb) +(bbdb-initialize 'sc) ;; 'Gnus or 'gnus should be deleted. +(add-hook 'gnus-startup-hook 'gnus-bbdb-insinuate) + + If you would like to decode the quoted encoded words forcibly, even +though FLIM does not decode them, put the following lines in your +.gnus file. + +(setq gnus-bbdb/decode-field-body-function + (function + (lambda (field-body field-name) + (eword-decode-string field-body)))) + +--- + This is a patch for bbdb.el / bbdb-hooks.el. + +------ cut here ------ cut here ------ cut here ------ cut here ------ +--- bbdb-hooks.el~ Tue Oct 13 03:13:50 1998 ++++ bbdb-hooks.el Fri Oct 30 17:05:53 1998 +@@ -352,12 +352,22 @@ + (marker (bbdb-header-start)) + field pairs fieldval ; do all bindings here for speed + regexp string notes-field-name notes +- replace-p replace-or-add-msg) ++ replace-p replace-or-add-msg ++ extract-field-value-funtion) + (set-buffer (marker-buffer marker)) + (save-restriction +- (widen) +- (goto-char marker) +- (if (and (setq fieldval (bbdb-extract-field-value "From")) ++ (let ((function-list bbdb-extract-field-value-function-list) ++ function) ++ (or (progn ++ (while (and (not extract-field-value-funtion) ++ (setq function (pop function-list))) ++ (setq extract-field-value-funtion (funcall function))) ++ extract-field-value-funtion) ++ (progn ++ (widen) ++ (goto-char marker) ++ (setq extract-field-value-funtion 'bbdb-extract-field-value)))) ++ (if (and (setq fieldval (funcall extract-field-value-funtion "From")) + (string-match (bbdb-user-mail-names) fieldval)) + ;; Don't do anything if this message is from us. Note that we have + ;; to look at the message instead of the record, because the record +@@ -368,7 +378,7 @@ + (goto-char marker) + (setq field (car (car ignore-all)) + regexp (cdr (car ignore-all)) +- fieldval (bbdb-extract-field-value field)) ++ fieldval (funcall extract-field-value-funtion field)) + (if (and fieldval + (string-match regexp fieldval)) + (setq ignore t) +@@ -382,7 +392,7 @@ + pairs (cdr (car rest)) ; (REGEXP . STRING) or + ; (REGEXP FIELD-NAME STRING) or + ; (REGEXP FIELD-NAME STRING REPLACE-P) +- fieldval (bbdb-extract-field-value field)) ; e.g., Subject line ++ fieldval (funcall extract-field-value-funtion field)) ; e.g., Subject line + (if fieldval + (while pairs + (setq regexp (car (car pairs)) +--- bbdb.el~ Tue Oct 13 03:14:55 1998 ++++ bbdb.el Fri Oct 30 17:05:53 1998 +@@ -620,6 +620,7 @@ + (defvar bbdb-showing-changed-ones nil) + (defvar bbdb-modified-p nil) + (defvar bbdb-elided-display nil) ++(defvar bbdb-extract-field-value-function-list nil) + + (defvar bbdb-debug t) + (defmacro bbdb-debug (&rest body) +------ cut here ------ cut here ------ cut here ------ cut here ------ + +--- diff --git a/README-gnus-bbdb.ja b/README-gnus-bbdb.ja new file mode 100644 index 0000000..18f3e9b --- /dev/null +++ b/README-gnus-bbdb.ja @@ -0,0 +1,104 @@ +-*- mode: text; fill-column: 70; -*- + +--- +BBDB を使用されている方は、 bbdb-gnus.elc を Semi-gnus 6.8.X 以前のも +のと共有することはできません。必ず、 byte-compile し直してください。 + +;; gnus を起動したあとで、 bbdb-gnus.el のみを byte-compile するという +;; のがお手軽です。 :-) + +--- +gnus-bbdb.el + +Semi-gnus に特化した BBDB API モジュールです。このモジュールを使用する +ことによって、 Semi-gnus で使用する場合には mime-bbdb が不要になります。 + +1.11.3 以降の FLIM が必要です。 + +bbdb-auto-notes-hook を使用していない方には不要ですが、使用している方 +は bbdb.el / bbdb-hooks.el にこのファイルの最後にある patch をあてる必 +要があります。 + +設定例: + +;; mime-bbdb に関する設定は不要です。 +;(setq mime-bbdb/use-mail-extr nil) +;(eval-after-load "mail-extr" '(require 'mime-bbdb)) + +(require 'bbdb) +(require 'gnus-bbdb) +(bbdb-initialize 'sc) ;; 'gnus / 'Gnus ははずしてください。 +(add-hook 'gnus-startup-hook 'gnus-bbdb-insinuate) + +FLIM では quote された eword encoded word は decode されませんが、それ +を強制的に decode したい場合には、次の設定を加えてください。 + +(setq gnus-bbdb/decode-field-body-function + (function + (lambda (field-body field-name) + (eword-decode-string field-body)))) + +--- +以下は bbdb.el / bbdb-hooks.el にあてる patch です。 + +------ cut here ------ cut here ------ cut here ------ cut here ------ +--- bbdb-hooks.el~ Tue Oct 13 03:13:50 1998 ++++ bbdb-hooks.el Fri Oct 30 17:05:53 1998 +@@ -352,12 +352,22 @@ + (marker (bbdb-header-start)) + field pairs fieldval ; do all bindings here for speed + regexp string notes-field-name notes +- replace-p replace-or-add-msg) ++ replace-p replace-or-add-msg ++ extract-field-value-funtion) + (set-buffer (marker-buffer marker)) + (save-restriction +- (widen) +- (goto-char marker) +- (if (and (setq fieldval (bbdb-extract-field-value "From")) ++ (let ((function-list bbdb-extract-field-value-function-list) ++ function) ++ (or (progn ++ (while (and (not extract-field-value-funtion) ++ (setq function (pop function-list))) ++ (setq extract-field-value-funtion (funcall function))) ++ extract-field-value-funtion) ++ (progn ++ (widen) ++ (goto-char marker) ++ (setq extract-field-value-funtion 'bbdb-extract-field-value)))) ++ (if (and (setq fieldval (funcall extract-field-value-funtion "From")) + (string-match (bbdb-user-mail-names) fieldval)) + ;; Don't do anything if this message is from us. Note that we have + ;; to look at the message instead of the record, because the record +@@ -368,7 +378,7 @@ + (goto-char marker) + (setq field (car (car ignore-all)) + regexp (cdr (car ignore-all)) +- fieldval (bbdb-extract-field-value field)) ++ fieldval (funcall extract-field-value-funtion field)) + (if (and fieldval + (string-match regexp fieldval)) + (setq ignore t) +@@ -382,7 +392,7 @@ + pairs (cdr (car rest)) ; (REGEXP . STRING) or + ; (REGEXP FIELD-NAME STRING) or + ; (REGEXP FIELD-NAME STRING REPLACE-P) +- fieldval (bbdb-extract-field-value field)) ; e.g., Subject line ++ fieldval (funcall extract-field-value-funtion field)) ; e.g., Subject line + (if fieldval + (while pairs + (setq regexp (car (car pairs)) +--- bbdb.el~ Tue Oct 13 03:14:55 1998 ++++ bbdb.el Fri Oct 30 17:05:53 1998 +@@ -620,6 +620,7 @@ + (defvar bbdb-showing-changed-ones nil) + (defvar bbdb-modified-p nil) + (defvar bbdb-elided-display nil) ++(defvar bbdb-extract-field-value-function-list nil) + + (defvar bbdb-debug t) + (defmacro bbdb-debug (&rest body) +------ cut here ------ cut here ------ cut here ------ cut here ------ + +--- diff --git a/README.branch b/README.branch new file mode 100644 index 0000000..188fbd6 --- /dev/null +++ b/README.branch @@ -0,0 +1,109 @@ +README.branch --- description of branches and tags. (DRAFT) +======================================================================== + +Semi-gnus revision tree (1998-07-16) + + vendor personal main trunk public + branch branches branches +------------------------------------------------------------------------ +qGnus 0.?? ------> Semi-gnus 6.0.0 + : : + : himi <-- 6.0.7 + : ichikawa <-- 6.0.8 + : akr <-- 6.2.3 + : shuhei-k <-- 6.3.1 +Gnus 5.6.11 ------> 6.3.3 + : 6.4.0 (for SEMI 1.5) + : (6.4.?)------> for SEMI 1.5 + : | \ + : | \ +(Synch with original Gnus | ---> for SEMI 1.6 + was done many times, but (6.4.?)------> 6.5 (for SEMI 1.7) + we don't include them.) | / 6.5.0 + : | (?)/ + : | <--- + : (6.5.?)------> 6.6 (for SEMI 1.8, FLIM 1.7) + : | \ 6.6.0 stable branch + : | \ + : | ---> 6.7 (for SEMI 1.8, FLIM 1.7) + : | 6.7.0 develop branch + : sync | : +Gnus 5.6.22 ------> | feedback 6.7.7 + : (6.7.8)<------ 6.7.8 + : | \ + : | \ + : | ---> 6.8 (for SEMI 1.8, FLIM 1.8) + : sync | 6.8.0 +Gnus 5.6.24 ------> | 6.8.1 + : : : + : : : +======================================================================== + +The Vendor Branch + + Original version of Gnus. + Each version has a tag of the form "qgnus-0_XY" or "gnus-5_X_Y" or + "pgnus-0_XY". + + The branch tag for the vendor branch is "larsi". + +The Main Trunk + + Semi-gnus was developed on the main trunk until current branch- + management plan (See "Public Branches" below) was introduced. + Each version has a tag of the form "gnus-6_N2_N3". (0 < N2 < 5) + +Public Branches + + Current main stream of Semi-gnus development. + + [Goal and policy of public branches here ???] + + Each branch has a tag of the form "gnus-N1_N2" and each version + has a tag of the form "gnus-N1_N2_N3". + + N1, N2, and N3 are changed by the following rules. + + N1 will be incremented if any fundamental architecture change is + made. Of cource, in this case, N2 and N3 will be reset to zero. + + N2 will be incremented and new branch will be made if any "major + changes" are made. "major changes" include API changes, major + version up of original Gnus, or synchronization with original Gnus + which requires design decision. + + N3 will be incremented if some "minor changes" are made. "minor + changes" include small bug fix or synchronization with original Gnus + without design decision. + + The following branch tags are currently available. + + for-semi-1_5 Semi-gnus for SEMI 1.5 API + for-semi-1_6 Semi-gnus for SEMI 1.6 API + gnus-6_5 Semi-gnus for SEMI 1.7 API + gnus-6_6 Semi-gnus for SEMI 1.8, FLIM 1.7 API (stable) + gnus-6_7 Semi-gnus for SEMI 1.8, FLIM 1.7 API (develop) + gnus-6_8 Semi-gnus for SEMI 1.8, FLIM 1.8 API + +Personal Branches + + Some Semi-gnus developers have their own "personal branches". + Each personal branch may have its own goal and/or policy. + See README.${tag} (if exists) for information of each branch. + + The following branch tags are curretly available. + + himi Owner: Miyashita Hisashi + ichikawa Owner: Tatsuya Ichikawa + akr Owner: Tanaka Akira + shuhei-k Owner: Shuhei KOBAYASHI + +"semi-gnus" Tag + + Was assigned to the latest stable version. + Currently not maintained. (XXX: ???) + +"for-semi-N1_N2" Tags + + Were assigned to corresponding version of SEMI API N1.N2. + We will not use this convention any longer. (XXX: ???) diff --git a/README.branch.ja b/README.branch.ja new file mode 100644 index 0000000..d458624 --- /dev/null +++ b/README.branch.ja @@ -0,0 +1,110 @@ +README.branch.ja --- branch と tag の説明 (草稿) +======================================================================== + +Semi-gnus revision tree (1998-07-16) + + vendor personal main trunk public + branch branches branches +------------------------------------------------------------------------ +qGnus 0.?? ------> Semi-gnus 6.0.0 + : : + : himi <-- 6.0.7 + : ichikawa <-- 6.0.8 + : akr <-- 6.2.3 + : shuhei-k <-- 6.3.1 +Gnus 5.6.11 ------> 6.3.3 + : 6.4.0 (for SEMI 1.5) + : (6.4.?)------> for SEMI 1.5 + : | \ + : | \ +(元の Gnus との Sync は何度 | ---> for SEMI 1.6 + もなされていますが、ここに (6.4.?)------> 6.5 (for SEMI 1.7) + は書きません。) | / 6.5.0 + : | (?)/ + : | <--- + : (6.5.?)------> 6.6 (for SEMI 1.8, FLIM 1.7) + : | \ 6.6.0 stable branch + : | \ + : | ---> 6.7 (for SEMI 1.8, FLIM 1.7) + : | 6.7.0 develop branch + : sync | : +Gnus 5.6.22 ------> | feedback 6.7.7 + : (6.7.8)<------ 6.7.8 + : | \ + : | \ + : | ---> 6.8 (for SEMI 1.8, FLIM 1.8) + : sync | 6.8.0 +Gnus 5.6.24 ------> | 6.8.1 + : : : + : : : +======================================================================== + +The Vendor Branch + + Gnus の元のバージョンです。 + それぞれのバージョンは "qgnus-0_XY" や "gnus-5_X_Y" や + "pgnus-0_XY" という形式の tag が付いています。 + + vendor branch の branch tag は "larsi" です。 + +The Main Trunk + + 現在の branch 管理計画が導入されるまで、Semi-gnus は main trunk で + 開発されていました (下の "Public Branches" を読んでください)。それ + ぞれのバージョンは "gnus-6_N2_N3" という形式です。(0 < N2 < 5) + +Public Branches + + 現在の Semi-gnus 開発の主流です。 + + [public branch の目標と主義を書く ???] + + それぞれの branch は "gnus-N1_N2" という形式の tag が付いていて、 + それぞれのバージョンは "gnus-N1_N2_N3" という形式の tag が付いてい + ます。 + + N1, N2, N3 は以下の規則に従って変更されます。 + + N1 は基礎的な仕組みの変更がなされたときに増やされます。もちろん、 + この場合は N2 と N3 は 0 になります。 + + N2 は新しい branch が "主な変更" を行ったときに増やされます。 "主 + な変更" とは、API の変更、元の Gnus の大きな更新、設計の決定を伴う + ような元の Gnus との同期などです。 + + N3 は "小さな変更" がなされたときに増やされます。"小さな変更" は小 + さなバグ修正や、設計の決定を伴わない元の Gnus との同期などです。 + + 現在は以下の branch tag が使用可能です。 + The following branch tags are currently available. + + for-semi-1_5 Semi-gnus for SEMI 1.5 API + for-semi-1_6 Semi-gnus for SEMI 1.6 API + gnus-6_5 Semi-gnus for SEMI 1.7 API + gnus-6_6 Semi-gnus for SEMI 1.8, FLIM 1.7 API (stable) + gnus-6_7 Semi-gnus for SEMI 1.8, FLIM 1.7 API (develop) + gnus-6_8 Semi-gnus for SEMI 1.8, FLIM 1.8 API + +Personal Branches + + Semi-gnus 開発者の中には自分の "personal branch" を持っている人も + います。それぞれの personal branch は目標、主義を持っているでしょ + う。それぞれの branch の情報は (存在するならば、) README.${tag} を + 読んでください。 + + 以下の branch tag が現在使用可能です。 + + himi Owner: Miyashita Hisashi + ichikawa Owner: Tatsuya Ichikawa + akr Owner: Tanaka Akira + shuhei-k Owner: Shuhei KOBAYASHI + +"semi-gnus" Tag + + これは最新の安定版に割り当てられていました。現在は維持されていませ + ん。(XXX: ???) + +"for-semi-N1_N2" Tags + + これは SEMI API N1.N2 に対応するバージョンに割り当てられていました。 + この習慣はもう使われません。(XXX: ???) diff --git a/README.semi b/README.semi index b297fe7..92809fe 100644 --- a/README.semi +++ b/README.semi @@ -8,13 +8,14 @@ all features of Gnus and gnus-mime, so there are no need to install Gnus to use it, and you must not use gnus-mime for SEMI. It requires SEMI package, so please get and install SEMI package -before to install it. - +before to install it. You can get SEMI from +ftp://ftp.jaist.ac.jp/pub/elisp/semi/ +Required environment for SEMI is written in README.en of SEMI package. How to get? (via CVS) ===================== -(0) cvs login +(0) cvs login (first time only) % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ login @@ -52,12 +53,15 @@ Major tags are following: himi himi branch ichikawa ichikawa branch + Based on pGnus. akr akr branch shuhei-k shuhei-k branch Mail-Followup-To/Mail-Reply-To, gnus-cache fix. +For more detailed information, please read README.branch. + How to get? (via ftp) ===================== @@ -92,4 +96,5 @@ Semi-gnus. To join the Semi-gnus ML, send an empty e-mail to semi-gnus-ja-help@meadow.scphys.kyoto-u.ac.jp (Japanese) In addition, we need developers. If you would like to develop it, -please send mail to cvs@chamonix.jaist.ac.jp. +please send mail to cvs@chamonix.jaist.ac.jp with your account name +and UNIX /etc/passwd style crypted password. diff --git a/README.semi.ja b/README.semi.ja new file mode 100644 index 0000000..c91c0a3 --- /dev/null +++ b/README.semi.ja @@ -0,0 +1,107 @@ +このパッケージには Semi-gnus が入っています。 + +Semi-gnus とは？ +================== + + Semi-gnus は SEMI のための gnus-mime と Gnus の組合せを置き換えるも +のです。Gnus と gnus-mime の全ての機能を持っていますので、これを使用す +るために Gnus をインストールする必要はなく、SEMI のための gnus-mime は +使用してはいけません。 + + SEMI パッケージを要求しますので、インストールする前に SEMI パッケー +ジをインストールしてください。SEMI は +ftp://ftp.jaist.ac.jp/pub/elisp/semi/ から取得することができます。必要 +な環境は SEMI の README.ja を参照してください。 + + +取得方法 (CVS) +===================== + +(0) cvs login (初回のみ) + + % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ + login + + CVS password: [CR] # 空文字列 + +(1) checkout + + % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ + checkout [-r TAG] gnus + +(2) compile + + % cd gnus + % make EMACS= + +(3) update + + % cvs update [-r TAG] + +主なタグは以下のようになっています: + + semi-gnus 最新の安定版に割り当てられます。非常に保守的で + す。(現在は使用されていません。) + + for-semi-N1_N2 SEMI API N1.N2 (N1 と N2 は自然数) に対応して + 最新の安定版に割り当てられます。(例 + `for-semi-1_3' は SEMI API 1.3 用です。) + (現在は使用されていません。) + + gnus-N1_N2_N3 gnus(Gnus) N1.N2.N3 に割り当てられます。 + (例 `gnus-6_2_1' は gnus 6.2.1 です。) + + larsi 元の Gnus + + himi himi branch + + ichikawa ichikawa branch + Based on pGnus + + akr akr branch + + shuhei-k shuhei-k branch + Mail-Followup-To/Mail-Reply-To, gnus-cache fix. + +詳しくは、README.branch.ja を参照してください。 + + +取得方法 (ftp) +===================== + + ほぼ毎日の snapshot が + + ftp://ftp.jaist.ac.jp/pub/GNU/elisp/semi-gnus/ + + から取得可能です。 + + 注意: これらの snapshot はその日の間に repository に何か変更があった + ときに自動的に作成され、普通はテストされていません。 + + +開発への参加方法 +======================= + + Gnus のバグを見つけたときは、`M-x gnus-bug' として、Gnus の維持者に + バグ報告を送ってください。 + + Semi-gnus のバグを見つけたか、Gnus のバグであるかどうかが分からない + ときは、バグ報告を Semi-gnus メーリングリストに送ってください: + + semi-gnus-en@meadow.scphys.kyoto-u.ac.jp (英語) + semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (日本語) + +Semi-gnus の改善のための提案も歓迎されます。 + + Semi-gnus ML では、Semi-gnus 関連のバグを報告したり、最新の + Semi-gnus のリリースを取得したり、Semi-gnus の将来の拡張を議論したり + することができます。Semi-gnus ML に参加するためには + + semi-gnus-en-help@meadow.scphys.kyoto-u.ac.jp (英語) + semi-gnus-ja-help@meadow.scphys.kyoto-u.ac.jp (日本語) + + に空のメールを送ってください。 + + 加えて、開発者を必要としています。開発に参加したい場合は、 +cvs@chamonix.jaist.ac.jp にアカウント名と UNIX の /etc/passwd の様式で +暗号化されたパスワードをメールを送ってください。 diff --git a/TODO.ja b/TODO.ja index cd7293d..ebac890 100644 --- a/TODO.ja +++ b/TODO.ja @@ -11,7 +11,7 @@ To do list. *1998/10/02-2 設定ファイル群読み込み時の coding-system 問題 ----------- 未対策 ----------- - + *1998/09/25-1 message/partial の結合機能の改良 Subject で summary を検索する代わりに、gnus-newsgroup-headers な @@ -22,11 +22,6 @@ To do list. Offline 時にメッセージを作成した場合、 Message-Id の形式が不当なも のになってしまう。 -*1998/10/02-5 Edit article 時にメッセージを破壊する問題 - - nnml 等で保存してあるメッセージで edit article を使用して編集を行っ - た場合、 MIME entity を破壊してしまう。 - *1998/10/02-6 smtpmail.el 削除 現在、 Semi-gnus では smtpmail.el を使用していないので削除する。 @@ -63,7 +58,7 @@ To do list. ここには、他ブランチで対策中または、対策済で gnus-V1_V2 枝に取り込 まれていないものを含む。 - + *1998/10/02-3 message/partial 使用時の Message-Id 問題 message/partial 形式でメッセージを送信した場合、全パートの @@ -107,3 +102,7 @@ To do list. *1998/10/02-1 Draft の編集・送信時の encode / decode 問題 1998/11/04 - 完了 + +*1998/10/02-5 Edit article 時にメッセージを破壊する問題 + + 1998/11/12 - 完了 diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 9fc4012..3504acc 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -3,6 +3,7 @@ ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko +;; Katsumi Yamaoka ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -2007,6 +2008,38 @@ commands: (mime-maybe-hide-echo-buffer)) (gnus-run-hooks 'gnus-mime-article-prepare-hook)) +(defun gnus-article-make-full-mail-header (&optional number charset) + "Create a new mail header structure in a raw article buffer." + (unless (and number charset) + (save-current-buffer + (set-buffer gnus-summary-buffer) + (unless number + (setq number (or (cdr gnus-article-current) 0))) + (unless charset + (setq charset (or default-mime-charset 'x-ctext))))) + (goto-char (point-min)) + (let ((header-end (if (search-forward "\n\n" nil t) + (1- (point)) + (goto-char (point-max)))) + (chars (- (point-max) (point))) + (lines (count-lines (point) (point-max))) + (default-mime-charset charset) + xref) + (narrow-to-region (point-min) header-end) + (setq xref (std11-fetch-field "xref")) + (prog1 + (make-full-mail-header + number + (std11-fetch-field "subject") + (std11-fetch-field "from") + (std11-fetch-field "date") + (std11-fetch-field "message-id") + (std11-fetch-field "references") + chars + lines + (when xref (concat "Xref: " xref))) + (widen)))) + (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. ARTICLE should either be an article number or a Message-ID. @@ -2100,25 +2133,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (or all-headers gnus-show-all-headers)))) (when (or (numberp article) (stringp article)) - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (let ((method - (if gnus-show-mime - (progn - (setq mime-message-structure gnus-current-headers) - (if (or (not gnus-strict-mime) - (mime-fetch-field "MIME-Version")) - gnus-article-display-method-for-mime - gnus-article-display-method-for-encoded-word)) - gnus-article-display-method-for-traditional))) - (gnus-run-hooks 'gnus-tmp-internal-hook) - (gnus-run-hooks 'gnus-article-prepare-hook) - ;; Display message. - (funcall method) - ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary summary-buffer) - ;; Perform the article display hooks. - (gnus-run-hooks 'gnus-article-display-hook)) + (gnus-article-prepare-display) ;; Do page break. (goto-char (point-min)) (setq gnus-page-broken @@ -2132,6 +2147,26 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) +(defun gnus-article-prepare-display () + "Make the current buffer look like a nice article." + (let ((method + (if gnus-show-mime + (progn + (mime-parse-buffer) + (if (or (not gnus-strict-mime) + (mime-fetch-field "MIME-Version")) + gnus-article-display-method-for-mime + gnus-article-display-method-for-encoded-word)) + gnus-article-display-method-for-traditional))) + (gnus-run-hooks 'gnus-tmp-internal-hook) + (gnus-run-hooks 'gnus-article-prepare-hook) + ;; Display message. + (funcall method) + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary (current-buffer)) + ;; Perform the article display hooks. + (gnus-run-hooks 'gnus-article-display-hook))) + (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion @@ -2561,6 +2596,12 @@ If given a prefix, show the hidden text instead." :group 'gnus-article-various :type 'hook) +(defcustom gnus-article-edit-article-setup-function + 'gnus-article-mime-edit-article-setup + "Function called to setup an editing article buffer." + :group 'gnus-article-various + :type 'function) + (defvar gnus-article-edit-done-function nil) (defvar gnus-article-edit-mode-map nil) @@ -2618,6 +2659,8 @@ groups." (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) + (when gnus-article-edit-article-setup-function + (funcall gnus-article-edit-article-setup-function)) (gnus-message 6 "C-c C-c to end edits"))) (defun gnus-article-edit-done (&optional arg) @@ -2648,6 +2691,8 @@ groups." (let ((func gnus-article-edit-done-function) (buf (current-buffer)) (start (window-start))) + (remove-hook 'gnus-article-mode-hook + 'gnus-article-mime-edit-article-unwind) (gnus-article-edit-exit) (save-excursion (set-buffer buf) @@ -2699,6 +2744,86 @@ groups." (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) ;;; +;;; Article editing with MIME-Edit +;;; + +(defcustom gnus-article-mime-edit-article-setup-hook nil + "Hook run after setting up a MIME editing article buffer." + :group 'gnus-article-various + :type 'hook) + +(defun gnus-article-mime-edit-article-unwind () + "Unwind `gnus-article-buffer' if article editing was given up." + (remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) + (when mime-edit-mode-flag + (mime-edit-exit 'nomime 'no-error) + (message "")) + (when (featurep 'font-lock) + (setq font-lock-defaults nil) + (font-lock-mode 0))) + +(defun gnus-article-mime-edit-article-setup () + "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode +after replacing with the original article." + (setq gnus-show-mime t) + (setq gnus-article-edit-done-function + `(lambda (&rest args) + (when mime-edit-mode-flag + (mime-edit-exit) + (message "")) + (goto-char (point-min)) + (let (case-fold-search) + (when (re-search-forward + (format "^%s$" (regexp-quote mail-header-separator)) + nil t) + (replace-match ""))) + (when (featurep 'font-lock) + (setq font-lock-defaults nil) + (font-lock-mode 0)) + (apply ,gnus-article-edit-done-function args) + (set-buffer gnus-original-article-buffer) + (erase-buffer) + (insert-buffer gnus-article-buffer) + (setq gnus-current-headers (gnus-article-make-full-mail-header)) + (gnus-article-prepare-display))) + (define-key (current-local-map) "\C-c\C-k" 'gnus-article-mime-edit-exit) + (erase-buffer) + (insert-buffer gnus-original-article-buffer) + (mime-edit-again) + (when (featurep 'font-lock) + (set (make-local-variable 'font-lock-defaults) + '(message-font-lock-keywords t)) + (font-lock-set-defaults) + (turn-on-font-lock)) + (add-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) + (gnus-run-hooks 'gnus-article-mime-edit-article-setup-hook)) + +(defun gnus-article-mime-edit-exit () + "Exit the article MIME editing without updating." + (interactive) + (let ((winconf gnus-prev-winconf) + buf) + (when mime-edit-mode-flag + (mime-edit-exit) + (message "")) + (goto-char (point-min)) + (let (case-fold-search) + (when (re-search-forward + (format "^%s$" (regexp-quote mail-header-separator)) nil t) + (replace-match ""))) + (when (featurep 'font-lock) + (setq font-lock-defaults nil) + (font-lock-mode 0)) + ;; We remove all text props from the article buffer. + (setq buf (format "%s" (buffer-string))) + (set-buffer (get-buffer-create gnus-original-article-buffer)) + (erase-buffer) + (insert buf) + (setq gnus-current-headers (gnus-article-make-full-mail-header)) + (gnus-article-prepare-display) + (set-window-configuration winconf))) + +;;; ;;; Article highlights ;;; diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 34eebdf..1991c52 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -953,14 +953,15 @@ this is a reply." (interactive "P") (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) - (message-bounce) - ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers))))) + (let (gnus-message-setup-hook) + (gnus-setup-message 'compose-bounce + (let* ((references (mail-fetch-field "references")) + (parent (and references (gnus-parent-id references)))) + (message-bounce) + ;; If there are references, we fetch the article we answered to. + (and fetch parent + (gnus-summary-refer-article parent) + (gnus-summary-show-all-headers)))))) ;;; Gcc handling. diff --git a/lisp/message.el b/lisp/message.el index 65c8b91..75498be 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -157,6 +157,11 @@ If this variable is nil, no such courtesy message will be added." :group 'message-interface :type 'regexp) +(defcustom message-bounce-setup-function 'message-bounce-setup-for-mime-edit + "Function to setup a re-sending bounced message." + :group 'message-sending + :type 'function) + ;;;###autoload (defcustom message-from-style 'default "*Specifies how \"From\" headers look. @@ -482,6 +487,12 @@ the signature is inserted." :group 'message-various :type 'hook) +(defcustom message-bounce-setup-hook nil + "Normal hook, run each time a a re-sending bounced message is initialized. +The function `message-bounce' runs this hook." + :group 'message-various + :type 'hook) + (defcustom message-mode-hook nil "Hook run in message mode buffers." :group 'message-various @@ -4143,6 +4154,13 @@ Optional NEWS will use news to forward instead of mail." (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) +(defun message-bounce-setup-for-mime-edit () + (goto-char (point-min)) + (when (search-forward (concat "\n" mail-header-separator "\n") nil t) + (replace-match "\n\n")) + (set (make-local-variable 'message-setup-hook) nil) + (mime-edit-again)) + ;;;###autoload (defun message-bounce () "Re-mail the current message. @@ -4182,6 +4200,9 @@ you." (message-remove-header message-ignored-bounced-headers t) (goto-char (point-max)) (insert mail-header-separator)) + (when message-bounce-setup-function + (funcall message-bounce-setup-function)) + (run-hooks 'message-bounce-setup-hook) (message-position-point))) ;;; diff --git a/lisp/pop3-fma.el b/lisp/pop3-fma.el index 8ceecff..d0ff5ac 100644 --- a/lisp/pop3-fma.el +++ b/lisp/pop3-fma.el @@ -257,7 +257,8 @@ Please do not set this valiable non-nil if you do not use Meadow.") (setq passwd (nth 2 (assoc mailhost pop3-fma-password))) (pop3-fma-decode-string passwd)) -(setq pop3-read-passwd 'pop3-fma-read-passwd) +(setq pop3-read-passwd 'pop3-fma-read-passwd + nnmail-read-passwd 'pop3-fma-read-passwd) ;; ;; Set multiple pop3 server's password (defun pop3-fma-store-password (passwd) -- 1.7.10.4