From: morioka Date: Tue, 12 Jan 1999 07:27:28 +0000 (+0000) Subject: Merge chao-gnus-6_12_5. X-Git-Tag: chaos-1_12_0~3 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c96775610b6fa5f1671e926df03ecaddc02ecd9e;p=elisp%2Fgnus.git- Merge chao-gnus-6_12_5. --- diff --git a/ChangeLog b/ChangeLog index 66e3023..bf6b9a8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,436 +1,297 @@ -1998-12-22 Katsumi Yamaoka +1998-12-01 MORIOKA Tomohiko - * lisp/gnus-art.el (gnus-article-prepare-display): Set - `gnus-article-current-summary' to `gnus-summary-buffer'. + * Chao-gnus: Version 6.12.5 was released. -1998-12-18 Katsumi Yamaoka + * Abolish smtp.el and smtpmail.el (moved to FLIM). - * lisp/gnus-start.el (gnus-read-newsrc-el-file): Bug (referring to - unbounded variable) fix. +1998-11-30 MORIOKA Tomohiko -1998-12-17 Katsumi Yamaoka - - * lisp/gnus-start.el (gnus-read-newsrc-el-file): Don't load newsrc - file if it does not exist. + * lisp/gnus.el (gnus-version-number): Update to 6.12.5. + (gnus-version): Modify for SEMI 1.12. -1998-12-14 Katsumi Yamaoka - - * lisp/gnus.el: (gnus-version-number): Update to 6.9.2. - - * lisp/nnheader.el (nnheader-find-file-noselect): Call - `find-file-noselect-as-coding-system' with CODING-SYSTEM as the - 1st arg. - - * lisp/nnmail.el (nnmail-find-file): Call - `insert-file-contents-as-coding-system' with CODING-SYSTEM as the - 1st arg. - * lisp/nnheader.el (nnheader-insert-file-contents): Likewise. - - * lisp/gnus-start.el (gnus-save-newsrc-file): Call - `write-region-as-coding-system' with CODING-SYSTEM as the 1st arg. - (gnus-read-newsrc-el-file): Call - `insert-file-contents-as-coding-system' with CODING-SYSTEM as the - 1st arg. - - * lisp/gnus-cache.el (gnus-cache-save-buffers): Call - `gnus-write-buffer-as-coding-system' with CODING-SYSTEM as the 1st - arg. - - * lisp/gnus-util.el (gnus-write-buffer-as-coding-system): Be - CODING-SYSTEM the 1st arg. - - * lisp/nnmail.el (nnmail-write-region): Call - `write-region-as-coding-system' with CODING-SYSTEM as the 1st arg. - * lisp/gnus-start.el (gnus-save-newsrc-file): Likewise. - * lisp/gnus-agent.el (gnus-agent-expire): Likewise. - (gnus-agent-fetch-headers): Likewise. - (gnus-agent-flush-cache): Likewise. - (gnus-agent-fetch-articles): Likewise. - (gnus-agent-save-history): Likewise. - (gnus-agent-save-groups): Likewise. - (gnus-agent-save-active): Likewise. - -1998-12-14 Katsumi Yamaoka - - * lisp/nnheader.el (nnheader-find-file-noselect): Use - `find-file-noselect-as-coding-system' (renamed from - `find-file-noselect-as-specified-coding-system'). - - * lisp/nnmail.el (nnmail-find-file): Use - `insert-file-contents-as-coding-system' (renamed from - `insert-file-contents-as-specified-coding-system'). - * lisp/nnheader.el (nnheader-insert-file-contents): Likewise. - - * lisp/gnus-start.el (gnus-save-newsrc-file): Use - `write-region-as-coding-system' (renamed from - `write-region-as-specified-coding-system'). - (gnus-read-newsrc-el-file): Use - `insert-file-contents-as-coding-system' (renamed from - `insert-file-contents-as-specified-coding-system'). - - * lisp/gnus-cache.el (gnus-cache-save-buffers): Use - `gnus-write-buffer-as-coding-system' (renamed from - `gnus-write-buffer-as-specified-coding-system'). - - * lisp/gnus-util.el (gnus-write-buffer-as-coding-system): - Renamed from `gnus-write-buffer-as-specified-coding-system'. - - * lisp/nnmail.el (nnmail-write-region): Use - `write-region-as-coding-system' (renamed from - `write-region-as-specified-coding-system'). - * lisp/gnus-start.el (gnus-save-newsrc-file): Likewise. - * lisp/gnus-agent.el (gnus-agent-expire): Likewise. - (gnus-agent-fetch-headers): Likewise. - (gnus-agent-flush-cache): Likewise. - (gnus-agent-fetch-articles): Likewise. - (gnus-agent-save-history): Likewise. - (gnus-agent-save-groups): Likewise. - (gnus-agent-save-active): Likewise. - -1998-12-11 Katsumi Yamaoka - - * lisp/nnheader.el (nnheader-find-file-noselect): Call - `find-file-noselect-as-specified-coding-system' directly. - -1998-12-10 Katsumi Yamaoka - - * lisp/pop3.el (pop3-movemail): Use `write-region-as-binary' - instead of `append-to-file'. - (pop3-movemail-file-coding-system): Abolished. - - * lisp/nnheader.el (nnheader-find-file-noselect): Use - `find-file-noselect-as-specified-coding-system' instead of - `find-file-noselect'. - - * lisp/nnmail.el (nnmail-find-file): Use - `insert-file-contents-as-specified-coding-system' instead of - `insert-file-contents'. - * lisp/nnheader.el (nnheader-insert-file-contents): Likewise. - - * lisp/message.el (message-send-mail-with-qmail): Enclose - `call-process-region' with `as-binary-process'. - (message-send-mail-with-sendmail): Likewise. - (message-send-coding-system): Abolished. - - * lisp/gnus-start.el (gnus-save-newsrc-file): Emulate - `save-buffer' with `write-region-as-specified-coding-system'. - (gnus-read-newsrc-el-file): Emulate `load' with - `insert-file-contents-as-specified-coding-system' and - `eval-region'. - - * lisp/gnus-cache.el (gnus-cache-save-buffers): Use - `gnus-write-buffer-as-specified-coding-system' instead of - `gnus-write-buffer'. - - * lisp/gnus-util.el (gnus-output-to-mail): Use - `write-region-as-binary' instead of `append-to-file'. - (gnus-output-to-mail): Use `gnus-write-buffer-as-binary' instead - of `gnus-write-buffer'. - (gnus-write-buffer-as-specified-coding-system): New function. - (gnus-write-buffer-as-binary): New function. - - * lisp/nnmail.el (nnmail-write-region): Use - `write-region-as-specified-coding-system' instead of - `write-region'. - * lisp/gnus-start.el (gnus-save-newsrc-file): Likewise. - * lisp/gnus-agent.el (gnus-agent-expire): Likewise. - (gnus-agent-fetch-headers): Likewise. - (gnus-agent-flush-cache): Likewise. - (gnus-agent-fetch-articles): Likewise. - (gnus-agent-save-history): Likewise. - (gnus-agent-save-groups): Likewise. - (gnus-agent-save-active): Likewise. - -1998-12-08 Katsumi Yamaoka - - * lisp/smtp.el (smtp-via-smtp): Use `open-network-stream-as-binary' - instead of `open-network-stream'. - * lisp/pop3.el (pop3-open-server): Likewise. - * lisp/nntp.el (nntp-open-network-stream): Likewise. - * lisp/gnus-gl.el (bbb-connect-to-bbbd): Likewise. - - * lisp/nntp.el (nntp-open-rlogin): Enclose `start-process' with - `as-binary-process'. - (nntp-open-telnet): Likewise. - - * lisp/smtp.el (smtp-coding-system): Abolished. - - * lisp/nntp.el (nntp-coding-system-for-write): Abolished. - (nntp-coding-system-for-read): Abolished. - - * lisp/nntp.el: Don't require `tcp'. - * lisp/nndb.el: Likewise. - -1998-12-07 Katsumi Yamaoka - - * lisp/message.el (message-get-parameter-with-eval): Call - `message-get-parameter' with arg `key' first. - -1998-11-26 Yoshiki Hayashi - - * lisp/gnus.el: (gnus-version-number): Update to 6.9.1. - (gnus-version): Modified for SEMI 1.11, FLIM 1.12. - - * lisp/gnus-draft.el: (gnus-draft-decoding-buffer): Call - `mime-edit-decode-message-in-buffer' instead of - `mime-edit-decode-buffer'. +1998-11-30 MORIOKA Tomohiko - * lisp/gnus-sum.el: (gnus-structured-field-decoder): Use - `eword-decode-and-unfold-structured-field-body' instead of - 'eword-decode-and-unfold-structured-field'. - (gnus-unstructured-field-decoder): remove `must-unfold'. + * lisp/message.el: Sync with Gnus 5.6.45. -1998-11-26 Katsumi Yamaoka +1998-07-03 Shuhei KOBAYASHI - * lisp/gnus-msg.el (gnus-summary-supersede-article): Bind - `gnus-message-setup-hook' to nil. + * lisp/message.el (message-send-mail-with-smtp): Require 'smtp. - * lisp/message.el (message-supersede-setup-for-mime-edit): New - function. - (message-supersede-setup-function): New user option. Use - `message-supersede-setup-for-mime-edit' in default. - (message-supersede): Call `message-supersede-setup-function' if it - is non-nil. - (message-supersede-setup-hook): New user option. +1998-06-18 Shuhei KOBAYASHI + + * lisp/message.el (message-send-mail-with-smtp): New + implementation. - * lisp/message.el (message-bounce-setup-for-mime-edit): Don't - delete header separator. It is up to MIME-Edit to do so. +1998-11-13 MORIOKA Tomohiko -1998-11-25 Hasebe Satoshi + * lisp/gnus.el (gnus-version-number): Update to 6.12.4. - * lisp/gnus-util.el: Require RMAIL in a different way. + * lisp/nnheader.el (nnheader-decode-subject): Use field-decoder + for `nov' mode. + (nnheader-decode-from): Likewise. -1998-11-24 Tatsuya Ichikawa +1998-11-04 MORIOKA Tomohiko - * lisp/pop3-fma.el (pop3-fma-save-password-information): New - variable. Do not save password information when - `pop3-fma-save-password-information' set to nil (in default). - (pop3-fma-encode-string): abolished - because of difference of - FLIM API. - (pop3-fma-decode-string): Likewise. + * lisp/gnus.el (gnus-version-number): Update to 6.12.3. -1998-11-24 Katsumi Yamaoka +1998-11-04 MORIOKA Tomohiko - * lisp/dgnushack.el (dgnushack-compile): Dismiss "gnus-bbdb.el" - from the list if BBDB has not been installed. + * lisp/mmgnus.el (entity-buffer): Must move to (point-min) before + search boundary between header and body (to fix problem with + Emacs). -1998-11-20 Tatsuya Ichikawa +1998-11-03 MORIOKA Tomohiko - * lisp/gnus-util.el: Require `rmail' only if RMAIL has been - installed. + * lisp/nnmh.el (nnmh-retrieve-headers): Don't use + `nnheader-fold-continuation-lines'. -1998-11-19 Keiichi Suzuki + * lisp/gnus-sum.el (gnus-get-newsgroup-headers): Don't expect + unfolded (to fix problem when using gnus-cache). - * lisp/message.el (message-get-reply-buffer): Abolished. - (message-get-original-reply-buffer): Abolished. - (message-get-parameter): New inline function. - (message-get-parameter-with-eval): New macro. - (message-fetch-reply-field): Do not use `message-get-reply-buffer'. - (message-yank-original): Ditto. - (message-setup): Use `message-get-parameter'. - (message-mime-insert-article): Use - `message-get-parameter-with-eval' instead of - `message-get-original-reply-buffer'. +1998-10-31 MORIOKA Tomohiko - * lisp/gnus-msg.el (gnus-inews-add-send-actions): Do not add - `set-window-configuration' to action when - `message-use-multi-frames' is non-`nil'. + * lisp/gnus.el (gnus-version-number): Update to 6.12.2. + (gnus-version): Modify for SEMI 1.11. -1998-11-19 Katsumi Yamaoka + * lisp/gnus-draft.el (gnus-draft-decoding-function): Use + `mime-edit-decode-message-in-buffer' instead of + `mime-edit-decode-buffer'. + +1998-10-29 MORIOKA Tomohiko - * lisp/gnus.el (gnus-version-number): Update to 6.8.20. + * lisp/gnus-draft.el (gnus-draft-decoding-function): Use + `mime-edit-decode-buffer' simply as initial value. - * Sync up with Gnus 5.6.45. + * lisp/gnus-art.el (gnus-article-decode-rfc1522): Use + `mime-decode-header-in-buffer' instead of `eword-decode-header'. + (gnus-article-display-message-with-encoded-word): Likewise. -1998-11-18 Katsumi Yamaoka + * lisp/gnus.el (gnus-version-number): Update to 6.12.1. - * lisp/message.el (message-mimic-kill-buffer): Rewrite. + * lisp/message.el (message-make-forward-subject): Use + `nnheader-decode-subject' instead of + `eword-decode-unstructured-field-body'. + + * lisp/nnheader.el (nnheader-decode-subject): New alias. + (nnheader-decode-from): New alias. + (make-full-mail-header): Use `nnheader-decode-subject' and + `nnheader-decode-from' instead of + `eword-decode-and-unfold-unstructured-field' and + `eword-decode-and-unfold-structured-field'. -1998-11-18 Katsumi Yamaoka +1998-10-20 MORIOKA Tomohiko - * lisp/message.el (message-mimic-kill-buffer): New function. - (message-mode-map): Use it for `C-x k'. + * lisp/gnus.el (gnus-version-number): Update to 6.9.7. + (gnus-version): Modify for SEMI 1.10. -1998-11-18 Keiichi Suzuki +1998-10-20 MORIOKA Tomohiko - * lisp/message.el (message-dont-send): Use `message-delete-frame'. + * lisp/nnheader.el (nnheader-insert-nov): Use `mime-fetch-field' + for Subject and From field. -1998-11-14 Kenji Itoh +1998-10-20 Katsumi Yamaoka - * lisp/nnmail.el (nnmail-read-passwd): Use `read-passwd' if it - exists as a function. + * lisp/nnheader.el (nnheader-parse-nov): Use + `make-full-mail-header'. - * lisp/pop3.el (pop3-read-passwd): Likewise. +1998-10-20 MORIOKA Tomohiko -1998-11-16 Katsumi Yamaoka + * lisp/nnheader.el (nnheader-parse-head): Use + `make-full-mail-header'. - * make.bat: Replace line endings from `LF' to `CRLF'. +1998-10-14 MORIOKA Tomohiko -1998-11-16 Katsumi Yamaoka + * lisp/gnus.el (gnus-version-number): Update to 6.9.6. + (gnus-version): Modify for SEMI 1.9. - * README-gnus-bbdb.en, README-gnus-bbdb.ja: New files. +1998-10-14 MORIOKA Tomohiko - * lisp/gnus-bbdb.el: Replace string in comment "Nana-" to "Semi-". + * lisp/gnus-sum.el (gnus-summary-line-format-alist): Use + `mime-read-field', `std11-address-string' and + `std11-full-name-string' instead of + `gnus-extract-address-components'. + (gnus-article-sort-by-author): Likewise. -1998-11-13 Keiichi Suzuki +1998-10-12 MORIOKA Tomohiko - * lisp/gnus-msg.el (gnus-setup-message): Setup - `message-startup-parameter-alist' for starting `message-mode'. + * lisp/gnus.el (gnus-version-number): Update to 6.9.5. - * lisp/message.el (message-parameter-alist): New variable. - (message-startup-parameter-alist): New variable. - (message-eval-parameter): New function. - (message-get-reply-buffer): New function. - (message-get-original-reply-buffer): New function. - (message-mode): Make new local variable `message-parameter-alist'. - (message-fetch-reply-field): Use `message-get-reply-buffer'. - (message-yank-original): Ditto. - (message-setup): Get message reply buffer from - `message-parameter-alist'. - (message-mime-insert-article): Use - `message-get-original-reply-buffer'. +1998-10-12 MORIOKA Tomohiko - * lisp/gnus-bbdb.el: New file. Interface for BBDB. + * lisp/nnheader.el (make-full-mail-header-from-decoded-header): + New function. -1998-11-12 Katsumi Yamaoka + * lisp/message.el (message-reply): Use + `make-full-mail-header-from-decoded-header' instead of + `make-full-mail-header'. + (message-followup): Likewise. - * lisp/gnus-msg.el (gnus-summary-resend-bounced-mail): Bind - `gnus-message-setup-hook' to nil. +1998-10-05 MORIOKA Tomohiko - * lisp/message.el (message-bounce-setup-for-mime-edit): New + * lisp/gnus-sum.el (gnus-summary-set-default-charset): New function. - (message-bounce-setup-function): New user option. Use - `message-bounce-setup-for-mime-edit' in default. - (message-bounce): Call `message-bounce-setup-function' if it is - non-nil. - (message-bounce-setup-hook): New user option. - * lisp/gnus-art.el (gnus-article-edit-done): Remove - `gnus-article-mime-edit-article-unwind' from - `gnus-article-mode-hook' before run `gnus-article-edit-exit'. - (gnus-article-edit-article): Call - `gnus-article-edit-article-setup-function' if it is non-nil. - (gnus-article-edit-article-setup-function): New user option. Use - `gnus-article-mime-edit-article-setup' in default. - (gnus-article-mime-edit-article-setup-hook): New hook. - (gnus-article-mime-edit-exit): New function. Use - `gnus-article-make-full-mail-header'. - (gnus-article-mime-edit-article-setup): Ditto. - (gnus-article-mime-edit-article-unwind): New function. - (gnus-article-make-full-mail-header): New function. - (gnus-article-prepare-display): New function. - (gnus-article-prepare): Use it. + * lisp/gnus-art.el (gnus-article-display-mime-message): Set up + buffer local variable `default-mime-charset' of + `gnus-original-article-buffer' and `gnus-article-buffer'. + (gnus-article-display-message-with-encoded-word): Likewise. -1998-11-11 Tatsuya Ichikawa +1998-10-05 MORIOKA Tomohiko - * lisp/message.el (message-mode-map): Add new command key - `C-x C-s' for `message-save-drafts'. + * lisp/gnus-msg.el (gnus-message-setup-hook): Add + `gnus-maybe-setup-default-charset'. + Delete dummy definition for `nnspool-rejected-article-hook' and + `xemacs-codename' + (gnus-maybe-setup-default-charset): New function. -1998-11-11 Keiichi Suzuki + * lisp/message.el (message-setup-hook): Delete + `message-maybe-setup-default-charset'. + Abolish variable `message-newsreader' and `message-mailer'. + (message-user-agent): New variable. + Abolish function `message-maybe-setup-default-charset'. - * lisp/message.el (message-8bit-encoding-list): New variable. - (message-send-mail): Use `message-check-mail-syntax'. - (message-check-news-body-syntax): Use `message-check-8bit'. - (message-check-mail-syntax): New function. - (message-check-mail-header-syntax): New function. - (message-check-mail-body-syntax): New function. - (message-check-8bit): New function. +1998-10-03 MORIOKA Tomohiko -1998-11-09 Tatsuya Ichikawa + * lisp/gnus.el (gnus-version-number): Update to 6.9.4. - * lisp/pop3-fma.el: Set the value of `nnmail-read-passwd' as a - symbol `pop3-fma-read-passwd'. +1998-10-03 MORIOKA Tomohiko -1998-11-04 Yoshiki Hayashi + * lisp/gnus-draft.el (gnus-draft-send): Call + `message-send-news-function' or `message-send-mail-function' + instead of `message-send-and-exit'. - * lisp/message.el: (message-do-fcc): Don't run message-header-hook - and message-before-do-fcc-hook. +1998-09-17 Tatsuya Ichikawa -1998-11-02 Yoshiki Hayashi + * lisp/gnus-draft.el (gnus-draft-edit-message): Use + `gnus-draft-setup-for-editing' instead of `gnus-draft-setup'. + (gnus-draft-send): Use `gnus-draft-setup-for-sending' instead of + `gnus-draft-setup'. + (gnus-draft-setup-for-editing): New function (renamed from + `gnus-draft-setup'). + (gnus-draft-setup-for-sending): New function. + (gnus-draft-send-draft-buffer): New variable. + +1998-10-02 MORIOKA Tomohiko - * lisp/message.el: (message-make-in-reply-to): Generate - In-Reply-To header according to draft-ietf-drums-msg-fmt-05. + * lisp/gnus-art.el (gnus-article-prepare): Don't store original + buffer to the entity. -1998-10-30 Tatsuya Ichikawa + * lisp/mmgnus.el: Use `generic' as mother backend; abolish method + `entity-header-start', `entity-header-end' and `fetch-field'. + (entity-buffer): New method. - * lisp/gnus.el: Add autoload setting for `pop3-fma'. + * lisp/gnus-cache.el (gnus-cache-possibly-enter-article): Use + `mime-fetch-field' to refer Subject and From field for saving + cache file. -1998-10-28 Tatsuya Ichikawa +1998-10-01 MORIOKA Tomohiko - * lisp/pop3-fma.el: Determin base64 encode/decode function by FLIM. + * lisp/gnus.el (gnus-version-number): Update to 6.9.3. -1998-10-26 Tatsuya Ichikawa + * lisp/nnheader.el (make-full-mail-header): Store original subject + and from fields. + +1998-09-30 MORIOKA Tomohiko - * lisp/message.el (message-save-drafts): New function. - To save drafts in network code. - (message-save-buffer): New variable. + * lisp/gnus-sum.el: Abolish variable + `gnus-structured-field-decoder' and + `gnus-unstructured-field-decoder'. + (gnus-nov-parse-line): Don't decode from and subject. + (gnus-get-newsgroup-headers): Likewise. - * lisp/pop3-fma.el: Require `mel-b-el' if `mel-b' does not exist. + * lisp/nnheader.el (make-full-mail-header): Decode subject and + from; changed to inline function. -1998-10-23 Katsumi Yamaoka +1998-09-30 MORIOKA Tomohiko - * lisp/gnus-msg.el (gnus-message-make-user-agent): New function. + * lisp/gnus-sum.el (gnus-get-newsgroup-headers): Store + content-type. -1998-10-21 Katsumi Yamaoka +1998-09-30 MORIOKA Tomohiko - * lisp/gnus-xmas.el (gnus-tilde-pad-form): Guard for non string - symbol. + * lisp/gnus.el (gnus-version-number): Update to 6.9.2. -1998-10-17 Tatsuya Ichikawa + * lisp/mmgnus.el: New module. - * lisp/pop3-fma.el (pop3-fma-init-message-hook): Change - message-send-hook to mime-edit-translate-hook. + * lisp/gnus-art.el (gnus-article-prepare): Use content of + `gnus-current-headers' as mime-message-structure. -1998-10-14 Katsumi Yamaoka +1998-09-30 MORIOKA Tomohiko - * lisp/pop3-fma.el (pop3-fma-read-char-exclusive): New macro. Use - `next-command-event' instead of `read-char-exclusive' under XEmacs. - (pop3-fma-read-noecho): Use it. + * lisp/gnus.el (gnus-version-number): Update to 6.9.1. + (gnus-version): Modify for Chao 1.11. -1998-10-13 Katsumi Yamaoka + * lisp/nnheader.el (make-full-mail-header): Changed to macro. - * lisp/nnheaderxm.el (nnheader-xmas-Y-or-n-p): New function. - It will be used for the substitute of `nnheader-Y-or-n-p' under - XEmacs. +1998-09-30 MORIOKA Tomohiko - * lisp/nnheader.el (nnheader-Y-or-n-p): Rewrite for Emacs 19 or - later except for XEmacs. + * lisp/gnus.el (gnus-version): Modify for Chao 1.10. -1998-10-08 Katsumi Yamaoka + * lisp/gnus-score.el (gnus-header-index): Modify to use + mime-entity structure as gnus-header structure. - * lisp/message.el (message-mode-map): Define key `C-x k'. - (message-kill-buffer): Change the prompt string. - (message-kill-buffer): Refer to - `message-kill-buffer-query-function'. - (message-kill-buffer-query-function): New user option. + * lisp/nnheader.el: Use `mime-entity' as gnus-header structure. + (mail-header-number): Use `mime-entity-location-internal'. + (mail-header-set-number): Use `mime-entity-set-location-internal'. + - Change other `mail-header-*' and `mail-header-set-*' to alias of + reference and set functions for mime-entity-internal. + (make-full-mail-header): Use `make-mime-entity-internal'. - * lisp/nnheader.el (nnheader-Y-or-n-p): New function. +1998-09-30 MORIOKA Tomohiko -1998-10-07 Yoshiki Hayashi + * lisp/message.el (message-reply): Use `make-full-mail-header'. + (message-followup): Likewise. - * lisp/nnagent.el (nnagent-open-server): Small bug fix. + * lisp/nnheader.el (mail-header-references): Use + `mime-fetch-field' and `mail-header-entity'. + (mail-header-set-references): Use `mail-header-set-field'. + Define mm-backend `nil' and its method `fetch-field'. + (make-full-mail-header): Modify data structure to store References + to mime-entity. -1998-10-07 Keiichi Suzuki +1998-09-29 MORIOKA Tomohiko - * TODO.ja: New file. + * lisp/nnheader.el (mail-header-id): Use `mime-fetch-field' and + `mail-header-entity'. + (mail-header-set-id): Use `mail-header-set-field'. + (make-full-mail-header): Modify data structure to store Message-Id + to mime-entity. -1998-10-05 Yoshiki Hayashi +1998-09-29 MORIOKA Tomohiko - * lisp/gnus.el (gnus-info-filename): New variable. - (gnus-info-find-node): Use `gnus-info-filename' and - `current-language-environment'. + * lisp/nnheader.el (mail-header-entity): New macro. + (mail-header-set-entity): New macro. + (mail-header-set-field): New macro. + (mail-header-set-parsed-field): New macro. + (mail-header-subject): Use `mail-header-entity'. + (mail-header-set-subject): Use `mail-header-set-parsed-field'. + (mail-header-from): Use `mail-header-entity'. + (mail-header-set-from): Use `mail-header-set-parsed-field'. + (mail-header-date): Use `mime-fetch-field' and + `mail-header-entity'. + (mail-header-set-date): Use `mail-header-set-field'. + (make-full-mail-header): Modify data structure to store Date to + mime-entity. + (make-mail-header): Use `make-full-mail-header'. -1998-10-03 MORIOKA Tomohiko +1998-09-29 MORIOKA Tomohiko - * lisp/gnus-draft.el (gnus-draft-send): Call - `message-send-news-function' or `message-send-mail-function' - instead of `message-send-and-exit'. + * lisp/nnheader.el (mail-header-from): Use `mime-read-field'. + (mail-header-set-from): Store to mime-entity. + (make-full-mail-header): Modify data structure to store Subject to + mime-entity. -1998-10-01 Tatsuya Ichikawa +1998-09-29 MORIOKA Tomohiko - * lisp/pop3-fma.el (pop3-fma-movemail): Bug fix. - Delete variable pop3-fma-movemail options. - Add new variabel pop3-fma-commandline-arguments. + * lisp/nnheader.el (mail-header-subject): Use `mime-read-field'. + (mail-header-set-subject): Store to mime-entity. + (make-full-mail-header): Modify data structure to store Subject to + mime-entity. + +1998-09-29 MORIOKA Tomohiko + + * lisp/gnus-sum.el (gnus-update-summary-mark-positions): Use + `make-full-mail-header'. 1998-09-30 MORIOKA Tomohiko @@ -468,16 +329,10 @@ * lisp/gnus-soup.el (gnus-soup-send-packet): `message-mailer' and `message-newsreader' were replaced by `message-user-agent'. -1998-09-17 Tatsuya Ichikawa +1998-09-29 MORIOKA Tomohiko - * lisp/gnus-draft.el (gnus-draft-edit-message): Use - `gnus-draft-setup-for-editing' instead of `gnus-draft-setup'. - (gnus-draft-send): Use `gnus-draft-setup-for-sending' instead of - `gnus-draft-setup'. - (gnus-draft-setup-for-editing): New function (renamed from - `gnus-draft-setup'). - (gnus-draft-setup-for-sending): New function. - (gnus-draft-send-draft-buffer): New variable. + * lisp/gnus-sum.el (gnus-get-newsgroup-headers): Use + `make-full-mail-header'. 1998-09-26 Katsumi Yamaoka @@ -493,13 +348,13 @@ 1998-09-11 MORIOKA Tomohiko * lisp/message.el (message-send): Don't call - `message-fix-before-sending' before `message-encode-function' is - called. + `message-fix-before-sending' before `message-encode-function' is + called. 1998-09-06 Tatsuya Ichikawa * lisp/pop3-fma.el: Add error handle and fix typo. - + 1998-08-28 Keiichi Suzuki * lisp/message.el: Repair `multi frame control'. @@ -584,7 +439,7 @@ * lisp/gnus.el (gnus-version-number): Update to 6.8.14. * Sync up with Gnus 5.6.38. - + 1998-08-20 Keiichi Suzuki * lisp/message.el (message-frames): New custom group. @@ -602,7 +457,7 @@ * lisp/gnus.el (gnus-version-number): Update to 6.8.13. * Sync up with Gnus 5.6.37. - + 1998-08-16 Yoshiki Hayashi * lisp/gnus-sum.el (gnus-summary-scroll-down): Failed to sync. @@ -612,20 +467,11 @@ * lisp/gnus.el (gnus-version-number): Update to 6.8.12. * Sync up with Gnus 5.6.36. - + 1998-08-15 Yoshiki Hayashi * texi/gnus-ja.texi: Update. -1998-08-14 Katsumi Yamaoka - - * lisp/gnus-start.el (gnus-save-newsrc-file): Bind - `coding-system-for-write' by `gnus-startup-file-coding-system' - while saving the quick newsrc file. - - * lisp/gnus-start.el (gnus-startup-file-coding-system): Change - default value to `ctext'. - 1998-08-13 Tatsuya Ichikawa * lisp/gnus.el (gnus-version-number): Fix typo. @@ -633,25 +479,25 @@ * lisp/gnus.el (gnus-version-number): Update to 6.8.11. * Sync up with Gnus 5.6.34. - + 1998-08-12 Tatsuya Ichikawa * lisp/gnus.el (gnus-version-number): Update to 6.8.10. * Sync up with Gnus 5.6.33. - + 1998-08-11 Tatsuya Ichikawa * lisp/gnus.el (gnus-version-number): Update to 6.8.9. * Sync up with Gnus 5.6.31. - + 1998-08-10 Tatsuya Ichikawa * lisp/gnus.el (gnus-version-number): Update to 6.8.8. * Sync up with Gnus 5.6.30. - + 1998-08-10 Keiichi Suzuki * lisp/message.el (message-yank-original): For citing any message. @@ -662,19 +508,19 @@ 1998-08-06 Katsumi Yamaoka - * lisp/smtp.el: Do not insert empty line at the end of message. - + *lisp/smtp.el: Do not insert empty line at the end of message. + 1998-08-06 Tatsuya Ichikawa * lisp/gnus.el (gnus-version-number): Update to 6.8.6. * Sync up with Gnus 5.6.29. - + 1998-08-05 Tatsuya Ichikawa * lisp/gnus-start.el (gnus-read-init-file): Fix indent. * lisp/gnus-ems.el (gnus-tilde-max-form): Redefine instead of - (gnus-summary-line-format-spec) to display Japanese character + (gnus-summary-line-format-spec) to display Japanese character correctly in Gnus summaly. 1998-08-05 Keiichi Suzuki @@ -781,7 +627,7 @@ * Sync up with Gnus 5.6.22 * lisp/gnus.el (gnus-version-number): Update to 6.7.8. * lisp/pop3-fma.el : Enable to get localhost mail spool. - + 1998-06-29 MORIOKA Tomohiko * lisp/gnus.el (gnus-version-number): Update to 6.7.7. @@ -854,9 +700,9 @@ Gnus 5.6.13. 1998-06-14 Tatsuya Ichikawa - + * Sync up with Gnus 5.6.13. - + 1998-06-24 MORIOKA Tomohiko * lisp/gnus-art.el (gnus-article-display-mime-message): Don't @@ -941,9 +787,9 @@ 1998-06-17 Tatsuya Ichikawa * lisp/pop3-fma.el: Small bug fix. - + * lisp/pop3-fma.el: Delete variable pop3-fma-cypher-key - Use base64-encode-string , base64-decode-string instead. + Use base64-encode-string , base64-decode-string instead. Both change by Yasuo OKABE 1998-06-13 Tatsuya Ichikawa @@ -989,7 +835,7 @@ * lisp/gnus.el (gnus-version-number): Update to 6.3.4. And fix typo 5.6.10 -> 5.6.11. - + 1998-06-03 Shuhei KOBAYASHI * lisp/gnus.el (gnus-version-number): Update to 6.3.3. @@ -1034,7 +880,7 @@ (gnus-version): Modify for SEMI 1.4. * lisp/gnus-sum.el: Use 'mime-add-condition to set up - acting-condition. + acting-condition. 1998-05-04 MORIOKA Tomohiko @@ -1057,8 +903,8 @@ * texi/gnus.texi, lisp/ChangeLog: Sync up with Gnus 5.6.7. * lisp/gnus.el, lisp/message.el, lisp/gnus-sum.el, - lisp/gnus-msg.el, lisp/gnus-cache.el, lisp/gnus-art.el: Sync up - with Gnus 5.6.7. + lisp/gnus-msg.el, lisp/gnus-cache.el, lisp/gnus-art.el: Sync up + with Gnus 5.6.7. 1998-04-28 Shuhei KOBAYASHI @@ -1081,7 +927,7 @@ 1998-04-25 MORIOKA Tomohiko * README.semi (How to get? (via CVS)): Modify descriptions about - TAG. + TAG. 1998-04-23 MORIOKA Tomohiko @@ -1090,11 +936,11 @@ 1998-04-23 MORIOKA Tomohiko * lisp/message.el (message-make-forward-subject): Use - `eword-decode-unstructured-field-body' for subject. + `eword-decode-unstructured-field-body' for subject. * lisp/gnus-msg.el (gnus-summary-mail-forward): Make local - variable `default-mime-charset' of `gnus-original-article-buffer' - and set up by `default-mime-charset' of `gnus-summary-buffer'. + variable `default-mime-charset' of `gnus-original-article-buffer' + and set up by `default-mime-charset' of `gnus-summary-buffer'. 1998-04-23 MORIOKA Tomohiko @@ -1116,7 +962,7 @@ (gnus-version): Modify for SEMI 1.3. * lisp/gnus-sum.el: Use 'ctree-set-calist-strictly instead of - 'set-atype to set up for 'mime-acting-condition. + 'set-atype to set up for 'mime-acting-condition. 1998-04-21 Yoshiki Hayashi @@ -1127,7 +973,7 @@ * texi/gnus-ja.texi: Modify styles. * texi/gnus.texi: Modify for Semi-gnus (sync up with - gnus-ja.texi). + gnus-ja.texi). 1998-04-20 Yoshiki Hayashi @@ -1152,7 +998,7 @@ 1998-04-19 MORIOKA Tomohiko * lisp/gnus-art.el (gnus-following-method): New function; set up - for 'mime-view-following-method-alist. + for 'mime-view-following-method-alist. 1998-04-18 MORIOKA Tomohiko @@ -1193,14 +1039,14 @@ `nnheader-insert-file-contents'. (gnus-agent-braid-nov): Ditto. (gnus-agent-expire): Ditto. - + * lisp/gnus-cache.el (gnus-cache-request-article): Ditto. (gnus-cache-retrieve-headers): Ditto. (gnus-cache-change-buffer): Ditto. (gnus-cache-braid-nov): Ditto. - + * lisp/gnus-sum.el (gnus-summary-import-article): Ditto. - + * lisp/nnkiboze.el (nnkiboze-retrieve-headers): Ditto. * lisp/message.el (message-generate-headers): Fix regexp. @@ -1209,25 +1055,25 @@ 1998-03-14 MORIOKA Tomohiko * lisp/gnus-art.el: Add setting for - `mime-raw-buffer-coding-system-alist'. + `mime-raw-buffer-coding-system-alist'. 1998-03-13 MORIOKA Tomohiko * lisp/gnus-art.el: Rename `mime-view-quitting-method-for-gnus' -> - `mime-preview-quitting-method-for-gnus'. + `mime-preview-quitting-method-for-gnus'. * lisp/gnus-art.el: Rename `mime-view-quitting-method-alist' -> - `mime-preview-quitting-method-alist'. + `mime-preview-quitting-method-alist'. * lisp/gnus-art.el: Rename `mime-view-kill-buffer' -> - `mime-preview-kill-buffer'. + `mime-preview-kill-buffer'. * lisp/gnus.el (gnus-version-number): Update to 6.0.10. * lisp/gnus-sum.el: Add code to check latest SEMI. (mime-acting-condition): Separate type and subtype; rename - `mime-combine-message/partials-automatically' -> - `mime-method-to-combine-message/partial-pieces'. + `mime-combine-message/partials-automatically' -> + `mime-method-to-combine-message/partial-pieces'. 1998-03-08 Shuhei KOBAYASHI @@ -1266,7 +1112,7 @@ * lisp/gnus.el (gnus-bdf-image-file): New variable. (gnus-mule-group-startup-message): Display bitmap image using bitmap.el running with Emacs 20. - + * lisp/gnus-agent.el (gnus-agent-fetch-headers): Fix problem when Xref field is not exist. @@ -1308,7 +1154,7 @@ 1998-02-20 Christophe Broult * README.semi (How to get?): The command `update' must come before - `-r semi-gnus'. (cf. [tm-en:1559]) + `-r semi-gnus'. (cf. [tm-en:1559]) 1998-02-17 MORIOKA Tomohiko @@ -1317,16 +1163,16 @@ * lisp/gnus.el, lisp/message.el: Sync up with qgnus-0.28. * lisp/message.el: Abolish variable - `message-references-generator'. Abolish function - `message-generate-filled-references', - `message-generate-folded-references' and - `message-generate-unfolded-references'. + `message-references-generator'. Abolish function + `message-generate-filled-references', + `message-generate-folded-references' and + `message-generate-unfolded-references'. (message-reply): Don't use `message-references-generator'. (message-followup): Don't use `message-references-generator'. (message-fill-references): New function. (message-header-format-alist): Use `message-fill-references' for - References. + References. 1998-02-17 MORIOKA Tomohiko @@ -1336,21 +1182,21 @@ * lisp/gnus-sum.el: Check SEMI-0.118.2 (Otomaru) or later. (gnus-structured-field-decoder): Use - `eword-decode-and-unfold-structured-field'. + `eword-decode-and-unfold-structured-field'. * lisp/gnus-art.el (gnus-article-decode-rfc1522): Use charset - conversion option of `eword-decode-header'. + conversion option of `eword-decode-header'. (gnus-article-decode-encoded-word): Use charset conversion option - of `eword-decode-header'; use `gnus-run-hooks'. + of `eword-decode-header'; use `gnus-run-hooks'. (gnus-content-header-filter): Use charset conversion option of - `eword-decode-header'. + `eword-decode-header'. * README.semi (How to get?): Should specify "-r semi-gnus". 1998-02-16 MORIOKA Tomohiko * lisp/gnus-art.el (gnus-article-decode-rfc1522): Decode header by - localized code. + localized code. 1998-02-16 MORIOKA Tomohiko @@ -1373,15 +1219,15 @@ * lisp/nnmail.el, lisp/nnmh.el: Use original. * lisp/gnus.el, lisp/gnus-draft.el, lisp/gnus-sum.el, - lisp/message.el, lisp/gnus-art.el: Sync up with qgnus-0.25. + lisp/message.el, lisp/gnus-art.el: Sync up with qgnus-0.25. 1998-02-11 Shuhei Kobayashi * texi/message.texi, texi/gnus.texi, texi/ChangeLog, - lisp/message.el, lisp/gnus.el, lisp/gnus-uu.el, - lisp/gnus-topic.el, lisp/gnus-sum.el, lisp/gnus-start.el, - lisp/gnus-score.el, lisp/gnus-group.el, lisp/gnus-art.el, - lisp/gnus-agent.el, lisp/ChangeLog: Importing qgnus-0.24 + lisp/message.el, lisp/gnus.el, lisp/gnus-uu.el, + lisp/gnus-topic.el, lisp/gnus-sum.el, lisp/gnus-start.el, + lisp/gnus-score.el, lisp/gnus-group.el, lisp/gnus-art.el, + lisp/gnus-agent.el, lisp/ChangeLog: Importing qgnus-0.24 1998-02-10 MORIOKA Tomohiko @@ -1416,7 +1262,7 @@ 1998-01-17 MORIOKA Tomohiko * lisp/message.el (message-send-mail-with-sendmail): Guard - `coding-system-for-write' by binary. + `coding-system-for-write' by binary. (message-send-mail-with-qmail): Likewise. 1998-01-16 MORIOKA Tomohiko @@ -1435,27 +1281,27 @@ 1998-01-12 MORIOKA Tomohiko * lisp/smtp.el (smtp-deduce-address-list): Don't use - `smtp-recipient-address-list' as global variable. + `smtp-recipient-address-list' as global variable. * lisp/message.el (message-send-mail-with-smtp): Don't use - `smtp-recipient-address-list' as global variable. + `smtp-recipient-address-list' as global variable. * lisp/smtpmail.el (smtpmail-recipient-address-list): New - variable; renamed from `smtp-recipient-address-list'. + variable; renamed from `smtp-recipient-address-list'. (smtpmail-send-it): Remove `(not (null ...))'. (smtpmail-send-queued-mail): Likewise. 1998-01-12 MORIOKA Tomohiko * lisp/message.el (message-send-mail-with-smtp): Don't generate - temporary buffer for message; don't generate and kill - `smtp-address-buffer' for `smtp-deduce-address-list'. + temporary buffer for message; don't generate and kill + `smtp-address-buffer' for `smtp-deduce-address-list'. * lisp/smtpmail.el (smtpmail-send-it): Don't generate and kill - `smtp-address-buffer' for `smtp-deduce-address-list'. + `smtp-address-buffer' for `smtp-deduce-address-list'. * lisp/smtp.el (smtp-deduce-address-list): Bind and generate - `smtp-address-buffer' in itself. + `smtp-address-buffer' in itself. 1998-01-12 MORIOKA Tomohiko @@ -1468,7 +1314,7 @@ * lisp/smtpmail.el: Split basic features into smtp.el. * lisp/message.el (message-send-mail-function): Add - `message-send-mail-with-smtp' as an item. + `message-send-mail-with-smtp' as an item. (message-send-mail-with-smtp): New function. * ChangeLog: New file. diff --git a/Makefile.in b/Makefile.in index a30ae8d..f486fd0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -25,6 +25,9 @@ l: info: cd texi && $(MAKE) EMACS=$(EMACS) all +info-ja: + cd texi && $(MAKE) EMACS=$(EMACS) MAKEINFO=no ja + clean: rm -f */*.orig */*.rej *.orig *.rej diff --git a/README.semi b/README.semi index 3dd5f49..b297fe7 100644 --- a/README.semi +++ b/README.semi @@ -1,4 +1,4 @@ -This package contains Semi-gnus 6.9. +This package contains Semi-gnus. What is Semi-gnus? ================== @@ -8,15 +8,13 @@ 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. Semi-gnus 6.9 requires SEMI 1.11. 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. +before to install it. + How to get? (via CVS) ===================== -(0) cvs login (first time only) +(0) cvs login % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ login @@ -55,15 +53,11 @@ Major tags are following: ichikawa ichikawa branch - pgnus-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) ===================== @@ -98,5 +92,4 @@ 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 with your account name -and UNIX /etc/passwd style crypted password. +please send mail to cvs@chamonix.jaist.ac.jp. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index e76e124..613b682 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,4 +1,4 @@ -;;; gnus-agent.el --- unplugged support for Gnus +;;; gnus-agent.el --- unplugged support for Semi-gnus ;; Copyright (C) 1997,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -646,7 +646,7 @@ the actual number of articles toggled is returned." ;; Prune off articles that we have already fetched. (while (and articles (cdr (assq (car articles) gnus-agent-article-alist))) - (pop articles)) + (pop articles)) (let ((arts articles)) (while (cdr arts) (if (cdr (assq (cadr arts) gnus-agent-article-alist)) @@ -1311,14 +1311,14 @@ The following commands are available: (cdr (assq 'dormant (gnus-info-marks info))))) nov-file (gnus-agent-article-name ".overview" group)) - (gnus-agent-load-alist group) + (gnus-agent-load-alist group) (gnus-message 5 "Expiring articles in %s" group) (set-buffer overview) (erase-buffer) (when (file-exists-p nov-file) (nnheader-insert-file-contents nov-file)) (goto-char (point-min)) - (setq article 0) + (setq article 0) (while (setq elem (pop articles)) (setq article (car elem)) (when (or (null low) @@ -1373,9 +1373,8 @@ The following commands are available: (setq prev alist alist (cdr alist)))) (setq gnus-agent-article-alist (cdr first)) - (gnus-agent-save-alist group) - ;; Mark all articles up to the first article - ;; in `gnus-article-alist' as read. + ;;; Mark all articles up to the first article + ;;; in `gnus-article-alist' as read. (when (and info (caar gnus-agent-article-alist)) (setcar (nthcdr 2 info) (gnus-range-add diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 4eab8db..9fc4012 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,8 +1,9 @@ -;;; gnus-art.el --- article mode commands for Gnus +;;; gnus-art.el --- article mode commands for Semi-gnus ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -33,6 +34,8 @@ (require 'gnus-spec) (require 'gnus-int) (require 'browse-url) +(require 'alist) +(require 'mime-view) (defgroup gnus-article nil "Article display." @@ -119,7 +122,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." :group 'gnus-article-hiding) (defcustom gnus-visible-headers - "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:" + "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:" "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." @@ -376,18 +379,27 @@ be used as possible file names." (sexp :value nil)))) (defcustom gnus-strict-mime t - "*If nil, MIME-decode even if there is no Mime-Version header." + "*If nil, MIME-decode even if there is no MIME-Version header." :group 'gnus-article-mime :type 'boolean) -(defcustom gnus-show-mime-method 'metamail-buffer - "Function to process a MIME message. +(defcustom gnus-article-display-method-for-mime + 'gnus-article-display-mime-message + "Function to display a MIME message. The function is called from the article buffer." :group 'gnus-article-mime :type 'function) -(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable - "*Function to decode MIME encoded words. +(defcustom gnus-article-display-method-for-encoded-word + 'gnus-article-display-message-with-encoded-word + "*Function to display a message with MIME encoded-words. +The function is called from the article buffer." + :group 'gnus-article-mime + :type 'function) + +(defcustom gnus-article-display-method-for-traditional + 'gnus-article-display-traditional-message + "*Function to display a traditional message. The function is called from the article buffer." :group 'gnus-article-mime :type 'function) @@ -763,8 +775,8 @@ always hide." from reply-to (ignore-errors (equal - (nth 1 (mail-extract-address-components from)) - (nth 1 (mail-extract-address-components reply-to))))) + (nth 1 (funcall gnus-extract-address-components from)) + (nth 1 (funcall gnus-extract-address-components reply-to))))) (gnus-article-hide-header "reply-to")))) ((eq elem 'date) (let ((date (message-fetch-field "date"))) @@ -946,84 +958,14 @@ characters to translate to." (process-send-region "article-x-face" beg end) (process-send-eof "article-x-face")))))))))) -(defun gnus-hack-decode-rfc1522 () - "Emergency hack function for avoiding problems when decoding." - (let ((buffer-read-only nil)) - (goto-char (point-min)) - ;; Remove encoded TABs. - (while (search-forward "=09" nil t) - (replace-match " " t t)) - ;; Remove encoded newlines. - (goto-char (point-min)) - (while (search-forward "=10" nil t) - (replace-match " " t t)))) - -(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) -(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) -(defun article-decode-rfc1522 () - "Hack to remove QP encoding from headers." - (let ((case-fold-search t) - (inhibit-point-motion-hooks t) - (buffer-read-only nil) - string) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - (while (re-search-forward - "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) - (setq string (match-string 1)) - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (delete-region (point-min) (point-max)) - (insert string) - (article-mime-decode-quoted-printable - (goto-char (point-min)) (point-max)) - (subst-char-in-region (point-min) (point-max) ?_ ? ) - (goto-char (point-max))) - (goto-char (point-min)))))) - -(defun article-de-quoted-unreadable (&optional force) - "Do a naive translation of a quoted-printable-encoded article. -This is in no way, shape or form meant as a replacement for real MIME -processing, but is simply a stop-gap measure until MIME support is -written. -If FORCE, decode the article whether it is marked as quoted-printable -or not." - (interactive (list 'force)) - (save-excursion - (let ((case-fold-search t) - (buffer-read-only nil) - (type (gnus-fetch-field "content-transfer-encoding"))) - (gnus-article-decode-rfc1522) - (when (or force - (and type (string-match "quoted-printable" (downcase type)))) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (article-mime-decode-quoted-printable (point) (point-max)))))) - -(defun article-mime-decode-quoted-printable-buffer () - "Decode Quoted-Printable in the current buffer." - (article-mime-decode-quoted-printable (point-min) (point-max))) - -(defun article-mime-decode-quoted-printable (from to) - "Decode Quoted-Printable in the region between FROM and TO." - (interactive "r") - (goto-char from) - (while (search-forward "=" to t) - (cond ((eq (following-char) ?\n) - (delete-char -1) - (delete-char 1)) - ((looking-at "[0-9A-F][0-9A-F]") - (subst-char-in-region - (1- (point)) (point) ?= - (hexl-hex-string-to-integer - (buffer-substring (point) (+ 2 (point))))) - (delete-char 2)) - ((looking-at "=") - (delete-char 1)) - ((gnus-message 3 "Malformed MIME quoted-printable message"))))) +(defun gnus-article-decode-rfc1522 () + "Decode MIME encoded-words in header fields." + (let (buffer-read-only) + (let ((charset (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset))) + (mime-decode-header-in-buffer charset) + ))) (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. @@ -1159,21 +1101,10 @@ always hide." (while (re-search-forward "^[ \t]*\n" nil t) (replace-match "" t t))))) -(defvar mime::preview/content-list) -(defvar mime::preview-content-info/point-min) (defun gnus-article-narrow-to-signature () "Narrow to the signature; return t if a signature is found, else nil." (widen) (let ((inhibit-point-motion-hooks t)) - (when (and (boundp 'mime::preview/content-list) - mime::preview/content-list) - ;; We have a MIMEish article, so we use the MIME data to narrow. - (let ((pcinfo (car (last mime::preview/content-list)))) - (ignore-errors - (narrow-to-region - (funcall (intern "mime::preview-content-info/point-min") pcinfo) - (point-max))))) - (when (gnus-article-search-signature) (forward-line 1) ;; Check whether we have some limits to what we consider @@ -1858,8 +1789,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (article-fill . gnus-article-word-wrap) article-remove-cr article-display-x-face - article-de-quoted-unreadable - article-mime-decode-quoted-printable article-hide-pgp article-hide-pem article-hide-signature @@ -1934,7 +1863,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] ["Remove carriage return" gnus-article-remove-cr t] - ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t])) + )) ;; Note "Commands" menu is defined in gnus-sum.el for consistency @@ -2032,6 +1961,52 @@ commands: (forward-line line) (point))))) +;;; @@ article filters +;;; + +(defun gnus-article-display-mime-message () + "Article display method for MIME message." + ;; called from `gnus-original-article-buffer'. + (let ((charset (with-current-buffer gnus-summary-buffer + default-mime-charset))) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + (mime-display-message mime-message-structure + gnus-article-buffer nil gnus-article-mode-map) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + ) + ;; `mime-display-message' changes current buffer to `gnus-article-buffer'. + (make-local-variable 'mime-button-mother-dispatcher) + (setq mime-button-mother-dispatcher + (function gnus-article-push-button)) + (run-hooks 'gnus-mime-article-prepare-hook)) + +(defun gnus-article-display-traditional-message () + "Article display method for traditional message." + (set-buffer gnus-article-buffer) + (let (buffer-read-only) + (erase-buffer) + (insert-buffer-substring gnus-original-article-buffer))) + +(defun gnus-article-display-message-with-encoded-word () + "Article display method for message with encoded-words." + (let ((charset (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset))) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + (gnus-article-display-traditional-message) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + (let (buffer-read-only) + (mime-decode-header-in-buffer charset) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (decode-mime-charset-region (match-end 0) (point-max) charset))) + (mime-maybe-hide-echo-buffer)) + (gnus-run-hooks 'gnus-mime-article-prepare-hook)) + (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. @@ -2049,7 +2024,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." result) (save-excursion (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) + (set-buffer gnus-original-article-buffer) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) @@ -2127,17 +2102,21 @@ If ALL-HEADERS is non-nil, no headers are hidden." (stringp article)) ;; Hooks for getting information from the article. ;; This hook must be called before being narrowed. - (let (buffer-read-only) + (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) - ;; Decode MIME message. - (when gnus-show-mime - (if (or (not gnus-strict-mime) - (gnus-fetch-field "Mime-Version")) - (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary)) - (funcall gnus-show-mime-method)) - (funcall gnus-decode-encoded-word-method))) + ;; 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)) ;; Do page break. @@ -2508,15 +2487,6 @@ If given a prefix, show the hidden text instead." (assq article gnus-newsgroup-reads))) gnus-canceled-mark)) nil) - ;; We first check `gnus-original-article-buffer'. - ((and (get-buffer gnus-original-article-buffer) - (numberp article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (and (equal (car gnus-original-article) group) - (eq (cdr gnus-original-article) article)))) - (insert-buffer-substring gnus-original-article-buffer) - 'article) ;; Check the backlog. ((and gnus-keep-backlog (gnus-backlog-request-article group article (current-buffer))) @@ -3195,26 +3165,29 @@ forbidden in URL encoding." (setq to (gnus-url-unhex-string url))) (setq args (cons (list "to" to) args) subject (cdr-safe (assoc "subject" args))) - (message-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (mapconcat 'identity (cdar args) ", ")) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject)))) + (gnus-setup-message 'reply + (message-mail) + (while args + (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) + (if (fboundp func) + (funcall func) + (message-position-on-field (caar args))) + (insert (mapconcat 'identity (cdar args) ", ")) + (setq args (cdr args))) + (if subject + (message-goto-body) + (message-goto-subject))))) (defun gnus-button-mailto (address) ;; Mail to ADDRESS. (set-buffer (gnus-copy-article-buffer)) - (message-reply address)) + (gnus-setup-message 'reply + (message-reply address))) (defun gnus-button-reply (address) ;; Reply to ADDRESS. - (message-reply address)) + (gnus-setup-message 'reply + (message-reply address))) (defun gnus-button-url (address) "Browse ADDRESS." @@ -3296,6 +3269,45 @@ forbidden in URL encoding." (gnus-article-prev-page) (select-window win))) + +;;; @ for mime-view +;;; + +(defun gnus-article-header-presentation-method (entity situation) + (mime-insert-decoded-header entity) + ) + +(set-alist 'mime-header-presentation-method-alist + 'gnus-original-article-mode + #'gnus-article-header-presentation-method) + +(defun gnus-mime-preview-quitting-method () + (if gnus-show-mime + (gnus-article-show-summary) + (mime-preview-kill-buffer) + (delete-other-windows) + (gnus-article-show-summary) + (gnus-summary-select-article nil t) + )) + +(set-alist 'mime-preview-quitting-method-alist + 'gnus-original-article-mode #'gnus-mime-preview-quitting-method) + +(defun gnus-following-method (buf) + (set-buffer buf) + (message-followup) + (message-yank-original) + (kill-buffer buf) + (goto-char (point-min)) + ) + +(set-alist 'mime-preview-following-method-alist + 'gnus-original-article-mode #'gnus-following-method) + + +;;; @ end +;;; + (gnus-ems-redefine) (provide 'gnus-art) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index acf13b3..9334a4f 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -203,8 +203,8 @@ it's not cached." ;; [number subject from date id references chars lines xref] (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" (mail-header-number headers) - (mail-header-subject headers) - (mail-header-from headers) + (mime-fetch-field 'Subject headers) + (mime-fetch-field 'From headers) (mail-header-date headers) (mail-header-id headers) (or (mail-header-references headers) "") @@ -264,7 +264,7 @@ it's not cached." (when (file-exists-p file) (erase-buffer) (gnus-kill-all-overlays) - (insert-file-contents file) + (nnheader-insert-file-contents file) t))) (defun gnus-cache-possibly-alter-active (group active) @@ -310,7 +310,7 @@ it's not cached." ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) - (insert-file-contents cache-file) + (nnheader-insert-file-contents cache-file) 'nov) ((eq type 'nov) ;; We have both cached and uncached NOV headers, so we @@ -489,7 +489,7 @@ Returns the list of articles removed." (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents (or file (gnus-cache-file-name group ".overview"))) + (nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview"))) (goto-char (point-min)) (insert "\n") (goto-char (point-min))) @@ -532,7 +532,7 @@ Returns the list of articles removed." (save-excursion (set-buffer cache-buf) (erase-buffer) - (insert-file-contents (gnus-cache-file-name group (car cached))) + (nnheader-insert-file-contents (gnus-cache-file-name group (car cached))) (goto-char (point-min)) (insert "220 ") (princ (car cached) (current-buffer)) @@ -583,7 +583,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" ;; We simply read the active file. (save-excursion (gnus-set-work-buffer) - (insert-file-contents gnus-cache-active-file) + (nnheader-insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format nil (setq gnus-cache-active-hashtb (gnus-make-hashtable diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 88a132e..c72ddb9 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,8 +1,10 @@ -;;; gnus-draft.el --- draft message support for Gnus +;;; gnus-draft.el --- draft message support for Semi-gnus ;; Copyright (C) 1997,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Tatsuya Ichikawa +;; Keywords: mail, news, MIME, offline ;; This file is part of GNU Emacs. @@ -94,7 +96,7 @@ (interactive) (let ((article (gnus-summary-article-number))) (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup article gnus-newsgroup-name) + (gnus-draft-setup-for-editing article gnus-newsgroup-name) (set-buffer-modified-p t) (save-buffer) (push @@ -118,7 +120,7 @@ (defun gnus-draft-send (article &optional group) "Send message ARTICLE." - (gnus-draft-setup article (or group "nndraft:queue")) + (gnus-draft-setup-for-sending article (or group "nndraft:queue")) (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me) message-send-hook type method) ;; We read the meta-information that says how and where @@ -133,16 +135,25 @@ (message-remove-header gnus-agent-meta-information-header))) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. - (when (and (or (null method) - (gnus-server-opened method) - (gnus-open-server method)) - (if type - (let ((message-this-is-news (eq type 'news)) - (message-this-is-mail (eq type 'mail)) - (gnus-post-method method) - (message-post-method method)) - (message-send-and-exit)) - (message-send-and-exit))) + (when (let ((mail-header-separator "")) + (cond ((eq type 'news) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-news-function method) + ))) + (funcall message-send-news-function method) + ) + ((eq type 'mail) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-mail-function) + ))) + (funcall message-send-mail-function) + t))) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) (or group "nndraft:queue") t))))) @@ -170,13 +181,19 @@ ;;; Utility functions +(defcustom gnus-draft-decoding-function + #'mime-edit-decode-message-in-buffer + "*Function called to decode the message from network representation." + :group 'gnus-agent + :type 'function) + ;;;!!!If this is byte-compiled, it fails miserably. ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, ;;;!!!but for the time being, we'll just run this tiny function uncompiled. (progn -(defun gnus-draft-setup (narticle group) +(defun gnus-draft-setup-for-editing (narticle group) (gnus-setup-message 'forward (let ((article narticle)) (message-mail) @@ -184,12 +201,26 @@ (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") ;; Insert the separator. + (funcall gnus-draft-decoding-function) (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) (insert mail-header-separator) (forward-line 1) (message-set-auto-save-file-name)))))) +;; +(defvar gnus-draft-send-draft-buffer " *send draft*") +(progn +(defun gnus-draft-setup-for-sending (narticle group) + (let ((article narticle)) + (if (not (get-buffer gnus-draft-send-draft-buffer)) + (get-buffer-create gnus-draft-send-draft-buffer)) + (set-buffer gnus-draft-send-draft-buffer) + (erase-buffer) + (if (not (gnus-request-restore-buffer article group)) + (error "Couldn't restore the article") + )))) +;; For draft TEST (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 0e95762..f798e12 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,7 +1,8 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen +;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa ;; Keywords: news ;; This file is part of GNU Emacs. @@ -57,9 +58,7 @@ from to) (goto-line number) (unless (eobp) ; Sometimes things become confused (broken). - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) + (forward-char (chars-in-string prefix)) (skip-chars-forward " \t") (setq from (point)) (end-of-line 1) @@ -70,13 +69,55 @@ gnus-cite-overlay-list) (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))) -(defun gnus-mule-max-width-function (el max-width) - (` (let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) (, max-width)) - (truncate-string valstr (, max-width)) - valstr)))) +(defvar gnus-mule-bitmap-image-file nil) +(defun gnus-mule-group-startup-message (&optional x y) + "Insert startup message in current buffer." + ;; Insert the message. + (erase-buffer) + (insert + (if (featurep 'bitmap) + (format " %s + +" + "" (if (and (stringp gnus-mule-bitmap-image-file) + (file-exists-p gnus-mule-bitmap-image-file)) + (insert-file gnus-mule-bitmap-image-file))) + (format " %s + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ + +" + ""))) + ;; And then hack it. + (gnus-indent-rigidly (point-min) (point-max) + (/ (max (- (window-width) (or x 46)) 0) 2)) + (goto-char (point-min)) + (forward-line 1) + (let* ((pheight (count-lines (point-min) (point-max))) + (wheight (window-height)) + (rest (- wheight pheight))) + (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) + ;; Fontify some. + (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) + (goto-char (point-min)) + (setq mode-line-buffer-identification (concat " " gnus-version)) + (setq gnus-simple-splash t) + (set-buffer-modified-p t)) (defun gnus-encode-coding-string (string system) string) @@ -173,38 +214,70 @@ ;; `emacs-version'. In this case, implementation for XEmacs/mule ;; may be able to share between XEmacs and XEmacs/mule. - (defalias 'gnus-truncate-string 'truncate-string) - (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") - (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) - (fset 'gnus-max-width-function 'gnus-mule-max-width-function) (fset 'gnus-summary-set-display-table (lambda ())) (fset 'gnus-encode-coding-string 'encode-coding-string) (fset 'gnus-decode-coding-string 'decode-coding-string) - + + (if (fboundp 'truncate-string-to-width) + (fset 'gnus-truncate-string 'truncate-string-to-width) + (fset 'gnus-truncate-string 'truncate-string)) + + (defun gnus-tilde-max-form (el max-width) + "Return a form that limits EL to MAX-WIDTH." + (let ((max (abs max-width))) + (if (symbolp el) + `(if (> (string-width ,el) ,max) + ,(if (< max-width 0) + `(gnus-truncate-string + ,el (string-width ,el) + (- (string-width ,el) ,max)) + `(gnus-truncate-string ,el ,max)) + ,el) + `(let ((val (eval ,el))) + (if (> (string-width val) ,max) + ,(if (< max-width 0) + `(gnus-truncate-string + val (string-width val) + (- (string-width val) ,max)) + `(gnus-truncate-string val ,max)) + val))))) + + (defun gnus-tilde-cut-form (el cut-width) + "Return a form that cuts CUT-WIDTH off of EL." + (let ((cut (abs cut-width))) + (if (symbolp el) + `(if (> (string-width ,el) ,cut) + ,(if (< cut-width 0) + `(gnus-truncate-string + ,el (- (string-width ,el) ,cut)) + `(gnus-truncate-string + ,el (- (string-width ,el) ,cut) ,cut)) + ,el) + `(let ((val (eval ,el))) + (if (> (string-width val) ,cut) + ,(if (< cut-width 0) + `(gnus-truncate-string + val (- (string-width val) ,cut)) + `(gnus-truncate-string + val (- (string-width val) ,cut) ,cut)) + val))))) + + (when window-system + (require 'path-util) + (if (module-installed-p 'bitmap) + (fset 'gnus-group-startup-message 'gnus-mule-group-startup-message) + )) + (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting (delq 'long-lines (delq 'control-chars gnus-check-before-posting)))) - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) + (when (fboundp 'chars-in-string) + (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)) + ))) (defun gnus-region-active-p () diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index b0e73aa..359409e 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,9 +1,11 @@ -;;; gnus-msg.el --- mail and post interface for Gnus +;;; gnus-msg.el --- mail and post interface for Semi-gnus ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Shuhei KOBAYASHI +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -91,7 +93,7 @@ Thank you. The first %s will be replaced by the Newsgroups header; the second with the current group name.") -(defvar gnus-message-setup-hook nil +(defvar gnus-message-setup-hook '(gnus-maybe-setup-default-charset) "Hook run after setting up a message buffer.") (defvar gnus-bug-create-help-buffer t @@ -119,7 +121,13 @@ the second with the current group name.") (defvar gnus-message-group-art nil) (defconst gnus-bug-message - "Sending a bug report to the Gnus Towers. + (format "Sending a bug report to the Gnus Towers. +======================================== + +This gnus is the %s%s. +If you think the bug is a Semi-gnus bug, send a bug report to Semi-gnus +Developers. (the addresses below are mailing list addresses) + ======================================== The buffer below is a mail buffer. When you press `C-c C-c', it will @@ -136,7 +144,11 @@ and include the backtrace in your bug report. Please describe the bug in annoying, painstaking detail. Thank you for your help in stamping out bugs. -") +" + gnus-product-name + (if (string= gnus-product-name "Semi-gnus") + "" + ", a modified version of Semi-gnus"))) (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) @@ -167,8 +179,8 @@ Thank you for your help in stamping out bugs. "\M-c" gnus-summary-mail-crosspost-complaint "om" gnus-summary-mail-forward "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) + "Om" gnus-summary-mail-digest + "Op" gnus-summary-post-digest) (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) "b" gnus-summary-resend-bounced-mail @@ -212,7 +224,7 @@ Thank you for your help in stamping out bugs. (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) - (setq message-newsreader (setq message-mailer (gnus-extended-version))) + (setq message-user-agent (gnus-extended-version)) (message-add-action `(set-window-configuration ,winconf) 'exit 'postpone 'kill) (message-add-action @@ -319,8 +331,10 @@ post using the current select method." article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) - (when (gnus-eval-in-buffer-window gnus-original-article-buffer - (message-cancel-news)) + (when (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (set-buffer gnus-original-article-buffer) + (message-cancel-news))) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) @@ -524,67 +538,14 @@ If SILENT, don't prompt the user." ;; Dummy to avoid byte-compile warning. -(defvar nnspool-rejected-article-hook) -(defvar xemacs-codename) +;;(defvar nnspool-rejected-article-hook) +;;(defvar xemacs-codename) -;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might -;;; as well include the Emacs version as well. -;;; The following function works with later GNU Emacs, and XEmacs. +;;; Since the User-Agent is ``vanity'' headers. (defun gnus-extended-version () - "Stringified Gnus version and Emacs version." + "Stringified gnus version." (interactive) - (concat - gnus-version - "/" - (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs " (substring emacs-version - (match-beginning 1) - (match-end 1)))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" - emacs-version) - (concat (substring emacs-version - (match-beginning 1) - (match-end 1)) - (format " %d.%d" emacs-major-version emacs-minor-version) - (if (match-beginning 3) - (substring emacs-version - (match-beginning 3) - (match-end 3)) - "") - (if (boundp 'xemacs-codename) - (concat " - \"" xemacs-codename "\"")))) - (t emacs-version)))) - -;; Written by "Mr. Per Persson" . -(defun gnus-inews-insert-mime-headers () - "Insert MIME headers. -Assumes ISO-Latin-1 is used iff 8-bit characters are present." - (goto-char (point-min)) - (let ((mail-header-separator - (progn - (goto-char (point-min)) - (if (and (search-forward (concat "\n" mail-header-separator "\n") - nil t) - (not (search-backward "\n\n" nil t))) - mail-header-separator - "")))) - (or (mail-position-on-field "Mime-Version") - (insert "1.0") - (cond ((save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward "[^\000-\177]" nil t)) - (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=ISO-8859-1")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "8bit"))) - (t (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=US-ASCII")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "7bit"))))))) - -(custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers) + (concat gnus-product-name "/" gnus-version-number)) ;;; @@ -639,11 +600,48 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") (gnus-setup-message 'forward (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) + (let ((charset default-mime-charset)) + (set-buffer gnus-original-article-buffer) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + ) (let ((message-included-forward-headers (if full-headers "" message-included-forward-headers))) (message-forward post)))) +(defun gnus-summary-post-forward (&optional full-headers) + "Forward the current article to a newsgroup. +If FULL-HEADERS (the prefix), include full headers when forwarding." + (interactive "P") + (gnus-summary-mail-forward full-headers t)) + +;;; XXX: generate Subject and ``Topics''? +(defun gnus-summary-mail-digest (&optional n post) + "Digests and forwards all articles in this series." + (interactive "P") + (let ((subject "Digested Articles") + (articles (gnus-summary-work-articles n)) + article) + (gnus-setup-message 'forward + (gnus-summary-select-article) + (if post (message-news nil subject) (message-mail nil subject)) + (message-goto-body) + (while (setq article (pop articles)) + (save-window-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-select-article nil nil nil article) + (gnus-summary-remove-process-mark article)) + (insert (mime-make-tag "message" "rfc822") "\n") + (insert-buffer-substring gnus-original-article-buffer)) + (push-mark) + (message-goto-body) + (mime-edit-enclose-digest-region (point)(mark t))))) + +(defun gnus-summary-post-digest (&optional n) + "Digest and forwards all articles in this series to a newsgroup." + (interactive "P") + (gnus-summary-mail-digest n t)) + (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." (interactive "sResend message(s) to: \nP") @@ -655,12 +653,6 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (set-buffer gnus-original-article-buffer) (message-resend address))))) -(defun gnus-summary-post-forward (&optional full-headers) - "Forward the current article to a newsgroup. -If FULL-HEADERS (the prefix), include full headers when forwarding." - (interactive "P") - (gnus-summary-mail-forward full-headers t)) - (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. @@ -819,7 +811,8 @@ If YANK is non-nil, include the original article." (insert gnus-bug-message) (goto-char (point-min))) (message-pop-to-buffer "*Gnus Bug*") - (message-setup `((To . ,gnus-maintainer) (Subject . ""))) + (message-setup + `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . ""))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) @@ -933,7 +926,7 @@ this is a reply." (save-restriction (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (cur (current-buffer)) + (coding-system-for-write 'raw-text) groups group method) (when gcc (message-remove-header "gcc") @@ -961,7 +954,8 @@ this is a reply." (gnus-request-create-group group method)) (save-excursion (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring cur) + (insert-buffer-substring message-encoding-buffer) + (gnus-run-hooks 'gnus-before-do-gcc-hook) (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") @@ -1147,6 +1141,24 @@ this is a reply." (insert (car val) ": " (cdr val) "\n")) (gnus-pull (car val) gnus-message-style-insertions))))) + +;;; @ for MIME Edit mode +;;; + +(defun gnus-maybe-setup-default-charset () + (let ((charset + (and (boundp 'gnus-summary-buffer) + (buffer-live-p gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset)))) + (if charset + (progn + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + )))) + + ;;; Allow redefinition of functions. (gnus-ems-redefine) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index c429950..76cc2a3 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -435,20 +435,20 @@ of the last successful match.") (defconst gnus-header-index ;; Name to index alist. - '(("number" 0 gnus-score-integer) - ("subject" 1 gnus-score-string) - ("from" 2 gnus-score-string) - ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) - ("xref" 8 gnus-score-string) + '(("number" 1 gnus-score-integer) + ("subject" 8 gnus-score-string) + ("from" 9 gnus-score-string) + ("date" 10 gnus-score-date) + ("message-id" 11 gnus-score-string) + ("references" 12 gnus-score-string) + ("chars" 13 gnus-score-integer) + ("lines" 14 gnus-score-integer) + ("xref" 15 gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) - ("followup" 2 gnus-score-followup) - ("thread" 5 gnus-score-thread))) + ("followup" 9 gnus-score-followup) + ("thread" 12 gnus-score-thread))) ;;; Summary mode score maps. diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 08f8176..3d97829 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -540,8 +540,7 @@ Return whether the unpacking was successful." (search-forward "\n\n") (forward-char -1) (insert mail-header-separator) - (setq message-newsreader (setq message-mailer - (gnus-extended-version))) + (setq message-user-agent (gnus-extended-version)) (cond ((string= (gnus-soup-reply-kind (car replies)) "news") (gnus-message 5 "Sending news message to %s..." diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index d910ae6..2a1e355 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -333,15 +333,16 @@ ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return a ;; string. - (let ((max-width 0) + (let (max-width spec flist fstring elem result dontinsert user-defined type value pad-width spec-beg cut-width ignore-value - tilde-form tilde elem-type) + tilde-form tilde elem-type + (xemacs-mule-p (and gnus-xemacs (featurep 'mule)))) (save-excursion (gnus-set-work-buffer) (insert format) (goto-char (point-min)) - (while (re-search-forward "%" nil t) + (while (search-forward "%" nil t) (setq user-defined nil spec-beg nil pad-width nil @@ -420,10 +421,11 @@ (setq elem '("*" ?s)))) (setq elem-type (cadr elem)) ;; Insert the new format elements. - (when pad-width - (insert (number-to-string pad-width))) + (and pad-width (not xemacs-mule-p) + (insert (number-to-string pad-width))) ;; Create the form to be evaled. - (if (or max-width cut-width ignore-value) + (if (or max-width cut-width ignore-value + (and pad-width xemacs-mule-p)) (progn (insert ?s) (let ((el (car elem))) @@ -437,6 +439,8 @@ (setq el (gnus-tilde-cut-form el cut-width))) (when max-width (setq el (gnus-tilde-max-form el max-width))) + (and pad-width xemacs-mule-p + (setq el (gnus-tilde-pad-form el pad-width))) (push el flist))) (insert elem-type) (push (car elem) flist)))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 97ab9b8..1d1260d 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -386,9 +386,6 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'boolean) -(defvar gnus-startup-file-coding-system 'binary - "*Coding system for startup file.") - ;;; Internal variables (defvar gnus-newsrc-file-version nil) @@ -427,9 +424,7 @@ Can be used to turn version control on or off." (file-exists-p (concat file ".el")) (file-exists-p (concat file ".elc"))) (condition-case var - (let ((coding-system-for-read - gnus-startup-file-coding-system)) - (load file nil t)) + (load file nil t) (error (error "Error in %s: %s" file var))))))))) @@ -1917,8 +1912,7 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) (condition-case nil - (let ((coding-system-for-read gnus-startup-file-coding-system)) - (load ding-file t t t)) + (load ding-file t t t) (error (ding) (unless (gnus-yes-or-no-p @@ -2279,8 +2273,7 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) (gnus-gnus-to-quick-newsrc-format) (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (let ((coding-system-for-write gnus-startup-file-coding-system)) - (save-buffer)) + (save-buffer) (kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 3084fc5..359d8a5 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,8 +1,9 @@ -;;; gnus-sum.el --- summary mode commands for Gnus +;;; gnus-sum.el --- summary mode commands for Semi-gnus ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -33,8 +34,10 @@ (require 'gnus-range) (require 'gnus-int) (require 'gnus-undo) -(require 'gnus-util) +(require 'mime-view) + (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -328,7 +331,7 @@ variable." :group 'gnus-article-various :type 'boolean) -(defcustom gnus-show-mime nil +(defcustom gnus-show-mime t "*If non-nil, do mime processing of articles. The articles will simply be fed to the function given by `gnus-show-mime-method'." @@ -663,18 +666,8 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -(defcustom gnus-structured-field-decoder 'identity - "Function to decode non-ASCII characters in structured field for summary." - :group 'gnus-various - :type 'function) - -(defcustom gnus-unstructured-field-decoder 'identity - "Function to decode non-ASCII characters in unstructured field for summary." - :group 'gnus-various - :type 'function) - (defcustom gnus-parse-headers-hook - (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522) + '(gnus-set-summary-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -812,9 +805,10 @@ which it may alter in any way.") (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) - (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) - ?s) - (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) + (?A (std11-address-string + (car (mime-read-field 'From gnus-tmp-header))) ?s) + (?a (or (std11-full-name-string + (car (mime-read-field 'From gnus-tmp-header))) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) @@ -1224,6 +1218,7 @@ increase the score of each group you read." "t" gnus-article-hide-headers "g" gnus-summary-show-article "l" gnus-summary-goto-last-article + "v" gnus-summary-preview-mime-message "\C-c\C-v\C-v" gnus-uu-decode-uu-view "\C-d" gnus-summary-enter-digest-group "\M-\C-d" gnus-summary-read-document @@ -1368,7 +1363,6 @@ increase the score of each group you read." "e" gnus-article-emphasize "w" gnus-article-fill-cited-article "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message @@ -1515,7 +1509,6 @@ increase the score of each group you read." ["Word wrap" gnus-article-fill-cited-article t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ["UnHTMLize" gnus-article-treat-html t] ["Rot 13" gnus-summary-caesar-message t] ["Unix pipe" gnus-summary-pipe-message t] @@ -1619,8 +1612,8 @@ increase the score of each group you read." ["Wide reply and yank" gnus-summary-wide-reply-with-original t] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] + ["Digest and mail" gnus-summary-mail-digest t] + ["Digest and post" gnus-summary-post-digest t] ["Resend message" gnus-summary-resend-message t] ["Send bounced mail" gnus-summary-resend-bounced-mail t] ["Send a mail" gnus-summary-mail-other-window t] @@ -2363,7 +2356,8 @@ marks of articles." (let ((gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) + (make-full-mail-header 0 "" "" "" "" "" 0 0 "") + 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) (- (point) 2))))) @@ -3063,10 +3057,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header number ; number - (funcall - gnus-unstructured-field-decoder (gnus-nov-field)) ; subject - (funcall - gnus-structured-field-decoder (gnus-nov-field)) ; from + (gnus-nov-field) ; subject + (gnus-nov-field) ; from (gnus-nov-field) ; date (or (gnus-nov-field) (nnheader-generate-fake-message-id)) ; id @@ -3462,14 +3454,15 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h1)))) - (or (car extract) (cadr extract) "")) - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h2)))) - (or (car extract) (cadr extract) "")))) + (let ((addr (mime-read-field 'From h1))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + (let ((addr (mime-read-field 'From h2))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + )) (defun gnus-thread-sort-by-author (h1 h2) "Sort threads by root author." @@ -4380,7 +4373,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (subst-char-in-region (point-min) (point-max) ?\t ? t) (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) - in-reply-to header p lines chars) + in-reply-to header p lines chars ctype) (goto-char (point-min)) ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. @@ -4395,7 +4388,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; doesn't always go hand in hand. (setq header - (vector + (make-full-mail-header ;; Number. (prog1 (read cur) @@ -4409,21 +4402,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (funcall - gnus-unstructured-field-decoder (nnheader-header-value)) + (buffer-substring (match-end 0) (std11-field-end)) "(none)")) ;; From. (progn (goto-char p) (if (search-forward "\nfrom: " nil t) - (funcall - gnus-structured-field-decoder (nnheader-header-value)) + (buffer-substring (match-end 0) (std11-field-end)) "(nobody)")) ;; Date. (progn (goto-char p) (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) + (buffer-substring (match-end 0) (std11-field-end)) + "")) ;; Message-ID. (progn (goto-char p) @@ -4443,11 +4435,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (setq end (point)) (prog1 - (nnheader-header-value) + (buffer-substring (match-end 0) (std11-field-end)) (setq ref (buffer-substring (progn - (end-of-line) + ;; (end-of-line) (search-backward ">" end t) (1+ (point))) (progn @@ -4457,7 +4449,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; were no references and the in-reply-to header looks ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (nnheader-header-value)) + (setq in-reply-to + (buffer-substring (match-end 0) + (std11-field-end))) (string-match "<[^>]+>" in-reply-to)) (let (ref2) (setq ref (substring in-reply-to (match-beginning 0) @@ -4487,7 +4481,13 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) + (buffer-substring (match-end 0) (std11-field-end)))))) + (goto-char p) + (if (and (search-forward "\ncontent-type: " nil t) + (setq ctype + (buffer-substring (match-end 0) (std11-field-end)))) + (mime-entity-set-content-type-internal + header (mime-parse-Content-Type ctype))) (when (equal id ref) (setq ref nil)) @@ -4663,7 +4663,7 @@ current article will be taken into consideration." (let ((max (max (point) (mark))) articles article) (save-excursion - (goto-char (min (min (point) (mark)))) + (goto-char (min (point) (mark))) (while (and (push (setq article (gnus-summary-article-number)) articles) @@ -5197,6 +5197,17 @@ The state which existed when entering the ephemeral is reset." (gnus-summary-recenter) (gnus-summary-position-point)))) +(defun gnus-summary-preview-mime-message (arg) + "MIME decode and play this message." + (interactive "P") + (or gnus-show-mime + (let ((gnus-break-pages nil) + (gnus-show-mime t)) + (gnus-summary-select-article t t) + )) + (select-window (get-buffer-window gnus-article-buffer)) + ) + ;;; Dead summaries. (defvar gnus-dead-summary-mode-map nil) @@ -6837,6 +6848,19 @@ If ARG is a positive number, turn MIME processing on." (> (prefix-numeric-value arg) 0))) (gnus-summary-select-article t 'force)) +(defun gnus-summary-set-default-charset (charset) + "Display the current article with MIME CHARSET." + (interactive + (list (completing-read "MIME-charset = " + (mapcar (function + (lambda (cs) + (list (symbol-name cs)) + )) + (mime-charset-list))))) + (let ((default-mime-charset charset)) + (gnus-summary-select-article t 'force) + )) + (defun gnus-summary-caesar-message (&optional arg) "Caesar rotate the current article by 13. The numerical prefix specifies how many places to rotate each letter @@ -7158,7 +7182,7 @@ latter case, they will be copied into the relevant groups." (set-buffer (gnus-get-buffer-create " *import file*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (unless (nnheader-article-p) ;; This doesn't look like an article, so we fudge some headers. @@ -7662,8 +7686,8 @@ returned." "Mark the current article quickly as unread with MARK." (let* ((article (gnus-summary-article-number)) (old-mark (gnus-summary-article-mark article))) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) + ;; Let the backend know about the mark change. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (if (eq mark old-mark) t (if (<= article 0) @@ -7719,8 +7743,8 @@ marked." (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number))) (old-mark (gnus-summary-article-mark article))) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) + ;; Let the backend know about the mark change. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (if (eq mark old-mark) t (unless article @@ -8965,6 +8989,38 @@ save those articles instead." (gnus-summary-exit)) buffers))))) + +;;; @ for mime-partial +;;; + +(defun gnus-request-partial-message () + (save-excursion + (let ((number (gnus-summary-article-number)) + (group gnus-newsgroup-name) + (mother gnus-article-buffer)) + (set-buffer (get-buffer-create " *Partial Article*")) + (erase-buffer) + (setq mime-preview-buffer mother) + (gnus-request-article-this-buffer number group) + (mime-parse-buffer) + ))) + +(autoload 'mime-combine-message/partial-pieces-automatically + "mime-partial" + "Internal method to combine message/partial messages automatically.") + +(mime-add-condition + 'action '((type . message)(subtype . partial) + (major-mode . gnus-original-article-mode) + (method . mime-combine-message/partial-pieces-automatically) + (summary-buffer-exp . gnus-summary-buffer) + (request-partial-message-method . gnus-request-partial-message) + )) + + +;;; @ end +;;; + (gnus-ems-redefine) (provide 'gnus-sum) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 8320698..7dcfdc8 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,8 +1,8 @@ -;;; gnus-util.el --- utility functions for Gnus +;;; gnus-util.el --- utility functions for Semi-gnus ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: news +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -76,7 +76,10 @@ (set symbol nil)) symbol)) -(defun gnus-truncate-string (str width) +;; Avoid byte-compile warning. +;; In Mule, this function will be redefined to `truncate-string', +;; which takes 3 or 4 args. +(defun gnus-truncate-string (str width &rest ignore) (substring str 0 width)) ;; Added by Geoffrey T. Dairiki . A safe way @@ -786,7 +789,8 @@ with potentially long computations." (let ((file-buffer (create-file-buffer filename))) (save-excursion (set-buffer file-buffer) - (let ((require-final-newline nil)) + (let ((require-final-newline nil) + (coding-system-for-write 'binary)) (gnus-write-buffer filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) @@ -804,7 +808,8 @@ with potentially long computations." ;; Decide whether to append to a file or to an Emacs buffer. (let ((outbuf (get-file-buffer filename))) (if (not outbuf) - (let ((buffer-read-only nil)) + (let ((buffer-read-only nil) + (coding-system-for-write 'binary)) (save-excursion (goto-char (point-max)) (forward-char -2) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 00fc583..d8106d1 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -478,7 +478,28 @@ call it with the value of the `gnus-data' text property." 'x-color-values (lambda (color) (color-instance-rgb-components - (make-color-instance color)))))) + (make-color-instance color))))) + + (when (featurep 'mule) + (defun gnus-tilde-pad-form (el pad-width) + "Return a form that pads EL to PAD-WIDTH." + (let ((pad (abs pad-width))) + (if (symbolp el) + (if (< pad-width 0) + `(concat ,el (make-string + (max 0 (- ,pad (string-width ,el))) ?\ )) + `(concat (make-string + (max 0 (- ,pad (string-width ,el))) ?\ ) + ,el)) + (if (< pad-width 0) + `(let ((val (eval ,el))) + (concat val (make-string + (max 0 (- ,pad (string-width val))) ?\ ))) + `(let ((val (eval ,el))) + (concat (make-string + (max 0 (- ,pad (string-width val))) ?\ ) + val)))))) + )) (defun gnus-xmas-redefine () "Redefine lots of Gnus functions for XEmacs." @@ -524,8 +545,91 @@ call it with the value of the `gnus-data' text property." (add-hook 'gnus-draft-mode-hook 'gnus-xmas-draft-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) - + (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off) + + (when (featurep 'mule) + (defun gnus-truncate-string (str end-column &optional start-column padding) + "Truncate string STR to end at column END-COLUMN. +The optional 2nd arg START-COLUMN, if non-nil, specifies +the starting column; that means to return the characters occupying +columns START-COLUMN ... END-COLUMN of STR. + +The optional 3rd arg PADDING, if non-nil, specifies a padding character +to add at the end of the result if STR doesn't reach column END-COLUMN, +or if END-COLUMN comes in the middle of a character in STR. +PADDING is also added at the beginning of the result +if column START-COLUMN appears in the middle of a character in STR. + +If PADDING is nil, no padding is added in these cases, so +the resulting string may be narrower than END-COLUMN. +\[Emacs 20.3 emulating function]" + (or start-column + (setq start-column 0)) + (let ((len (length str)) + (idx 0) + (column 0) + (head-padding "") (tail-padding "") + ch last-column last-idx from-idx) + (condition-case nil + (while (< column start-column) + (setq ch (aref str idx) + column (+ column (char-width ch)) + idx (1+ idx))) + (args-out-of-range (setq idx len))) + (if (< column start-column) + (if padding (make-string end-column padding) "") + (if (and padding (> column start-column)) + (setq head-padding + (make-string (- column start-column) padding))) + (setq from-idx idx) + (if (< end-column column) + (setq idx from-idx) + (condition-case nil + (while (< column end-column) + (setq last-column column + last-idx idx + ch (aref str idx) + column (+ column (char-width ch)) + idx (1+ idx))) + (args-out-of-range (setq idx len))) + (if (> column end-column) + (setq column last-column idx last-idx)) + (if (and padding (< column end-column)) + (setq tail-padding + (make-string (- end-column column) padding)))) + (setq str (substring str from-idx idx)) + (if padding + (concat head-padding str tail-padding) + str)))) + + (defun gnus-tilde-max-form (el max-width) + "Return a form that limits EL to MAX-WIDTH." + (let ((max (abs max-width))) + (if (symbolp el) + (if (< max-width 0) + `(let ((width (string-width ,el))) + (gnus-truncate-string ,el width (- width ,max))) + `(gnus-truncate-string ,el ,max)) + (if (< max-width 0) + `(let* ((val (eval ,el)) + (width (string-width val))) + (gnus-truncate-string val width (- width ,max))) + `(let ((val (eval ,el))) + (gnus-truncate-string val ,max)))))) + + (defun gnus-tilde-cut-form (el cut-width) + "Return a form that cuts CUT-WIDTH off of EL." + (let ((cut (abs cut-width))) + (if (symbolp el) + (if (< cut-width 0) + `(gnus-truncate-string ,el (- (string-width ,el) ,cut)) + `(gnus-truncate-string ,el (string-width ,el) ,cut)) + (if (< cut-width 0) + `(let ((val (eval ,el))) + (gnus-truncate-string val (- (string-width val) ,cut))) + `(let ((val (eval ,el))) + (gnus-truncate-string val (string-width val) ,cut)))))) + )) ;;; XEmacs logo and toolbar. diff --git a/lisp/gnus.el b/lisp/gnus.el index 18a398f..beaf3c8 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,11 +250,16 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.6.45" - "Version number for this version of Gnus.") +(defconst gnus-product-name "Chaos" + "Product name of this version of gnus.") -(defconst gnus-version (format "Gnus v%s" gnus-version-number) - "Version string for this version of Gnus.") +(defconst gnus-version-number "1.12.0" + "Version number for this version of gnus.") + +(defconst gnus-version + (format "%s %s (based on Gnus 5.6.45; for SEMI 1.12, FLIM 1.12)" + gnus-product-name gnus-version-number) + "Version string for this version of gnus.") (defcustom gnus-inhibit-startup-message nil "If non-nil, the startup message will not be displayed. @@ -1136,6 +1141,7 @@ slower." :group 'gnus-summary-format :type '(radio (function-item gnus-extract-address-components) (function-item mail-extract-address-components) + (function-item std11-extract-address-components) (function :tag "Other"))) (defcustom gnus-carpal nil @@ -1369,7 +1375,6 @@ want." gnus-article-emphasize gnus-article-fill-cited-article gnus-article-remove-cr - gnus-article-de-quoted-unreadable gnus-summary-stop-page-breaking ;; gnus-summary-caesar-message ;; gnus-summary-verbose-headers @@ -1479,6 +1484,12 @@ want." "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") +(defconst semi-gnus-developers + "Semi-gnus Developers: + semi-gnus-en@meadow.scphys.kyoto-u.ac.jp (In English),\ + semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (In Japanese);" + "The mail address of the Semi-gnus developers.") + (defvar gnus-info-nodes '((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") @@ -1567,8 +1578,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (if (eq (nth 1 package) ':interactive) (cdddr package) (cdr package))))) - '(("metamail" metamail-buffer) - ("info" Info-goto-node) + '(("info" Info-goto-node) ("hexl" hexl-hex-string-to-integer) ("pp" pp pp-to-string pp-eval-expression) ("ps-print" ps-print-preprint) @@ -1700,7 +1710,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-word-wrap gnus-article-remove-cr gnus-article-remove-trailing-blank-lines - gnus-article-display-x-face gnus-article-de-quoted-unreadable + gnus-article-display-x-face gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local diff --git a/lisp/lpath.el b/lisp/lpath.el index d41172b..c8ee274 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -2,6 +2,12 @@ (defvar byte-compile-default-warnings) +(or (featurep 'path-util) + (load "apel/path-util")) +(add-path "apel") +(add-path "flim") +(add-path "semi") + (defun maybe-fbind (args) (while args (or (fboundp (car args)) diff --git a/lisp/message.el b/lisp/message.el index 20f2c33..0b9e25a 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2,7 +2,10 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news +;; MORIOKA Tomohiko +;; Shuhei KOBAYASHI +;; Keiichi Suzuki +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -29,7 +32,10 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'smtp) + ) (require 'mailheader) (require 'nnheader) @@ -39,6 +45,7 @@ (if (string-match "XEmacs\\|Lucid" emacs-version) (require 'mail-abbrevs) (require 'mailabbrev)) +(require 'mime-edit) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -98,6 +105,10 @@ :group 'message :group 'faces) +(defgroup message-frames nil + "Message frames" + :group 'message) + (defcustom message-directory "~/Mail/" "*Directory from which all other mail file variables are derived." :group 'message-various @@ -122,6 +133,11 @@ mailbox format." (function :tag "Other")) :group 'message-sending) +(defcustom message-encode-function 'message-maybe-encode + "*A function called to encode messages." + :group 'message-sending + :type 'function) + (defcustom message-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" "*This is inserted at the start of a mailed copy of a posted message. @@ -172,11 +188,11 @@ shorten-followup-to existing-newsgroups buffer-file-name unchanged." (defcustom message-required-news-headers '(From Newsgroups Subject Date Message-ID (optional . Organization) Lines - (optional . X-Newsreader)) + (optional . User-Agent)) "*Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines, In-Reply-To, Expires, and -X-Newsreader are optional. If don't you want message to insert some +User-Agent are optional. If don't you want message to insert some header, remove it from this list." :group 'message-news :group 'message-headers @@ -184,10 +200,10 @@ header, remove it from this list." (defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID Lines - (optional . X-Mailer)) + (optional . User-Agent)) "*Headers to be generated or prompted for when mailing a message. RFC822 required that From, Date, To, Subject and Message-ID be -included. Organization, Lines and X-Mailer are optional." +included. Organization, Lines and User-Agent are optional." :group 'message-mail :group 'message-headers :type '(repeat sexp)) @@ -210,7 +226,7 @@ included. Organization, Lines and X-Mailer are optional." :group 'message-headers :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^X-Trace:\\|^X-Complaints-To:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." @@ -275,13 +291,13 @@ If t, use `message-user-organization-file'." :group 'message-headers) (defcustom message-forward-start-separator - "------- Start of forwarded message -------\n" + (concat (mime-make-tag "message" "rfc822") "\n") "*Delimiter inserted before forwarded messages." :group 'message-forwarding :type 'string) (defcustom message-forward-end-separator - "------- End of forwarded message -------\n" + (concat (mime-make-tag "text" "plain") "\n") "*Delimiter inserted after forwarded messages." :group 'message-forwarding :type 'string) @@ -292,7 +308,7 @@ If t, use `message-user-organization-file'." :type 'boolean) (defcustom message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:" "*Regexp matching headers to be included in forwarded messages." :group 'message-forwarding :type 'regexp) @@ -318,7 +334,7 @@ The provided functions are: :group 'message-forwarding :type 'boolean) -(defcustom message-ignored-resent-headers "^Return-receipt" +(defcustom message-ignored-resent-headers "^Return-Receipt" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) @@ -342,16 +358,17 @@ variable `mail-header-separator'. Legal values include `message-send-mail-with-sendmail' (the default), `message-send-mail-with-mh', `message-send-mail-with-qmail' and -`smtpmail-send-it'." +`message-send-mail-with-smtp'." :type '(radio (function-item message-send-mail-with-sendmail) (function-item message-send-mail-with-mh) (function-item message-send-mail-with-qmail) - (function-item smtpmail-send-it) + (function-item message-send-mail-with-smtp) (function :tag "Other")) :group 'message-sending :group 'message-mail) -(defcustom message-send-news-function 'message-send-news +;; 1997-09-29 by MORIOKA Tomohiko +(defcustom message-send-news-function 'message-send-news-with-gnus "Function to call to send the current buffer as news. The headers should be delimited by a line whose contents match the variable `mail-header-separator'." @@ -438,7 +455,7 @@ variable isn't used." :group 'message-headers :type 'boolean) -(defcustom message-setup-hook nil +(defcustom message-setup-hook '(turn-on-mime-edit) "Normal hook, run each time a new outgoing message is initialized. The function `message-setup' runs this hook." :group 'message-various @@ -456,7 +473,7 @@ the signature is inserted." :group 'message-various :type 'hook) -(defcustom message-header-hook nil +(defcustom message-header-hook '(eword-encode-header) "Hook run in a message mode buffer narrowed to the headers." :group 'message-various :type 'hook) @@ -547,8 +564,7 @@ If stringp, use this; if non-nil, use no host name (user name only)." (defvar message-reply-buffer nil) (defvar message-reply-headers nil) -(defvar message-newsreader nil) -(defvar message-mailer nil) +(defvar message-user-agent nil) ; XXX: This symbol is overloaded! See below. (defvar message-sent-message-via nil) (defvar message-checksum nil) (defvar message-send-actions nil @@ -559,6 +575,7 @@ If stringp, use this; if non-nil, use no host name (user name only)." "A list of actions to be performed before killing a message buffer.") (defvar message-postpone-actions nil "A list of actions to be performed after postponing a message.") +(defvar message-original-frame nil) (define-widget 'message-header-lines 'text "All header lines must be LFD terminated." @@ -843,6 +860,18 @@ The cdr of ech entry is a function for applying the face to a region.") :group 'message-various :type 'hook) +(defcustom message-use-multi-frames nil + "Make new frame when sending messages." + :group 'message-frames + :type 'boolean) + +(defcustom message-delete-frame-on-exit nil + "Delete frame after sending messages." + :group 'message-frames + :type '(choice (const :tag "off" nil) + (const :tag "always" t) + (const :tag "ask" ask))) + (defvar message-send-coding-system 'binary "Coding system to encode outgoing mail.") @@ -936,9 +965,8 @@ The cdr of ech entry is a function for applying the face to a region.") (Lines) (Expires) (Message-ID) - (References . message-shorten-references) - (X-Mailer) - (X-Newsreader)) + (References . message-fill-references) + (User-Agent)) "Alist used for formatting headers.") (eval-and-compile @@ -954,6 +982,7 @@ The cdr of ech entry is a function for applying the face to a region.") (autoload 'nndraft-request-expire-articles "nndraft") (autoload 'gnus-open-server "gnus-int") (autoload 'gnus-request-post "gnus-int") + (autoload 'gnus-copy-article-buffer "gnus-msg") (autoload 'gnus-alive-p "gnus-util") (autoload 'rmail-output "rmail")) @@ -1338,8 +1367,7 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (setq paragraph-separate paragraph-start) (make-local-variable 'message-reply-headers) (setq message-reply-headers nil) - (make-local-variable 'message-newsreader) - (make-local-variable 'message-mailer) + (make-local-variable 'message-user-agent) (make-local-variable 'message-post-method) (make-local-variable 'message-sent-message-via) (setq message-sent-message-via nil) @@ -1730,6 +1758,7 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (forward-line 1)))) (goto-char start))) +(defvar gnus-article-copy) (defun message-yank-original (&optional arg) "Insert the message being replied to, if any. Puts point before the text and mark after. @@ -1744,6 +1773,8 @@ prefix, and don't delete any headers." (let ((modified (buffer-modified-p))) (when (and message-reply-buffer message-cite-function) + (gnus-copy-article-buffer) + (setq message-reply-buffer gnus-article-copy) (delete-windows-on message-reply-buffer t) (insert-buffer message-reply-buffer) (funcall message-cite-function) @@ -1859,11 +1890,18 @@ The text will also be indented the normal way." ;;; Sending messages ;;; +;; Avoid byte-compile warning. +(defvar message-encoding-buffer nil) +(defvar message-edit-buffer nil) +(defvar message-mime-mode nil) + (defun message-send-and-exit (&optional arg) "Send message like `message-send', then, if no errors, exit from mail buffer." (interactive "P") (let ((buf (current-buffer)) - (actions message-exit-actions)) + (actions message-exit-actions) + (frame (selected-frame)) + (org-frame message-original-frame)) (when (and (message-send arg) (buffer-name buf)) (if message-kill-buffer-on-exit @@ -1872,6 +1910,7 @@ The text will also be indented the normal way." (when (eq buf (current-buffer)) (message-bury buf))) (message-do-actions actions) + (message-delete-frame frame org-frame) t))) (defun message-dont-send () @@ -1888,10 +1927,32 @@ The text will also be indented the normal way." (interactive) (when (or (not (buffer-modified-p)) (yes-or-no-p "Message modified; kill anyway? ")) - (let ((actions message-kill-actions)) + (let ((actions message-kill-actions) + (frame (selected-frame)) + (org-frame message-original-frame)) (setq buffer-file-name nil) (kill-buffer (current-buffer)) - (message-do-actions actions)))) + (message-do-actions actions) + (message-delete-frame frame org-frame)))) + +(defun message-delete-frame (frame org-frame) + "Delete frame for editing message." + (when (and (or (and (featurep 'xemacs) + (not (eq 'tty (device-type)))) + window-system + (>= emacs-major-version 20)) + (or (and (eq message-delete-frame-on-exit t) + (select-frame frame) + (or (eq frame org-frame) + (prog1 + (y-or-n-p "Delete this frame?") + (message "")))) + (and (eq message-delete-frame-on-exit 'ask) + (select-frame frame) + (prog1 + (y-or-n-p "Delete this frame?") + (message ""))))) + (delete-frame frame))) (defun message-bury (buffer) "Bury this mail buffer." @@ -1918,23 +1979,32 @@ the user from the mailer." (undo-boundary) (let ((inhibit-read-only t)) (put-text-property (point-min) (point-max) 'read-only nil)) - (message-fix-before-sending) (run-hooks 'message-send-hook) (message "Sending...") - (let ((alist message-send-method-alist) + (let ((message-encoding-buffer + (message-generate-new-buffer-clone-locals " message encoding")) + (message-edit-buffer (current-buffer)) + (message-mime-mode mime-edit-mode-flag) + (alist message-send-method-alist) (success t) elem sent) - (while (and success - (setq elem (pop alist))) - (when (and (or (not (funcall (cadr elem))) - (and (or (not (memq (car elem) - message-sent-message-via)) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem)))) - (setq success (funcall (caddr elem) arg))))) - (setq sent t))) + (save-excursion + (set-buffer message-encoding-buffer) + (erase-buffer) + (insert-buffer message-edit-buffer) + (funcall message-encode-function) + (message-fix-before-sending) + (while (and success + (setq elem (pop alist))) + (when (and (or (not (funcall (cadr elem))) + (and (or (not (memq (car elem) + message-sent-message-via)) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem)))) + (setq success (funcall (caddr elem) arg))))) + (setq sent t)))) (when (and success sent) (message-do-fcc) ;;(when (fboundp 'mail-hist-put-headers-into-history) @@ -1957,7 +2027,7 @@ the user from the mailer." (defun message-send-via-news (arg) "Send the current message via news." - (funcall message-send-news-function arg)) + (message-send-news arg)) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -1997,8 +2067,7 @@ the user from the mailer." (require 'mail-utils) (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) (case-fold-search nil) - (news (message-news-p)) - (mailbuf (current-buffer))) + (news (message-news-p))) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -2011,11 +2080,7 @@ the user from the mailer." (save-excursion (set-buffer tembuf) (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer mailbuf) - (buffer-string)))) + (insert-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -2029,9 +2094,15 @@ the user from the mailer." (or (message-fetch-field "cc") (message-fetch-field "to"))) (message-insert-courtesy-copy)) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-mail-function) + ))) (funcall message-send-mail-function)) (kill-buffer tembuf)) - (set-buffer mailbuf) + (set-buffer message-edit-buffer) (push 'mail message-sent-message-via))) (defun message-send-mail-with-sendmail () @@ -2158,13 +2229,40 @@ to find out how to use this." ;; Pass it on to mh. (mh-send-letter))) +(defun message-send-mail-with-smtp () + "Send off the prepared buffer with SMTP." + (require 'smtp) ; XXX + (let ((case-fold-search t) + recipients) + (save-restriction + (message-narrow-to-headers) + (setq recipients + ;; XXX: Should be replaced by better one. + (smtp-deduce-address-list (current-buffer) + (point-min) (point-max))) + ;; Remove BCC lines. + (message-remove-header "bcc")) + ;; replace the header delimiter with a blank line. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (run-hooks 'message-send-mail-hook) + (if recipients + (let ((result (smtp-via-smtp user-mail-address + recipients + (current-buffer)))) + (unless (eq result t) + (error "Sending failed; " result))) + (error "Sending failed; no recipients")))) + (defun message-send-news (&optional arg) (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) (case-fold-search nil) (method (if (message-functionp message-post-method) (funcall message-post-method arg) message-post-method)) - (messbuf (current-buffer)) (message-syntax-checks (if arg (cons '(existing-newsgroups . disabled) @@ -2187,11 +2285,7 @@ to find out how to use this." (set-buffer tembuf) (buffer-disable-undo (current-buffer)) (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer messbuf) - (buffer-string)))) + (insert-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -2201,30 +2295,48 @@ to find out how to use this." ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) - (let ((case-fold-search t)) - ;; Remove the delimiter. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1)) - (run-hooks 'message-send-news-hook) - ;;(require (car method)) - ;;(funcall (intern (format "%s-open-server" (car method))) - ;;(cadr method) (cddr method)) - ;;(setq result - ;; (funcall (intern (format "%s-request-post" (car method))) - ;; (cadr method))) - (gnus-open-server method) - (setq result (gnus-request-post method))) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (save-restriction + (std11-narrow-to-header mail-header-separator) + (goto-char (point-min)) + (when (re-search-forward "^Message-Id:" nil t) + (delete-region (match-end 0)(std11-field-end)) + (insert (concat " " (message-make-message-id))) + )) + (funcall message-send-news-function method) + ))) + (setq result (funcall message-send-news-function method))) (kill-buffer tembuf)) - (set-buffer messbuf) + (set-buffer message-edit-buffer) (if result (push 'news message-sent-message-via) (message "Couldn't send message via news: %s" (nnheader-get-report (car method))) nil)))) +;; 1997-09-29 by MORIOKA Tomohiko +(defun message-send-news-with-gnus (method) + (let ((case-fold-search t)) + ;; Remove the delimiter. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (run-hooks 'message-send-news-hook) + ;;(require (car method)) + ;;(funcall (intern (format "%s-open-server" (car method))) + ;;(cadr method) (cddr method)) + ;;(setq result + ;; (funcall (intern (format "%s-request-post" (car method))) + ;; (cadr method))) + (gnus-open-server method) + (gnus-request-post method) + )) + ;;; ;;; Header generation & syntax checking. ;;; @@ -2258,7 +2370,9 @@ to find out how to use this." (message-narrow-to-headers) (message-check-news-header-syntax))) ;; Check the body. - (message-check-news-body-syntax))))) + (save-excursion + (set-buffer message-edit-buffer) + (message-check-news-body-syntax)))))) (defun message-check-news-header-syntax () (and @@ -2518,18 +2632,19 @@ to find out how to use this." (defun message-do-fcc () "Process Fcc headers in the current buffer." (let ((case-fold-search t) - (buf (current-buffer)) + (coding-system-for-write 'raw-text) list file) (save-excursion (set-buffer (get-buffer-create " *message temp*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-buffer-substring buf) + (insert-buffer-substring message-encoding-buffer) (save-restriction (message-narrow-to-headers) (while (setq file (message-fetch-field "fcc")) (push file list) (message-remove-header "fcc" nil t))) + (run-hooks 'message-header-hook 'message-before-do-fcc-hook) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (replace-match "" t t) @@ -2847,6 +2962,24 @@ give as trustworthy answer as possible." (or mail-host-address (message-make-fqdn))) +(defun message-make-user-agent () + "Return user-agent info." + (if message-user-agent + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t) + user-agent beg p end) + (if (re-search-forward "^User-Agent:[ \t]*" nil t) + (progn + (setq beg (match-beginning 0) + p (match-end 0) + end (std11-field-end) + user-agent (buffer-substring p end)) + (delete-region beg (1+ end)) + (concat message-user-agent " " user-agent) + ) + message-user-agent))))) + (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." @@ -2863,9 +2996,7 @@ Headers already prepared in the buffer are not modified." (To nil) (Distribution (message-make-distribution)) (Lines (message-make-lines)) - (X-Newsreader message-newsreader) - (X-Mailer (and (not (message-fetch-field "X-Newsreader")) - message-mailer)) + (User-Agent (message-make-user-agent)) (Expires (message-make-expires)) (case-fold-search t) header value elem) @@ -3031,6 +3162,13 @@ Headers already prepared in the buffer are not modified." (widen) (forward-line 1))) +(defun message-fill-references (header value) + (insert (capitalize (symbol-name header)) + ": " + (std11-fill-msg-id-list-string + (if (consp value) (car value) value)) + "\n")) + (defun message-fill-header (header value) (let ((begin (point)) (fill-column 990) @@ -3113,7 +3251,24 @@ Headers already prepared in the buffer are not modified." (defun message-pop-to-buffer (name) "Pop to buffer NAME, and warn if it already exists and is modified." - (let ((buffer (get-buffer name))) + (let ((pop-up-frames pop-up-frames) + (special-display-buffer-names special-display-buffer-names) + (special-display-regexps special-display-regexps) + (same-window-buffer-names same-window-buffer-names) + (same-window-regexps same-window-regexps) + (buffer (get-buffer name)) + (cur (current-buffer))) + (if (or (and (featurep 'xemacs) + (not (eq 'tty (device-type)))) + window-system + (>= emacs-major-version 20)) + (when message-use-multi-frames + (setq pop-up-frames t + special-display-buffer-names nil + special-display-regexps nil + same-window-buffer-names nil + same-window-regexps nil)) + (setq pop-up-frames nil)) (if (and buffer (buffer-name buffer)) (progn @@ -3124,7 +3279,10 @@ Headers already prepared in the buffer are not modified." (error "Message being composed"))) (set-buffer (pop-to-buffer name))) (erase-buffer) - (message-mode))) + (message-mode) + (when pop-up-frames + (make-local-variable 'message-original-frame) + (setq message-original-frame (selected-frame))))) (defun message-do-send-housekeeping () "Kill old message buffers." @@ -3353,7 +3511,8 @@ OTHER-HEADERS is an alist of header/value pairs." (if wide to-address nil))) (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) + (make-full-mail-header-from-decoded-header + 0 subject from date message-id references 0 0 "")) (message-setup `((Subject . ,subject) @@ -3478,7 +3637,8 @@ responses here are directed to other newsgroups.")) cur) (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")))) + (make-full-mail-header-from-decoded-header + 0 subject from date message-id references 0 0 "")))) ;;;###autoload @@ -3499,14 +3659,14 @@ responses here are directed to other newsgroups.")) message-id (message-fetch-field "message-id" t) distribution (message-fetch-field "distribution"))) ;; Make sure that this article was written by the user. - (unless (or (and sender - (string-equal - (downcase sender) - (downcase (message-make-sender)))) - (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (cadr (mail-extract-address-components - (message-make-from)))))) + (unless (or (and sender + (string-equal + (downcase sender) + (downcase (message-make-sender)))) + (string-equal + (downcase (cadr (mail-extract-address-components from))) + (downcase (cadr (mail-extract-address-components + (message-make-from)))))) (error "This article is not yours")) ;; Make control message. (setq buf (set-buffer (get-buffer-create " *message cancel*"))) @@ -3523,8 +3683,10 @@ responses here are directed to other newsgroups.")) message-cancel-message) (message "Canceling your article...") (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) + 'dont-check-for-anything-just-trust-me) + (message-encoding-buffer (current-buffer)) + (message-edit-buffer (current-buffer))) + (message-send-news)) (message "Canceling your article...done")) (kill-buffer buf))))) @@ -3641,8 +3803,12 @@ the message." (let ((funcs message-make-forward-subject-function) (subject (if message-wash-forwarded-subjects (message-wash-subject - (or (message-fetch-field "Subject") "")) - (or (message-fetch-field "Subject") "")))) + (or (nnheader-decode-subject + (message-fetch-field "Subject")) + "")) + (or (nnheader-decode-subject + (message-fetch-field "Subject")) + "")))) ;; Make sure funcs is a list. (and funcs (not (listp funcs)) @@ -3703,7 +3869,10 @@ Optional NEWS will use news to forward instead of mail." (set-buffer (get-buffer-create " *message resend*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (message-setup `((To . ,address))) + ;; avoid to turn-on-mime-edit + (let (message-setup-hook) + (message-setup `((To . ,address))) + ) ;; Insert our usual headers. (message-generate-headers '(From Date To)) (message-narrow-to-headers) @@ -3734,7 +3903,9 @@ Optional NEWS will use news to forward instead of mail." (when (looking-at "From ") (replace-match "X-From-Line: ")) ;; Send it. - (message-send-mail) + (let ((message-encoding-buffer (current-buffer)) + (message-edit-buffer (current-buffer))) + (message-send-mail)) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) @@ -3751,7 +3922,7 @@ you." (insert-buffer-substring cur) (undo-boundary) (message-narrow-to-head) - (if (and (message-fetch-field "Mime-Version") + (if (and (message-fetch-field "MIME-Version") (setq boundary (message-fetch-field "Content-Type"))) (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) (setq boundary (concat (match-string 1 boundary) " *\n" @@ -3978,7 +4149,7 @@ regexp varstr." (let ((locals (save-excursion (set-buffer buffer) (buffer-local-variables))) - (regexp "^gnus\\|^nn\\|^message")) + (regexp "^\\(gnus\\|nn\\|message\\|user-\\(mail-address\\|full-name\\)\\)")) (mapcar (lambda (local) (when (and (consp local) @@ -3989,6 +4160,34 @@ regexp varstr." (cdr local))))) locals))) + +;;; @ for MIME Edit mode +;;; + +(defun message-maybe-encode () + (when message-mime-mode + (run-hooks 'mime-edit-translate-hook) + (if (catch 'mime-edit-error + (save-excursion + (mime-edit-translate-body) + )) + (error "Translation error!") + ) + (end-of-invisible) + (run-hooks 'mime-edit-exit-hook) + )) + +(defun message-mime-insert-article (&optional message) + (interactive) + (let ((message-cite-function 'mime-edit-inserted-message-filter) + (message-reply-buffer gnus-original-article-buffer) + ) + (message-yank-original nil) + )) + +(set-alist 'mime-edit-message-inserter-alist + 'message-mode (function message-mime-insert-article)) + ;;; Miscellaneous functions ;; stolen (and renamed) from nnheader.el diff --git a/lisp/mmgnus.el b/lisp/mmgnus.el new file mode 100644 index 0000000..a2f5d2c --- /dev/null +++ b/lisp/mmgnus.el @@ -0,0 +1,62 @@ +;;; mmgnus.el --- MIME entity implementation for gnus-article + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: MIME, multimedia, mail, news + +;; This file is part of Chao-gnus. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'mmbuffer) + +(mm-define-backend gnus (generic)) + +(mm-define-method entity-buffer ((entity gnus)) + ;; (if (with-current-buffer gnus-summary-buffer + ;; (eq gnus-current-article (mail-header-number entity))) + ;; ...) + (unless (mime-entity-header-start-internal entity) + (set-buffer gnus-original-article-buffer) + (mime-entity-set-header-start-internal entity (point-min)) + (mime-entity-set-body-end-internal entity (point-max)) + (goto-char (point-min)) + (if (re-search-forward "^$" nil t) + (progn + (mime-entity-set-header-end-internal entity (match-end 0)) + (mime-entity-set-body-start-internal + entity + (if (= (mime-entity-header-end-internal entity) + (mime-entity-body-end-internal entity)) + (mime-entity-body-end-internal entity) + (1+ (mime-entity-header-end-internal entity)) + )) + ) + (mime-entity-set-header-end-internal entity (point-min)) + (mime-entity-set-body-start-internal entity (point-min)) + )) + gnus-original-article-buffer) + + +;;; @ end +;;; + +(provide 'mmgnus) + +;;; mmgnus.el ends here diff --git a/lisp/nnheader.el b/lisp/nnheader.el index bc725b6..875da91 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,9 +1,10 @@ -;;; nnheader.el --- header access macros for Gnus and its backends +;;; nnheader.el --- header access macros for Semi-gnus and its backends ;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news +;; Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -40,6 +41,7 @@ (eval-when-compile (require 'cl)) (require 'mail-utils) +(require 'mime) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") @@ -68,86 +70,78 @@ on your system, you could say something like: (defmacro mail-header-number (header) "Return article number in HEADER." - `(aref ,header 0)) + `(mime-entity-location-internal ,header)) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) + `(mime-entity-set-location-internal ,header ,number)) -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) +(defalias 'mail-header-subject 'mime-entity-decoded-subject-internal) +(defalias 'mail-header-set-subject 'mime-entity-set-decoded-subject-internal) -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) +(defalias 'mail-header-from 'mime-entity-decoded-from-internal) +(defalias 'mail-header-set-from 'mime-entity-set-decoded-from-internal) -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) +(defalias 'mail-header-date 'mime-entity-date-internal) +(defalias 'mail-header-set-date 'mime-entity-set-date-internal) -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) +(defalias 'mail-header-message-id 'mime-entity-message-id-internal) +(defalias 'mail-header-id 'mime-entity-message-id-internal) +(defalias 'mail-header-set-message-id 'mime-entity-set-message-id-internal) +(defalias 'mail-header-set-id 'mime-entity-set-message-id-internal) -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) +(defalias 'mail-header-references 'mime-entity-references-internal) +(defalias 'mail-header-set-references 'mime-entity-set-references-internal) -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) +(defalias 'mail-header-chars 'mime-entity-chars-internal) +(defalias 'mail-header-set-chars 'mime-entity-set-chars-internal) -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) +(defalias 'mail-header-lines 'mime-entity-lines-internal) +(defalias 'mail-header-set-lines 'mime-entity-set-lines-internal) -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) +(defalias 'mail-header-xref 'mime-entity-xref-internal) +(defalias 'mail-header-set-xref 'mime-entity-set-xref-internal) -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) +(defalias 'nnheader-decode-subject + (mime-find-field-decoder 'Subject 'nov)) +(defalias 'nnheader-decode-from + (mime-find-field-decoder 'From 'nov)) -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article xref of HEADER to xref." - `(aset ,header 8 ,xref)) +(defsubst make-full-mail-header (&optional number subject from date id + references chars lines xref) + "Create a new mail header structure initialized with the parameters given." + (make-mime-entity-internal + 'gnus number + nil + nil nil nil + (if subject + (nnheader-decode-subject subject) + ) + (if from + (nnheader-decode-from from) + ) + date id references + chars lines xref + (list (cons 'Subject subject) + (cons 'From from)) + )) + +(defsubst make-full-mail-header-from-decoded-header + (&optional number subject from date id references chars lines xref) + "Create a new mail header structure initialized with the parameters given." + (make-mime-entity-internal + 'gnus number + nil + nil nil nil + subject + from + date id references + chars lines xref)) (defun make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." - (make-vector 9 init)) - -(defun make-full-mail-header (&optional number subject from date id - references chars lines xref) - "Create a new mail header structure initialized with the parameters given." - (vector number subject from date id references chars lines xref)) + (make-full-mail-header init init init init init + init init init init)) ;; fake message-ids: generation and detection @@ -183,7 +177,7 @@ on your system, you could say something like: ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance ;; don't always go hand in hand. - (vector + (make-full-mail-header ;; Number. (if naked (progn @@ -280,7 +274,7 @@ on your system, you could say something like: (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) - (vector + (make-full-mail-header (nnheader-nov-read-integer) ; number (nnheader-nov-field) ; subject (nnheader-nov-field) ; from @@ -299,8 +293,8 @@ on your system, you could say something like: (princ (mail-header-number header) (current-buffer)) (insert "\t" - (or (mail-header-subject header) "(none)") "\t" - (or (mail-header-from header) "(nobody)") "\t" + (or (mime-fetch-field 'Subject header) "(none)") "\t" + (or (mime-fetch-field 'From header) "(nobody)") "\t" (or (mail-header-date header) "") "\t" (or (mail-header-id header) (nnmail-message-id)) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index c47a10d..38a0244 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -232,7 +232,7 @@ Finds out what articles are to be part of the nnkiboze groups." (load newsrc-file)) (nnheader-temp-write nov-file (when (file-exists-p nov-file) - (insert-file-contents nov-file)) + (nnheader-insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) ;; Go through the active hashtb and add new all groups that match the ;; kiboze regexp. diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 8aafd7d..8997237 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -110,7 +110,7 @@ (when large (nnheader-message 5 "nnmh: Receiving headers...done")) - (nnheader-fold-continuation-lines) + ;; (nnheader-fold-continuation-lines) 'headers)))) (deffoo nnmh-open-server (server &optional defs) diff --git a/lisp/pop3-fma.el b/lisp/pop3-fma.el index 293efe6..e95c147 100644 --- a/lisp/pop3-fma.el +++ b/lisp/pop3-fma.el @@ -3,7 +3,7 @@ ;; Yasuo Okabe ;; Author: Tatsuya Ichikawa ;; Yasuo OKABE -;; Version: 1.16 +;; Version: 1.11 ;; Keywords: mail , gnus , pop3 ;; ;; SPECIAL THANKS @@ -78,21 +78,30 @@ (` (defvar (, symbol) (, value) (, doc)))) ) +(unless (and (fboundp 'pop3-fma-encode-string) + (fboundp 'pop3-fma-decode-string)) + (require 'mel-b) + (fset 'pop3-fma-encode-string 'base64-encode-string) + (fset 'pop3-fma-decode-string 'base64-decode-string)) + (defgroup pop3-fma nil "Multile POP3 account utility for Gnus." :prefix "pop3-fma-" :group 'mail :group 'news) -(defconst pop3-fma-version-number "1.16") +(defconst pop3-fma-version-number "1.11") (defconst pop3-fma-codename +;; "Feel the wind" ; 0.10 +;; "My home town" ; 0.11 +;; "On the road" ; 0.12 +;; "Rock'n Roll city" ; 0.13 +;; "Money" ; 0.20 +;; "Still 19" ; 0.21 ;; "J boy" ; 1.00 ;; "Blood line" ; 1.10 -;; "Star ring" ; 1.11 -;; "Goodbye Game" ; 1.12 -;; "Love is Gamble" ; 1.13 -;; "Lonely" ; 1.14 - "Feel the wind" ; 1.16 + "Star ring" ; 0.xx +;; "Goodbye Game" ; 0.xx ) (defconst pop3-fma-version (format "Multiple POP3 account utiliy for Gnus v%s - \"%s\"" pop3-fma-version-number @@ -128,57 +137,21 @@ Lisp means `nnmail-movemail-program' is lisp function. :group 'pop3-fma :type '(repeat (string :tag "Argument"))) -(defcustom pop3-fma-save-password-information nil - "*If non nil , save POP Server's password information. -============== Important notice ===================== -Please take care of your password information. -If set to t , your pop3 password is saved in pop3-fma-password in raw text. -So , Anybody can see this information by describe-variable. -If there is any problem , please set this variable to nil(default). -============== Important notice =====================" - :group 'pop3-fma - :type 'boolean) - ;;; Internal variables. (defvar pop3-fma-password nil "*POP3 password , user , mailhost information for Gnus.") -(defvar pop3-fma-movemail-program - (if (eq system-type 'windows-nt) - "movemail.exe" - "movemail") - "*External program name your movemail.") - +(defvar pop3-fma-movemail-program "movemail.exe" + "*External program name your movemail. +Please do not set this valiable non-nil if you do not use Meadow.") ;; Temporary variable (defvar hdr nil) (defvar passwd nil) (defvar str nil) +(defvar pop3-fma-movemail-options pop3-fma-movemail-arguments) (defvar spool nil) (defvar movemail-output-buffer " *movemail-out*") -(defvar pop3-fma-commandline-arguments nil) - -;;; To silence byte compiler -(and - (fboundp 'eval-when-compile) - (eval-when-compile - (save-excursion - (beginning-of-defun) - (eval-region (point-min) (point))) - (let (case-fold-search) - (mapcar - (function - (lambda (symbol) - (unless (boundp symbol) - (make-local-variable symbol) - (eval (list 'setq symbol nil))))) - '(:group - :prefix :type - pop3-maildrop - pop3-mailhost - )) - (make-local-variable 'byte-compile-warnings) - (setq byte-compile-warnings nil)))) (defun pop3-fma-init-message-hook () (add-hook 'message-send-hook 'pop3-fma-message-add-header)) @@ -204,12 +177,7 @@ If there is any problem , please set this variable to nil(default). (pop3-mailhost (substring inbox (match-end (string-match "^.*@" inbox)))) (pop3-password - (if pop3-fma-save-password-information - (pop3-fma-read-passwd (substring inbox (match-end (string-match "^.*@" inbox)))) - (pop3-fma-input-password - (substring inbox (match-end (string-match "^.*@" inbox))) - (substring inbox (match-end (string-match "^po:" inbox)) - (- (match-end (string-match "^.*@" inbox)) 1))))) + (pop3-fma-read-passwd (substring inbox (match-end (string-match "^.*@" inbox))))) (pop3-authentication-scheme (nth 1 (assoc inbox pop3-fma-spool-file-alist))) (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox))) @@ -220,12 +188,12 @@ If there is any problem , please set this variable to nil(default). (eq pop3-fma-movemail-type 'exe)) (progn (setenv "MAILHOST" pop3-mailhost) - (if (and (not (memq pop3-password pop3-fma-commandline-arguments)) - (not (memq (concat "po:" pop3-maildrop) pop3-fma-commandline-arguments))) + (if (and (not (memq pop3-password pop3-fma-movemail-arguments)) + (not (memq (concat "po:" pop3-maildrop) pop3-fma-movemail-arguments))) (progn - (setq pop3-fma-commandline-arguments - (append - pop3-fma-movemail-arguments + (setq pop3-fma-movemail-arguments nil) + (setq pop3-fma-movemail-arguments + (append pop3-fma-movemail-options (list (concat "po:" pop3-maildrop) crashbox @@ -238,7 +206,7 @@ If there is any problem , please set this variable to nil(default). exec-directory pop3-fma-movemail-program) nil movemail-output-buffer nil - pop3-fma-commandline-arguments) + pop3-fma-movemail-arguments) (let ((string (buffer-string))) (if (> (length string) 0) (progn @@ -261,14 +229,9 @@ If there is any problem , please set this variable to nil(default). ;; (defun pop3-fma-read-passwd (mailhost) (setq passwd (nth 2 (assoc mailhost pop3-fma-password))) - passwd) + (pop3-fma-decode-string passwd)) -(defun pop3-fma-input-password (mailhost maildrop) - (pop3-fma-read-noecho - (format "POP Password for %s at %s: " maildrop mailhost) t)) - -(setq pop3-read-passwd 'pop3-fma-read-passwd - nnmail-read-passwd 'pop3-fma-read-passwd) +(setq pop3-read-passwd 'pop3-fma-read-passwd) ;; ;; Set multiple pop3 server's password (defun pop3-fma-store-password (passwd) @@ -282,26 +245,24 @@ If there is any problem , please set this variable to nil(default). (list pop3-mailhost pop3-maildrop - passwd))))) + (pop3-fma-encode-string passwd))))) (setcar (cdr (cdr (assoc pop3-mailhost pop3-fma-password))) - passwd) - (message "POP password registered.") - passwd) + (pop3-fma-encode-string passwd))) + (message "POP password registered.") + (pop3-fma-encode-string passwd)) ;; ;;;###autoload (defun pop3-fma-set-pop3-password() (interactive) - (if pop3-fma-save-password-information - (progn - (mapcar - (lambda (x) - (let ((pop3-maildrop - (substring (car x) (match-end (string-match "^po:" (car x))) - (- (match-end (string-match "^.*@" (car x))) 1))) - (pop3-mailhost - (substring (car x) (match-end (string-match "^.*@" (car x)))))) - (call-interactively 'pop3-fma-store-password))) - pop3-fma-spool-file-alist))) + (mapcar + (lambda (x) + (let ((pop3-maildrop + (substring (car x) (match-end (string-match "^po:" (car x))) + (- (match-end (string-match "^.*@" (car x))) 1))) + (pop3-mailhost + (substring (car x) (match-end (string-match "^.*@" (car x)))))) + (call-interactively 'pop3-fma-store-password))) + pop3-fma-spool-file-alist) (setq nnmail-movemail-program 'pop3-fma-movemail) ;; (setq nnmail-spool-file pop3-fma-spool-file-alist)) (setq nnmail-spool-file (append @@ -311,22 +272,6 @@ If there is any problem , please set this variable to nil(default). (car spool)) pop3-fma-spool-file-alist)))) ;; -(defmacro pop3-fma-read-char-exclusive () - (cond ((featurep 'xemacs) - '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?) - (left . ?\C-h)))) - event key) - (while (not - (and - (key-press-event-p (setq event (next-command-event))) - (setq key (or (event-to-character event) - (cdr (assq (event-key event) table))))))) - key)) - ((fboundp 'read-char-exclusive) - '(read-char-exclusive)) - (t - '(read-char)))) -;; (defun pop3-fma-read-noecho (prompt &optional stars) "Read a single line of text from user without echoing, and return it. Argument PROMPT ." @@ -345,15 +290,15 @@ Argument PROMPT ." (and (> truncate 0) (setq msg (concat "$" (substring msg (1+ truncate)))))) (message msg) - (setq c (pop3-fma-read-char-exclusive)) - (cond ((eq ?\C-g c) + (setq c (read-char-exclusive)) + (cond ((= c ?\C-g) (setq quit-flag t done t)) - ((memq c '(?\r ?\n ?\e)) + ((or (= c ?\r) (= c ?\n) (= c ?\e)) (setq done t)) - ((eq ?\C-u c) + ((= c ?\C-u) (setq ans "")) - ((and (/= ?\b c) (/= ?\177 c)) + ((and (/= c ?\b) (/= c ?\177)) (setq ans (concat ans (char-to-string c)))) ((> (length ans) 0) (setq ans (substring ans 0 -1))))) @@ -399,4 +344,3 @@ Argument PROMPT ." ;; ;; pop3-fma.el ends here. - diff --git a/lisp/pop3.el b/lisp/pop3.el index 3d5cdf5..beef181 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -4,7 +4,7 @@ ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 -;; Version: 1.3m +;; Version: 1.3m+ ;; This file is part of GNU Emacs. @@ -37,7 +37,7 @@ (require 'mail-utils) (provide 'pop3) -(defconst pop3-version "1.3m") +(defconst pop3-version "1.3m+") (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil) "*POP3 maildrop.") @@ -60,6 +60,9 @@ values are 'apop.") "Timestamp returned when initially connected to the POP server. Used for APOP authentication.") +(defvar pop3-movemail-file-coding-system 'binary + "Crashbox made by pop3-movemail with this coding system.") + (defvar pop3-read-point nil) (defvar pop3-debug nil) @@ -91,7 +94,8 @@ Used for APOP authentication.") (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) - (append-to-file (point-min) (point-max) crashbox) + (let ((coding-system-for-write pop3-movemail-file-coding-system)) + (append-to-file (point-min) (point-max) crashbox)) (set-buffer (process-buffer process)) (while (> (buffer-size) 5000) (goto-char (point-min)) @@ -126,8 +130,7 @@ Returns the process associated with the connection." (setq pop3-timestamp (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) - process - )) + process)) ;; Support functions