From: hayashi Date: Thu, 26 Nov 1998 02:03:17 +0000 (+0000) Subject: Merge gnus-6_8 X-Git-Tag: gnus-199811302358~2 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=47b7a4bada24ae3f277e2a8f336128ba949840ea;p=elisp%2Fgnus.git- Merge gnus-6_8 --- diff --git a/ChangeLog b/ChangeLog index ee05b87..1f6ba5b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,574 @@ -1998-07-19 Tatsuya Ichikawa +1998-11-25 Hasebe Satoshi - * lisp/pop3-fma.el: Change version No to 1.00. + * lisp/gnus-util.el: Require RMAIL in a different way. + +1998-11-24 Tatsuya Ichikawa + + * 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. + +1998-11-24 Katsumi Yamaoka + + * lisp/dgnushack.el (dgnushack-compile): Dismiss "gnus-bbdb.el" + from the list if BBDB has not been installed. + +1998-11-20 Tatsuya Ichikawa + + * lisp/gnus-util.el: Require `rmail' only if RMAIL has been + installed. + +1998-11-19 Keiichi Suzuki + + * 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'. + + * 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'. + +1998-11-19 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.8.20. + + * Sync up with Gnus 5.6.45. + +1998-11-18 Katsumi Yamaoka + + * lisp/message.el (message-mimic-kill-buffer): Rewrite. + +1998-11-18 Katsumi Yamaoka + + * lisp/message.el (message-mimic-kill-buffer): New function. + (message-mode-map): Use it for `C-x k'. + +1998-11-18 Keiichi Suzuki + + * lisp/message.el (message-dont-send): Use `message-delete-frame'. + +1998-11-14 Kenji Itoh + + * lisp/nnmail.el (nnmail-read-passwd): Use `read-passwd' if it + exists as a function. + + * lisp/pop3.el (pop3-read-passwd): Likewise. + +1998-11-16 Katsumi Yamaoka + + * make.bat: Replace line endings from `LF' to `CRLF'. + +1998-11-16 Katsumi Yamaoka + + * README-gnus-bbdb.en, README-gnus-bbdb.ja: New files. + + * lisp/gnus-bbdb.el: Replace string in comment "Nana-" to "Semi-". + +1998-11-13 Keiichi Suzuki + + * lisp/gnus-msg.el (gnus-setup-message): Setup + `message-startup-parameter-alist' for starting `message-mode'. + + * 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'. + + * lisp/gnus-bbdb.el: New file. Interface for BBDB. + +1998-11-12 Katsumi Yamaoka + + * lisp/gnus-msg.el (gnus-summary-resend-bounced-mail): Bind + `gnus-message-setup-hook' to nil. + + * lisp/message.el (message-bounce-setup-for-mime-edit): 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. + +1998-11-11 Tatsuya Ichikawa + + * lisp/message.el (message-mode-map): Add new command key + `C-x C-s' for `message-save-drafts'. + +1998-11-11 Keiichi Suzuki + + * 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-11-09 Tatsuya Ichikawa + + * lisp/pop3-fma.el: Set the value of `nnmail-read-passwd' as a + symbol `pop3-fma-read-passwd'. + +1998-11-04 Yoshiki Hayashi + + * lisp/message.el: (message-do-fcc): Don't run message-header-hook + and message-before-do-fcc-hook. + +1998-11-02 Yoshiki Hayashi + + * lisp/message.el: (message-make-in-reply-to): Generate + In-Reply-To header according to draft-ietf-drums-msg-fmt-05. + +1998-10-30 Tatsuya Ichikawa + + * lisp/gnus.el: Add autoload setting for `pop3-fma'. + +1998-10-28 Tatsuya Ichikawa + + * lisp/pop3-fma.el: Determin base64 encode/decode function by FLIM. + +1998-10-26 Tatsuya Ichikawa + + * lisp/message.el (message-save-drafts): New function. + To save drafts in network code. + (message-save-buffer): New variable. + + * lisp/pop3-fma.el: Require `mel-b-el' if `mel-b' does not exist. + +1998-10-23 Katsumi Yamaoka + + * lisp/gnus-msg.el (gnus-message-make-user-agent): New function. + +1998-10-21 Katsumi Yamaoka + + * lisp/gnus-xmas.el (gnus-tilde-pad-form): Guard for non string + symbol. + +1998-10-17 Tatsuya Ichikawa + + * lisp/pop3-fma.el (pop3-fma-init-message-hook): Change + message-send-hook to mime-edit-translate-hook. + +1998-10-14 Katsumi Yamaoka + + * 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. + +1998-10-13 Katsumi Yamaoka + + * 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. + + * lisp/nnheader.el (nnheader-Y-or-n-p): Rewrite for Emacs 19 or + later except for XEmacs. + +1998-10-08 Katsumi Yamaoka + + * 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 (nnheader-Y-or-n-p): New function. + +1998-10-07 Yoshiki Hayashi + + * lisp/nnagent.el (nnagent-open-server): Small bug fix. + +1998-10-07 Keiichi Suzuki + + * TODO.ja: New file. + +1998-10-05 Yoshiki Hayashi + + * lisp/gnus.el (gnus-info-filename): New variable. + (gnus-info-find-node): Use `gnus-info-filename' and + `current-language-environment'. + +1998-10-03 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'. + +1998-10-01 Tatsuya Ichikawa + + * lisp/pop3-fma.el (pop3-fma-movemail): Bug fix. + Delete variable pop3-fma-movemail options. + Add new variabel pop3-fma-commandline-arguments. + +1998-09-30 MORIOKA Tomohiko + + * lisp/message.el (message-make-user-agent): New implementation. + +1998-08-25 Shuhei KOBAYASHI + + * lisp/gnus-msg.el (gnus-bug-message): About Semi-gnus. + (gnus-extended-version): Return gnus version only. + (gnus-bug): Add Semi-gnus developers to recipients. + + * lisp/message.el (message-make-user-agent): New function. + (message-generate-headers): Use it. + +1998-06-12 Shuhei KOBAYASHI + + * lisp/message.el (message-required-news-headers): `X-Newsreader' + was replaced by `User-Agent'. + (message-required-mail-headers): `X-Mailer' was replaced by + `User-Agent'. + (message-header-format-alist): `X-Mailer' and `X-Newsreader' were + replaced by `User-Agent'. + (message-generate-headers): Ditto. + + (message-user-agent): New variable. + (message-newsreader): Replaced by `message-user-agent'. + (message-mailer): Ditto. + (message-mode): `message-mailer' and `message-newsreader' were + replaced by `message-user-agent'. + + * lisp/gnus-msg.el (gnus-inews-add-send-actions): `message-mailer' + and `message-newsreader' were replaced by `message-user-agent'. + (gnus-extended-version): Generate "PRODUCT/VERSION" style strings. + + * lisp/gnus-soup.el (gnus-soup-send-packet): `message-mailer' and + `message-newsreader' were replaced by `message-user-agent'. + +1998-09-17 Tatsuya Ichikawa + + * 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-09-26 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.8.19. + + * Sync up with Gnus 5.6.44. + +1998-09-16 Katsumi Yamaoka + + * Makefile.in: Add entry `info-ja'. + * texi/Makefile.in: Add entry `ja'. + +1998-09-11 MORIOKA Tomohiko + + * lisp/message.el (message-send): Don't call + `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'. + +1998-08-27 Tatsuya Ichikawa + + * lisp/gnus.el (gnus-version-number): Update to 6.8.16. + + * Sync up with Gnus 5.6.41. + +1998-08-26 Katsumi Yamaoka + + * lisp/gnus-spec.el (gnus-parse-simple-format): Use + `gnus-tilde-pad-form' instead of the padding faculty of `format' + under XEmacs-mule. + + * lisp/gnus-xmas.el + (gnus-xmas-redefine): Redifine `gnus-truncate-string', + `gnus-tilde-max-form' and `gnus-tilde-cut-form' for XEmacs-mule. + (gnus-xmas-define): New function 'gnus-tilde-pad-form' for + XEmacs-mule. + +1998-08-26 Shuhei KOBAYASHI + + * lisp/gnus-art.el (gnus-article-narrow-to-signature): + Removed TM stuff. + (gnus-article-display-mime-message): + Set `mime-button-mother-dispatcher' in correct buffer. + (gnus-url-mailto): Use `gnus-setup-message'. + (gnus-button-mailto): Ditto. + (gnus-button-reply): Ditto. + + * lisp/gnus-ems.el (gnus-mule-max-width-function): Removed. + (gnus-truncate-string): Use `truncate-string-to-width' if available. + (gnus-tilde-max-form): New implementation. + (gnus-tilde-cut-form): Ditto. + + * lisp/gnus-msg.el (gnus-summary-mail-digest): New function. + (gnus-summary-post-digest): New function. + + * lisp/gnus-sum.el (gnus-summary-make-menu-bar): Use + `gnus-summary-mail-digest' and `gnus-summary-post-digest' instead + of `gnus-uu-digest-mail-forward' and `gnus-uu-digest-post-forward'. + + * lisp/gnus-util.el (gnus-truncate-string): Ignore more than two + arguments. + + * lisp/message.el (message-forward-end-separator): Use + `text/plain' tag. + +1998-08-23 Shuhei KOBAYASHI + + * lisp/message.el: Suppress some byte-compile warnings. + (message-make-forward-subject): Failed to sync. + (message-setup): Ditto. + (message-clone-locals): Modify regexp. + +1998-08-23 Shuhei KOBAYASHI + + * lisp/gnus-agent.el (gnus-agent-braid-nov): Use + `nnheader-insert-file-contents'. + + * lisp/gnus-i18n.el (gnus-set-summary-default-charset): Sync up + with "akr" branch. + +1998-08-23 Tatsuya Ichikawa + + * lisp/gnus.el (gnus-version-number): Update to 6.8.15. + + * Sync up with Gnus 5.6.39. + + * lisp/pop3-fma.el (pop3-fma-movemail): Enable to get from APOP server. + (pop3-fma-set-pop3-password) Enable to get from APOP server. + +1998-08-20 Yoshiki Hayashi + + * lisp/message.el (message-clone-locals): Add `user-full-name' + and `user-mail-address' to regexp. + +1998-08-20 Tatsuya Ichikawa + + * 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. + (message-original-frame): New variable. + (message-use-multi-frames): New variable. + (message-delete-frame-on-exit): New variable. + (message-send-and-exit): Delete frame which made for editing + message. + (message-kill-buffer): Ditto. + (message-delete-frame): New function. + (message-pop-to-buffer): Make new frame when edit message. + +1998-08-18 Tatsuya Ichikawa + + * 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. + +1998-08-16 Tatsuya Ichikawa + + * 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. + + * 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. + +1998-08-10 Shuhei KOBAYASHI + + * lisp/gnus.el (gnus-version-number): Update to 6.8.7. + +1998-08-06 Katsumi Yamaoka + + * 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 + correctly in Gnus summaly. + +1998-08-05 Keiichi Suzuki + + * lisp/gnus-start.el (gnus-read-init-file): Don't restrict + `coding-system-for-read' by `binary' when loading `.gnus'. + +1998-08-04 Tatsuya Ichikawa + + * lisp/gnus.el (gnus-version-number): Update to 6.8.5. + + * Sync up with Gnus 5.6.28. + +1998-07-27 Tatsuya Ichikawa + + * lisp/gnus.el (gnus-version-number): Update to 6.8.4. + + * Sync up with Gnus 5.6.27. + +1998-07-27 Yoshiki Hayashi + + * texi/message-ja.texi: Japanese translation of "message.texi". + +1998-07-26 Tatsuya Ichikawa + + * lisp/gnus.el (gnus-version-number): Update to 6.8.3. + + * Sync up with Gnus 5.6.26. + +1998-07-23 Shuhei KOBAYASHI + + * lisp/gnus.el (gnus-version-number): Update to 6.8.2. + (gnus-version): Change to "Semi-gnus". Change comment format. + +1998-07-21 Keisuke Mori + + * texi/gnus-ja.texi: Add "Appendices". + +1998-07-21 Yoshiki Hayashi + + * texi/gnus-ja.texi: Add "Appendices". + +1998-07-16 Shuhei KOBAYASHI + + * lisp/gnus.el (gnus-version-number): Update to 6.8.1. + + * Sync up with Gnus 5.6.24. + +1998-07-10 Keiichi Suzuki + + * lisp/gnus-ems.el (gnus-mule-cite-add-face): Fix problem when multi + bytes charactors are used in cite prefix. (for Emacs 20.1 and 20.2) + (gnus-ems-redefine): for Emacs 20.1 and 20.2 + + * lisp/gnus-cite.el (gnus-cite-add-face): Abolish my last bogus change. + +1998-07-09 Keiichi Suzuki + + * lisp/gnus-cite.el (gnus-cite-add-face): Fix problem when multi + bytes charactors are used in cite prefix. + +1998-07-07 Yoshiki Hayashi + + * texi/gnus-ja.texi: Add "The End". + +1998-07-06 Keisuke Mori + + * texi/gnus-ja.texi: Add "Various". + +1998-07-06 Yoshiki Hayashi + + * texi/gnus-ja.texi: Add "Various". + * texi/gnus-ja.texi: Sync up with Gnus 5.6.22 + +1998-07-02 MORIOKA Tomohiko + + * lisp/message.el (message-header-format-alist): Repair to use + `message-fill-references' for References. + +1998-07-01 MORIOKA Tomohiko + + * lisp/gnus-art.el (gnus-article-header-presentation-method): + Delete nil optional arguments. + - Delete setting for `mime-raw-representation-type-alist'. + +1998-07-01 MORIOKA Tomohiko + + * lisp/gnus.el (gnus-version-number): Update to 6.8.0. + (gnus-version): Modify for FLIM 1.8. + + * lisp/gnus-art.el (gnus-article-header-presentation-method): + Modify for FLIM 1.8. 1998-06-30 Keisuke Mori @@ -15,7 +583,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. @@ -88,9 +656,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 @@ -175,9 +743,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 @@ -223,7 +791,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. @@ -268,7 +836,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 @@ -291,8 +859,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 @@ -315,7 +883,7 @@ 1998-04-25 MORIOKA Tomohiko * README.semi (How to get? (via CVS)): Modify descriptions about - TAG. + TAG. 1998-04-23 MORIOKA Tomohiko @@ -324,11 +892,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 @@ -350,7 +918,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 @@ -361,7 +929,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 @@ -386,7 +954,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 @@ -427,14 +995,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. @@ -443,25 +1011,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 @@ -500,7 +1068,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. @@ -542,7 +1110,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 @@ -551,16 +1119,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 @@ -570,21 +1138,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 @@ -607,15 +1175,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 @@ -650,7 +1218,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 @@ -669,27 +1237,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 @@ -702,7 +1270,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/GNUS-NEWS b/GNUS-NEWS index a0ba334..0c5b11a 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -1,11 +1,102 @@ ** Gnus changes. -*** Gnus is now a MIME-capable reader. See the manual for details. +*** The Gnus distribution no longer bundles Custom and Widget. +If your Emacs doesn't come with these libraries, fetch them from +. You also then need to +add the following to the lisp/dgnushack.el file: -*** gnus-auto-select-first can now be a function to be -called to position point. + (push "~/lisp/custom" load-path) -*** The user can now decide which extra headers should be included in -summary buffers and NOV files. +Modify to suit your needs. +*** New functionality for using Gnus as an offline newsreader has been +added. A plethora of new commands and modes have been added. See the +Gnus manual for the full story. +*** The nndraft backend has returned, but works differently than +before. All Message buffers are now also articles in the nndraft +group, which is created automatically. + +*** `gnus-alter-header-function' can now be used to alter header +values. + +*** `gnus-summary-goto-article' now accept Message-ID's. + +*** A new Message command for deleting text in the body of a message +outside the region: `C-c C-v'. + +*** You can now post to component group in nnvirtual groups with +`C-u C-c C-c'. + +*** `nntp-rlogin-program' -- new variable to ease customization. + +*** `C-u C-c C-c' in `gnus-article-edit-mode' will now inhibit +re-highlighting of the article buffer. + +*** New element in `gnus-boring-article-headers' -- `long-to'. + +*** `M-i' symbolic prefix command. See the section "Symbolic +Prefixes" in the Gnus manual for details. + +*** `L' and `I' in the summary buffer now take the symbolic prefix +`a' to add the score rule to the "all.SCORE" file. + +*** `gnus-simplify-subject-functions' variable to allow greater +control over simplification. + +*** `A T' -- new command for fetching the current thread. + +*** `/ T' -- new command for including the current thread in the +limit. + +*** `M-RET' is a new Message command for breaking cited text. + +*** \\1-expressions are now valid in `nnmail-split-methods'. + +*** The `custom-face-lookup' function has been removed. +If you used this function in your initialization files, you must +rewrite them to use `face-spec-set' instead. + +*** Cancelling now uses the current select method. Symbolic prefix +`a' forces normal posting method. + +*** New command to translate M******** sm*rtq**t*s into proper text +-- `W d'. + +*** For easier debugging of nntp, you can set `nntp-record-commands' +to a non-nil value. + +*** nntp now uses ~/.authinfo, a .netrc-like file, for controlling +where and how to send AUTHINFO to NNTP servers. + +*** A command for editing group parameters from the summary buffer +has been added. + +*** A history of where mails have been split is available. + +*** A new article date command has been added -- `article-date-iso8601'. + +*** Subjects can be simplified when threading by setting +`gnus-score-thread-simplify'. + +*** A new function for citing in Message has been added -- +`message-cite-original-without-signature'. + +*** `article-strip-all-blank-lines' -- new article command. + +*** A new Message command to kill to the end of the article has +been added. + +*** A minimum adaptive score can be specified by using the +`gnus-adaptive-word-minimum' variable. + +*** The "lapsed date" article header can be kept continually +updated by the `gnus-start-date-timer' command. + +*** Web listserv archives can be read with the nnlistserv backend. + +*** Old dejanews archives can now be read by nnweb. + +*** Byte-compilation of user-specs now works under XEmacs. + +*** `gnus-posting-styles' has been re-activated. diff --git a/Makefile.in b/Makefile.in index c6205a8..f486fd0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1,3 +1,5 @@ +prefix = @prefix@ +datadir = @datadir@ lispdir = @lispdir@ srcdir = @srcdir@ @@ -23,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 @@ -37,7 +42,7 @@ x: distclean: make clean - rm -r *~ + rm -rf *~ for i in lisp texi; do (cd $$i; make distclean); done rm -f config.log config.status Makefile diff --git a/README-gnus-bbdb.en b/README-gnus-bbdb.en new file mode 100644 index 0000000..b99d805 --- /dev/null +++ b/README-gnus-bbdb.en @@ -0,0 +1,104 @@ +-*- mode: text; fill-column: 70; -*- + +--- + If BBDB is used then, bbdb-gnus.elc can't be shared with them before +Semi-gnus 6.8.X. It is necessary to byte-compile it again. + +;; It is a simple way that only bbdb-gnus.el is byte-compiled after +;; gnus starts. + +--- +gnus-bbdb.el + + This is the BBDB API module for Semi-gnus. `mime-bbdb' should not be +necessary for Semi-gnus, if that module were used. + + You need FLIM 1.11.3 or later. + + If you are using bbdb-auto-notes-hook, the patch listed at the end +of this file should be applied. If not, it might not. + + EXAMPLE: + +;; You need to set nothing for `mime-bbdb'. +;(setq mime-bbdb/use-mail-extr nil) +;(eval-after-load "mail-extr" '(require 'mime-bbdb)) + +(require 'bbdb) +(require 'gnus-bbdb) +(bbdb-initialize 'sc) ;; 'Gnus or 'gnus should be deleted. +(add-hook 'gnus-startup-hook 'gnus-bbdb-insinuate) + + If you would like to decode the quoted encoded words forcibly, even +though FLIM does not decode them, put the following lines in your +.gnus file. + +(setq gnus-bbdb/decode-field-body-function + (function + (lambda (field-body field-name) + (eword-decode-string field-body)))) + +--- + This is a patch for bbdb.el / bbdb-hooks.el. + +------ cut here ------ cut here ------ cut here ------ cut here ------ +--- bbdb-hooks.el~ Tue Oct 13 03:13:50 1998 ++++ bbdb-hooks.el Fri Oct 30 17:05:53 1998 +@@ -352,12 +352,22 @@ + (marker (bbdb-header-start)) + field pairs fieldval ; do all bindings here for speed + regexp string notes-field-name notes +- replace-p replace-or-add-msg) ++ replace-p replace-or-add-msg ++ extract-field-value-funtion) + (set-buffer (marker-buffer marker)) + (save-restriction +- (widen) +- (goto-char marker) +- (if (and (setq fieldval (bbdb-extract-field-value "From")) ++ (let ((function-list bbdb-extract-field-value-function-list) ++ function) ++ (or (progn ++ (while (and (not extract-field-value-funtion) ++ (setq function (pop function-list))) ++ (setq extract-field-value-funtion (funcall function))) ++ extract-field-value-funtion) ++ (progn ++ (widen) ++ (goto-char marker) ++ (setq extract-field-value-funtion 'bbdb-extract-field-value)))) ++ (if (and (setq fieldval (funcall extract-field-value-funtion "From")) + (string-match (bbdb-user-mail-names) fieldval)) + ;; Don't do anything if this message is from us. Note that we have + ;; to look at the message instead of the record, because the record +@@ -368,7 +378,7 @@ + (goto-char marker) + (setq field (car (car ignore-all)) + regexp (cdr (car ignore-all)) +- fieldval (bbdb-extract-field-value field)) ++ fieldval (funcall extract-field-value-funtion field)) + (if (and fieldval + (string-match regexp fieldval)) + (setq ignore t) +@@ -382,7 +392,7 @@ + pairs (cdr (car rest)) ; (REGEXP . STRING) or + ; (REGEXP FIELD-NAME STRING) or + ; (REGEXP FIELD-NAME STRING REPLACE-P) +- fieldval (bbdb-extract-field-value field)) ; e.g., Subject line ++ fieldval (funcall extract-field-value-funtion field)) ; e.g., Subject line + (if fieldval + (while pairs + (setq regexp (car (car pairs)) +--- bbdb.el~ Tue Oct 13 03:14:55 1998 ++++ bbdb.el Fri Oct 30 17:05:53 1998 +@@ -620,6 +620,7 @@ + (defvar bbdb-showing-changed-ones nil) + (defvar bbdb-modified-p nil) + (defvar bbdb-elided-display nil) ++(defvar bbdb-extract-field-value-function-list nil) + + (defvar bbdb-debug t) + (defmacro bbdb-debug (&rest body) +------ cut here ------ cut here ------ cut here ------ cut here ------ + +--- diff --git a/README-gnus-bbdb.ja b/README-gnus-bbdb.ja new file mode 100644 index 0000000..18f3e9b --- /dev/null +++ b/README-gnus-bbdb.ja @@ -0,0 +1,104 @@ +-*- mode: text; fill-column: 70; -*- + +--- +BBDB $B$r;HMQ$5$l$F$$$kJ}$O!"(B bbdb-gnus.elc $B$r(B Semi-gnus 6.8.X $B0JA0$N$b(B +$B$N$H6&M-$9$k$3$H$O$G$-$^$;$s!#I,$:!"(B byte-compile $B$7D>$7$F$/$@$5$$!#(B + +;; gnus $B$r5/F0$7$?$"$H$G!"(B bbdb-gnus.el $B$N$_$r(B byte-compile $B$9$k$H$$$&(B +;; $B$N$,$*l9g$K$O(B mime-bbdb $B$,ITMW$K$J$j$^$9!#(B + +1.11.3 $B0J9_$N(B FLIM $B$,I,MW$G$9!#(B + +bbdb-auto-notes-hook $B$r;HMQ$7$F$$$J$$J}$K$OITMW$G$9$,!";HMQ$7$F$$$kJ}(B +$B$O(B bbdb.el / bbdb-hooks.el $B$K$3$N%U%!%$%k$N:G8e$K$"$k(B patch $B$r$"$F$kI,(B +$BMW$,$"$j$^$9!#(B + +$B@_DjNc(B: + +;; mime-bbdb $B$K4X$9$k@_Dj$OITMW$G$9!#(B +;(setq mime-bbdb/use-mail-extr nil) +;(eval-after-load "mail-extr" '(require 'mime-bbdb)) + +(require 'bbdb) +(require 'gnus-bbdb) +(bbdb-initialize 'sc) ;; 'gnus / 'Gnus $B$O$O$:$7$F$/$@$5$$!#(B +(add-hook 'gnus-startup-hook 'gnus-bbdb-insinuate) + +FLIM $B$G$O(B quote $B$5$l$?(B eword encoded word $B$O(B decode $B$5$l$^$;$s$,!"$=$l(B +$B$r6/@)E*$K(B decode $B$7$?$$>l9g$K$O!" Semi-gnus 6.0.0 + : : + : himi <-- 6.0.7 + : ichikawa <-- 6.0.8 + : akr <-- 6.2.3 + : shuhei-k <-- 6.3.1 +Gnus 5.6.11 ------> 6.3.3 + : 6.4.0 (for SEMI 1.5) + : (6.4.?)------> for SEMI 1.5 + : | \ + : | \ +(Synch with original Gnus | ---> for SEMI 1.6 + was done many times, but (6.4.?)------> 6.5 (for SEMI 1.7) + we don't include them.) | / 6.5.0 + : | (?)/ + : | <--- + : (6.5.?)------> 6.6 (for SEMI 1.8, FLIM 1.7) + : | \ 6.6.0 stable branch + : | \ + : | ---> 6.7 (for SEMI 1.8, FLIM 1.7) + : | 6.7.0 develop branch + : sync | : +Gnus 5.6.22 ------> | feedback 6.7.7 + : (6.7.8)<------ 6.7.8 + : | \ + : | \ + : | ---> 6.8 (for SEMI 1.8, FLIM 1.8) + : sync | 6.8.0 +Gnus 5.6.24 ------> | 6.8.1 + : : : + : : : +======================================================================== + +The Vendor Branch + + Original version of Gnus. + Each version has a tag of the form "qgnus-0_XY" or "gnus-5_X_Y" or + "pgnus-0_XY". + + The branch tag for the vendor branch is "larsi". + +The Main Trunk + + Semi-gnus was developed on the main trunk until current branch- + management plan (See "Public Branches" below) was introduced. + Each version has a tag of the form "gnus-6_N2_N3". (0 < N2 < 5) + +Public Branches + + Current main stream of Semi-gnus development. + + [Goal and policy of public branches here ???] + + Each branch has a tag of the form "gnus-N1_N2" and each version + has a tag of the form "gnus-N1_N2_N3". + + N1, N2, and N3 are changed by the following rules. + + N1 will be incremented if any fundamental architecture change is + made. Of cource, in this case, N2 and N3 will be reset to zero. + + N2 will be incremented and new branch will be made if any "major + changes" are made. "major changes" include API changes, major + version up of original Gnus, or synchronization with original Gnus + which requires design decision. + + N3 will be incremented if some "minor changes" are made. "minor + changes" include small bug fix or synchronization with original Gnus + without design decision. + + The following branch tags are currently available. + + for-semi-1_5 Semi-gnus for SEMI 1.5 API + for-semi-1_6 Semi-gnus for SEMI 1.6 API + gnus-6_5 Semi-gnus for SEMI 1.7 API + gnus-6_6 Semi-gnus for SEMI 1.8, FLIM 1.7 API (stable) + gnus-6_7 Semi-gnus for SEMI 1.8, FLIM 1.7 API (develop) + gnus-6_8 Semi-gnus for SEMI 1.8, FLIM 1.8 API + +Personal Branches + + Some Semi-gnus developers have their own "personal branches". + Each personal branch may have its own goal and/or policy. + See README.${tag} (if exists) for information of each branch. + + The following branch tags are curretly available. + + himi Owner: Miyashita Hisashi + ichikawa Owner: Tatsuya Ichikawa + akr Owner: Tanaka Akira + shuhei-k Owner: Shuhei KOBAYASHI + +"semi-gnus" Tag + + Was assigned to the latest stable version. + Currently not maintained. (XXX: ???) + +"for-semi-N1_N2" Tags + + Were assigned to corresponding version of SEMI API N1.N2. + We will not use this convention any longer. (XXX: ???) diff --git a/README.branch.ja b/README.branch.ja new file mode 100644 index 0000000..d458624 --- /dev/null +++ b/README.branch.ja @@ -0,0 +1,110 @@ +README.branch.ja --- branch $B$H(B tag $B$N@bL@(B ($BAp9F(B) +======================================================================== + +Semi-gnus revision tree (1998-07-16) + + vendor personal main trunk public + branch branches branches +------------------------------------------------------------------------ +qGnus 0.?? ------> Semi-gnus 6.0.0 + : : + : himi <-- 6.0.7 + : ichikawa <-- 6.0.8 + : akr <-- 6.2.3 + : shuhei-k <-- 6.3.1 +Gnus 5.6.11 ------> 6.3.3 + : 6.4.0 (for SEMI 1.5) + : (6.4.?)------> for SEMI 1.5 + : | \ + : | \ +($B85$N(B Gnus $B$H$N(B Sync $B$O2?EY(B | ---> for SEMI 1.6 + $B$b$J$5$l$F$$$^$9$,!"$3$3$K(B (6.4.?)------> 6.5 (for SEMI 1.7) + $B$O=q$-$^$;$s!#(B) | / 6.5.0 + : | (?)/ + : | <--- + : (6.5.?)------> 6.6 (for SEMI 1.8, FLIM 1.7) + : | \ 6.6.0 stable branch + : | \ + : | ---> 6.7 (for SEMI 1.8, FLIM 1.7) + : | 6.7.0 develop branch + : sync | : +Gnus 5.6.22 ------> | feedback 6.7.7 + : (6.7.8)<------ 6.7.8 + : | \ + : | \ + : | ---> 6.8 (for SEMI 1.8, FLIM 1.8) + : sync | 6.8.0 +Gnus 5.6.24 ------> | 6.8.1 + : : : + : : : +======================================================================== + +The Vendor Branch + + Gnus $B$N85$N%P!<%8%g%s$G$9!#(B + $B$=$l$>$l$N%P!<%8%g%s$O(B "qgnus-0_XY" $B$d(B "gnus-5_X_Y" $B$d(B + "pgnus-0_XY" $B$H$$$&7A<0$N(B tag $B$,IU$$$F$$$^$9!#(B + + vendor branch $B$N(B branch tag $B$O(B "larsi" $B$G$9!#(B + +The Main Trunk + + $B8=:_$N(B branch $B4IM}7W2h$,F3F~$5$l$k$^$G!"(BSemi-gnus $B$O(B main trunk $B$G(B + $B3+H/$5$l$F$$$^$7$?(B ($B2<$N(B "Public Branches" $B$rFI$s$G$/$@$5$$(B)$B!#$=$l(B + $B$>$l$N%P!<%8%g%s$O(B "gnus-6_N2_N3" $B$H$$$&7A<0$G$9!#(B(0 < N2 < 5) + +Public Branches + + $B8=:_$N(B Semi-gnus $B3+H/$N$l$N(B branch $B$O(B "gnus-N1_N2" $B$H$$$&7A<0$N(B tag $B$,IU$$$F$$$F!"(B + $B$=$l$>$l$N%P!<%8%g%s$O(B "gnus-N1_N2_N3" $B$H$$$&7A<0$N(B tag $B$,IU$$$F$$(B + $B$^$9!#(B + + N1, N2, N3 $B$O0J2<$N5,B'$K=>$C$FJQ99$5$l$^$9!#(B + + N1 $B$O4pACE*$J;EAH$_$NJQ99$,$J$5$l$?$H$-$KA}$d$5$l$^$9!#$b$A$m$s!"(B + $B$3$N>l9g$O(B N2 $B$H(B N3 $B$O(B 0 $B$K$J$j$^$9!#(B + + N2 $B$O?7$7$$(B branch $B$,(B "$B.$5$JJQ99(B" $B$,$J$5$l$?$H$-$KA}$d$5$l$^$9!#(B"$B>.$5$JJQ99(B" $B$O>.(B + $B$5$J%P%0=$@5$d!"@_7W$N7hDj$rH<$o$J$$85$N(B Gnus $B$H$NF14|$J$I$G$9!#(B + + $B8=:_$O0J2<$N(B branch tag $B$,;HMQ2DG=$G$9!#(B + The following branch tags are currently available. + + for-semi-1_5 Semi-gnus for SEMI 1.5 API + for-semi-1_6 Semi-gnus for SEMI 1.6 API + gnus-6_5 Semi-gnus for SEMI 1.7 API + gnus-6_6 Semi-gnus for SEMI 1.8, FLIM 1.7 API (stable) + gnus-6_7 Semi-gnus for SEMI 1.8, FLIM 1.7 API (develop) + gnus-6_8 Semi-gnus for SEMI 1.8, FLIM 1.8 API + +Personal Branches + + Semi-gnus $B3+H/$l$N(B personal branch $B$OL\I8!"$l$N(B branch $B$N>pJs$O(B ($BB8:_$9$k$J$i$P!"(B) README.${tag} $B$r(B + $BFI$s$G$/$@$5$$!#(B + + $B0J2<$N(B branch tag $B$,8=:_;HMQ2DG=$G$9!#(B + + himi Owner: Miyashita Hisashi + ichikawa Owner: Tatsuya Ichikawa + akr Owner: Tanaka Akira + shuhei-k Owner: Shuhei KOBAYASHI + +"semi-gnus" Tag + + $B$3$l$O:G?7$N0BDjHG$K3d$jEv$F$i$l$F$$$^$7$?!#8=:_$O0];}$5$l$F$$$^$;(B + $B$s!#(B(XXX: ???) + +"for-semi-N1_N2" Tags + + $B$3$l$O(B SEMI API N1.N2 $B$KBP1~$9$k%P!<%8%g%s$K3d$jEv$F$i$l$F$$$^$7$?!#(B + $B$3$N=,47$O$b$&;H$o$l$^$;$s!#(B(XXX: ???) diff --git a/README.semi b/README.semi index b297fe7..92809fe 100644 --- a/README.semi +++ b/README.semi @@ -8,13 +8,14 @@ all features of Gnus and gnus-mime, so there are no need to install Gnus to use it, and you must not use gnus-mime for SEMI. It requires SEMI package, so please get and install SEMI package -before to install it. - +before to install it. You can get SEMI from +ftp://ftp.jaist.ac.jp/pub/elisp/semi/ +Required environment for SEMI is written in README.en of SEMI package. How to get? (via CVS) ===================== -(0) cvs login +(0) cvs login (first time only) % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ login @@ -52,12 +53,15 @@ Major tags are following: himi himi branch ichikawa ichikawa branch + Based on pGnus. akr akr branch shuhei-k shuhei-k branch Mail-Followup-To/Mail-Reply-To, gnus-cache fix. +For more detailed information, please read README.branch. + How to get? (via ftp) ===================== @@ -92,4 +96,5 @@ Semi-gnus. To join the Semi-gnus ML, send an empty e-mail to semi-gnus-ja-help@meadow.scphys.kyoto-u.ac.jp (Japanese) In addition, we need developers. If you would like to develop it, -please send mail to cvs@chamonix.jaist.ac.jp. +please send mail to cvs@chamonix.jaist.ac.jp with your account name +and UNIX /etc/passwd style crypted password. diff --git a/README.semi.ja b/README.semi.ja new file mode 100644 index 0000000..c91c0a3 --- /dev/null +++ b/README.semi.ja @@ -0,0 +1,107 @@ +$B$3$N%Q%C%1!<%8$K$O(B Semi-gnus $B$,F~$C$F$$$^$9!#(B + +Semi-gnus $B$H$O!)(B +================== + + Semi-gnus $B$O(B SEMI $B$N$?$a$N(B gnus-mime $B$H(B Gnus $B$NAH9g$;$rCV$-49$($k$b(B +$B$N$G$9!#(BGnus $B$H(B gnus-mime $B$NA4$F$N5!G=$r;}$C$F$$$^$9$N$G!"$3$l$r;HMQ$9(B +$B$k$?$a$K(B Gnus $B$r%$%s%9%H!<%k$9$kI,MW$O$J$/!"(BSEMI $B$N$?$a$N(B gnus-mime $B$O(B +$B;HMQ$7$F$O$$$1$^$;$s!#(B + + SEMI $B%Q%C%1!<%8$rMW5a$7$^$9$N$G!"%$%s%9%H!<%k$9$kA0$K(B SEMI $B%Q%C%1!<(B +$B%8$r%$%s%9%H!<%k$7$F$/$@$5$$!#(BSEMI $B$O(B +ftp://ftp.jaist.ac.jp/pub/elisp/semi/ $B$+$iH$7$F$/$@$5$$!#(B + + +$B + +(3) update + + % cvs update [-r TAG] + +$Bo$KJ]\$7$/$O!"(BREADME.branch.ja $B$r;2>H$7$F$/$@$5$$!#(B + + +$B-Mh$N3HD%$r5DO@$7$?$j(B + $B$9$k$3$H$,$G$-$^$9!#(BSemi-gnus ML $B$K;22C$9$k$?$a$K$O(B + + semi-gnus-en-help@meadow.scphys.kyoto-u.ac.jp ($B1Q8l(B) + semi-gnus-ja-help@meadow.scphys.kyoto-u.ac.jp ($BF|K\8l(B) + + $B$K6u$N%a!<%k$rAw$C$F$/$@$5$$!#(B + + $B2C$($F!"3+H/l9g$O!"(B +cvs@chamonix.jaist.ac.jp $B$K%"%+%&%s%HL>$H(B UNIX $B$N(B /etc/passwd $B$NMM<0$G(B +$B0E9f2=$5$l$?%Q%9%o!<%I$r%a!<%k$rAw$C$F$/$@$5$$!#(B diff --git a/TODO.ja b/TODO.ja new file mode 100644 index 0000000..0dbd5cf --- /dev/null +++ b/TODO.ja @@ -0,0 +1,116 @@ +-*- mode: text; left-margin: 4; fill-column: 70; -*- + +To do list. + +;; $BBP:v:Q$N$b$N$O!"E,Ev$J%?%$%_%s%0(B($B%j%j!<%9;~(B?)$B$G:o=|$7$F$/$@$5$$!#(B +;; $B$^$?!"3F(B personal branch $B$GBP:vCf!"$^$?$OBP:v:Q$N$b$N$K4X$7$F$O$=$N(B +;; $B;]$r5-:\$7$F$/$@$5$$!#(B + +------------ $BITL@(B ------------ + +*1998/10/02-2 $B@_Dj%U%!%$%k72FI$_9~$_;~$N(B coding-system $BLdBj(B + +----------- $BL$BP:v(B ----------- + +*1998/09/25-1 message/partial $B$N7k9g5!G=$N2~NI(B + + Subject $B$G(B summary $B$r8!:w$9$kBe$o$j$K!"(Bgnus-newsgroup-headers $B$J$I(B + $B$N>pJs$r;H$C$F!"3Nl9g!"DL>o$N%F%-%9%H!&%G!<(B + $B%?$H$7$FJ]B8$7$F$$$k$,!"$3$l$r(B network $B7A<0$GJ]B8$9$k$h$&$KJQ99$7!"(B + $B:FJT=8$O(B decode $B$7$F$+$i9T$$!"Aw?.$O$=$N$^$^$N7A<0$G9T$&$h$&$K$9$k!#(B + +*1998/10/02-4 Offline $B;~$K:n@.$7$?%a%C%;!<%8$N(B Message-Id $BLdBj(B + + Offline $B;~$K%a%C%;!<%8$r:n@.$7$?>l9g!"(B Message-Id $B$N7A<0$,ITEv$J$b(B + $B$N$K$J$C$F$7$^$&!#(B + +*1998/10/02-6 smtpmail.el $B:o=|(B + + $B8=:_!"(B Semi-gnus $B$G$O(B smtpmail.el $B$r;HMQ$7$F$$$J$$$N$G:o=|$9$k!#(B + +*1998/10/02-7 smtp.el $B0\F0(B + + smtp.el $B$O!"B>$N(B package $B$G$b;HMQ$9$k2DG=@-$,$"$k$N$G!"(B FLIM $B$K0\(B + $BF0$9$k!#(B + $B$=$NA0$K!"(B shuhei-k $B;^$N(B smtp.el $B$H$N;EMM$r6&DL2=$9$kI,MW$,$"$k!#(B + +*1998/10/02-10 $B$O$8$a$F(B gnus-agent $B$r;HMQ$7$?$H$-$NLdBj(B + + $B0J2<$N$h$&$JJ}K!(B($B5/F0;~$+$i(B unplugged $B$K$9$k(B)$B$G!"$O$8$a$F(B + gnus-agent $B$r;HMQ$7$?>l9g!"5/F0;~$K!H(Bnntp open error$B!I$H$J$k!#(B + + (gnus-agentize) + (gnus-agent-toggle-plugged nil) + + [$BJdB-(B] + + .emacs $B$K(B (setq gnus-plugged nil) + .gnus.el $B$K(B (gnus-agentize) $B$H$7$F;HMQ$7$?J}$,$h$$$N$G$O$J$$$+(B? + +*1998/10/02-11 message.el $B$NFHN)$7$?;HMQ;~$NLdBj(B + + message.el $B$OC1FH(B(Semi-gnus$B$,5/F0$5$l$F$$$J$$>uBV(B)$B$G;HMQ$5$l$k2DG=(B + $B@-$,$"$k$N$G!"(B Semi-gnus $BK\BN$K0MB8$7$F$$$kItJ,$rGS=|$9$k!#(B + +*1998/10/02-12 $B%X%C%@!%V%i%s%A$GBP:vCf$^$?$O!"BP:v:Q$G(B gnus-V1_V2 $B;^$Kl9g!"A4%Q!<%H$N(B + Messge-Id $B$,F1$8$b$N$K$J$C$F$7$^$&!#(B + + [$BBP:v(B] + + $B8=>u$G$O!"3F%a%C%;!<%8$K(B Message-Id $B$rIU2C$7$J$$$H$$$&J}K!$GBP:v:Q!#(B + + [$B0F(B] + + $B$?$@$7!"$=$l$>$l$K(B Message-Id $B$rIU2C$9$k$C$?7A<0$KJQ99$9$k!#(B + + 1998/11/02 - $B40N;(B + +*1998/10/03-2 Info (gnus/gnus-ja) $B$NA*Br(B + + $B40N;(B + +*1998/10/02-5 Edit article $B;~$K%a%C%;!<%8$rGK2u$9$kLdBj(B + + 1998/11/12 - $B40N;(B diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 68e3957..459c782 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,935 @@ +Thu Nov 19 04:37:45 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.45 is released. + +1998-11-08 00:42:58 Andrew Innes + + * nntp.el (nntp-request-group): Allow for error codes. + +1998-10-12 Andrew Innes + + * gnus/nntp.el (nntp-possibly-change-group): Allow for unexpected + responses to GROUP command, since this may be called from a timer + with quit inhibited. + +1998-10-11 01:16:14 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-expire): Check (car expired). + +1998-10-02 04:49:27 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-generate-active): Ignore directories + that start with a dot. + +1998-10-01 07:42:40 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-article-group): Expand properly. + + * gnus-group.el (gnus-group-apropos): Also do non-active groups. + +1998-09-29 13:12:31 Lars Magne Ingebrigtsen + + * gnus-async.el (gnus-make-async-article-function): Don't use + push. + +Thu Sep 24 19:29:43 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.44 is released. + +1998-09-23 20:34:27 Markus Rost + + * gnus.el: Extend autoloads. + +1998-09-15 18:57:48 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-draft-send): Bind required headers to nil. + (gnus-draft-send): No. + +1998-09-14 15:16:42 Lars Magne Ingebrigtsen + + * message.el (message-fix-before-sending): Comment out invisible + text things. + +1998-09-14 14:30:09 Tatsuya Ichikawa + + * gnus-agent.el (gnus-agent-file-coding-system): Renamed. + +1998-09-13 Mike McEwan + + * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed + groups. + +1998-09-13 07:02:04 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-save-group-info): Create proper active + lines. + +1998-09-10 02:40:28 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-draft-edit-message): Save the buffer. + +Sun Sep 6 20:09:36 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.43 is released. + +1998-09-06 19:41:54 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-remove-thread): Unhide threads before + removing. + (gnus-data-compute-positions): Ditto. + +1998-08-31 11:40:13 Shuhei KOBAYASHI + + * nnmail.el (nnmail-date-to-time): Parse time locally if no + timezone. + +1998-08-31 11:21:53 Lars Magne Ingebrigtsen + + * gnus-srvr.el (gnus-browse-foreign-server): Protect against + out-of-range articles. + + * gnus-msg.el (gnus-summary-reply): Don't inhibit posting styles. + +1998-08-30 22:33:33 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-summary-increase-score): Temporary third + majuscle. + +1998-08-30 22:32:31 Dan Christensen + + * gnus-score.el (gnus-summary-increase-score): Score thread on + Message-ID. + +1998-08-29 02:46:00 Simon Josefsson + + * gnus-sum.el (gnus-summary-mark-article-as-read): + (gnus-summary-mark-article-as-unread): + (gnus-summary-mark-article): Call gnus-request-update-mark. + +1998-08-29 Mike McEwan + + * gnus-agent.el (gnus-agent-fetch-headers): Cater for when there's + no .agentview, all articles have been expired, or everything bar a + few downloaded arts have been expired. + (gnus-agent-expire): Mark *all* expired articles as read. + +Sat Aug 29 19:17:19 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.42 is released. + +1998-08-29 17:06:27 Simon Josefsson + + * gnus-sum.el (gnus-summary-make-menu-bar): Typo. + +1998-08-29 12:47:42 Tatsuya Ichikawa + + * gnus-agent.el: Use nnheader-insert-file-contents. + +1998-08-29 12:18:18 Lars Magne Ingebrigtsen + + * nnvirtual.el (nnvirtual-request-group): Update the right group. + +1998-08-27 16:46:38 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-data-compute-positions): Didn't work on hidden + threads. + + * nnvirtual.el (nnvirtual-request-group): Work when always + updating. + (nnvirtual-always-rescan): Default to t. + +Thu Aug 27 11:03:59 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.41 is released. + +1998-08-27 Mike McEwan + + * gnus-agent.el (gnus-agent-fetch-group-1): Leave the calculation + of `articles' to `gnus-agent-fetch-headers'. + (gnus-agent-fetch-headers): We only want headers that are after + the last entry in `gnus-group-alist'. + +1998-08-27 09:45:42 Lars Magne Ingebrigtsen + + * Makefile.in (warn): New. + + * gnus.el: Removed unreferenced bound variables all over. + + * gnus-group.el (gnus-update-group-mark-positions): Removed topic. + + * gnus-cus.el (gnus-group-customize): No part. + + * gnus-agent.el (gnus-category-line-format-alist): Renamed specs. + (gnus-category-insert-line): Use it. + +Thu Aug 27 09:29:53 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.40 is released. + +1998-08-27 09:19:31 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-mode): Only toggle plugged in group + mode. + +1998-08-27 07:25:47 Lars Balker Rasmussen + + * message.el (message-supersede): Check the right headers. + +1998-08-26 13:51:18 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-sort-threads): Changed level. + +1998-08-26 Mike McEwan + + * gnus-sum.el (gnus-build-all-threads): `save-excursion' and + `set-buffer' back to `gnus-summary-buffer' in order to access + buffer-local variables. + +1998-08-26 06:00:44 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-data-compute-positions): More and faster. + +1998-08-26 05:41:15 Matt Pharr + + * message.el (message-wash-subject): Remove more. + +1998-08-25 11:33:28 Tatsuya Ichikawa + + * gnus-cache.el (gnus-cache-overview-coding-system): New + variable. + +1998-08-25 08:23:05 Albert L. Ting + + * gnus-group.el (gnus-fetch-group-other-frame): New command. + +1998-08-25 07:24:51 Lars Magne Ingebrigtsen + + * gnus-uu.el (gnus-uu-grab-articles): Check for pseudos. + + * gnus-art.el (gnus-ignored-headers): More headers. + + * gnus-sum.el (gnus-summary-move-article): Update the right + group. + +1998-08-23 14:31:31 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-ignored-headers): More headers. + +1998-08-23 Mike McEwan + + * gnus-agent.el (gnus-agent-copy-nov-line): Return to beginning of + line before next read. + (gnus-agent-braid-nov): Remove redundant `let'. + +1998-08-22 10:40:54 Lars Magne Ingebrigtsen + + * gnus-art.el (article-display-x-face): Allow multiple X-Faces + under XEmacs. + +Sat Aug 22 10:28:25 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.39 is released. + +1998-08-22 10:06:03 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-ignored-headers): Added more headers. + +1998-08-21 02:49:56 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-type): Doc fix. + + * gnus-sum.el (gnus-summary-set-process-mark): Move to the right + article. + +1998-08-20 23:10:01 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-spool-file): Allow lists of files. + +1998-08-20 Per Starback + + * gnus/gnus-start.el (gnus-check-first-time-used): Change current + buffer before creating help group. + +1998-08-20 01:33:08 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-message-style-insertions): New variable. + (gnus-message-insert-stylings): New function. + (gnus-configure-posting-styles): Use them. + + * gnus-topic.el (gnus-topic-mode): Don't alter summary-exit-hook. + + * gnus-sum.el (gnus-select-newsgroup): Don't update group. + + * gnus-msg.el (gnus-setup-message): Bind message-mode-hook. + (gnus-inhibit-posting-styles): New variable. + (gnus-summary-reply): Use it. + (gnus-configure-posting-styles): Ditto. + + * gnus-group.el (gnus-group-suspend): Don't kill dribble buffer. + +Thu Aug 20 00:28:35 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.38 is released. + +1998-08-20 00:02:50 Lars Magne Ingebrigtsen + + * message.el (message-mail): Doc fix. + +1998-08-19 23:22:02 Bill Pringlemeir + + * messcompat.el (message-send-mail-function): Initialized from + send-mail-function. + +1998-08-19 23:20:42 Martin Larose + + * message.el (message-send-coding-system): New variable. + +1998-08-19 19:00:37 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-configure-posting-styles): Reinstated most of + old code. + + * gnus-start.el (gnus-save-newsrc-file): Use coding system. + +1980-06-08 03:53:56 Mike McEwan + + * gnus-agent.el (gnus-agent-braid-nov): Go to right place. + +1980-06-08 03:01:48 Shuhei KOBAYASHI + + * gnus-group.el (gnus-group-suspend): Fix. + +1998-08-18 00:25:11 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-cited-opened-text-button-line-format-alist): + New n spec. + + * gnus-group.el (gnus-group-suspend): Use mapcar. + +1998-08-17 14:35:33 Lars Magne Ingebrigtsen + + * gnus-ems.el (gnus-add-minor-mode): Set mode var. + + * gnus-start.el (gnus-slave-mode): New function. + + * gnus-msg.el (gnus-post-method): Work with current in nndraft. + +1998-08-16 23:30:14 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-request-article-this-buffer): Allow recursive + selection of nneething groups. + + * nneething.el (nneething-address): Renamed from directory. + +Sun Aug 16 18:59:41 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.37 is released. + +1998-08-16 14:52:43 Lars Magne Ingebrigtsen + + * gnus.el: Autoload gnus-summary-wide-reply. + + * gnus-sum.el (gnus-get-newsgroup-headers): Return the value of + In-Reply-To. + + * gnus-msg.el (gnus-setup-message): Posting styles have to be + configured in message-mode-hook. + + * nntp.el (nntp-connection-timeout): Restored. + (nntp-open-connection): Use it. + +1998-08-15 22:46:49 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-make-useful-group): Doc fix. + + * gnus-art.el (gnus-article-push-button): Place point where you + click. + +1998-08-15 Mike McEwan + + * gnus-agent.el (gnus-agent-save-group-info): Update "groups" file + if `nntp-server-list-active-group' is nil. + +1998-08-15 00:35:03 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-summary-increase-score): Swap t and r. + + * gnus-sum.el (gnus-remove-thread): Didn't work with sparse + threads. + +1998-08-14 François Pinard + + * nndoc.el (nndoc-generate-mime-parts-head): Use original Subject, + Message-ID, and References in fully blown articles. + +Fri Aug 14 23:03:51 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.36 is released. + +1998-08-14 21:49:22 Lars Magne Ingebrigtsen + + * gnus.el (load): Push onto list. + + * gnus-group.el (gnus-group-get-new-news-this-group): Store active + info. + +Fri Aug 14 21:41:59 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.35 is released. + +1998-08-14 00:00:15 Lars Magne Ingebrigtsen + + * gnus-srvr.el (gnus-server-scan-server): Error better. + + * nndir.el: Make independent of nnmh. + Revert. + + * message.el (message-remove-text-with-property): New function. + (message-fix-before-sending): Check for invisible text. + + * gnus.el (load): Create the Gnus buffer even when no splash. + + * gnus-msg.el (gnus-setup-message): Add buffer to list. + + * gnus-win.el (gnus-remove-some-windows): Use new buffer system. + (gnus-delete-windows-in-gnusey-frames): Ditto. + + * gnus.el (gnus-add-buffer): New function. + +1998-08-13 23:38:21 Lars Magne Ingebrigtsen + + * gnus-xmas.el (gnus-buffer-list): Removed. + + * gnus.el (gnus-buffers): New variable. + (gnus-get-buffer-create): New function; used throughout. + (gnus-buffers): New function. + + * gnus-msg.el (gnus-configure-posting-styles): Go to eoh + reliably. + + * message.el (message-goto-eoh): New command. + +1998-08-13 23:13:53 Simon Josefsson + + * gnus-msg.el (gnus-setup-message): use message-setup-hook + instead + (gnus-configure-posting-styles): new posting-style 'body + (gnus-configure-posting-styles): insert headers immediately + +1998-08-13 13:05:36 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-summary-increase-score): Change thread to + "r". + + * gnus-sum.el (gnus-summary-scroll-down): New command and + keystroke. + + * gnus-agent.el (gnus-agent-expire): Check that directories + exist. + +1998-08-12 20:56:41 Simon Josefsson + + * gnus-cache.el (gnus-uncacheable-groups): doc change + (gnus-cacheable-groups): new variable + (gnus-cache-possibly-enter-article): use it + +1998-08-12 22:30:16 Lars Magne Ingebrigtsen + + * nntp.el (nntp-encode-text): Too much text. + +1998-08-12 21:58:50 Matt Pharr + + * message.el (message-make-forward-subject-function): New + variable. + (message-wash-forwarded-subjects): Ditto. + +Wed Aug 12 21:09:58 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.34 is released. + +1998-08-12 13:32:38 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-post-method): Don't use `current' in drafts. + + * gnus-score.el (gnus-summary-increase-score): Changed T to h and + downcase. + +Tue Aug 11 20:46:25 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.33 is released. + +1998-08-11 20:07:55 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-apropos): Check symbol value. + + * gnus-cite.el (gnus-cited-closed-text-button-line-format): + Changed. + +Tue Aug 11 19:42:42 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.32 is released. + +1998-08-11 13:36:56 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-type-alist): Do MIME digests before multiparts. + + * gnus.el (gnus-predefined-server-alist): Expand vars. + +1998-08-09 Dave Love + + * gnus-art.el (article-display-x-face): Don't try (and fail) to + display multiple faces. + +1998-08-11 11:41:43 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-header-newsgroups-face): Don't bold so much. + + * gnus-group.el (gnus-group-rename-group): Remove old group name + from list of killed groups. + + * gnus-int.el (gnus-get-function): Error better. + + * gnus-art.el (gnus-article-narrow-to-signature): Inhibit motion + hooks. + (article-hide-pgp): Delete text instead of hiding it. + + * gnus-group.el (gnus-group-find-new-groups): Ditto. + + * gnus-start.el (gnus-find-new-newsgroups): Accept C-u C-u as a + total query. + +1998-08-10 09:31:36 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-prepare): Place point at the beginning + of the body. + + * gnus-cite.el (gnus-cite-attribution-face): Changed to italic. + + * gnus-art.el (gnus-article-edit-article): Delete "annotation" + text. + (gnus-insert-prev-page-button): Mark as annotation. + (gnus-insert-next-page-button): Ditto. + + * gnus-cite.el (gnus-cited-closed-text-button-line-format): New + variable. + (gnus-cited-closed-text-button-line-format-alist): Ditto. + (gnus-article-toggle-cited-text): Toggle between different + symbols. + +1998-08-09 19:58:36 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version): Remove backend info. + +Sun Aug 9 19:37:40 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.31 is released. + +1998-08-09 François Pinard + + * nndoc.el: Split MIME multipart messages, maybe recursively. + (nndoc-mime-parts-type-p, nndoc-transform-mime-parts, + nndoc-generate-mime-parts-head, nndoc-dissect-mime-parts, + nndoc-dissect-mime-parts-sub): New functions. + + * nndoc.el: Quoting boundaries is optional, for multipart digests. + +1998-08-09 17:51:25 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-save-group-info): Check whether file + exists. + + * message.el (message-goto-signature): Return nil if no sig. + (message-delete-not-region): Delete properly if no sig. + +1998-08-09 17:26:30 Simon Josefsson + + * gnus-srvr.el (gnus-browse-make-menu-bar): select did read + +1998-08-09 15:51:43 Lars Magne Ingebrigtsen + + * gnus-sum.el (t): Added keystroke for W W C. + + * gnus-cite.el (gnus-article-hide-citation-maybe): hiden->hidden. + +Sun Aug 9 15:46:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.30 is released. + +1998-08-09 10:48:31 Lars Magne Ingebrigtsen + + * message.el (message-cite-original-without-signature): Peel off + blank lines. + + * gnus-art.el (gnus-article-maybe-highlight): Doc fix. + + * gnus-sum.el (gnus-data-enter-list): Threw away all new list data + at the beginning of the buffer. + +1998-08-07 01:41:29 Gareth Jones + + * gnus-score.el (gnus-summary-increase-score): Don't downcase + before lookin in char-to-header. + +1998-08-07 01:33:22 Lars Magne Ingebrigtsen + + * gnus.el (gnus-predefined-server-alist): Too many parentheses. + +1998-08-06 11:20:08 Lars Magne Ingebrigtsen + + * gnus.el (gnus-continuum-version): Include quassia. + + * gnus-sum.el (gnus-data-enter-list): Check before entering list. + +1998-08-06 11:13:56 Francois Felix Ingrand + + * gnus-salt.el (gnus-generate-vertical-tree): Don't go too far to + the left. + +Thu Aug 6 07:58:17 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.29 is released. + +1998-08-06 07:10:31 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-expire): Check whether (caar + gnus-agent-article-alist) is nil. + + * gnus.el (gnus-read-method): Allow selecting predefined servers. + + * gnus-topic.el (gnus-topic-update-topic-line): Compute right + number when inserting missing topic lines. + + * gnus-start.el (gnus-get-unread-articles): Check that the group + is alive. + + * gnus-score.el (gnus-score-load-score-alist): Better error + messaging. + +Tue Aug 4 09:42:31 1998 Kurt Swanson + + * gnus-salt.el (gnus-pick-mouse-pick-region): Fix picking bug due + to use of gnus-read-event-char. + +1998-07-28 Dave Love + + * gnus-group.el (gnus-group-fetch-faq): Don't mung dots in group + name. + +1998-07-27 Dave Love + + * gnus-topic.el (gnus-topic-mode-map): Provide Emacs tty + alternatives to [tab], [(meta tab)]. + +1998-08-06 04:41:38 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-startup-file-coding-system): New variable. + (gnus-read-init-file): Use it. + (gnus-read-newsrc-el-file): Ditto. + + * gnus-sum.el (gnus-thread-ignore-subject): Changed default. + +1998-08-06 04:38:02 Richard Stallman + + * message.el (sendmail): Required. + +1998-08-06 02:11:37 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-auto-select-same): Dix fix. + +1998-08-04 Mike McEwan + + * gnus-sum.el (gnus-select-newsgroup): Set + `gnus-newsgroup-unselected' when selecting specific articles via + SELECT-ARTICLE - there may be more headers to fetch if + `gnus-fetch-old-headers' is non-nil. + (gnus-summary-read-group): pass SELECT-ARTICLE to + `gnus-summary-read-group-1' and reset to nil when going to next group. + (gnus-summary-read-group): Change `select-article' to + `select-articles' for consistency. + +Tue Aug 4 05:25:01 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.28 is released. + +1998-08-03 22:00:25 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-set-delims): Removed article-end. + (nndoc-dissect-buffer): Use eobp. + +1998-08-03 19:59:36 Trung Tran-Duc + + * nntp.el (nntp-open-connection): Bind coding-system-for-write. + +1998-07-31 16:45:36 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-read-ephemeral-group): Make the server + unique. + +1998-07-28 François Pinard + + * gnus-uu.el (gnus-uu-reginize-string): Consider the number of + parts as part of the fixed subject, instead of a wild quantity. + +1998-07-30 21:47:23 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-summary-insert-cached-articles): Sort + articles. + + * nndir.el (nndir): Use nnml functions. + +Mon Jul 27 03:26:00 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.27 is released. + +1998-07-27 02:27:11 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-update-unreads): New function. + + * gnus-sum.el (gnus-summary-limit): Update mode line. + + * gnus-soup.el (gnus-soup-add-article): Update mode line. + + * gnus-group.el (gnus-group-make-menu-bar): Bug. + + * gnus-art.el (gnus-article-make-menu-bar): Menu. + + * gnus-sum.el (gnus-summary-make-menu-bar): Bug reports. + + * gnus-topic.el (gnus-topic-mode-map): h -> H. + +1998-07-19 16:59 Simon Josefsson + + * gnus-util.el (gnus-netrc-syntax-table): @ is whitespace + +1998-07-17 Gordon Matzigkeit + + * gnus-uu.el (gnus-uu-reginize-string): Simplify by looking + from back to front for part numbers, rather than skipping + leading ``version numbers.'' + + (gnus-uu-part-number): Make consistent with + gnus-uu-reginize-string. + +1998-07-26 19:01:58 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-request-article-this-buffer): Pass along + header. + + * gnus-sum.el (gnus-summary-update-article): Don't pass along + iheader to regeneration routine. + +1998-07-27 KOSEKI Yoshinori + + * nnmail.el (nnmail-move-inbox): Clear nnmail-internal-password, + when supplied Password is incorrect. + +Sat Jul 25 19:31:36 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.26 is released. + +1998-07-25 14:53:24 Lars Magne Ingebrigtsen + + * gnus-salt.el (gnus-pick-mouse-pick-region): Use + gnus-read-event-char. + +Sat Jul 25 02:43:35 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.25 is released. + +1998-07-25 00:03:24 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-read-ephemeral-group): Ditto. + + * gnus-sum.el (gnus-summary-read-group-1): Ditto. + + * gnus-group.el (gnus-group-read-group): Accept article list. + +1998-07-24 14:35:02 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-configure-posting-styles): Quote some. + + * message.el (message-ignored-supersedes-headers): Added X-Trace + and X-Complaints-To. + + * nnmail.el (gnus-util): Required. + +1998-07-21 23:03:13 Lars Magne Ingebrigtsen + + * gnus.el (gnus-news-group-p): Bogosity in params. + +1998-07-21 16:14:32 Robert Bihlmeyer + + * gnus-util.el (gnus-globalify-regexp): New function. + +1998-07-18 21:49:01 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-list-of-unread-articles): Peel off articles + outside active range. + +1998-07-15 10:47:39 Lars Magne Ingebrigtsen + + * nnvirtual.el (nnvirtual-request-type): Handle non-numerical + articles. + + * gnus.el (gnus-news-group-p): Do something sensible with negative + articlies. + +Wed Jul 15 10:27:05 1998 Lars Magne Ingebrigtsen + + * gnus-salt.el (gnus-tree-minimize-window): Allow numbers. + +Wed Jul 15 10:25:29 1998 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-expire): Ignored ticks. + +Wed Jul 15 10:15:28 1998 Hallvard B. Furuseth + + * nntp.el (nntp-send-authinfo): Message better and stuff. + +Wed Jul 15 10:10:07 1998 Lars Magne Ingebrigtsen + + * gnus.el (gnus-message-archive-group): Allow sexp. + +Wed Jul 15 09:56:47 1998 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-select-newsgroup): Accept select-articles + para, + +1998-07-13 Mike McEwan + + * gnus-sum.el (gnus-select-newsgroup): Don't call the Agent to + mark articles as read until *all* headers have been retrieved. + +Wed Jul 15 09:06:18 1998 Lars Magne Ingebrigtsen + + * nndir.el (nndir): Use nnml to request article. + +1998-07-11 SL Baur + + * gnus-topic.el (gnus-topic-mode-map): Use modern key syntax. + +Sun Jul 12 04:01:22 1998 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-current-home-score-file): New function. + +1998-07-11 Mike McEwan + + * gnus-agent.el (gnus-agent-fetch-headers): Note last fetched + headers per sesion to aid expiry in `headers only' groups. + + * gnus-agent.el (gnus-agent-expire): Update group info to add + expired articles to list of read articles and prevent + re-fetching. + +1998-07-12 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-active-file-coding-system): Changed to + binary. + +Sun Jul 12 03:16:18 1998 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-load-file): Specify which alist to + decay. + +1998-07-12 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-startup-file-coding-system): New variable. + (gnus-read-newsrc-el-file): Use it. + +Sat Jul 11 03:03:53 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.24 is released. + +Fri Jul 10 04:23:24 1998 Hallvard B. Furuseth + + * gnus-util.el (gnus-parse-netrc): Allow "default" values. + +Fri Jul 10 04:15:35 1998 Lars Magne Ingebrigtsen + + * nntp.el (nntp-server-opened-hook): Doc change. + +Fri Jul 10 03:03:48 1998 François Pinard + + * gnus-sum.el (gnus-summary-respool-trace): New command and + keystroke. + +Fri Jul 10 02:18:01 1998 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-prin1): Bind print-escape-multibyte to nil. + +Mon Jul 6 01:02:59 1998 Simon Josefsson + + * gnus-range.el (gnus-sorted-complement): Fix comments. + +Thu Jul 2 11:16:14 1998 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-iterate): New macro. + + * message.el (message-pop-to-buffer): Clone locals. + + * gnus-msg.el (gnus-posting-styles): Reinstated. + (gnus-posting-style-alist): Ditto. + +Wed Jul 1 18:02:31 1998 Lars Magne Ingebrigtsen + + * gnus-int.el (gnus-get-function): Set funct to nil. + +1998-07-01 16:57:38 Simon Josefsson + + * gnus-int.el (gnus-get-function): returned non-nil when + function wasn't bound, if noerror=t + +Wed Jul 1 17:30:41 1998 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-mode-map): Bind TAB and M-TAB. + + * gnus-sum.el (gnus-build-sparse-threads): Make sure no dates are + nil. + (gnus-summary-limit-mark-excluded-as-read): Use the intersection. + + * gnus-msg.el (gnus-setup-message): Clone all local variables from + the summary buffer. + +Wed Jul 1 14:03:52 1998 Richard Stallman + + * message.el (message-cite-original): Use mail-citation-hook. + (message-cite-function): Ditto. + +Wed Jul 1 14:00:53 1998 Rajappa Iyer + + * gnus-salt.el (gnus-pick-mode-map): Changed keymap. + +Wed Jul 1 13:33:26 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.23 is released. + +Wed Jul 1 12:52:32 1998 Lars Magne Ingebrigtsen + + * nntp.el (nntp-record-command): Give more precise time info. + (nntp-next-result-arrived-p): Look for the end of error lines. + +Wed Jul 1 12:24:06 1998 François Pinard + + * gnus-util.el (gnus-delete-if): Would do the opposite. + +Wed Jul 1 01:53:31 1998 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-build-sparse-threads): Didn't work at all. + +Tue Jun 30 15:56:54 1998 Lars Magne Ingebrigtsen + + * nntp.el (nntp-send-authinfo): Store the user name. + (nntp-authinfo-user): New variable. + + * gnus-sum.el (gnus-summary-limit-mark-excluded-as-read): Would + mark some articles as unread. + + * gnus-agent.el (gnus-agent-expire): Don't sort lines. + +Tue Jun 30 15:56:31 1998 Mike McEwan + + * gnus-agent.el (gnus-agent-expire): Use a fresh hash table. + Mon Jun 29 22:49:49 1998 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.6.22 is released. @@ -15,7 +947,7 @@ Mon Jun 29 21:22:46 1998 Lars Magne Ingebrigtsen Sun Jun 28 14:32:08 1998 Lars Magne Ingebrigtsen - * gnus-spec.el (gnus-face-face-function): Double quoting removed. + * gnus-spec.el (gnus-face-face-function): Double quoting removed. Sun Jun 28 09:54:52 1998 Lars Magne Ingebrigtsen @@ -27,7 +959,7 @@ Sun Jun 28 08:51:39 1998 Lars Magne Ingebrigtsen a temp buffer before replacing. * gnus-msg.el (gnus-post-news): Treat broken-reply-to in - followups. + followups. * gnus-sum.el (gnus-summary-goto-subject): Position point. @@ -41,7 +973,7 @@ Sat Jun 27 09:19:20 1998 Lars Magne Ingebrigtsen * gnus-util.el (gnus-put-text-properties-excluding-characters-with-faces): New - function. + function. Sat Jun 27 08:56:08 1998 Lars Magne Ingebrigtsen @@ -54,7 +986,7 @@ Sat Jun 27 08:49:51 1998 Arne Georg Gleditsch Sat Jun 27 08:45:09 1998 Lars Magne Ingebrigtsen * message.el (message-check-news-body-syntax): Buggy checksum - check. + check. Sat Jun 27 07:59:22 1998 Lars Magne Ingebrigtsen @@ -71,7 +1003,7 @@ Sat Jun 27 03:18:57 1998 Lars Magne Ingebrigtsen * nnfolder.el (nnfolder-request-replace-article): Check all X-From headers. - * gnus-sum.el (gnus-update-marks): Don't nix out cache lists. + * gnus-sum.el (gnus-update-marks): Don't nix out cache lists. * nngateway.el (nngateway-mail2news-header-transformation): Changed semantics. @@ -103,7 +1035,7 @@ Fri Jun 26 13:45:24 1998 Lars Magne Ingebrigtsen * gnus-util.el (gnus-delete-alist): New function. * gnus-sum.el (gnus-update-marks): Don't save list of cached - articles. + articles. * message.el (message-mode-menu): Include kill-buffer. @@ -120,7 +1052,7 @@ Fri Jun 26 13:45:09 1998 Richard Stallman Fri Jun 26 13:30:42 1998 Kevin Christian * gnus-score.el (gnus-score-string): Do updating of scores after - fuzzies. + fuzzies. Fri Jun 26 07:26:03 1998 Lars Magne Ingebrigtsen @@ -138,7 +1070,7 @@ Fri Jun 26 04:29:44 1998 Lars Magne Ingebrigtsen * gnus-score.el (gnus-score-load-file): Would ignore all score files without un-advanced rules. - * gnus-ems.el ((fboundp 'split-string)): Use it where it exists. + * gnus-ems.el ((fboundp 'split-string)): Use it where it exists. Fri Jun 26 04:23:12 1998 Lars Magne Ingebrigtsen @@ -147,7 +1079,7 @@ Fri Jun 26 04:23:12 1998 Lars Magne Ingebrigtsen Fri Jun 26 03:39:32 1998 Lars Magne Ingebrigtsen * nnfolder.el (nnfolder-request-replace-article): Delete old - delimiter. + delimiter. * gnus-msg.el (gnus-summary-reply): Use it. @@ -172,9 +1104,9 @@ Thu Jun 25 10:35:48 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-limit-to-age): Reverse logic. * gnus-score.el (gnus-summary-score-entry): Removed interactive - spec. + spec. ((gnus-summary-score-map "V" gnus-summary-mode-map)): Removed - keystroke. + keystroke. * gnus-art.el (gnus-article-show-summary): Position point. @@ -198,7 +1130,7 @@ Thu Jun 25 05:13:31 1998 Lars Magne Ingebrigtsen * gnus-salt.el (gnus-pick-mode-map): Reinstated keymap. * gnus-sum.el (gnus-build-sparse-threads): Put the proper date - in. + in. Wed Jun 24 07:52:30 1998 Lars Magne Ingebrigtsen @@ -211,12 +1143,12 @@ Wed Jun 24 07:47:04 1998 Lars Magne Ingebrigtsen Wed Jun 24 07:33:17 1998 Vladimir Alexiev * nnvirtual.el (nnvirtual-update-xref-header): Regexp-quote group - name. + name. Wed Jun 24 06:15:27 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-build-sparse-threads): Give all the sparse - articles the date of the current child. + articles the date of the current child. * gnus-topic.el (gnus-group-topic-parameters): Didn't compute. @@ -247,7 +1179,7 @@ Wed Jun 24 03:04:05 1998 Kim-Minh Kaplan Wed Jun 24 02:49:57 1998 Castor - * nntp.el (nntp-open-ssl-stream): + * nntp.el (nntp-open-ssl-stream): Wed Jun 24 02:31:46 1998 Lars Magne Ingebrigtsen @@ -257,7 +1189,7 @@ Wed Jun 24 02:31:46 1998 Lars Magne Ingebrigtsen Wed Jun 24 01:43:26 1998 Decklin Foster * nngateway.el (nngateway-mail2news-header-transformation): New - function. + function. Wed Jun 24 00:25:45 1998 Lars Magne Ingebrigtsen @@ -271,18 +1203,18 @@ Wed Jun 24 00:25:45 1998 Lars Magne Ingebrigtsen Tue Jun 23 23:58:48 1998 Lars Magne Ingebrigtsen * gnus-topic.el (gnus-topic-prepare-topic): Respect visible topic - param. + param. (gnus-topic-hierarchical-parameters): New function. 1998-06-02 Didier Verna * gnus-picon.el (gnus-get-buffer-name): use get-buffer-create - instead of get-buffer + instead of get-buffer Wed Jun 3 04:41:45 1998 Lars Magne Ingebrigtsen * nnkiboze.el (nnkiboze-request-delete-group): Delete .newsrc - file. + file. * nnmail.el (nnmail-article-group): Nuke looong lines. @@ -371,7 +1303,7 @@ Sat May 23 19:44:43 1998 Lars Magne Ingebrigtsen Tue May 19 04:11:33 1998 Yoshiki Hayashi * nnheader.el (nnheader-translate-file-chars): Don't change - string. + string. Tue May 19 03:07:45 1998 P. E. Jareth Hein @@ -388,7 +1320,7 @@ Tue May 12 06:12:42 1998 Lars Magne Ingebrigtsen Sun May 10 19:08:28 1998 Lars Magne Ingebrigtsen * gnus-group.el (gnus-group-read-ephemeral-group): Don't add - `address'. + `address'. Sun May 3 18:01:01 1998 Lars Magne Ingebrigtsen @@ -421,7 +1353,7 @@ Sat May 2 01:36:37 1998 Lars Magne Ingebrigtsen `find-file-hooks' to nil. * nnmail.el (nnmail-process-unix-mail-format): Don't use - `find-file-noselect'. + `find-file-noselect'. * gnus-group.el (gnus-group-make-menu-bar): Typo. @@ -453,7 +1385,7 @@ Fri May 1 16:56:32 1998 Lars Magne Ingebrigtsen buffer. * gnus-soup.el (gnus-soup-parse-areas): Check whether the file - exists. + exists. * gnus-draft.el (gnus-draft-send): Use meta-information. @@ -465,7 +1397,7 @@ Fri May 1 16:56:32 1998 Lars Magne Ingebrigtsen Fri May 1 16:43:35 1998 Paul Franklin * message.el (message-generate-headers): Insert Sender when - required. + required. Fri May 1 15:28:55 1998 Lars Magne Ingebrigtsen @@ -475,10 +1407,10 @@ Fri May 1 15:28:55 1998 Lars Magne Ingebrigtsen when hiding. * gnus-msg.el (gnus-post-method): Allow ARG to override - `current'. + `current'. * gnus-sum.el (gnus-remove-thread): Remove the dummy root - properly. + properly. * nnfolder.el (nnfolder-goto-article): New function. (nnfolder-retrieve-headers): Use it. @@ -496,7 +1428,7 @@ Wed Apr 29 20:54:35 1998 Lars Magne Ingebrigtsen dummy roots. * gnus-cache.el (gnus-cache-enter-article): Update marks - properly. + properly. * gnus-xmas.el (gnus-xmas-draft-menu-add): New function. @@ -512,22 +1444,22 @@ Wed Apr 29 20:54:35 1998 Lars Magne Ingebrigtsen Wed Apr 29 20:18:45 1998 Kurt Swanson * gnus-art.el (article-update-date-lapsed): Bind - `deactivate-mark'. + `deactivate-mark'. * gnus-salt.el (gnus-pick-mode-map): Moved keys around to avoid - shadowing. + shadowing. * gnus-art.el (gnus-article-read-summary-keys): New version. - * gnus-sum.el (gnus-summary-make-menu-bar): New for article mode. + * gnus-sum.el (gnus-summary-make-menu-bar): New for article mode. * gnus-msg.el (gnus-post-method): `current' custom. Wed Apr 29 19:04:27 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-set-local-parameters): Ignore - quit-config. - (gnus-select-newsgroup): Use the value of gnus-fetch-old-headers. + quit-config. + (gnus-select-newsgroup): Use the value of gnus-fetch-old-headers. * message.el (message-post-method): Doc fix. @@ -546,7 +1478,7 @@ Tue Apr 28 03:15:50 1998 Hallvard B. Furuseth Tue Apr 28 03:00:16 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-parent-headers): Don't infloop on nil - References. + References. * gnus-art.el (gnus-article-mode): Don't kill local vars. @@ -601,9 +1533,9 @@ Sun Apr 26 14:34:06 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-update-info): Don't nix out scores. * gnus-start.el (gnus-active-to-gnus-format): Removed "." from - quoting. + quoting. - * gnus.el (gnus-cache-directory): Moved here. + * gnus.el (gnus-cache-directory): Moved here. (gnus-predefined-server-alist): Use. * message.el (message-autosave-directory): Put back in. @@ -626,7 +1558,7 @@ Sun Apr 26 14:34:06 1998 Lars Magne Ingebrigtsen Sun Apr 26 14:05:40 1998 Frank Bennett * nnmail.el (nnmail-move-inbox): Push error'ed mailboxes onto the - list. + list. Sun Apr 26 13:01:53 1998 Lars Magne Ingebrigtsen @@ -698,7 +1630,7 @@ Wed Apr 1 16:01:44 1998 Lars Magne Ingebrigtsen Sun Mar 29 11:54:33 1998 Lars Magne Ingebrigtsen * nnkiboze.el (nnkiboze-generate-group): Would mess up newsrs - hashtb. + hashtb. (nnkiboze-enter-nov): Created bogus Xrefs headers. * gnus-agent.el (gnus-agent-save-group-info): New function. @@ -708,7 +1640,7 @@ Sun Mar 29 11:54:33 1998 Lars Magne Ingebrigtsen * message.el (message-expand-group): Allow completion from in the middle of strings. (message-font-lock-keywords): Work when mail-header-separator is - "". + "". Sun Mar 29 09:56:00 1998 Lars Magne Ingebrigtsen @@ -763,7 +1695,7 @@ Thu Mar 19 15:09:14 1998 Wes Hardaker 1998-03-17 Per Abrahamsen * gnus-uu.el (gnus-uu-digest-headers): Add `Content-Type' and - `Content-Transfer-Encoding'. + `Content-Transfer-Encoding'. 1998-03-18 Per Abrahamsen @@ -791,7 +1723,7 @@ Thu Mar 19 12:44:12 1998 Lars Magne Ingebrigtsen * gnus-msg.el: Would use nil group names. * nntp.el (nntp-send-authinfo): Send authinfo to "force"d - servers. + servers. * gnus-util.el (gnus-parse-netrc): Accept the "force" token. @@ -828,7 +1760,7 @@ Fri Mar 13 22:07:17 1998 Shenghuo ZHU Fri Mar 13 21:10:24 1998 Lars Magne Ingebrigtsen - * nnvirtual.el (nnvirtual-request-group): Force updating of info. + * nnvirtual.el (nnvirtual-request-group): Force updating of info. Sun Mar 8 20:46:51 1998 Lars Magne Ingebrigtsen @@ -841,7 +1773,7 @@ Sun Mar 8 14:05:25 1998 Lars Magne Ingebrigtsen Sun Mar 8 00:35:09 1998 Lars Magne Ingebrigtsen * gnus-picon.el (gnus-get-buffer-name): Look in the assoc for the - variable. + variable. * nntp.el (nntp-wait-for): Check more for dead connections. @@ -901,7 +1833,7 @@ Sat Mar 7 15:01:57 1998 Lars Magne Ingebrigtsen Sat Mar 7 15:00:05 1998 Wes Hardaker * gnus-art.el (gnus-article-prepare): Mark articles as - downloadable. + downloadable. Wed Mar 4 22:33:27 1998 Ken Raeburn @@ -950,10 +1882,10 @@ Sat Feb 28 13:35:26 1998 Lars Magne Ingebrigtsen (nntp-record-commands): New variable. (nntp-record-command): New function. - * gnus-agent.el (gnus-agent-group-path): Use real name of group. + * gnus-agent.el (gnus-agent-group-path): Use real name of group. * gnus-sum.el (gnus-summary-insert-subject): Don't allow nil - articles. + articles. (gnus-summary-read-group): Respect backward movement. 1998-03-01 Kim-Minh Kaplan @@ -987,7 +1919,7 @@ Sat Feb 28 08:17:37 1998 Lars Magne Ingebrigtsen Sat Feb 28 08:10:27 1998 Lars Magne Ingebrigtsen * gnus-picon.el (gnus-picons-display-x-face): `buf' -- unbound - var. + var. Sat Feb 28 08:03:23 1998 François Pinard @@ -999,7 +1931,7 @@ Sat Feb 28 07:43:00 1998 Nelson Jose dos Santos Ferreira - * gnus-start.el (gnus-ask-server-for-new-groups): Message more. + * gnus-start.el (gnus-ask-server-for-new-groups): Message more. Fri Feb 27 13:26:34 1998 Lars Magne Ingebrigtsen @@ -1020,7 +1952,7 @@ Mon Feb 23 18:26:48 1998 Lars Magne Ingebrigtsen * gnus-ems.el (gnus-ems-redefine): Define 'gnus-summary-set-display-table as a function that takes no - params. + params. * gnus.el (gnus-interactive): Don't use gnus-sum macros. (gnus-valid-select-methods): Include nnlistserv. @@ -1084,7 +2016,7 @@ Sat Feb 21 00:09:14 1998 Lars Magne Ingebrigtsen the mark doesn't change. * gnus-art.el (gnus-article-prepare): Don't enter article into - cache. + cache. * gnus-sum.el (gnus-summary-reparent-thread): Don't mark as read. (gnus-summary-mark-article): Don't do cache things here. @@ -1094,7 +2026,7 @@ Sat Feb 21 00:09:14 1998 Lars Magne Ingebrigtsen Fri Feb 20 22:56:22 1998 Lars Magne Ingebrigtsen * gnus-srvr.el (gnus-browse-unsubscribe-group): Wouldn't allow - unsubscription. + unsubscription. * gnus-sum.el (gnus-summary-insert-subject): Allow inserting articles outside limits. @@ -1102,7 +2034,7 @@ Fri Feb 20 22:56:22 1998 Lars Magne Ingebrigtsen * gnus-start.el (gnus-dribble-enter): Update mode line. * gnus-srvr.el (gnus-browse-unsubscribe-group): Allow - unsubscription. + unsubscription. * gnus-picon.el (gnus-article-display-picons): Check that the extents are live first. @@ -1118,7 +2050,7 @@ Thu Feb 19 02:28:17 1998 Jens-Ulrik Holger Petersen * gnus-sum.el (gnus-get-newsgroup-headers): Just use the header - value. + value. (gnus-summary-exit): Set global vars. Tue Feb 17 07:17:49 1998 Lars Magne Ingebrigtsen @@ -1134,7 +2066,7 @@ Tue Feb 17 07:00:43 1998 Lars Magne Ingebrigtsen Tue Feb 17 06:15:03 1998 Lars Magne Ingebrigtsen * nnmail.el (nnmail-purge-split-history): List of alists, not - alist. + alist. Mon Feb 16 20:22:04 1998 Lars Magne Ingebrigtsen @@ -1143,10 +2075,10 @@ Mon Feb 16 20:22:04 1998 Lars Magne Ingebrigtsen 1998-02-16 Lars Magne Ingebrigtsen * message.el (message-dont-send): Make sure the article really is - saved. + saved. * nnmail.el (nnmail-purge-split-history): Alist; not a list of - alists. + alists. 1998-02-16 Hrvoje Niksic @@ -1161,7 +2093,7 @@ Mon Feb 16 20:22:04 1998 Lars Magne Ingebrigtsen 1998-02-16 Lars Magne Ingebrigtsen * gnus-util.el (gnus-run-hooks): Use unwind-protect instead of - save-excursion. + save-excursion. 1998-02-16 Per Abrahamsen @@ -1193,7 +2125,7 @@ Sun Feb 15 19:41:14 1998 Lars Magne Ingebrigtsen Sun Feb 15 19:35:11 1998 Kurt Swanson * gnus-art.el (gnus-article-read-summary-keys): Go to top on - some. + some. Sun Feb 15 19:26:21 1998 SeokChan LEE @@ -1226,14 +2158,14 @@ Sun Feb 15 14:23:51 1998 Lars Magne Ingebrigtsen * message.el (message-mode): Set font-lock things before running mode hook. - * gnus-agent.el (gnus-agent-group-path): Respect long file names. + * gnus-agent.el (gnus-agent-group-path): Respect long file names. Sat Feb 14 21:31:25 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-goto-last-article): Force jumping to articles outside limit. - * gnus-agent.el (gnus-agent-toggle-plugged): un/plug before hook. + * gnus-agent.el (gnus-agent-toggle-plugged): un/plug before hook. Sat Feb 14 21:08:03 1998 Kim-Minh Kaplan @@ -1250,7 +2182,7 @@ Sat Feb 14 19:28:01 1998 Lars Magne Ingebrigtsen Sat Feb 14 18:40:55 1998 Lars Magne Ingebrigtsen - * gnus-agent.el (gnus-agent-directory): Translate file chars. + * gnus-agent.el (gnus-agent-directory): Translate file chars. * gnus-sum.el (gnus-summary-print-article): Don't display all headers. @@ -1261,7 +2193,7 @@ Sat Feb 14 18:40:55 1998 Lars Magne Ingebrigtsen Sat Feb 14 18:39:45 1998 Fred Oberhauser * nnmail.el (nnmail-process-babyl-mail-format): Fix point - movement. + movement. Sat Feb 14 18:31:39 1998 Lars Magne Ingebrigtsen @@ -1298,7 +2230,7 @@ Sat Feb 14 17:41:44 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-work-articles): change buffer before looking at marked articles (gnus-summary-work-articles): better check of marked articles - + Sat Feb 14 15:10:36 1998 Lars Magne Ingebrigtsen * nntp.el (nntp-send-authinfo): Use new .netrc functionality. @@ -1312,10 +2244,10 @@ Sat Feb 14 15:10:36 1998 Lars Magne Ingebrigtsen * gnus.el (gnus-expert-user): Dix fox. - * nnmail.el (nnmail-article-group): Remove duplicates from split. + * nnmail.el (nnmail-article-group): Remove duplicates from split. * message.el (message-check-news-header-syntax): Check more on - Message-ID. + Message-ID. * nnmh.el: Don't call nnmail-activate. @@ -1373,7 +2305,7 @@ Fri Feb 13 17:10:31 1998 Lars Magne Ingebrigtsen (gnus-cite-parse-maybe): Use it. * gnus-sum.el (gnus-summary-move-article): Move back to summary - buffer. + buffer. * nnfolder.el (nnfolder-request-accept-article): Save excursion. (nnfolder-request-move-article): Ditto. @@ -1406,12 +2338,12 @@ Tue Feb 10 21:59:53 1998 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agent-fetch-session): Reversed reversal. * gnus-topic.el (gnus-topic-rename): Check whether the new name - exists. + exists. Tue Feb 10 21:39:47 1998 dave edmondson * message.el (message-font-lock-keywords): Allow : as a citation - ending. + ending. Tue Feb 10 20:09:02 1998 Lars Magne Ingebrigtsen @@ -1422,11 +2354,11 @@ Mon Feb 9 17:02:09 1998 Lars Magne Ingebrigtsen * message.el (message-fill-header): Fill to column 990. * gnus-score.el (gnus-score-load-file): Exclude all excluded - files. + files. Mon Feb 9 16:55:41 1998 jari aalto - * gnus-art.el (gnus-article-time-format): Extended variable. + * gnus-art.el (gnus-article-time-format): Extended variable. Mon Feb 9 16:27:59 1998 Lars Magne Ingebrigtsen @@ -1458,7 +2390,7 @@ Sun Feb 8 18:13:58 1998 Lars Magne Ingebrigtsen Sun Feb 8 17:20:40 1998 Lars Magne Ingebrigtsen - * gnus-group.el (gnus-update-group-mark-positions): Bind `topic'. + * gnus-group.el (gnus-update-group-mark-positions): Bind `topic'. * message.el (message-expand-group): Added doc string. @@ -1468,7 +2400,7 @@ Sun Feb 8 17:20:40 1998 Lars Magne Ingebrigtsen Sun Feb 8 16:44:36 1998 Richard Hoskins * message.el (message-kill-to-signature): Don't kill the - delimiter. + delimiter. Sun Feb 8 16:15:33 1998 Lars Magne Ingebrigtsen @@ -1476,7 +2408,7 @@ Sun Feb 8 16:15:33 1998 Lars Magne Ingebrigtsen (gnus-summary-read-group-1): Use it. * message.el (message-cite-original-without-signature): New - function. + function. (message-cite-function): Added to custom. 1998-01-13 Per Abrahamsen @@ -1499,7 +2431,7 @@ Mon Feb 2 18:56:22 1998 Lars Magne Ingebrigtsen (gnus-agent-fetch-session): Use it. * gnus-art.el (article-strip-all-blank-lines): New command and - keystroke. + keystroke. Sun Feb 1 18:00:54 1998 Lars Magne Ingebrigtsen @@ -1516,7 +2448,7 @@ Sun Feb 1 18:00:54 1998 Lars Magne Ingebrigtsen Thu Jan 15 22:47:38 1998 * gnus-art.el (gnus-request-article-this-buffer): Put it into the - backlog. + backlog. Mon Jan 12 23:30:59 1998 Lars Magne Ingebrigtsen @@ -1574,15 +2506,15 @@ Sun Jan 4 14:28:35 1998 Lars Magne Ingebrigtsen 1997-12-10 Per Abrahamsen * gnus/gnus-msg.el (gnus-inews-insert-mime-headers): Added - documentation. + documentation. (gnus-inews-insert-mime-headers): Made it work with Emacs MULE. (gnus-inews-insert-mime-headers): Added as option to - `message-header-hook'. + `message-header-hook'. 1997-12-22 Per Abrahamsen * gnus/gnus-art.el (gnus-button-alist): Assume msg-id after "in - message". + message". 1997-12-22 Simon Josefsson @@ -1598,9 +2530,9 @@ Sun Jan 4 13:35:14 1998 Lars Magne Ingebrigtsen * nndraft.el (nndraft-request-associate-buffer): Open the damn server first. Sheesh. - * gnus-draft.el (gnus-draft-send): Bind message-send-hook to nil. + * gnus-draft.el (gnus-draft-send): Bind message-send-hook to nil. - * gnus-sum.el (gnus-summary-catchup): Don't nix out downloadable. + * gnus-sum.el (gnus-summary-catchup): Don't nix out downloadable. (gnus-summary-highlight): Highlight down/un as unread. Sun Jan 4 13:27:31 1998 Kim-Minh Kaplan @@ -1610,7 +2542,7 @@ Sun Jan 4 13:27:31 1998 Kim-Minh Kaplan Sun Jan 4 13:18:04 1998 Lars Magne Ingebrigtsen * nnsoup.el (nnsoup-store-reply): Bind mail-header-separator to - "". + "". * gnus-xmas.el (gnus-xmas-agent-server-menu-add): New. @@ -1675,7 +2607,7 @@ Fri Dec 19 21:39:43 1997 Hrvoje Niksic Fri Dec 19 21:26:08 1997 Lars Magne Ingebrigtsen - * gnus-cache.el (gnus-cache-read-active): Check for empty files. + * gnus-cache.el (gnus-cache-read-active): Check for empty files. Sun Dec 14 11:46:50 1997 Lars Magne Ingebrigtsen @@ -1684,7 +2616,7 @@ Sun Dec 14 11:46:50 1997 Lars Magne Ingebrigtsen 1997-12-10 SL Baur - * gnus-start.el (gnus-read-descriptions-file): Really bind and gag + * gnus-start.el (gnus-read-descriptions-file): Really bind and gag Mule. Fri Dec 5 15:15:05 1997 Danny Siu @@ -1698,7 +2630,7 @@ Sun Dec 14 11:11:22 1997 Lars Magne Ingebrigtsen * gnus-uu.el (gnus-uu-pre-uudecode-hook): New hook. * gnus-sum.el (gnus-summary-read-group-1): Set mode line after - configuring. + configuring. Sun Dec 14 11:03:26 1997 Wes Hardaker @@ -1720,7 +2652,7 @@ Sat Dec 6 17:27:04 1997 Kim-Minh Kaplan Sat Dec 6 17:23:26 1997 Christian von Roques * gnus-start.el (gnus-read-descriptions-file): Fix - enable-multibyte-characters. + enable-multibyte-characters. 1997-12-05 Dave Love @@ -1733,7 +2665,7 @@ Sat Dec 6 17:23:26 1997 Christian von Roques Sat Dec 6 17:16:28 1997 Lars Balker Rasmussen - * gnus-art.el (article-make-date-line): Don't add extra newlines. + * gnus-art.el (article-make-date-line): Don't add extra newlines. 1997-11-27 MORIOKA Tomohiko @@ -1748,7 +2680,7 @@ Sat Dec 6 17:04:40 1997 Kim-Minh Kaplan * nnml.el (nnml-parse-head): Out-of-bounds fix. * nndraft.el (nndraft-request-associate-buffer): Get proper file - name. + name. Sat Dec 6 15:35:37 1997 Gary D. Foster @@ -1757,7 +2689,7 @@ Sat Dec 6 15:35:37 1997 Gary D. Foster Thu Nov 27 19:56:59 1997 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-summary-set-agent-mark): Remove marks - properly. + properly. 1997-11-27 Christoph Wedler @@ -1786,7 +2718,7 @@ Wed Nov 26 18:19:29 1997 Lars Magne Ingebrigtsen * nnweb.el (nnweb-type-definition): Rescued dejanewsold. * gnus-mh.el (gnus-summary-save-in-folder): Reverted to old - version. + version. * gnus-sum.el (gnus-kill-or-deaden-summary): Save excursion. @@ -1795,7 +2727,7 @@ Wed Nov 26 18:19:29 1997 Lars Magne Ingebrigtsen * gnus-start.el (gnus-setup-news): Always push archive server. * gnus-sum.el (gnus-read-header): Would bug out on sparse - articles. + articles. Wed Nov 26 17:50:41 1997 Kurt Swanson @@ -1808,16 +2740,16 @@ Wed Nov 26 17:40:57 1997 Lars Magne Ingebrigtsen Wed Nov 26 16:04:25 1997 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-move-article): Don't work on canceled - articles. + articles. * gnus-start.el (gnus-subscribe-hierarchical-interactive): Use - `read-char-exclusive'. + `read-char-exclusive'. * gnus-sum.el (gnus-summary-mode): Localize - gnus-summary-dummy-line-format. + gnus-summary-dummy-line-format. * nnml.el (nnml-open-nov): Check that the file exists before - inserting it. + inserting it. * gnus-art.el (article-date-ut): Insert a newline if needed. @@ -1835,7 +2767,7 @@ Wed Nov 26 15:47:40 1997 Greg Klanderman Wed Nov 26 15:43:53 1997 Lars Magne Ingebrigtsen * gnus-start.el (gnus-setup-news): Protect against nil - gnus-message-archive-method. + gnus-message-archive-method. 1997-11-26 Christoph Wedler @@ -1859,7 +2791,7 @@ Wed Nov 26 13:50:01 1997 Alastair Burt Wed Nov 26 13:45:35 1997 Lars Magne Ingebrigtsen - * gnus-util.el (gnus-kill-all-overlays): Remove check for XEmacs. + * gnus-util.el (gnus-kill-all-overlays): Remove check for XEmacs. 1997-09-30 Dave Love @@ -1889,7 +2821,7 @@ Wed Nov 26 10:31:17 1997 Lars Magne Ingebrigtsen that spanned several lines. * gnus-util.el (gnus-date-iso8601): Didn't pick out the date - header. + header. * gnus-demon.el (gnus-demon-scan-mail): Clean inboxes. @@ -1901,7 +2833,7 @@ Wed Nov 26 10:31:17 1997 Lars Magne Ingebrigtsen Wed Nov 26 08:54:26 1997 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-update-info): Would use wrong group - name. + name. 1997-11-26 Hrvoje Niksic @@ -1926,7 +2858,7 @@ Wed Nov 26 08:54:26 1997 Lars Magne Ingebrigtsen Wed Nov 26 08:31:28 1997 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-stop-date-timer): Cancel instead of delete. + * gnus-art.el (gnus-stop-date-timer): Cancel instead of delete. (gnus-start-date-timer): Use the numerical prefix. Tue Nov 25 20:03:34 1997 Lars Magne Ingebrigtsen @@ -1940,7 +2872,7 @@ Tue Nov 25 19:57:55 1997 Dan Christensen Tue Nov 25 19:54:00 1997 Lars Magne Ingebrigtsen * gnus-move.el (gnus-move-group-to-server): Protect agains - nil-ness. + nil-ness. Tue Nov 25 19:03:38 1997 Lars Magne Ingebrigtsen @@ -1949,7 +2881,7 @@ Tue Nov 25 19:03:38 1997 Lars Magne Ingebrigtsen Tue Nov 25 16:05:01 1997 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-read-header): Remove thread entry before - rebuilding. + rebuilding. * gnus-cite.el (gnus-cite-add-face): Keep track of all overlays. @@ -1959,10 +2891,10 @@ Tue Nov 25 16:05:01 1997 Lars Magne Ingebrigtsen (article-date-ut): Would move around. * gnus-group.el (gnus-group-read-ephemeral-group): Accept server - names. + names. * gnus-srvr.el (gnus-browse-foreign-server): Use proper server - names. + names. * gnus.el (gnus-group-prefixed-name): Give the right result for native groups. @@ -1994,7 +2926,7 @@ Mon Nov 24 18:07:21 1997 Lars Magne Ingebrigtsen Mon Nov 24 17:36:00 1997 Lars Magne Ingebrigtsen * message.el (message-reply): Respect Mail-Copies-To even when - `to-address'. + `to-address'. Mon Nov 24 17:32:47 1997 Thor Kristoffersen @@ -2006,7 +2938,7 @@ Mon Nov 24 16:18:19 1997 Lars Magne Ingebrigtsen entering group. * gnus-start.el (gnus-setup-news): Get correct value of archive - server. + server. Wed Oct 8 20:29:35 1997 Robert Bihlmeyer @@ -2019,7 +2951,7 @@ Mon Nov 24 14:09:00 1997 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-last-newsgroup-variables-set): New variable. (gnus-set-global-variables): Don't do to much; gets run off of - pre-command-hook. + pre-command-hook. Got rid of gnus-set-global-variables throughout. (gnus-summary-exit): Update adaptive scoring here. (gnus-summary-isearch-article): Widen. @@ -2051,12 +2983,12 @@ Sun Nov 23 14:04:07 1997 Lars Magne Ingebrigtsen bound. And gagged. * message.el (message-send-mail-with-mh): Use - `mh-new-draft-name'. + `mh-new-draft-name'. * nnfolder.el (nnfolder-read-folder): Save new buffers. * gnus-sum.el (gnus-summary-make-menu-bar): Removed "write to - file". + file". * gnus-util.el (gnus-byte-code): Use indirect-function. @@ -2065,7 +2997,7 @@ Sun Nov 23 14:04:07 1997 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-reparent-thread): Update thread. * gnus-score.el (gnus-all-score-files): Don't do anything unless - GROUP. + GROUP. * nnmail.el (nnmail-split-it): Save-excursion. (nnmail-group-pathname): Translate file chars. @@ -2073,7 +3005,7 @@ Sun Nov 23 14:04:07 1997 Lars Magne Ingebrigtsen Sun Nov 23 13:41:10 1997 Gunnar Horrigmo * gnus-sum.el (gnus-summary-exit): Don't skip if group - disappeared. + disappeared. Sun Nov 23 13:32:55 1997 Lars Magne Ingebrigtsen @@ -2099,7 +3031,7 @@ Sun Nov 23 12:44:38 1997 Lars Magne Ingebrigtsen Sun Nov 23 12:15:00 1997 Hallvard B. Furuseth * gnus-sum.el (gnus-summary-limit-include-thread): Interactive - fix. + fix. Sun Nov 23 07:06:58 1997 Lars Magne Ingebrigtsen @@ -2120,7 +3052,7 @@ Sat Nov 22 18:04:34 1997 Lars Magne Ingebrigtsen Sat Nov 22 18:01:26 1997 Didier Verna - * gnus-sum.el (gnus-summary-remove-bookmark): Interactive spec. + * gnus-sum.el (gnus-summary-remove-bookmark): Interactive spec. Mon Nov 17 23:50:51 1997 Lars Magne Ingebrigtsen @@ -2138,7 +3070,7 @@ Thu Nov 13 22:57:23 1997 Kenichi Handa Thu Nov 13 22:30:19 1997 seokchan lee * message.el (message-ignored-supersedes-headers): Ignore more - headers. + headers. Thu Nov 13 22:28:13 1997 Lars Magne Ingebrigtsen @@ -2170,15 +3102,15 @@ Thu Nov 6 01:53:51 1997 Stefan Waldherr Thu Nov 6 01:52:43 1997 Lars Magne Ingebrigtsen * gnus-topic.el (gnus-topic-change-level): Really delete multiple - instances. + instances. Wed Nov 5 14:04:54 1997 Lars Magne Ingebrigtsen * gnus-topic.el (gnus-topic-update-topic-line): Possibly fix nil - numbers. + numbers. * gnus-sum.el (gnus-summary-show-article): New command and - keystroke. + keystroke. Tue Nov 4 06:29:58 1997 Lars Magne Ingebrigtsen @@ -2194,7 +3126,7 @@ Sat Oct 25 05:52:22 1997 Lars Magne Ingebrigtsen Sat Oct 25 00:39:42 1997 Lars Balker Rasmussen * gnus-art.el (gnus-article-fill-paragraph): New command and - keystroke. + keystroke. 1997-10-16 Colin Rafferty @@ -2221,7 +3153,7 @@ Mon Oct 13 00:01:35 1997 Lars Magne Ingebrigtsen Sun Oct 12 23:54:55 1997 ISO-2022-JP * gnus-agent.el (gnus-agent-article-file-coding-system): New - variable. + variable. Sun Oct 12 16:46:11 1997 Lars Magne Ingebrigtsen @@ -2249,21 +3181,21 @@ Sat Oct 4 00:16:39 1997 Lars Magne Ingebrigtsen * nnmail.el (nnmail-delete-incoming): Changed default to nil. * gnus-int.el (gnus-request-scan): Don't do anything if - unplugged. + unplugged. Fri Oct 3 21:09:19 1997 Lars Magne Ingebrigtsen * gnus-art.el (gnus-ignored-headers): Doc fix. * gnus-demon.el (gnus-demon-add-nntp-close-connection): New - function. + function. (gnus-demon-nntp-close-connection): Ditto. * nntp.el (nntp-last-command-time): New variable. (nntp-retrieve-data): Use it. * message.el (message-news-p): Messages with Posted-To aren't - news. + news. (message-mode): Heed message-yank-prefix when filling. * nndraft.el (nndraft-request-restore-buffer): Remove Xrefs and @@ -2285,7 +3217,7 @@ Sat Sep 27 12:57:44 1997 Lars Magne Ingebrigtsen * gnus-xmas.el (gnus-xmas-window-edges): New function. * gnus-score.el (gnus-score-edit-current-scores): Don't select - window. + window. Sat Sep 27 12:52:31 1997 Hallvard B. Furuseth @@ -2298,10 +3230,10 @@ Sat Sep 27 09:22:15 1997 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-pop-article): Force. * gnus-art.el (gnus-article-prepare): Push the article onto the - history. + history. * gnus-sum.el (gnus-summary-pop-article): Pop to the right - article. + article. * gnus-demon.el (gnus-demon-scan-news): Save excursion. @@ -2342,7 +3274,7 @@ Sat Sep 27 04:32:45 1997 Lars Magne Ingebrigtsen Sat Sep 27 03:50:12 1997 Lars Magne Ingebrigtsen * message.el (message-send): Post without asking. - (message-mode): Modify paragraphs-start and paragraph-separate. + (message-mode): Modify paragraphs-start and paragraph-separate. (message-newline-and-reformat): New command and keystroke. Thu Sep 25 00:13:41 1997 Lars Magne Ingebrigtsen @@ -2390,17 +3322,17 @@ Tue Sep 23 01:41:04 1997 Lars Magne Ingebrigtsen * dgnushack.el (dgnushack-compile): Check for cus-edit. * message.el (message-included-forward-headers): Include Mime - headers. + headers. (message-send): Allow posting without confirming from Agent. Mon Sep 22 05:43:14 1997 Lars Magne Ingebrigtsen * dgnushack.el (byte-compile-warnings): Don't warn about obsolete - variables. + variables. * gnus-sum.el (gnus-summary-refer-thread): New command and - keystroke. - (gnus-summary-limit-include-thread): New command and keystroke. + keystroke. + (gnus-summary-limit-include-thread): New command and keystroke. (gnus-summary-articles-in-thread): New function. (gnus-articles-in-thread): Renamed. @@ -2435,14 +3367,14 @@ Sun Sep 21 00:14:40 1997 Lars Magne Ingebrigtsen (gnus-current-prefix-symbols): New variable. * gnus-score.el (gnus-summary-increase-score): Take symbolic - prefix. + prefix. * gnus.el (gnus-interactive): Removed. (gnus-interactive): Renamed from gnus-interactive-1. (gnus-symbolic-argument): New command. * gnus-draft.el (gnus-draft-send-message): Disable message - checks. + checks. (gnus-draft-send): Ditto. (gnus-draft-setup): Don't save buffer. @@ -2451,7 +3383,7 @@ Sun Sep 21 00:14:40 1997 Lars Magne Ingebrigtsen * gnus-group.el (gnus-group-iterate): Use gensymmed variables. * pop3.el (pop3-md5): `with-temp-buffer' doesn't exist in Emacs - 19.34. + 19.34. * nneething.el (nneething-directory): Defvarred. @@ -2468,12 +3400,12 @@ Sun Sep 21 00:14:40 1997 Lars Magne Ingebrigtsen throughout. * gnus-sum.el (gnus-summary-edit-article): Supply additional - param. + param. * gnus-group.el (gnus-group-iterate): Undo bogus change. * gnus-agent.el (gnus-agentize): Just call gnus-open-agent - directly. + directly. * gnus.el (gnus-interactive): New macro. (gnus-interactive-1): New function. @@ -2540,12 +3472,12 @@ Thu Sep 18 03:33:54 1997 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-setup-message): Slap a progn around forms. - * nndraft.el (nndraft-articles): Make sure directory exists. + * nndraft.el (nndraft-articles): Make sure directory exists. * message.el (message-mode): Don't delete article. * nnmh.el (nnmh-request-accept-article): Don't save when - noinsert. + noinsert. Wed Sep 17 03:37:59 1997 Lars Magne Ingebrigtsen @@ -2568,10 +3500,10 @@ Wed Sep 17 02:30:04 1997 Lars Magne Ingebrigtsen References. * gnus-agent.el (gnus-agent-fetch-group-1): Separated out into - function. + function. * message.el (message-delete-not-region): New command and - keystroke. + keystroke. Tue Sep 16 00:58:26 1997 Lars Magne Ingebrigtsen @@ -2584,7 +3516,7 @@ Tue Sep 16 00:58:26 1997 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agentize): Don't set twice. * gnus-art.el (gnus-article-prepare): Go to the right line before - marking. + marking. * gnus-start.el: Renamed the drafts group. @@ -2603,7 +3535,7 @@ Mon Sep 15 00:53:50 1997 Lars Magne Ingebrigtsen (gnus-get-newsgroup-headers): Ditto. * gnus-draft.el (gnus-group-send-drafts): Don't send when - unplugged. + unplugged. * gnus-sum.el (gnus-summary-read-group): Don't show-all when skipping groups. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index cd61fdc..d143e8f 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -18,6 +18,9 @@ total: all: rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile +warn: + rm -f *.elc ; $(EMACS) $(FLAGS) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max" + clever: $(EMACS) $(FLAGS) -f dgnushack-compile diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 37bdb98..73e457f 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -32,7 +32,7 @@ (require 'bytecomp) (push "~/lisp/custom" load-path) (push "." load-path) -(load "./lpath.el") +(load "./lpath.el" nil t) (defalias 'device-sound-enabled-p 'ignore) (defalias 'play-sound-file 'ignore) @@ -48,11 +48,11 @@ (fset 'x-defined-colors 'ignore) (fset 'read-color 'ignore))) -(setq byte-compile-warnings - '(free-vars unresolved callargs redefine)) - -(defun dgnushack-compile () +(defun dgnushack-compile (&optional warn) ;;(setq byte-compile-dynamic t) + (unless warn + (setq byte-compile-warnings + '(free-vars unresolved callargs redefine))) (unless (locate-library "cus-edit") (error "You do not seem to have Custom installed. Fetch it from . @@ -68,6 +68,9 @@ Modify to suit your needs.")) (condition-case () (require 'w3-forms) (error (setq files (delete "nnweb.el" (delete "nnlistserv.el" files))))) + (condition-case () + (require 'bbdb) + (error (setq files (delete "gnus-bbdb.el" files)))) (while (setq file (pop files)) (when (or (and (not xemacs) (not (member file '("gnus-xmas.el" "gnus-picon.el" diff --git a/lisp/earcon.el b/lisp/earcon.el index a698479..4302182 100644 --- a/lisp/earcon.el +++ b/lisp/earcon.el @@ -74,6 +74,8 @@ (defvar earcon-button-marker-list nil) (make-variable-buffer-local 'earcon-button-marker-list) + + ;;; FIXME!! clone of code from gnus-vis.el FIXME!! (defun earcon-article-push-button (event) "Check text under the mouse pointer for a callback function. @@ -154,6 +156,7 @@ If N is negative, move backward instead." (setq entry nil))) entry)) + (defun earcon-button-push (marker) ;; Push button starting at MARKER. (save-excursion diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 7d40b82..613b682 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -92,7 +92,7 @@ If nil, only read articles will be expired." (defvar gnus-agent-spam-hashtb nil) (defvar gnus-agent-file-name nil) (defvar gnus-agent-send-mail-function nil) -(defvar gnus-agent-article-file-coding-system 'no-conversion) +(defvar gnus-agent-file-coding-system 'no-conversion) ;; Dynamic variables (defvar gnus-headers) @@ -107,7 +107,7 @@ If nil, only read articles will be expired." (gnus-agent-read-servers) (gnus-category-read) (setq gnus-agent-overview-buffer - (get-buffer-create " *Gnus agent overview*")) + (gnus-get-buffer-create " *Gnus agent overview*")) (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) @@ -129,7 +129,7 @@ If nil, only read articles will be expired." "Load FILE and do a `read' there." (nnheader-temp-write nil (ignore-errors - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (read (current-buffer))))) @@ -203,7 +203,8 @@ If nil, only read articles will be expired." (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" buffer)))) minor-mode-map-alist)) - (gnus-agent-toggle-plugged gnus-plugged) + (when (eq major-mode 'gnus-group-mode) + (gnus-agent-toggle-plugged gnus-plugged)) (gnus-run-hooks 'gnus-agent-mode-hook (intern (format "gnus-agent-%s-mode-hook" buffer))))) @@ -516,7 +517,7 @@ the actual number of articles toggled is returned." (let* ((gnus-command-method method) (file (gnus-agent-lib-file "active"))) (gnus-make-directory (file-name-directory file)) - (let ((coding-system-for-write gnus-agent-article-file-coding-system)) + (let ((coding-system-for-write gnus-agent-file-coding-system)) (write-region (point-min) (point-max) file nil 'silent)) (when (file-exists-p (gnus-agent-lib-file "groups")) (delete-file (gnus-agent-lib-file "groups")))))) @@ -525,22 +526,32 @@ the actual number of articles toggled is returned." (let* ((gnus-command-method method) (file (gnus-agent-lib-file "groups"))) (gnus-make-directory (file-name-directory file)) - (write-region (point-min) (point-max) file nil 'silent)) + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent)) (when (file-exists-p (gnus-agent-lib-file "active")) - (delete-file (gnus-agent-lib-file "active")))) + (delete-file (gnus-agent-lib-file "active"))))) (defun gnus-agent-save-group-info (method group active) (when (gnus-agent-method-p method) (let* ((gnus-command-method method) - (file (gnus-agent-lib-file "active"))) + (file (if nntp-server-list-active-group + (gnus-agent-lib-file "active") + (gnus-agent-lib-file "groups")))) (gnus-make-directory (file-name-directory file)) (nnheader-temp-write file - (insert-file-contents file) + (when (file-exists-p file) + (nnheader-insert-file-contents file)) (goto-char (point-min)) - (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) - (gnus-delete-line)) - (insert group " " (number-to-string (cdr active)) " " - (number-to-string (car active)) "\n"))))) + (if nntp-server-list-active-group + (progn + (when (re-search-forward + (concat "^" (regexp-quote group) " ") nil t) + (gnus-delete-line)) + (insert group " " (number-to-string (cdr active)) " " + (number-to-string (car active)) " y\n")) + (when (re-search-forward (concat (regexp-quote group) " ") nil t) + (gnus-delete-line)) + (insert-buffer-substring nntp-server-buffer)))))) (defun gnus-agent-group-path (group) "Translate GROUP into a path." @@ -572,7 +583,7 @@ the actual number of articles toggled is returned." (defun gnus-agent-open-history () (save-excursion (push (cons (gnus-agent-method) - (set-buffer (get-buffer-create + (set-buffer (gnus-get-buffer-create (format " *Gnus agent %s history*" (gnus-agent-method))))) gnus-agent-history-buffers) @@ -587,8 +598,9 @@ the actual number of articles toggled is returned." (save-excursion (set-buffer gnus-agent-current-history) (gnus-make-directory (file-name-directory gnus-agent-file-name)) - (write-region (1+ (point-min)) (point-max) - gnus-agent-file-name nil 'silent))) + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (write-region (1+ (point-min)) (point-max) + gnus-agent-file-name nil 'silent)))) (defun gnus-agent-close-history () (when (gnus-buffer-live-p gnus-agent-current-history) @@ -646,15 +658,14 @@ the actual number of articles toggled is returned." (gnus-agent-group-path group) "/")) (date (gnus-time-to-day (current-time))) (case-fold-search t) - pos alists crosses id elem) + pos crosses id elem) (gnus-make-directory dir) (gnus-message 7 "Fetching articles for %s..." group) ;; Fetch the articles from the backend. (if (gnus-check-backend-function 'retrieve-articles group) (setq pos (gnus-retrieve-articles articles group)) (nnheader-temp-write nil - (let ((buf (current-buffer)) - article) + (let (article) (while (setq article (pop articles)) (when (gnus-request-article article group) (goto-char (point-max)) @@ -687,7 +698,7 @@ the actual number of articles toggled is returned." (setq id "No-Message-ID-in-article") (setq id (buffer-substring (match-beginning 1) (match-end 1)))) (let ((coding-system-for-write - gnus-agent-article-file-coding-system)) + gnus-agent-file-coding-system)) (write-region (point-min) (point-max) (concat dir (number-to-string (caar pos))) nil 'silent)) @@ -714,7 +725,7 @@ the actual number of articles toggled is returned." gnus-agent-group-alist)) (setcdr alist (cons (cons (cdar crosses) t) (cdr alist))) (save-excursion - (set-buffer (get-buffer-create (format " *Gnus agent overview %s*" + (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*" group))) (when (= (point-max) (point-min)) (push (cons group (current-buffer)) gnus-agent-buffer-alist) @@ -730,10 +741,12 @@ the actual number of articles toggled is returned." (save-excursion (while gnus-agent-buffer-alist (set-buffer (cdar gnus-agent-buffer-alist)) - (write-region (point-min) (point-max) - (gnus-agent-article-name ".overview" - (caar gnus-agent-buffer-alist)) - nil 'silent) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) + (gnus-agent-article-name ".overview" + (caar gnus-agent-buffer-alist)) + nil 'silent)) (pop gnus-agent-buffer-alist)) (while gnus-agent-group-alist (nnheader-temp-write (caar gnus-agent-group-alist) @@ -741,18 +754,14 @@ the actual number of articles toggled is returned." (insert "\n")) (pop gnus-agent-group-alist)))) -(defun gnus-agent-fetch-headers (group articles &optional force) - (gnus-agent-load-alist group) - ;; Find out what headers we need to retrieve. - (when articles - (while (and articles - (assq (car articles) gnus-agent-article-alist)) - (pop articles)) - (let ((arts articles)) - (while (cdr arts) - (if (assq (cadr arts) gnus-agent-article-alist) - (setcdr arts (cddr arts)) - (setq arts (cdr arts))))) +(defun gnus-agent-fetch-headers (group &optional force) + (let ((articles (if (gnus-agent-load-alist group) + (gnus-sorted-intersection + (gnus-list-of-unread-articles group) + (gnus-uncompress-range + (cons (1+ (caar (last gnus-agent-article-alist))) + (cdr (gnus-active group))))) + (gnus-list-of-unread-articles group)))) ;; Fetch them. (when articles (gnus-message 7 "Fetching headers for %s..." group) @@ -760,17 +769,6 @@ the actual number of articles toggled is returned." (set-buffer nntp-server-buffer) (unless (eq 'nov (gnus-retrieve-headers articles group)) (nnvirtual-convert-headers)) - ;; - ;; To gnus-agent-expire work fine with no Xref field in .overview - ;; Tatsuya Ichikawa - (goto-char (point-min)) - (while (not (eobp)) - (goto-char (point-at-eol)) - (insert "\t") - (forward-line 1)) - ;; Tatsuya Ichikawa - ;; To gnus-agent-expire work fine with no Xref field in .overview - ;; ;; Save these headers for later processing. (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) (let (file) @@ -779,9 +777,15 @@ the actual number of articles toggled is returned." (gnus-agent-braid-nov group articles file)) (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file))) - (write-region (point-min) (point-max) file nil 'silent) - (gnus-agent-save-alist group articles nil)) - t)))) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent)) + (gnus-agent-save-alist group articles nil) + (gnus-agent-enter-history + "last-header-fetched-for-session" + (list (cons group (nth (- (length articles) 1) articles))) + (gnus-time-to-day (current-time))) + articles))))) (defsubst gnus-agent-copy-nov-line (article) (let (b e) @@ -789,47 +793,48 @@ the actual number of articles toggled is returned." (setq b (point)) (if (eq article (read (current-buffer))) (setq e (progn (forward-line 1) (point))) - (setq e b)) + (progn + (beginning-of-line) + (setq e b))) (set-buffer nntp-server-buffer) (insert-buffer-substring gnus-agent-overview-buffer b e))) (defun gnus-agent-braid-nov (group articles file) - (let (beg end) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (if (or (= (point-min) (point-max)) - (progn - (forward-line -1) - (< (read (current-buffer)) (car articles)))) - ;; We have only headers that are after the older headers, - ;; so we just append them. - (progn - (goto-char (point-max)) - (insert-buffer-substring gnus-agent-overview-buffer)) - ;; We do it the hard way. - (nnheader-find-nov-line (car articles)) - (gnus-agent-copy-nov-line (car articles)) - (pop articles) - (while (and articles - (not (eobp))) - (while (and (not (eobp)) - (< (read (current-buffer)) (car articles))) - (forward-line 1)) - (beginning-of-line) - (unless (eobp) - (gnus-agent-copy-nov-line (car articles)) - (setq articles (cdr articles)))) - (when articles - (let (b e) - (set-buffer gnus-agent-overview-buffer) - (setq b (point) - e (point-max)) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e)))))) + (set-buffer gnus-agent-overview-buffer) + (goto-char (point-min)) + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents file) + (goto-char (point-max)) + (if (or (= (point-min) (point-max)) + (progn + (forward-line -1) + (< (read (current-buffer)) (car articles)))) + ;; We have only headers that are after the older headers, + ;; so we just append them. + (progn + (goto-char (point-max)) + (insert-buffer-substring gnus-agent-overview-buffer)) + ;; We do it the hard way. + (nnheader-find-nov-line (car articles)) + (gnus-agent-copy-nov-line (car articles)) + (pop articles) + (while (and articles + (not (eobp))) + (while (and (not (eobp)) + (< (read (current-buffer)) (car articles))) + (forward-line 1)) + (beginning-of-line) + (unless (eobp) + (gnus-agent-copy-nov-line (car articles)) + (setq articles (cdr articles)))) + (when articles + (let (b e) + (set-buffer gnus-agent-overview-buffer) + (setq b (point) + e (point-max)) + (set-buffer nntp-server-buffer) + (insert-buffer-substring gnus-agent-overview-buffer b e))))) (defun gnus-agent-load-alist (group &optional dir) "Load the article-state alist for GROUP." @@ -840,7 +845,7 @@ the actual number of articles toggled is returned." (gnus-agent-article-name ".agentview" group))))) (defun gnus-agent-save-alist (group &optional articles state dir) - "Load the article-state alist for GROUP." + "Save the article-state alist for GROUP." (nnheader-temp-write (if dir (concat dir ".agentview") (gnus-agent-article-name ".agentview" group)) @@ -890,12 +895,11 @@ the actual number of articles toggled is returned." (let ((gnus-command-method method) gnus-newsgroup-dependencies gnus-newsgroup-headers gnus-newsgroup-scored gnus-headers gnus-score - gnus-use-cache articles score arts + gnus-use-cache articles arts category predicate info marks score-param) ;; Fetch headers. (when (and (or (gnus-active group) (gnus-activate-group group)) - (setq articles (gnus-list-of-unread-articles group)) - (gnus-agent-fetch-headers group articles)) + (setq articles (gnus-agent-fetch-headers group))) ;; Parse them and see which articles we want to fetch. (setq gnus-newsgroup-dependencies (make-vector (length articles) 0)) @@ -963,8 +967,8 @@ the actual number of articles toggled is returned." (defvar gnus-category-buffer "*Agent Category*") (defvar gnus-category-line-format-alist - `((?c name ?s) - (?g groups ?d))) + `((?c gnus-tmp-name ?s) + (?g gnus-tmp-groups ?d))) (defvar gnus-category-mode-line-format-alist `((?u user-defined ?s))) @@ -1040,15 +1044,15 @@ The following commands are available: (defalias 'gnus-category-position-point 'gnus-goto-colon) (defun gnus-category-insert-line (category) - (let* ((name (car category)) - (groups (length (cadddr category)))) + (let* ((gnus-tmp-name (car category)) + (gnus-tmp-groups (length (cadddr category)))) (beginning-of-line) (gnus-add-text-properties (point) (prog1 (1+ (point)) ;; Insert the text. (eval gnus-category-line-format-spec)) - (list 'gnus-category name)))) + (list 'gnus-category gnus-tmp-name)))) (defun gnus-enter-category-buffer () "Go to the Category buffer." @@ -1060,8 +1064,7 @@ The following commands are available: (defun gnus-category-setup-buffer () (unless (get-buffer gnus-category-buffer) (save-excursion - (set-buffer (get-buffer-create gnus-category-buffer)) - (gnus-add-current-to-buffer-list) + (set-buffer (gnus-get-buffer-create gnus-category-buffer)) (gnus-category-mode)))) (defun gnus-category-prepare () @@ -1265,13 +1268,13 @@ The following commands are available: (interactive) (let ((methods gnus-agent-covered-methods) (day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days)) - (expiry-hashtb (gnus-make-hashtable 1023)) gnus-command-method sym group articles history overview file histories elem art nov-file low info unreads marked article) (save-excursion - (setq overview (get-buffer-create " *expire overview*")) + (setq overview (gnus-get-buffer-create " *expire overview*")) (while (setq gnus-command-method (pop methods)) + (let ((expiry-hashtb (gnus-make-hashtable 1023))) (gnus-agent-open-history) (set-buffer (setq gnus-agent-current-history @@ -1303,7 +1306,7 @@ The following commands are available: info (gnus-get-info group) unreads (ignore-errors (gnus-list-of-unread-articles group)) marked (nconc (gnus-uncompress-range - (cdr (assq 'ticked (gnus-info-marks info)))) + (cdr (assq 'tick (gnus-info-marks info)))) (gnus-uncompress-range (cdr (assq 'dormant (gnus-info-marks info))))) @@ -1330,7 +1333,7 @@ The following commands are available: (< art article))) (if (file-exists-p (gnus-agent-article-name - (number-to-string article) group)) + (number-to-string art) group)) (forward-line 1) ;; Remove old NOV lines that have no articles. (gnus-delete-line))) @@ -1345,13 +1348,17 @@ The following commands are available: (delete-file file)) ;; Schedule the history line for nuking. (push (cdr elem) histories))) - (write-region (point-min) (point-max) nov-file nil 'silent) + (gnus-make-directory (file-name-directory nov-file)) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) nov-file nil 'silent)) ;; Delete the unwanted entries in the alist. (setq gnus-agent-article-alist (sort gnus-agent-article-alist 'car-less-than-car)) (let* ((alist gnus-agent-article-alist) (prev (cons nil alist)) - (first prev)) + (first prev) + expired) (while (and alist (<= (caar alist) article)) (if (or (not (cdar alist)) @@ -1360,11 +1367,34 @@ The following commands are available: (number-to-string (caar alist)) group)))) - (setcdr prev (setq alist (cdr alist))) + (progn + (push (caar alist) expired) + (setcdr prev (setq alist (cdr alist)))) (setq prev alist alist (cdr alist)))) - (setq gnus-agent-article-alist (cdr first))) - (gnus-agent-save-alist group)) + (setq gnus-agent-article-alist (cdr first)) + ;;; 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 + (nth 2 info) + (cons 1 (- (caar gnus-agent-article-alist) 1))))) + ;; Maybe everything has been expired from `gnus-article-alist' + ;; and so the above marking as read could not be conducted, + ;; or there are expired article within the range of the alist. + (when (and (car expired) + (or (not (caar gnus-agent-article-alist)) + (> (car expired) + (caar gnus-agent-article-alist))) ) + (setcar (nthcdr 2 info) + (gnus-add-to-range + (nth 2 info) + (nreverse expired)))) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string info) + ")")))) expiry-hashtb) (set-buffer history) (setq histories (nreverse (sort histories '<))) @@ -1373,7 +1403,7 @@ The following commands are available: (gnus-delete-line)) (gnus-agent-save-history) (gnus-agent-close-history)) - (gnus-message 4 "Expiry...done"))))) + (gnus-message 4 "Expiry...done")))))) ;;;###autoload (defun gnus-agent-batch () diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 02480f7..247338f 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2,7 +2,8 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko +;; Katsumi Yamaoka ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -94,10 +95,25 @@ :group 'gnus-article) (defcustom gnus-ignored-headers - '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:" - "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:" - "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:" - "^Approved:" "^Sender:" "^Received:" "^Mail-from:") + '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:" + "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" + "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:" + "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:" + "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:" + "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:" + "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:" + "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:" + "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:" + "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:" + "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:" + "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" + "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:" + "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" + "^Old-Received:" "^X-Pgp-Fingerprint:" "^X-Pgp-Key-Id:" + "^X-Pgp-Public-Key-Url:" "^X-Auth:" "^X-From-Line:" + "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" + "^X-Mailing-List:" "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:" + "^Status:") "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -107,7 +123,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." @@ -364,7 +380,7 @@ 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) @@ -456,12 +472,12 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (defface gnus-header-from-face '((((class color) (background dark)) - (:foreground "spring green" :bold t)) + (:foreground "spring green")) (((class color) (background light)) - (:foreground "red3" :bold t)) + (:foreground "red3")) (t - (:bold t :italic t))) + (:italic t))) "Face used for displaying from headers." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -469,10 +485,10 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (defface gnus-header-subject-face '((((class color) (background dark)) - (:foreground "SeaGreen3" :bold t)) + (:foreground "SeaGreen3")) (((class color) (background light)) - (:foreground "red4" :bold t)) + (:foreground "red4")) (t (:bold t :italic t))) "Face used for displaying subject headers." @@ -482,12 +498,12 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (defface gnus-header-newsgroups-face '((((class color) (background dark)) - (:foreground "yellow" :bold t :italic t)) + (:foreground "yellow" :italic t)) (((class color) (background light)) - (:foreground "MidnightBlue" :bold t :italic t)) + (:foreground "MidnightBlue" :italic t)) (t - (:bold t :italic t))) + (:italic t))) "Face used for displaying newsgroups headers." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -588,7 +604,7 @@ Initialized from `text-mode-syntax-table.") b e (cons 'article-type (cons type gnus-hidden-properties)))) (defun gnus-article-unhide-text-type (b e type) - "Hide text of TYPE between B and E." + "Unhide text of TYPE between B and E." (remove-text-properties b e (cons 'article-type (cons type gnus-hidden-properties))) (when (memq 'intangible gnus-hidden-properties) @@ -667,7 +683,7 @@ always hide." (listp gnus-visible-headers)) (mapconcat 'identity gnus-visible-headers "\\|")))) (inhibit-point-motion-hooks t) - want-list beg) + beg) ;; First we narrow to just the headers. (widen) (goto-char (point-min)) @@ -760,8 +776,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"))) @@ -902,12 +918,13 @@ characters to translate to." (delete-process "article-x-face")) (let ((inhibit-point-motion-hooks t) (case-fold-search t) - from) + from last) (save-restriction (nnheader-narrow-to-headers) (setq from (message-fetch-field "from")) (goto-char (point-min)) (while (and gnus-article-x-face-command + (not last) (or force ;; Check whether this face is censored. (not gnus-article-x-face-too-ugly) @@ -916,6 +933,12 @@ characters to translate to." from)))) ;; Has to be present. (re-search-forward "^X-Face: " nil t)) + ;; This used to try to do multiple faces (`while' instead of + ;; `when' above), but (a) sending multiple EOFs to xv doesn't + ;; work (b) it can crash some versions of Emacs (c) are + ;; multiple faces really something to encourage? + (when (stringp gnus-article-x-face-command) + (setq last t)) ;; We now have the area of the buffer where the X-Face is stored. (save-excursion (let ((beg (point)) @@ -958,27 +981,25 @@ always hide." (goto-char (point-min)) ;; Hide the "header". (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (gnus-article-hide-text-type (1+ (match-beginning 0)) - (match-end 0) 'pgp) + (delete-region (1+ (match-beginning 0)) (match-end 0)) (setq beg (point)) ;; Hide the actual signature. (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type + (delete-region end (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) (match-end 0) ;; Perhaps we shouldn't hide to the end of the buffer ;; if there is no end to the signature? - (point-max)) - 'pgp)) + (point-max)))) ;; Hide "- " PGP quotation markers. (when (and beg end) (narrow-to-region beg end) (goto-char (point-min)) (while (re-search-forward "^- " nil t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pgp)) + (delete-region + (match-beginning 0) (match-end 0))) (widen)) (gnus-run-hooks 'gnus-article-hide-pgp-hook)))))) @@ -1081,42 +1102,32 @@ 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) - (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 - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (gnus-functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t)))) + (let ((inhibit-point-motion-hooks t)) + (when (gnus-article-search-signature) + (forward-line 1) + ;; Check whether we have some limits to what we consider + ;; to be a signature. + (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit + (list gnus-signature-limit))) + limit limited) + (while (setq limit (pop limits)) + (if (or (and (integerp limit) + (< (- (point-max) (point)) limit)) + (and (floatp limit) + (< (count-lines (point) (point-max)) limit)) + (and (gnus-functionp limit) + (funcall limit)) + (and (stringp limit) + (not (re-search-forward limit nil t)))) + () ; This limit did not succeed. + (setq limited t + limits nil))) + (unless limited + (narrow-to-region (point) (point-max)) + t))))) (defun gnus-article-search-signature () "Search the current buffer for the signature separator. @@ -1193,8 +1204,7 @@ means show, 0 means toggle." (defun gnus-article-hidden-text-p (type) "Say whether the current buffer contains hidden text of type TYPE." - (let ((start (point-min)) - (pos (text-property-any (point-min) (point-max) 'article-type type))) + (let ((pos (text-property-any (point-min) (point-max) 'article-type type))) (while (and pos (not (get-text-property pos 'invisible))) (setq pos @@ -1409,7 +1419,7 @@ is to run." (unless n (setq n 1)) (gnus-stop-date-timer) - (setq article-lapsed-timer + (setq article-lapsed-timer (nnheader-run-at-time 1 n 'article-update-date-lapsed))) (defun gnus-stop-date-timer () @@ -1843,7 +1853,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Scroll backwards" gnus-article-goto-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] - ["Mail to address at point" gnus-article-mail t])) + ["Mail to address at point" gnus-article-mail t] + ["Send a bug report" gnus-bug t])) (easy-menu-define gnus-article-treatment-menu gnus-article-mode-map "" @@ -1890,9 +1901,9 @@ commands: (use-local-map gnus-article-mode-map) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) - (make-local-variable 'gnus-page-broken) - (make-local-variable 'gnus-button-marker-list) - (make-local-variable 'gnus-article-current-summary) + (make-local-variable 'gnus-page-broken) + (make-local-variable 'gnus-button-marker-list) + (make-local-variable 'gnus-article-current-summary) (gnus-set-default-directory) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) @@ -1918,23 +1929,20 @@ commands: (gnus-set-global-variables))) ;; Init original article buffer. (save-excursion - (set-buffer (get-buffer-create gnus-original-article-buffer)) + (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) (buffer-disable-undo (current-buffer)) (setq major-mode 'gnus-original-article-mode) - (gnus-add-current-to-buffer-list) (make-local-variable 'gnus-original-article)) (if (get-buffer name) (save-excursion (set-buffer name) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (current-buffer)) (save-excursion - (set-buffer (get-buffer-create name)) - (gnus-add-current-to-buffer-list) + (set-buffer (gnus-get-buffer-create name)) (gnus-article-mode) (make-local-variable 'gnus-summary-buffer) (current-buffer))))) @@ -1959,27 +1967,24 @@ commands: (defun gnus-article-display-mime-message () "Article display method for MIME message." + ;; called from `gnus-original-article-buffer'. + (let ((default-mime-charset (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset))) + (mime-display-message mime-message-structure + gnus-article-buffer nil gnus-article-mode-map)) + ;; `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)) - (let ((default-mime-charset - (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset)) - ) - (mime-display-message mime-message-structure - gnus-article-buffer nil gnus-article-mode-map) - ) - (run-hooks 'gnus-mime-article-prepare-hook) - ) + (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) - )) + (insert-buffer-substring gnus-original-article-buffer))) (defun gnus-article-display-message-with-encoded-word () "Article display method for message with encoded-words." @@ -1991,12 +1996,41 @@ commands: (eword-decode-header 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) - ) + (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-make-full-mail-header (&optional number charset) + "Create a new mail header structure in a raw article buffer." + (unless (and number charset) + (save-current-buffer + (set-buffer gnus-summary-buffer) + (unless number + (setq number (or (cdr gnus-article-current) 0))) + (unless charset + (setq charset (or default-mime-charset 'x-ctext))))) + (goto-char (point-min)) + (let ((header-end (if (search-forward "\n\n" nil t) + (1- (point)) + (goto-char (point-max)))) + (chars (- (point-max) (point))) + (lines (count-lines (point) (point-max))) + (default-mime-charset charset) + xref) + (narrow-to-region (point-min) header-end) + (setq xref (std11-fetch-field "xref")) + (prog1 + (make-full-mail-header + number + (std11-fetch-field "subject") + (std11-fetch-field "from") + (std11-fetch-field "date") + (std11-fetch-field "message-id") + (std11-fetch-field "references") + chars + lines + (when xref (concat "Xref: " xref))) + (widen)))) (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. @@ -2010,7 +2044,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (setq gnus-summary-buffer (current-buffer)) (let* ((gnus-article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) - (internal-hook gnus-article-internal-prepare-hook) + (gnus-tmp-internal-hook gnus-article-internal-prepare-hook) (group gnus-newsgroup-name) result) (save-excursion @@ -2037,9 +2071,10 @@ If ALL-HEADERS is non-nil, no headers are hidden." (message "Message marked for downloading")) (gnus-summary-mark-article article gnus-canceled-mark) (unless (memq article gnus-newsgroup-sparse) - (gnus-error 1 + (gnus-error 1 "No such article (may have expired or been canceled)"))))) - (if (or (eq result 'pseudo) (eq result 'nneething)) + (if (or (eq result 'pseudo) + (eq result 'nneething)) (progn (save-excursion (set-buffer summary-buffer) @@ -2072,7 +2107,12 @@ If ALL-HEADERS is non-nil, no headers are hidden." (unless (vectorp gnus-current-headers) (setq gnus-current-headers nil)) (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-show-thread) + (when (gnus-summary-show-thread) + ;; If the summary buffer really was folded, the + ;; previous goto may not actually have gone to + ;; the right article, but the thread root instead. + ;; So we go again. + (gnus-summary-goto-subject gnus-current-article)) (gnus-run-hooks 'gnus-mark-article-hook) (gnus-set-mode-line 'summary) (when (gnus-visual-p 'article-highlight 'highlight) @@ -2085,25 +2125,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (or all-headers gnus-show-all-headers)))) (when (or (numberp article) (stringp article)) - (let ((method - (if gnus-show-mime - (progn - (mime-parse-buffer) - (if (or (not gnus-strict-mime) - (mime-fetch-field "MIME-Version")) - gnus-article-display-method-for-mime - gnus-article-display-method-for-encoded-word)) - gnus-article-display-method-for-traditional))) - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (gnus-run-hooks 'internal-hook) - (gnus-run-hooks 'gnus-article-prepare-hook) - ;; Display message. - (funcall method) - ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary summary-buffer) - ;; Perform the article display hooks. - (gnus-run-hooks 'gnus-article-display-hook)) + (gnus-article-prepare-display) ;; Do page break. (goto-char (point-min)) (setq gnus-page-broken @@ -2113,8 +2135,30 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-set-mode-line 'article) (gnus-configure-windows 'article) (goto-char (point-min)) + (search-forward "\n\n" nil t) + (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) +(defun gnus-article-prepare-display () + "Make the current buffer look like a nice article." + (let ((method + (if gnus-show-mime + (progn + (mime-parse-buffer) + (if (or (not gnus-strict-mime) + (mime-fetch-field "MIME-Version")) + gnus-article-display-method-for-mime + gnus-article-display-method-for-encoded-word)) + gnus-article-display-method-for-traditional))) + (gnus-run-hooks 'gnus-tmp-internal-hook) + (gnus-run-hooks 'gnus-article-prepare-hook) + ;; Display message. + (funcall method) + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary (current-buffer)) + ;; Perform the article display hooks. + (gnus-run-hooks 'gnus-article-display-hook))) + (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion @@ -2137,7 +2181,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if mime ?m ? ) (if emphasis ?e ? ))))) -(defun gnus-article-hide-headers-if-wanted () +(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) + +(defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatibility." (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) @@ -2386,7 +2432,7 @@ If given a prefix, show the hidden text instead." (gnus-article-hide-signature arg)) (defun gnus-article-maybe-highlight () - "Do some article highlighting if `article-visual' is non-nil." + "Do some article highlighting if article highlighting is requested." (when (gnus-visual-p 'article-highlight 'highlight) (gnus-article-highlight-some))) @@ -2399,7 +2445,7 @@ If given a prefix, show the hidden text instead." (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." - (let (do-update-line) + (let (do-update-line sparse-header) (prog1 (save-excursion (erase-buffer) @@ -2433,7 +2479,7 @@ If given a prefix, show the hidden text instead." (setq do-update-line article) (setq article (mail-header-id header)) (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article)) + (setq sparse-header (gnus-read-header article))) (setq gnus-newsgroup-sparse (delq article gnus-newsgroup-sparse))) ((vectorp header) @@ -2448,8 +2494,11 @@ If given a prefix, show the hidden text instead." gnus-newsgroup-name))) (when (and (eq (car method) 'nneething) (vectorp header)) - (let ((dir (concat (file-name-as-directory (nth 1 method)) - (mail-header-subject header)))) + (let ((dir (concat + (file-name-as-directory + (or (cadr (assq 'nneething-address method)) + (nth 1 method))) + (mail-header-subject header)))) (when (file-directory-p dir) (setq article 'nneething) (gnus-group-enter-directory dir)))))))) @@ -2498,13 +2547,33 @@ If given a prefix, show the hidden text instead." ;; It was a pseudo. (t article))) + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary gnus-summary-buffer) + + ;; Take the article from the original article buffer + ;; and place it in the buffer it's supposed to be in. + (when (and (get-buffer gnus-article-buffer) + (equal (buffer-name (current-buffer)) + (buffer-name (get-buffer gnus-article-buffer)))) + (save-excursion + (if (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) + (buffer-disable-undo (current-buffer)) + (setq major-mode 'gnus-original-article-mode) + (setq buffer-read-only t)) + (let (buffer-read-only) + (erase-buffer) + (insert-buffer-substring gnus-article-buffer)) + (setq gnus-original-article (cons group article)))) + ;; Update sparse articles. (when (and do-update-line (or (numberp article) (stringp article))) (let ((buf (current-buffer))) (set-buffer gnus-summary-buffer) - (gnus-summary-update-article do-update-line) + (gnus-summary-update-article do-update-line sparse-header) (gnus-summary-goto-subject do-update-line nil t) (set-window-point (get-buffer-window (current-buffer) t) (point)) @@ -2519,6 +2588,12 @@ If given a prefix, show the hidden text instead." :group 'gnus-article-various :type 'hook) +(defcustom gnus-article-edit-article-setup-function + 'gnus-article-mime-edit-article-setup + "Function called to setup an editing article buffer." + :group 'gnus-article-various + :type 'function) + (defvar gnus-article-edit-done-function nil) (defvar gnus-article-edit-mode-map nil) @@ -2571,10 +2646,13 @@ groups." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) (gnus-article-edit-mode) + (gnus-article-delete-text-of-type 'annotation) (gnus-set-text-properties (point-min) (point-max) nil) (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) + (when gnus-article-edit-article-setup-function + (funcall gnus-article-edit-article-setup-function)) (gnus-message 6 "C-c C-c to end edits"))) (defun gnus-article-edit-done (&optional arg) @@ -2605,6 +2683,8 @@ groups." (let ((func gnus-article-edit-done-function) (buf (current-buffer)) (start (window-start))) + (remove-hook 'gnus-article-mode-hook + 'gnus-article-mime-edit-article-unwind) (gnus-article-edit-exit) (save-excursion (set-buffer buf) @@ -2656,6 +2736,86 @@ groups." (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) ;;; +;;; Article editing with MIME-Edit +;;; + +(defcustom gnus-article-mime-edit-article-setup-hook nil + "Hook run after setting up a MIME editing article buffer." + :group 'gnus-article-various + :type 'hook) + +(defun gnus-article-mime-edit-article-unwind () + "Unwind `gnus-article-buffer' if article editing was given up." + (remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) + (when mime-edit-mode-flag + (mime-edit-exit 'nomime 'no-error) + (message "")) + (when (featurep 'font-lock) + (setq font-lock-defaults nil) + (font-lock-mode 0))) + +(defun gnus-article-mime-edit-article-setup () + "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode +after replacing with the original article." + (setq gnus-show-mime t) + (setq gnus-article-edit-done-function + `(lambda (&rest args) + (when mime-edit-mode-flag + (mime-edit-exit) + (message "")) + (goto-char (point-min)) + (let (case-fold-search) + (when (re-search-forward + (format "^%s$" (regexp-quote mail-header-separator)) + nil t) + (replace-match ""))) + (when (featurep 'font-lock) + (setq font-lock-defaults nil) + (font-lock-mode 0)) + (apply ,gnus-article-edit-done-function args) + (set-buffer gnus-original-article-buffer) + (erase-buffer) + (insert-buffer gnus-article-buffer) + (setq gnus-current-headers (gnus-article-make-full-mail-header)) + (gnus-article-prepare-display))) + (define-key (current-local-map) "\C-c\C-k" 'gnus-article-mime-edit-exit) + (erase-buffer) + (insert-buffer gnus-original-article-buffer) + (mime-edit-again) + (when (featurep 'font-lock) + (set (make-local-variable 'font-lock-defaults) + '(message-font-lock-keywords t)) + (font-lock-set-defaults) + (turn-on-font-lock)) + (add-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) + (gnus-run-hooks 'gnus-article-mime-edit-article-setup-hook)) + +(defun gnus-article-mime-edit-exit () + "Exit the article MIME editing without updating." + (interactive) + (let ((winconf gnus-prev-winconf) + buf) + (when mime-edit-mode-flag + (mime-edit-exit) + (message "")) + (goto-char (point-min)) + (let (case-fold-search) + (when (re-search-forward + (format "^%s$" (regexp-quote mail-header-separator)) nil t) + (replace-match ""))) + (when (featurep 'font-lock) + (setq font-lock-defaults nil) + (font-lock-mode 0)) + ;; We remove all text props from the article buffer. + (setq buf (format "%s" (buffer-string))) + (set-buffer (get-buffer-create gnus-original-article-buffer)) + (erase-buffer) + (insert buf) + (setq gnus-current-headers (gnus-article-make-full-mail-header)) + (gnus-article-prepare-display) + (set-window-configuration winconf))) + +;;; ;;; Article highlights ;;; @@ -2755,6 +2915,7 @@ call it with the value of the `gnus-data' text property." (let* ((pos (posn-point (event-start event))) (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) + (goto-char pos) (when fun (funcall fun data)))) @@ -3113,7 +3274,7 @@ forbidden in URL encoding." ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) - (let (to args source-url subject func) + (let (to args subject func) (if (string-match (regexp-quote "?") url) (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) args (gnus-url-parse-query-string @@ -3121,26 +3282,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." @@ -3172,7 +3336,8 @@ forbidden in URL encoding." (gnus-eval-format gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map - gnus-callback gnus-article-button-prev-page)))) + gnus-callback gnus-article-button-prev-page + gnus-type annotation)))) (defvar gnus-next-page-map nil) (unless gnus-next-page-map @@ -3200,9 +3365,10 @@ forbidden in URL encoding." (defun gnus-insert-next-page-button () (let ((buffer-read-only nil)) (gnus-eval-format gnus-next-page-line-format nil - `(gnus-next t local-map ,gnus-next-page-map - gnus-callback - gnus-article-button-next-page)))) + `(gnus-next + t local-map ,gnus-next-page-map + gnus-callback gnus-article-button-next-page + gnus-type annotation)))) (defun gnus-article-button-next-page (arg) "Go to the next page." @@ -3225,7 +3391,7 @@ forbidden in URL encoding." ;;; (defun gnus-article-header-presentation-method (entity situation) - (mime-insert-decoded-header entity nil nil default-mime-charset) + (mime-insert-decoded-header entity) ) (set-alist 'mime-header-presentation-method-alist @@ -3241,9 +3407,6 @@ forbidden in URL encoding." (gnus-summary-select-article nil t) )) -(set-alist 'mime-raw-representation-type-alist - 'gnus-original-article-mode 'binary) - (set-alist 'mime-preview-quitting-method-alist 'gnus-original-article-mode #'gnus-mime-preview-quitting-method) diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 8da43cc..870192f 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -213,11 +213,13 @@ It should return non-nil if the article is to be prefetched." (when arg (gnus-async-set-buffer) (gnus-async-with-semaphore - (push (list ',(intern (format "%s-%d" group article) - gnus-asynch-obarray) - ,mark (set-marker (make-marker) (point-max)) - ,group ,article) - gnus-async-article-alist))) + (setq + gnus-async-article-alist + (cons (list ',(intern (format "%s-%d" group article) + gnus-asynch-obarray) + ,mark (set-marker (make-marker) (point-max)) + ,group ,article) + gnus-async-article-alist)))) (if (not (gnus-buffer-live-p ,summary)) (gnus-async-with-semaphore (setq gnus-async-fetch-list nil)) diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el new file mode 100644 index 0000000..10b1acc --- /dev/null +++ b/lisp/gnus-bbdb.el @@ -0,0 +1,581 @@ +;; gnus-bbdb.el --- Interface to Semi-gnus. + +;; Copyright (c) 1991,1992,1993 Jamie Zawinski . +;; Copyright (C) 1995,1996,1997 Shuhei KOBAYASHI +;; Copyright (C) 1997,1998 MORIOKA Tomohiko +;; Copyright (C) 1998 Keiichi Suzuki + +;; Author: Keiichi Suzuki +;; Author: Shuhei KOBAYASHI +;; Keywords: BBDB, MIME, multimedia, multilingual, mail, news + +;; This file is part of Semi-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 'bbdb) +(require 'gnus) +(require 'std11) +(eval-when-compile + (require 'gnus-win)) + +(defvar gnus-bbdb/decode-field-body-function 'eword-decode-string + "*Field body decoder.") + +(defmacro gnus-bbdb/decode-field-body (field-body field-name) + `(or (and (functionp gnus-bbdb/decode-field-body-function) + (funcall gnus-bbdb/decode-field-body-function + ,field-body)) + ,field-body)) + +;;;###autoload +(defun gnus-bbdb/update-record (&optional offer-to-create) + "returns the record corresponding to the current GNUS message, creating +or modifying it as necessary. A record will be created if +bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and +the user confirms the creation." + (if bbdb-use-pop-up + (gnus-bbdb/pop-up-bbdb-buffer offer-to-create) + (save-excursion + (save-restriction + (let (from) + (set-buffer gnus-original-article-buffer) + (widen) + (narrow-to-region (point-min) + (progn (goto-char (point-min)) + (or (search-forward "\n\n" nil t) + (error "message unexists")) + (- (point) 2))) + (when (setq from (mail-fetch-field "from")) + (setq from (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body from 'From)))) + (when (and (car (cdr from)) + (string-match (bbdb-user-mail-names) + (car (cdr from)))) + ;; if logged-in user sent this, use recipients. + (let ((to (mail-fetch-field "to"))) + (when to + (setq from + (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body to 'To)))))) + (when from + (bbdb-annotate-message-sender from t + (or (bbdb-invoke-hook-for-value + bbdb/news-auto-create-p) + offer-to-create) + offer-to-create))))))) + +;;;###autoload +(defun gnus-bbdb/annotate-sender (string &optional replace) + "Add a line to the end of the Notes field of the BBDB record +corresponding to the sender of this message. If REPLACE is non-nil, +replace the existing notes entry (if any)." + (interactive (list (if bbdb-readonly-p + (error "The Insidious Big Brother Database is read-only.") + (read-string "Comments: ")))) + (bbdb-annotate-notes (gnus-bbdb/update-record t) string 'notes replace)) + +(defun gnus-bbdb/edit-notes (&optional arg) + "Edit the notes field or (with a prefix arg) a user-defined field +of the BBDB record corresponding to the sender of this message." + (interactive "P") + (let ((record (or (gnus-bbdb/update-record t) (error "")))) + (bbdb-display-records (list record)) + (if arg + (bbdb-record-edit-property record nil t) + (bbdb-record-edit-notes record t)))) + +;;;###autoload +(defun gnus-bbdb/show-sender () + "Display the contents of the BBDB for the sender of this message. +This buffer will be in bbdb-mode, with associated keybindings." + (interactive) + (let ((record (gnus-bbdb/update-record t))) + (if record + (bbdb-display-records (list record)) + (error "unperson")))) + + +(defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create) + "Make the *BBDB* buffer be displayed along with the GNUS windows, +displaying the record corresponding to the sender of the current message." + (let ((bbdb-gag-messages t) + (bbdb-use-pop-up nil) + (bbdb-electric-p nil)) + (let ((record (gnus-bbdb/update-record offer-to-create)) + (bbdb-elided-display (bbdb-pop-up-elided-display)) + (b (current-buffer))) + ;; display the bbdb buffer iff there is a record for this article. + (cond (record + (bbdb-pop-up-bbdb-buffer + (function (lambda (w) + (let ((b (current-buffer))) + (set-buffer (window-buffer w)) + (prog1 (or (eq major-mode 'mime-veiw-mode) + (eq major-mode 'gnus-article-mode)) + (set-buffer b)))))) + (bbdb-display-records (list record))) + (t + (or bbdb-inside-electric-display + (not (get-buffer-window bbdb-buffer-name)) + (let (w) + (delete-other-windows) + (if (assq 'article gnus-buffer-configuration) + (gnus-configure-windows 'article) + (gnus-configure-windows 'SelectArticle)) + (if (setq w (get-buffer-window gnus-summary-buffer)) + (select-window w)) + )))) + (set-buffer b) + record))) + +;; +;; Announcing BBDB entries in the summary buffer +;; + +(defcustom gnus-bbdb/lines-and-from-length 18 + "*The number of characters used to display From: info in Gnus, if you have +set gnus-optional-headers to 'gnus-bbdb/lines-and-from." + :group 'bbdb-mua-specific-gnus + :type 'integer) + +(defcustom gnus-bbdb/summary-mark-known-posters t + "*If t, mark messages created by people with records in the BBDB. +In GNUS, this marking will take place in the subject list (assuming +`gnus-optional-headers' contains `gnus-bbdb/lines-and-from'). In Gnus, the +marking will take place in the Summary buffer if the format code defined by +`gnus-bbdb/summary-user-format-letter' is used in `gnus-summary-line-format'. +This variable has no effect on the marking controlled by +`gnus-bbdb/summary-in-bbdb-format-letter'." + :group 'bbdb-mua-specific-gnus + :type '(choice (const :tag "Mark known posters" t) + (const :tag "Do not mark known posters" nil))) +(defvaralias 'gnus-bbdb/mark-known-posters + 'gnus-bbdb/summary-mark-known-posters) + +(defcustom gnus-bbdb/summary-known-poster-mark "+" + "This is the default character to prefix author names with if +gnus-bbdb/summary-mark-known-posters is t. If the poster's record has +an entry in the field named by bbdb-message-marker-field, then that will +be used instead." + :group 'bbdb-mua-specific-gnus + :type 'character) + +(defcustom gnus-bbdb/summary-show-bbdb-names t + "*If both this variable and `gnus-bbdb/summary-prefer-real-names' are true, +then for messages from authors who are in your database, the name +displayed will be the primary name in the database, rather than the +one in the From line of the message. This doesn't affect the names of +people who aren't in the database, of course. (`gnus-optional-headers' +must be `gnus-bbdb/lines-and-from' for GNUS users.)" + :group 'bbdb-mua-specific-gnus + :type 'boolean) +(defvaralias 'gnus-bbdb/header-show-bbdb-names + 'gnus-bbdb/summary-show-bbdb-names) + +(defcustom gnus-bbdb/summary-prefer-bbdb-data t + "If t, then for posters who are in our BBDB, replace the information +provided in the From header with data from the BBDB." + :group 'bbdb-mua-specific-gnus + :type 'boolean) + +(defcustom gnus-bbdb/summary-prefer-real-names t + "If t, then display the poster's name from the BBDB if we have one, +otherwise display his/her primary net address if we have one. If it +is set to the symbol bbdb, then real names will be used from the BBDB +if present, otherwise the net address in the post will be used. If +gnus-bbdb/summary-prefer-bbdb-data is nil, then this has no effect. +See `gnus-bbdb/lines-and-from' for GNUS users, or +`gnus-bbdb/summary-user-format-letter' for Gnus users." + :group 'bbdb-mua-specific-gnus + :type '(choice (const :tag "Prefer real names" t) + (const :tag "Prefer network addresses" nil))) +(defvaralias 'gnus-bbdb/header-prefer-real-names + 'gnus-bbdb/summary-prefer-real-names) + +(defcustom gnus-bbdb/summary-user-format-letter "B" + "This is the gnus-user-format-function- that will be used to insert +the information from the BBDB in the summary buffer (using +`gnus-bbdb/summary-get-author'). This format code is meant to replace +codes that insert sender names or addresses (like %A or %n). Unless +you've alread got other code using user format B, you might as well +stick with the default. Additionally, if the value of this variable +is nil, no format function will be installed for +`gnus-bbdb/summary-get-author'. See also +`gnus-bbdb/summary-in-bbdb-format-letter', which installs a format +code for `gnus-bbdb/summary-author-in-bbdb'" + :group 'bbdb-mua-specific-gnus + :type 'character) + +(defcustom gnus-bbdb/summary-in-bbdb-format-letter "b" + "This is the gnus-user-format-function- that will be used to insert +`gnus-bbdb/summary-known-poster-mark' (using +`gnus-bbdb/summary-author-in-bbdb') if the poster is in the BBDB, and +\" \" if not. If the value of this variable is nil, no format code +will be installed for `gnus-bbdb/summary-author-in-bbdb'. See also +`gnus-bbdb/summary-user-format-letter', which installs a format code +for `gnus-bbdb/summary-get-author'." + :group 'bbdb-mua-specific-gnus + :type 'character) + +(defcustom bbdb-message-marker-field 'mark-char + "*The field whose value will be used to mark messages by this user in Gnus." + :group 'bbdb-mua-specific-gnus + :type 'symbol) + +;;;###autoload +(defun gnus-bbdb/lines-and-from (header) + "Useful as the value of gnus-optional-headers in *GNUS* (not Gnus). +NOTE: This variable no longer seems to be present in Gnus. It seems +to have been replaced by `message-default-headers', which only takes +strings. In the future this should change." + (let* ((length gnus-bbdb/lines-and-from-length) + (lines (mail-header-lines header)) + (from (mail-header-from header)) + (data (and (or gnus-bbdb/summary-mark-known-posters + gnus-bbdb/summary-show-bbdb-names) + (condition-case () + (gnus-bbdb/extract-address-components from) + (error nil)))) + (name (car data)) + (net (car (cdr data))) + (record (and data + (bbdb-search-simple name + (if (and net bbdb-canonicalize-net-hook) + (bbdb-canonicalize-address net) + net)))) + string L) + + (if (and record name (member (downcase name) (bbdb-record-net record))) + ;; bogon! + (setq record nil)) + + (setq name + (or (and gnus-bbdb/summary-prefer-bbdb-data + (or (and gnus-bbdb/summary-prefer-real-names + (and record (bbdb-record-name record))) + (and record (bbdb-record-net record) + (nth 0 (bbdb-record-net record))))) + (and gnus-bbdb/summary-prefer-real-names + (or (and (equal gnus-bbdb/summary-prefer-real-names 'bbdb) + net) + name)) + net from "**UNKNOWN**")) + ;; GNUS can't cope with extra square-brackets appearing in the summary. + (if (and name (string-match "[][]" name)) + (progn (setq name (copy-sequence name)) + (while (string-match "[][]" name) + (aset name (match-beginning 0) ? )))) + (setq string (format "%s%3d:%s" + (if (and record gnus-bbdb/summary-mark-known-posters) + (or (bbdb-record-getprop + record bbdb-message-marker-field) + "*") + " ") + lines (or name from)) + L (length string)) + (cond ((> L length) (substring string 0 length)) + ((< L length) (concat string (make-string (- length L) ? ))) + (t string)))) + +(defun gnus-bbdb/summary-get-author (header) + "Given a Gnus message header, returns the appropriate piece of +information to identify the author in a Gnus summary line, depending on +the settings of the various configuration variables. See the +documentation for the following variables for more details: + `gnus-bbdb/summary-mark-known-posters' + `gnus-bbdb/summary-known-poster-mark' + `gnus-bbdb/summary-prefer-bbdb-data' + `gnus-bbdb/summary-prefer-real-names' +This function is meant to be used with the user function defined in + `gnus-bbdb/summary-user-format-letter'" + (let* ((from (mail-header-from header)) + (data (and gnus-bbdb/summary-show-bbdb-names + (condition-case () + (gnus-bbdb/extract-address-components from) + (error nil)))) + (name (car data)) + (net (car (cdr data))) + (record (and data + (bbdb-search-simple name + (if (and net bbdb-canonicalize-net-hook) + (bbdb-canonicalize-address net) + net))))) + (if (and record name (member (downcase name) (bbdb-record-net record))) + ;; bogon! + (setq record nil)) + (setq name + (or (and gnus-bbdb/summary-prefer-bbdb-data + (or (and gnus-bbdb/summary-prefer-real-names + (and record (bbdb-record-name record))) + (and record (bbdb-record-net record) + (nth 0 (bbdb-record-net record))))) + (and gnus-bbdb/summary-prefer-real-names + (or (and (equal gnus-bbdb/summary-prefer-real-names 'bbdb) + net) + name)) + net from "**UNKNOWN**")) + (format "%s%s" + (or (and record gnus-bbdb/summary-mark-known-posters + (or (bbdb-record-getprop + record bbdb-message-marker-field) + gnus-bbdb/summary-known-poster-mark)) + " ") + name))) + +;; DEBUG: (gnus-bbdb/summary-author-in-bbdb "From: simmonmt@acm.org") +(defun gnus-bbdb/summary-author-in-bbdb (header) + "Given a Gnus message header, returns a mark if the poster is in the BBDB, \" \" otherwise. The mark itself is the value of the field indicated by `bbdb-message-marker-field' (`mark-char' by default) if the indicated field is in the poster's record, and `gnus-bbdb/summary-known-poster-mark' otherwise." + (let* ((from (mail-header-from header)) + (data (condition-case () + (gnus-bbdb/extract-address-components from) + (error nil))) + (name (car data)) + (net (cadr data)) + record) + (if (and data + (setq record + (bbdb-search-simple + name (if (and net bbdb-canonicalize-net-hook) + (bbdb-canonicalize-address net) + net)))) + (or (bbdb-record-getprop + record bbdb-message-marker-field) + gnus-bbdb/summary-known-poster-mark) " "))) + +;; +;; Scoring +;; + +(defcustom gnus-bbdb/score-field 'gnus-score + "This variable contains the name of the BBDB field which should be +checked for a score to add to the net addresses in the same record." + :group 'bbdb-mua-specific-gnus-scoring + :type 'symbol) + +(defcustom gnus-bbdb/score-default nil + "If this is set, then every net address in the BBDB that does not have +an associated score field will be assigned this score. A value of nil +implies a default score of zero." + :group 'bbdb-mua-specific-gnus-scoring + :type '(choice (const :tag "Do not assign default score") + (integer :tag "Assign this default score" 0))) + +(defvar gnus-bbdb/score-default-internal nil + "Internal variable for detecting changes to +`gnus-bbdb/score-default'. You should not set this variable directly - +set `gnus-bbdb/score-default' instead.") + +(defvar gnus-bbdb/score-alist nil + "The text version of the scoring structure returned by +gnus-bbdb/score. This is built automatically from the BBDB.") + +(defvar gnus-bbdb/score-rebuild-alist t + "Set to t to rebuild gnus-bbdb/score-alist on the next call to +gnus-bbdb/score. This will be set automatically if you change a BBDB +record which contains a gnus-score field.") + +(defun gnus-bbdb/score-invalidate-alist (rec) + "This function is called through bbdb-after-change-hook, and sets +gnus-bbdb/score-rebuild-alist to t if the changed record contains a +gnus-score field." + (if (bbdb-record-getprop rec gnus-bbdb/score-field) + (setq gnus-bbdb/score-rebuild-alist t))) + +;;;###autoload +(defun gnus-bbdb/score (group) + "This returns a score alist for GNUS. A score pair will be made for +every member of the net field in records which also have a gnus-score +field. This allows the BBDB to serve as a supplemental global score +file, with the advantage that it can keep up with multiple and changing +addresses better than the traditionally static global scorefile." + (list (list + (condition-case nil + (read (gnus-bbdb/score-as-text group)) + (error (setq gnus-bbdb/score-rebuild-alist t) + (message "Problem building BBDB score table.") + (ding) (sit-for 2) + nil))))) + +(defun gnus-bbdb/score-as-text (group) + "Returns a SCORE file format string built from the BBDB." + (cond ((or (cond ((/= (or gnus-bbdb/score-default 0) + (or gnus-bbdb/score-default-internal 0)) + (setq gnus-bbdb/score-default-internal + gnus-bbdb/score-default) + t)) + (not gnus-bbdb/score-alist) + gnus-bbdb/score-rebuild-alist) + (setq gnus-bbdb/score-rebuild-alist nil) + (setq gnus-bbdb/score-alist + (concat "((touched nil) (\"from\"\n" + (mapconcat + (lambda (rec) + (let ((score (or (bbdb-record-getprop rec + gnus-bbdb/score-field) + gnus-bbdb/score-default)) + (net (bbdb-record-net rec))) + (if (not (and score net)) nil + (mapconcat + (lambda (addr) + (concat "(\"" addr "\" " score ")\n")) + net "")))) + (bbdb-records) "") + "))")))) + gnus-bbdb/score-alist) + +(defun gnus-bbdb/extract-field-value-init () + (when (or (and (eq (current-buffer) (get-buffer gnus-article-buffer)) + (buffer-live-p gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer)) + (eq (current-buffer) (get-buffer gnus-original-article-buffer))) + (widen) + (narrow-to-region (point-min) + (progn (goto-char (point-min)) + (or (search-forward "\n\n" nil t) + (error "message unexists")) + (- (point) 2))) + 'gnus-bbdb/extract-field-value)) + +(defun gnus-bbdb/extract-field-value (field-name) + "Given the name of a field (like \"Subject\") this returns the value of +that field in the current message, or nil. This works whether you're in +Semi-gnus, Rmail, or VM. This works on multi-line fields, but if more than +one field of the same name is present, only the last is returned. It is +expected that the current buffer has a message in it, and (point) is at the +beginning of the message headers." + ;; we can't special-case VM here to use its cache, because the cache has + ;; divided real-names from addresses; the actual From: and Subject: fields + ;; exist only in the message. + (let (value) + (when (setq value (mail-fetch-field field-name)) + (gnus-bbdb/decode-field-body value field-name)))) + +;;; @ mail-extr +;;; + +(defvar gnus-bbdb/canonicalize-full-name-methods + '(gnus-bbdb/canonicalize-dots + gnus-bbdb/canonicalize-spaces)) + +(defun gnus-bbdb/extract-address-components (str) + (let* ((ret (std11-extract-address-components str)) + (phrase (car ret)) + (address (car (cdr ret))) + (methods gnus-bbdb/canonicalize-full-name-methods)) + (while (and phrase methods) + (setq phrase (funcall (car methods) phrase) + methods (cdr methods))) + (if (string= address "") (setq address nil)) + (if (string= phrase "") (setq phrase nil)) + (when (or phrase address) + (list phrase address)) + )) + +;;; @ full-name canonicalization methods +;;; + +(defun gnus-bbdb/canonicalize-spaces (str) + (let (dest) + (while (string-match "\\s +" str) + (setq dest (cons (substring str 0 (match-beginning 0)) dest)) + (setq str (substring str (match-end 0))) + ) + (or (string= str "") + (setq dest (cons str dest))) + (setq dest (nreverse dest)) + (mapconcat 'identity dest " ") + )) + +(defun gnus-bbdb/canonicalize-dots (str) + (let (dest) + (while (string-match "\\." str) + (setq dest (cons (substring str 0 (match-end 0)) dest)) + (setq str (substring str (match-end 0))) + ) + (or (string= str "") + (setq dest (cons str dest))) + (setq dest (nreverse dest)) + (mapconcat 'identity dest " ") + )) + +;; +;; Insinuation +;; + +;;;###autoload +(defun gnus-bbdb-insinuate () + "Call this function to hook BBDB into Semi-gnus." +;; (setq gnus-optional-headers 'gnus-bbdb/lines-and-from) + (when (boundp 'bbdb-extract-field-value-function-list) + (add-to-list 'bbdb-extract-field-value-function-list + 'gnus-bbdb/extract-field-value-init)) + (add-hook 'gnus-article-prepare-hook 'gnus-bbdb/update-record) + (add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save) + (define-key gnus-summary-mode-map ":" 'gnus-bbdb/show-sender) + (define-key gnus-summary-mode-map ";" 'gnus-bbdb/edit-notes) + + ;; Set up user field for use in gnus-summary-line-format + (let ((get-author-user-fun (intern + (concat "gnus-user-format-function-" + gnus-bbdb/summary-user-format-letter))) + (in-bbdb-user-fun (intern + (concat "gnus-user-format-function-" + gnus-bbdb/summary-in-bbdb-format-letter)))) + ; The big one - whole name + (cond (gnus-bbdb/summary-user-format-letter + (if (and (fboundp get-author-user-fun) + (not (eq (symbol-function get-author-user-fun) + 'gnus-bbdb/summary-get-author))) + (bbdb-warn + (format "`gnus-user-format-function-%s' already seems to be in use. +Please redefine `gnus-bbdb/summary-user-format-letter' to a different letter." + gnus-bbdb/summary-user-format-letter)) + (fset get-author-user-fun 'gnus-bbdb/summary-get-author)))) + + ; One tick. One tick only, please + (cond (gnus-bbdb/summary-in-bbdb-format-letter + (if (and (fboundp in-bbdb-user-fun) + (not (eq (symbol-function in-bbdb-user-fun) + 'gnus-bbdb/summary-author-in-bbdb))) + (bbdb-warn + (format "`gnus-user-format-function-%s' already seems to be in use. +Redefine `gnus-bbdb/summary-in-bbdb-format-letter' to a different letter." + gnus-bbdb/summary-in-bbdb-format-letter)) + (fset in-bbdb-user-fun 'gnus-bbdb/summary-author-in-bbdb))))) + + ;; Scoring + (add-hook 'bbdb-after-change-hook 'gnus-bbdb/score-invalidate-alist) +; (setq gnus-score-find-score-files-function +; (if (boundp 'gnus-score-find-score-files-function) +; (cond ((functionp gnus-score-find-score-files-function) +; (list gnus-score-find-score-files-function +; 'gnus-bbdb/score)) +; ((listp gnus-score-find-score-files-function) +; (append gnus-score-find-score-files-function +; 'gnus-bbdb/score)) +; (t 'gnus-bbdb/score)) +; 'gnus-bbdb/score)) + ) + +;;;###autoload +(defun gnus-bbdb-insinuate-message () + "Call this function to hook BBDB into message-mode." + (define-key message-mode-map "\M-\t" 'bbdb-complete-name)) + +(provide 'gnus-bbdb) diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index d9934e5..d370673 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -41,10 +41,9 @@ "Return the backlog buffer." (or (get-buffer gnus-backlog-buffer) (save-excursion - (set-buffer (get-buffer-create gnus-backlog-buffer)) + (set-buffer (gnus-get-buffer-create gnus-backlog-buffer)) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) (get-buffer gnus-backlog-buffer)))) (defun gnus-backlog-setup () diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 21e3c50..7ac6ba2 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -50,15 +50,33 @@ :group 'gnus-cache :type '(set (const ticked) (const dormant) (const unread) (const read))) +(defcustom gnus-cacheable-groups nil + "*Groups that match this regexp will be cached. + +If you only want to cache your nntp groups, you could set this +variable to \"^nntp\". + +If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups +it's not cached." + :group 'gnus-cache + :type '(choice (const :tag "off" nil) + regexp)) + (defcustom gnus-uncacheable-groups nil "*Groups that match this regexp will not be cached. If you want to avoid caching your nnml groups, you could set this -variable to \"^nnml\"." +variable to \"^nnml\". + +If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups +it's not cached." :group 'gnus-cache :type '(choice (const :tag "off" nil) regexp)) +(defvar gnus-cache-overview-coding-system 'raw-text + "Coding system used on Gnus cache files.") + ;;; Internal variables. @@ -106,7 +124,9 @@ variable to \"^nnml\"." (set-buffer buffer) (if (> (buffer-size) 0) ;; Non-empty overview, write it to a file. - (gnus-write-buffer overview-file) + (let ((coding-system-for-write + gnus-cache-overview-coding-system)) + (gnus-write-buffer overview-file)) ;; Empty overview file, remove it (when (file-exists-p overview-file) (delete-file overview-file)) @@ -135,11 +155,13 @@ variable to \"^nnml\"." headers (copy-sequence headers)) (mail-header-set-number headers (cdr result)))) (let ((number (mail-header-number headers)) - file dir) + file) (when (and number (> number 0) ; Reffed article. (or force - (and (or (not gnus-uncacheable-groups) + (and (or (not gnus-cacheable-groups) + (string-match gnus-cacheable-groups group)) + (or (not gnus-uncacheable-groups) (not (string-match gnus-uncacheable-groups group))) (gnus-cache-member-of-class @@ -147,7 +169,7 @@ variable to \"^nnml\"." (not (file-exists-p (setq file (gnus-cache-file-name group number))))) ;; Possibly create the cache directory. - (gnus-make-directory (setq dir (file-name-directory file))) + (gnus-make-directory (file-name-directory file)) ;; Save the article in the cache. (if (file-exists-p file) t ; The article already is saved. @@ -347,7 +369,7 @@ Returns the list of articles removed." (defun gnus-summary-insert-cached-articles () "Insert all the articles cached for this group into the current buffer." (interactive) - (let ((cached gnus-newsgroup-cached) + (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '<)) (gnus-verbose (max 6 gnus-verbose))) (unless cached (gnus-message 3 "No cached articles for this group")) @@ -371,7 +393,8 @@ Returns the list of articles removed." (save-excursion (setq gnus-cache-buffer (cons group - (set-buffer (get-buffer-create " *gnus-cache-overview*")))) + (set-buffer (gnus-get-buffer-create + " *gnus-cache-overview*")))) (buffer-disable-undo (current-buffer)) ;; Insert the contents of this group's cache overview. (erase-buffer) @@ -459,7 +482,7 @@ Returns the list of articles removed." articles))) (defun gnus-cache-braid-nov (group cached &optional file) - (let ((cache-buf (get-buffer-create " *gnus-cache*")) + (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")) beg end) (gnus-cache-save-buffers) (save-excursion @@ -491,7 +514,7 @@ Returns the list of articles removed." (kill-buffer cache-buf))) (defun gnus-cache-braid-heads (group cached) - (let ((cache-buf (get-buffer-create " *gnus-cache*"))) + (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) (save-excursion (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) @@ -619,6 +642,8 @@ If LOW, update the lower bound instead." (when top (gnus-message 5 "Generating the cache active file...") (setq gnus-cache-active-hashtb (gnus-make-hashtable 123))) + (when (string-match "^\\(nn[^_]+\\)_" group) + (setq group (replace-match "\\1:" t t group))) ;; Separate articles from all other files and directories. (while files (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) @@ -631,7 +656,7 @@ If LOW, update the lower bound instead." ;; Go through all the other files. (while alphs (when (and (file-directory-p (car alphs)) - (not (string-match "^\\.\\.?$" + (not (string-match "^\\." (file-name-nondirectory (car alphs))))) ;; We descend directories. (gnus-cache-generate-active (car alphs))) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 3fca44b..025273b 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -28,7 +28,6 @@ (require 'wid-edit) (require 'gnus-score) -(require 'gnus-topic) ;;; Widgets: @@ -160,15 +159,7 @@ An arbitrary comment on the group.") (visible (const :tag "Permanently visible" t) "\ Always display this group, even when there are no unread articles -in it..") - - (charset (string :tag "Charset") "\ -The default charset to use in the group.") - - (iso-8859-1-forced (const :tag "Force ISO 8859-1 to default charset" - t)"\ -Force ISO 8859-1 to default charset in the group.") -) +in it..")) "Alist of valid group parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter @@ -178,11 +169,10 @@ DOC is a documentation string for the parameter.") (defvar gnus-custom-params) (defvar gnus-custom-method) (defvar gnus-custom-group) -(defvar gnus-custom-topic) -(defun gnus-group-customize (group &optional topic) - "Edit the group or topic on the current line." - (interactive (list (gnus-group-group-name) (gnus-group-topic-name))) +(defun gnus-group-customize (group) + "Edit the group on the current line." + (interactive (list (gnus-group-group-name))) (let (info (types (mapcar (lambda (entry) `(cons :format "%v%h\n" @@ -190,11 +180,9 @@ DOC is a documentation string for the parameter.") (const :format "" ,(nth 0 entry)) ,(nth 1 entry))) gnus-group-parameters))) - (unless (or group topic) + (unless group (error "No group on current line")) - (when (and group topic) - (error "Both a group an topic on current line")) - (unless (or topic (setq info (gnus-get-info group))) + (unless (setq info (gnus-get-info group)) (error "Killed group; can't be edited")) ;; Ready. (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) @@ -202,20 +190,13 @@ DOC is a documentation string for the parameter.") (gnus-custom-mode) (make-local-variable 'gnus-custom-group) (setq gnus-custom-group group) - (make-local-variable 'gnus-custom-topic) - (setq gnus-custom-topic topic) (widget-insert "Customize the ") - (if group - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "group parameters" - "(gnus)Group Parameters") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "topic parameters" - "(gnus)Topic Parameters")) + (widget-create 'info-link + :help-echo "Push me to learn more." + :tag "group parameters" + "(gnus)Group Parameters") (widget-insert " for <") - (widget-insert (or group topic)) + (widget-insert group) (widget-insert "> and press ") (widget-create 'push-button :tag "done" @@ -225,17 +206,15 @@ DOC is a documentation string for the parameter.") (make-local-variable 'gnus-custom-params) (setq gnus-custom-params (widget-create 'group - :value (if group - (gnus-info-params info) - (gnus-topic-parameters topic)) + :value (gnus-info-params info) `(set :inline t :greedy t :tag "Parameters" :format "%t:\n%h%v" :doc "\ These special paramerters are recognized by Gnus. -Check the [ ] for the parameters you want to apply to this group or -to the groups in this topic, then edit the value to suit your taste." +Check the [ ] for the parameters you want to apply to this group, then +edit the value to suit your taste." ,@types) '(repeat :inline t :tag "Variables" @@ -253,7 +232,7 @@ like. If you want to hear a beep when you enter a group, you could put something like `(dummy-variable (ding))' in the parameters of that group. `dummy-variable' will be set to the result of the `(ding)' form, but who cares?" - (cons :format "%v" :value (nil . nil) + (group :value (nil nil) (symbol :tag "Variable") (sexp :tag "Value"))) @@ -261,30 +240,26 @@ form, but who cares?" '(repeat :inline t :tag "Unknown entries" sexp))) - (when group - (widget-insert "\n\nYou can also edit the ") - (widget-create 'info-link - :tag "select method" - :help-echo "Push me to learn more about select methods." - "(gnus)Select Methods") - (widget-insert " for the group.\n") - (setq gnus-custom-method - (widget-create 'sexp - :tag "Method" - :value (gnus-info-method info)))) + (widget-insert "\n\nYou can also edit the ") + (widget-create 'info-link + :tag "select method" + :help-echo "Push me to learn more about select methods." + "(gnus)Select Methods") + (widget-insert " for the group.\n") + (setq gnus-custom-method + (widget-create 'sexp + :tag "Method" + :value (gnus-info-method info))) (use-local-map widget-keymap) (widget-setup))) (defun gnus-group-customize-done (&rest ignore) "Apply changes and bury the buffer." (interactive) - (if gnus-custom-topic - (gnus-topic-set-parameters gnus-custom-topic - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'params gnus-custom-group - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'method gnus-custom-group - (widget-value gnus-custom-method))) + (gnus-group-edit-group-done 'params gnus-custom-group + (widget-value gnus-custom-params)) + (gnus-group-edit-group-done 'method gnus-custom-group + (widget-value gnus-custom-method)) (bury-buffer)) ;;; Score Customization: @@ -605,7 +580,6 @@ if you do all your changes will be lost. ") (gnus-score-string :tag "Subject") (gnus-score-string :tag "References") (gnus-score-string :tag "Xref") - (gnus-score-string :tag "Extra") (gnus-score-string :tag "Message-ID") (gnus-score-integer :tag "Lines") (gnus-score-integer :tag "Chars") diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index fce8744..f428731 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -95,7 +95,11 @@ (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) + (let ((gnus-verbose-backends nil)) + (gnus-request-expire-articles (list article) gnus-newsgroup-name t)) (push `((lambda () (when (gnus-buffer-exists-p ,gnus-summary-buffer) @@ -117,7 +121,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 @@ -132,13 +136,28 @@ (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. - (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))))) (defun gnus-draft-send-all-messages () "Send all the sendable drafts." @@ -178,8 +197,7 @@ ;;;!!!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) @@ -193,7 +211,19 @@ (forward-char -1) (insert mail-header-separator) (forward-line 1) - (message-set-auto-save-file-name)))))) + (message-set-auto-save-file-name))))) +;; +(defvar gnus-draft-send-draft-buffer " *send draft*") +(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-eform.el b/lisp/gnus-eform.el index ff35a42..6a93242 100644 --- a/lisp/gnus-eform.el +++ b/lisp/gnus-eform.el @@ -88,9 +88,8 @@ It is a slightly enhanced emacs-lisp-mode. Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning of the buffer." (let ((winconf (current-window-configuration))) - (set-buffer (get-buffer-create gnus-edit-form-buffer)) + (set-buffer (gnus-get-buffer-create gnus-edit-form-buffer)) (gnus-configure-windows 'edit-form) - (gnus-add-current-to-buffer-list) (gnus-edit-form-mode) (setq gnus-prev-winconf winconf) (setq gnus-edit-form-done-function exit-func) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 7328093..f798e12 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -58,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) @@ -71,14 +69,6 @@ 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." @@ -224,16 +214,56 @@ ;; `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) @@ -245,23 +275,9 @@ (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 () @@ -274,6 +290,7 @@ (defun gnus-add-minor-mode (mode name map) (if (fboundp 'add-minor-mode) (add-minor-mode mode name map) + (set (make-local-variable mode) t) (unless (assq mode minor-mode-alist) (push `(,mode ,name) minor-mode-alist)) (unless (assq mode minor-mode-map-alist) @@ -285,7 +302,7 @@ (let ((dir (nnheader-find-etc-directory "gnus")) pixmap file height beg i) (save-excursion - (switch-to-buffer (get-buffer-create gnus-group-buffer)) + (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) (let ((buffer-read-only nil)) (erase-buffer) (when (and dir diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 3d9fc88..d56f5ce 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -730,6 +730,7 @@ ticked: The number of ticked articles." ["Read manual" gnus-info-find-node t] ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] + ["Send a bug report" gnus-bug t] ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t])) @@ -772,6 +773,8 @@ The following commands are available: (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (when gnus-use-undo (gnus-undo-mode 1)) + (when gnus-slave + (gnus-slave-mode)) (gnus-run-hooks 'gnus-group-mode-hook)) (defun gnus-update-group-mark-positions () @@ -815,9 +818,8 @@ The following commands are available: (or level gnus-group-default-list-level gnus-level-subscribed)))) (defun gnus-group-setup-buffer () - (set-buffer (get-buffer-create gnus-group-buffer)) + (set-buffer (gnus-get-buffer-create gnus-group-buffer)) (unless (eq major-mode 'gnus-group-mode) - (gnus-add-current-to-buffer-list) (gnus-group-mode) (when gnus-carpal (gnus-carpal-setup-buffer 'group)))) @@ -1150,7 +1152,8 @@ already." found buffer-read-only) ;; Enter the current status into the dribble buffer. (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (and entry (not (gnus-ephemeral-group-p group))) + (when (and entry + (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter (concat "(gnus-group-set-info '" (gnus-prin1-to-string (nth 2 entry)) @@ -1471,12 +1474,12 @@ and with point over the group in question." (save-selected-window (save-excursion (funcall ,function ,group))))))))) - + (put 'gnus-group-iterate 'lisp-indent-function 1) ;; Selecting groups. -(defun gnus-group-read-group (&optional all no-article group) +(defun gnus-group-read-group (&optional all no-article group select-articles) "Read news in this newsgroup. If the prefix argument ALL is non-nil, already read articles become readable. IF ALL is a number, fetch this number of articles. If the @@ -1507,7 +1510,7 @@ group." (cdr (assq 'tick marked))) (gnus-range-length (cdr (assq 'dormant marked))))))) - no-article nil no-display))) + no-article nil no-display nil select-articles))) (defun gnus-group-select-group (&optional all) "Select this newsgroup. @@ -1553,10 +1556,6 @@ be permanent." gnus-summary-mode-hook gnus-select-group-hook (group (gnus-group-group-name)) (method (gnus-find-method-for-group group))) - (setq method - `(,(car method) ,(concat (cadr method) "-ephemeral") - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method))) (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) @@ -1569,30 +1568,41 @@ Returns whether the fetching was successful or not." (gnus-no-server)) (gnus-group-read-group nil nil group)) +;;;###autoload +(defun gnus-fetch-group-other-frame (group) + "Pop up a frame and enter GROUP." + (interactive "P") + (let ((window (get-buffer-window gnus-group-buffer))) + (cond (window + (select-frame (window-frame window))) + ((= (length (frame-list)) 1) + (select-frame (make-frame))) + (t + (other-frame 1)))) + (gnus-fetch-group group)) + (defvar gnus-ephemeral-group-server 0) ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. (defun gnus-group-read-ephemeral-group (group method &optional activate - quit-config request-only) + quit-config request-only + select-articles) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. If QUIT-CONFIG, use that window configuration when exiting from the ephemeral group. If REQUEST-ONLY, don't actually read the group; just request it. +If SELECT-ARTICLES, only select those articles. Return the name of the group is selection was successful." ;; Transform the select method into a unique server. (when (stringp method) (setq method (gnus-server-to-method method))) -;;; (let ((saddr (intern (format "%s-address" (car method))))) -;;; (setq method (gnus-copy-sequence method)) -;;; (require (car method)) -;;; (when (boundp saddr) -;;; (unless (assq saddr method) -;;; (nconc method `((,saddr ,(cadr method)))) -;;; (setf (cadr method) (format "%s-%d" (cadr method) -;;; (incf gnus-ephemeral-group-server)))))) + (setq method + `(,(car method) ,(concat (cadr method) "-ephemeral") + (,(intern (format "%s-address" (car method))) ,(cadr method)) + ,@(cddr method))) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) (gnus-sethash @@ -1616,7 +1626,7 @@ Return the name of the group is selection was successful." (if request-only group (condition-case () - (when (gnus-group-read-group t t group) + (when (gnus-group-read-group t t group select-articles) group) ;;(error nil) (quit nil))))) @@ -1791,6 +1801,8 @@ ADDRESS." (gnus-read-group "Group name: ") (gnus-read-method "From method: "))) + (when (stringp method) + (setq method (gnus-server-to-method method))) (let* ((meth (when (and method (not (gnus-server-equal method gnus-select-method))) (if address (list (intern method) address) @@ -1903,6 +1915,8 @@ and NEW-NAME will be prompted for." (gnus-set-active new-name (gnus-active group)) (gnus-message 6 "Renaming group %s to %s...done" group new-name) new-name) + (setq gnus-killed-list (delete group gnus-killed-list)) + (gnus-set-active group nil) (gnus-dribble-touch) (gnus-group-position-point))) @@ -1982,6 +1996,7 @@ and NEW-NAME will be prompted for." (gnus-group-position-point))) (defun gnus-group-make-useful-group (group method) + "Create one of the groups described in `gnus-useful-groups'." (interactive (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups nil t) @@ -1997,8 +2012,7 @@ and NEW-NAME will be prompted for." "Create the Gnus documentation group." (interactive) (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) - (file (nnheader-find-etc-directory "gnus-tut.txt" t)) - dir) + (file (nnheader-find-etc-directory "gnus-tut.txt" t))) (when (gnus-gethash name gnus-newsrc-hashtb) (error "Documentation group already exists")) (if (not file) @@ -2391,7 +2405,7 @@ If REVERSE, sort in reverse order." (when (gnus-group-native-p (gnus-info-group info)) (gnus-info-clear-data info))) (gnus-get-unread-articles) - (gnus-dribble-enter "") + (gnus-dribble-touch) (when (gnus-y-or-n-p "Move the cache away to avoid problems in the future? ") (call-interactively 'gnus-cache-move-cache))))) @@ -2915,17 +2929,19 @@ If N is negative, this group and the N-1 previous groups will be checked." (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n (point))) - group) + group method) (while (setq group (pop groups)) (gnus-group-remove-mark group) ;; Bypass any previous denials from the server. - (gnus-remove-denial (gnus-find-method-for-group group)) + (gnus-remove-denial (setq method (gnus-find-method-for-group group))) (if (gnus-activate-group group (if dont-scan nil 'scan)) (progn (gnus-get-unread-articles-in-group (gnus-get-info group) (gnus-active group) t) (unless (gnus-virtual-group-p group) (gnus-close-group group)) + (gnus-agent-save-group-info + method (gnus-group-real-name group) (gnus-active group)) (gnus-group-update-group group)) (if (eq (gnus-server-status (gnus-find-method-for-group group)) 'denied) @@ -2959,8 +2975,6 @@ to use." (while (and (not found) (setq dir (pop dirs))) (let ((name (gnus-group-real-name group))) - (while (string-match "\\." name) - (setq name (replace-match "/" t t name))) (setq file (concat (file-name-as-directory dir) name))) (if (not (file-exists-p file)) (gnus-message 1 "No such file: %s" file) @@ -3026,6 +3040,7 @@ to use." (lambda (group) (and (symbol-name group) (string-match regexp (symbol-name group)) + (symbol-value group) (push (symbol-name group) groups))) gnus-active-hashtb) ;; Also go through all descriptions that are known to Gnus. @@ -3033,7 +3048,6 @@ to use." (mapatoms (lambda (group) (and (string-match regexp (symbol-value group)) - (gnus-active (symbol-name group)) (push (symbol-name group) groups))) gnus-description-hashtb)) (if (not groups) @@ -3126,12 +3140,14 @@ group." (defun gnus-group-find-new-groups (&optional arg) "Search for new groups and add them. Each new group will be treated with `gnus-subscribe-newsgroup-method.' -If ARG (the prefix), use the `ask-server' method to query -the server for new groups." - (interactive "P") - (gnus-find-new-newsgroups arg) +With 1 C-u, use the `ask-server' method to query the server for new +groups. +With 2 C-u's, use most complete method possible to query the server +for new groups, and subscribe the new groups as zombies." + (interactive "p") + (gnus-find-new-newsgroups (or arg 1)) (gnus-group-list-groups)) - + (defun gnus-group-edit-global-kill (&optional article group) "Edit the global kill file. If GROUP, edit that local kill file instead." @@ -3161,16 +3177,13 @@ The hook gnus-suspend-gnus-hook is called before actually suspending." (interactive) (gnus-run-hooks 'gnus-suspend-gnus-hook) ;; Kill Gnus buffers except for group mode buffer. - (let* ((group-buf (get-buffer gnus-group-buffer)) - ;; Do this on a separate list in case the user does a ^G before we finish - (gnus-buffer-list - (delete group-buf (delete gnus-dribble-buffer - (append gnus-buffer-list nil))))) - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) + (let ((group-buf (get-buffer gnus-group-buffer))) + (mapcar (lambda (buf) + (unless (member buf (list group-buf gnus-dribble-buffer)) + (kill-buffer buf))) + (gnus-buffers)) (gnus-kill-gnus-frames) (when group-buf - (setq gnus-buffer-list (list group-buf)) (bury-buffer group-buf) (delete-windows-on group-buf t)))) @@ -3317,7 +3330,6 @@ and the second element is the address." ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) - (uncompressed '(score bookmark killed)) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) diff --git a/lisp/gnus-i18n.el b/lisp/gnus-i18n.el index 3737fb9..78eeb03 100644 --- a/lisp/gnus-i18n.el +++ b/lisp/gnus-i18n.el @@ -76,15 +76,15 @@ It is specified by variable `gnus-newsgroup-default-charset-alist' )) (setq alist (cdr alist))) )))) - (when charset - (save-excursion - (set-buffer gnus-summary-buffer) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - ) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - )))) + (if charset + (progn + (save-excursion + (set-buffer gnus-summary-buffer) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) + (kill-local-variable 'default-mime-charset))))) ;;; @ end diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 3246bb4..8143d0d 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -149,10 +149,13 @@ If it is down, start it up (again)." (cdr method-fnlist-elt)))) ;; Maybe complain if there is no function. (unless (fboundp func) + (unless (car method) + (error "Trying to require a method that doesn't exist")) (require (car method)) - (when (and (not (fboundp func)) - (not noerror)) - (error "No such function: %s" func))) + (when (not (fboundp func)) + (if noerror + (setq func nil) + (error "No such function: %s" func)))) func)) @@ -305,7 +308,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (gnus-group-real-name group) article)))) (defun gnus-request-update-mark (group article mark) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." + "Allow the backend to change the mark the user tries to put on an article." (let ((gnus-command-method (gnus-find-method-for-group group))) (if (not (gnus-check-backend-function 'request-update-mark (car gnus-command-method))) diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index 40d94d4..abcc401 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -406,7 +406,6 @@ Returns the number of articles marked as read." () (gnus-message 6 "Processing kill file %s..." (car kill-files)) (find-file (car kill-files)) - (gnus-add-current-to-buffer-list) (goto-char (point-min)) (if (consp (ignore-errors (read (current-buffer)))) @@ -469,9 +468,9 @@ Returns the number of articles marked as read." (?h . "") (?f . "from") (?: . "subject"))) - (com-to-com - '((?m . " ") - (?j . "X"))) + ;;(com-to-com + ;; '((?m . " ") + ;; (?j . "X"))) pattern modifier commands) (while (not (eobp)) (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) @@ -566,7 +565,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (not (consp (cdadr (nth 2 object)))))) (concat "\n" (gnus-prin1-to-string object)) (save-excursion - (set-buffer (get-buffer-create "*Gnus PP*")) + (set-buffer (gnus-get-buffer-create "*Gnus PP*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index f2913f1..c276a0b 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -164,9 +164,9 @@ (funcall type match (or (aref gnus-advanced-headers index) 0)))) (defun gnus-advanced-date (index match type) - (let ((date (encode-time (parse-time-string - (aref gnus-advanced-headers index)))) - (match (encode-time (parse-time-string match)))) + (let ((date (apply 'encode-time (parse-time-string + (aref gnus-advanced-headers index)))) + (match (apply 'encode-time (parse-time-string match)))) (cond ((eq type 'at) (equal date match)) diff --git a/lisp/gnus-mh.el b/lisp/gnus-mh.el index 3960408..fa01f5a 100644 --- a/lisp/gnus-mh.el +++ b/lisp/gnus-mh.el @@ -64,7 +64,7 @@ Optional argument FOLDER specifies folder name." (funcall gnus-folder-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-folder) t)))) - (errbuf (get-buffer-create " *Gnus rcvstore*")) + (errbuf (gnus-get-buffer-create " *Gnus rcvstore*")) ;; Find the rcvstore program. (exec-path (if mh-lib (cons mh-lib exec-path) exec-path))) (gnus-eval-in-buffer-window gnus-original-article-buffer diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 0c830cb..5ef7209 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -2,8 +2,9 @@ ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; Shuhei KOBAYASHI ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -98,15 +99,35 @@ the second with the current group name.") (defvar gnus-bug-create-help-buffer t "*Should we create the *Gnus Help Bug* buffer?") +(defvar gnus-posting-styles nil + "*Alist of styles to use when posting.") + +(defvar gnus-posting-style-alist + '((organization . message-user-organization) + (signature . message-signature) + (signature-file . message-signature-file) + (address . user-mail-address) + (name . user-full-name)) + "*Mapping from style parameters to variables.") + ;;; Internal variables. +(defvar gnus-inhibit-posting-styles nil + "Inhibit the use of posting styles.") + (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) (defvar gnus-last-posting-server nil) (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 @@ -123,7 +144,12 @@ 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) @@ -154,8 +180,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 @@ -175,9 +201,15 @@ Thank you for your help in stamping out bugs. (,article (and gnus-article-reply (gnus-summary-article-number))) (,group gnus-newsgroup-name) (message-header-setup-hook - (copy-sequence message-header-setup-hook))) + (copy-sequence message-header-setup-hook)) + (message-mode-hook (copy-sequence message-mode-hook)) + (message-startup-parameter-alist + '((reply-buffer . gnus-copy-article-buffer) + (original-buffer . gnus-original-article-buffer) + (user-agent . Gnus)))) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) + (add-hook 'message-mode-hook 'gnus-configure-posting-styles) (unwind-protect (progn ,@forms) @@ -187,6 +219,7 @@ Thank you for your help in stamping out bugs. (cons ,group ,article)) (make-local-variable 'gnus-newsgroup-name) (gnus-run-hooks 'gnus-message-setup-hook)) + (gnus-add-buffer) (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) @@ -196,9 +229,10 @@ 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))) - (message-add-action - `(set-window-configuration ,winconf) 'exit 'postpone 'kill) + (setq message-user-agent (gnus-extended-version)) + (when (not message-use-multi-frames) + (message-add-action + `(set-window-configuration ,winconf) 'exit 'postpone 'kill)) (message-add-action `(when (gnus-buffer-exists-p ,buffer) (save-excursion @@ -338,12 +372,10 @@ header line with the old Message-ID." ;; this copy is in the buffer gnus-article-copy. ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used ;; this buffer should be passed to all mail/news reply/post routines. - (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) + (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*")) (buffer-disable-undo gnus-article-copy) - (or (memq gnus-article-copy gnus-buffer-list) - (push gnus-article-copy gnus-buffer-list)) (let ((article-buffer (or article-buffer gnus-article-buffer)) - end beg contents) + end beg) (if (not (and (get-buffer article-buffer) (gnus-buffer-exists-p article-buffer))) (error "Can't find any article buffer") @@ -500,9 +532,11 @@ If SILENT, don't prompt the user." method-alist)))) ;; Override normal method. ((and (eq gnus-post-method 'current) + (not (eq (car group-method) 'nndraft)) (not arg)) group-method) - (gnus-post-method + ((and gnus-post-method + (not (eq gnus-post-method 'current))) gnus-post-method) ;; Use the normal select method. (t gnus-select-method)))) @@ -513,13 +547,51 @@ If SILENT, don't prompt the user." (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. (defun gnus-extended-version () "Stringified gnus version." (interactive) - gnus-version) + (concat gnus-product-name "/" gnus-version-number)) + +(defun gnus-message-make-user-agent (&optional include-mime-info max-column) + "Return user-agent info. +INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable + `mime-edit-user-agent-value' exists, the return value will include it. +MAX-COLUMN the optional second argument if it is specified, the return value + will be folded up in the proper way." + (let ((user-agent (if (and include-mime-info + (boundp 'mime-edit-user-agent-value)) + (concat (gnus-extended-version) + " " + mime-edit-user-agent-value) + (gnus-extended-version)))) + (if max-column + (let (boundary) + (unless (natnump max-column) (setq max-column 76)) + (with-temp-buffer + (insert " " user-agent) + (goto-char 13) + (while (re-search-forward "[\n\t ]+" nil t) + (replace-match " ")) + (goto-char 13) + (while (re-search-forward "[^ ()/]+\\(/[^ ()/]+\\)? ?" nil t) + (while (eq ?\( (char-after (point))) + (forward-list) + (skip-chars-forward " ")) + (skip-chars-backward " ") + (if (> (current-column) max-column) + (progn + (if (or (not boundary) (eq ?\n (char-after boundary))) + (progn + (setq boundary (point)) + (unless (eobp) + (delete-char 1) + (insert "\n "))) + (goto-char boundary) + (delete-char 1) + (insert "\n "))) + (setq boundary (point)))) + (buffer-substring 13 (point-max)))) + user-agent))) ;;; @@ -583,6 +655,39 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (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") @@ -594,12 +699,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. @@ -758,7 +857,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)) @@ -793,7 +893,7 @@ The source file has to be in the Emacs load path." (sit-for 0) ;; Go through all the files looking for non-default values for variables. (save-excursion - (set-buffer (get-buffer-create " *gnus bug info*")) + (set-buffer (gnus-get-buffer-create " *gnus bug info*")) (buffer-disable-undo (current-buffer)) (while files (erase-buffer) @@ -853,14 +953,15 @@ this is a reply." (interactive "P") (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) - (message-bounce) - ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers))))) + (let (gnus-message-setup-hook) + (gnus-setup-message 'compose-bounce + (let* ((references (mail-fetch-field "references")) + (parent (and references (gnus-parent-id references)))) + (message-bounce) + ;; If there are references, we fetch the article we answered to. + (and fetch parent + (gnus-summary-refer-article parent) + (gnus-summary-show-all-headers)))))) ;;; Gcc handling. @@ -1004,6 +1105,89 @@ this is a reply." (insert " "))) (insert "\n"))))))) +;;; Posting styles. + +(defvar gnus-message-style-insertions nil) + +(defun gnus-configure-posting-styles () + "Configure posting styles according to `gnus-posting-styles'." + (unless gnus-inhibit-posting-styles + (let ((styles gnus-posting-styles) + (gnus-newsgroup-name (or gnus-newsgroup-name "")) + style match variable attribute value value-value) + (make-local-variable 'gnus-message-style-insertions) + ;; Go through all styles and look for matches. + (while styles + (setq style (pop styles) + match (pop style)) + (when (cond ((stringp match) + ;; Regexp string match on the group name. + (string-match match gnus-newsgroup-name)) + ((or (symbolp match) + (gnus-functionp match)) + (cond ((gnus-functionp match) + ;; Function to be called. + (funcall match)) + ((boundp match) + ;; Variable to be checked. + (symbol-value match)))) + ((listp match) + ;; This is a form to be evaled. + (eval match))) + ;; We have a match, so we set the variables. + (while style + (setq attribute (pop style) + value (cadr attribute) + variable nil) + ;; We find the variable that is to be modified. + (if (and (not (stringp (car attribute))) + (not (eq 'body (car attribute))) + (not (setq variable + (cdr (assq (car attribute) + gnus-posting-style-alist))))) + (message "Couldn't find attribute %s" (car attribute)) + ;; We get the value. + (setq value-value + (cond ((stringp value) + value) + ((or (symbolp value) + (gnus-functionp value)) + (cond ((gnus-functionp value) + (funcall value)) + ((boundp value) + (symbol-value value)))) + ((listp value) + (eval value)))) + (if variable + ;; This is an ordinary variable. + (set (make-local-variable variable) value-value) + ;; This is either a body or a header to be inserted in the + ;; message. + (when value-value + (let ((attr (car attribute))) + (make-local-variable 'message-setup-hook) + (if (eq 'body attr) + (add-hook 'message-setup-hook + `(lambda () + (save-excursion + (message-goto-body) + (insert ,value-value)))) + (add-hook 'message-setup-hook + 'gnus-message-insert-stylings) + (push (cons (if (stringp attr) attr + (symbol-name attr)) + value-value) + gnus-message-style-insertions)))))))))))) + +(defun gnus-message-insert-stylings () + (let (val) + (save-excursion + (message-goto-eoh) + (while (setq val (pop gnus-message-style-insertions)) + (when (cdr val) + (insert (car val) ": " (cdr val) "\n")) + (gnus-pull (car val) gnus-message-style-insertions))))) + ;;; Allow redefinition of functions. (gnus-ems-redefine) diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 799e883..672e726 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -55,7 +55,7 @@ list1)) (defun gnus-sorted-complement (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2. + "Return a list of elements that are in LIST1 or LIST2 but not both. Both lists have to be sorted over <." (let (out) (if (or (null list1) (null list2)) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index c8280b2..e98762e 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -73,21 +73,10 @@ It accepts the same format specs that `gnus-summary-line-format' does." (gnus-define-keys gnus-pick-mode-map " " gnus-pick-next-page - "u" gnus-summary-unmark-as-processable - "." gnus-pick-article + "u" gnus-pick-unmark-article-or-thread + "." gnus-pick-article-or-thread gnus-down-mouse-2 gnus-pick-mouse-pick-region "\r" gnus-pick-start-reading - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "r" gnus-uu-mark-region - "R" gnus-uu-unmark-region - "e" gnus-uu-mark-by-regexp - "E" gnus-uu-mark-by-regexp - "b" gnus-uu-mark-buffer - "B" gnus-uu-unmark-buffer - "X" gnus-pick-start-reading )) (defun gnus-pick-make-menu-bar () @@ -172,21 +161,48 @@ If given a prefix, mark all unpicked articles as read." (gnus-summary-next-group))) (error "No articles have been picked")))) +(defun gnus-pick-goto-article (arg) + "Go to the article number indicated by ARG. If ARG is an invalid +article number, then stay on current line." + (let (pos) + (save-excursion + (goto-char (point-min)) + (when (zerop (forward-line (1- (prefix-numeric-value arg)))) + (setq pos (point)))) + (if (not pos) + (gnus-error 2 "No such line: %s" arg) + (goto-char pos)))) + (defun gnus-pick-article (&optional arg) - "Pick the article on the current line. + "Pick the article on the current line. If ARG, pick the article on that line instead." (interactive "P") (when arg - (let (pos) - (save-excursion - (goto-char (point-min)) - (when (zerop (forward-line (1- (prefix-numeric-value arg)))) - (setq pos (point)))) - (if (not pos) - (gnus-error 2 "No such line: %s" arg) - (goto-char pos)))) + (gnus-pick-goto-article arg)) (gnus-summary-mark-as-processable 1)) +(defun gnus-pick-article-or-thread (&optional arg) + "If gnus-thread-hide-subtree is t, then pick the thread on the current line. +Otherwise pick the article on the current line. +If ARG, pick the article/thread on that line instead." + (interactive "P") + (when arg + (gnus-pick-goto-article arg)) + (if gnus-thread-hide-subtree + (gnus-uu-mark-thread) + (gnus-summary-mark-as-processable 1))) + +(defun gnus-pick-unmark-article-or-thread (&optional arg) + "If gnus-thread-hide-subtree is t, then unmark the thread on current line. +Otherwise unmark the article on current line. +If ARG, unmark thread/article on that line instead." + (interactive "P") + (when arg + (gnus-pick-goto-article arg)) + (if gnus-thread-hide-subtree + (gnus-uu-unmark-thread) + (gnus-summary-unmark-as-processable 1))) + (defun gnus-pick-mouse-pick (e) (interactive "e") (mouse-set-point e) @@ -203,7 +219,6 @@ This must be bound to a button-down mouse event." (start-point (posn-point start-posn)) (start-line (1+ (count-lines 1 start-point))) (start-window (posn-window start-posn)) - (start-frame (window-frame start-window)) (bounds (gnus-window-edges start-window)) (top (nth 1 bounds)) (bottom (if (window-minibuffer-p start-window) @@ -223,50 +238,48 @@ This must be bound to a button-down mouse event." ;; end-of-range is used only in the single-click case. ;; It is the place where the drag has reached so far ;; (but not outside the window where the drag started). - (let (event end end-point last-end-point (end-of-range (point))) + (let (event end end-point (end-of-range (point))) (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (eq (car-safe event) 'switch-frame))) - (if (eq (car-safe event) 'switch-frame) - nil - (setq end (event-end event) - end-point (posn-point end)) - (when end-point - (setq last-end-point end-point)) - - (cond - ;; Are we moving within the original window? - ((and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (gnus-pick-article) - ;; In case the user moved his mouse really fast, pick - ;; articles on the line between this one and the last one. - (let* ((this-line (1+ (count-lines 1 end-point))) - (min-line (min this-line start-line)) - (max-line (max this-line start-line))) - (while (< min-line max-line) - (goto-line min-line) - (gnus-pick-article) - (setq min-line (1+ min-line))) - (setq start-line this-line)) - (when (zerop (% click-count 3)) - (setq end-of-range (point)))) - (t - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top))) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window - (1+ (- mouse-row bottom))))))))))) + (while (progn + (setq event (cdr (gnus-read-event-char))) + (or (mouse-movement-p event) + (eq (car-safe event) 'switch-frame))) + (if (eq (car-safe event) 'switch-frame) + nil + (setq end (event-end event) + end-point (posn-point end)) + + (cond + ;; Are we moving within the original window? + ((and (eq (posn-window end) start-window) + (integer-or-marker-p end-point)) + ;; Go to START-POINT first, so that when we move to END-POINT, + ;; if it's in the middle of intangible text, + ;; point jumps in the direction away from START-POINT. + (goto-char start-point) + (goto-char end-point) + (gnus-pick-article) + ;; In case the user moved his mouse really fast, pick + ;; articles on the line between this one and the last one. + (let* ((this-line (1+ (count-lines 1 end-point))) + (min-line (min this-line start-line)) + (max-line (max this-line start-line))) + (while (< min-line max-line) + (goto-line min-line) + (gnus-pick-article) + (setq min-line (1+ min-line))) + (setq start-line this-line)) + (when (zerop (% click-count 3)) + (setq end-of-range (point)))) + (t + (let ((mouse-row (cdr (cdr (mouse-position))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top))) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window + (1+ (- mouse-row bottom))))))))))) (when (consp event) (let ((fun (key-binding (vector (car event))))) ;; Run the binding of the terminating up-event, if possible. @@ -363,7 +376,8 @@ This must be bound to a button-down mouse event." "If non-nil, minimize the tree buffer window. If a number, never let the tree buffer grow taller than that number of lines." - :type 'boolean + :type '(choice boolean + integer) :group 'gnus-summary-tree) (defcustom gnus-selected-tree-face 'modeline @@ -540,9 +554,8 @@ Two predefined functions are available: (defun gnus-get-tree-buffer () "Return the tree buffer properly initialized." (save-excursion - (set-buffer (get-buffer-create gnus-tree-buffer)) + (set-buffer (gnus-get-buffer-create gnus-tree-buffer)) (unless (eq major-mode 'gnus-tree-mode) - (gnus-add-current-to-buffer-list) (gnus-tree-mode)) (current-buffer))) @@ -746,7 +759,8 @@ Two predefined functions are available: (setq beg (point)) (forward-char -1) ;; Draw "-" lines leftwards. - (while (= (char-after (1- (point))) ? ) + (while (and (> (point) 1) + (= (char-after (1- (point))) ? )) (delete-char -1) (insert (car gnus-tree-parent-child-edges)) (forward-char -1)) @@ -963,11 +977,10 @@ The following commands are available: (if (get-buffer buffer) () (save-excursion - (set-buffer (get-buffer-create buffer)) + (set-buffer (gnus-get-buffer-create buffer)) (gnus-carpal-mode) (setq gnus-carpal-attached-buffer (intern (format "gnus-%s-buffer" type))) - (gnus-add-current-to-buffer-list) (let ((buttons (symbol-value (intern (format "gnus-carpal-%s-buffer-buttons" type)))) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 68f9c69..c429950 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -500,12 +500,12 @@ used as score." (?b "body" "" nil body-string) (?h "head" "" nil body-string) (?i "message-id" nil t string) - (?t "references" "message-id" nil string) + (?r "references" "message-id" nil string) (?x "xref" nil nil string) (?l "lines" nil nil number) (?d "date" nil nil date) (?f "followup" nil nil string) - (?T "thread" nil nil string))) + (?t "thread" "message-id" nil string))) (char-to-type '((?s s "substring" string) (?e e "exact string" string) @@ -591,7 +591,7 @@ used as score." ;; It was a majuscule, so we end reading and use the default. (if mimic (message "%c %c %c" prefix hchar tchar) (message "")) - (setq pchar (or pchar ?p))) + (setq pchar (or pchar ?t))) ;; We continue reading. (while (not pchar) @@ -671,7 +671,7 @@ used as score." (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) (save-excursion - (set-buffer (get-buffer-create "*Score Help*")) + (set-buffer (gnus-get-buffer-create "*Score Help*")) (buffer-disable-undo (current-buffer)) (delete-windows-on (current-buffer)) (erase-buffer) @@ -1121,7 +1121,7 @@ SCORE is the score to add." (or (not decay) (gnus-decay-scores alist decay))) (gnus-score-set 'touched '(t) alist) - (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))) + (gnus-score-set 'decay (list (gnus-time-to-day (current-time))) alist)) ;; We do not respect eval and files atoms from global score ;; files. (when (and files (not global)) @@ -1213,10 +1213,16 @@ SCORE is the score to add." (read (current-buffer)) (error (gnus-error 3.2 "Problem with score file %s" file)))))) - (if (eq (car alist) 'setq) - ;; This is an old-style score file. - (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) - (setq gnus-score-alist alist)) + (cond + ((and alist + (atom alist)) + ;; Bogus score file. + (error "Invalid syntax with score file %s" file)) + ((eq (car alist) 'setq) + ;; This is an old-style score file. + (setq gnus-score-alist (gnus-score-transform-old-to-new alist))) + (t + (setq gnus-score-alist alist))) ;; Check the syntax of the score file. (setq gnus-score-alist (gnus-score-check-syntax gnus-score-alist file))))) @@ -1397,7 +1403,7 @@ SCORE is the score to add." gnus-scores-articles)))) (save-excursion - (set-buffer (get-buffer-create "*Headers*")) + (set-buffer (gnus-get-buffer-create "*Headers*")) (buffer-disable-undo (current-buffer)) (when (gnus-buffer-live-p gnus-summary-buffer) (message-clone-locals gnus-summary-buffer)) @@ -2283,7 +2289,6 @@ SCORE is the score to add." 1 "No score rules apply to the current article (default score %d)." gnus-summary-default-score) (set-buffer "*Score Trace*") - (gnus-add-current-to-buffer-list) (while trace (insert (format "%S -> %s\n" (cdar trace) (if (caar trace) @@ -2329,7 +2334,6 @@ SCORE is the score to add." (while rules (insert (format "%-5d: %s\n" (caar rules) (cdar rules))) (pop rules)) - (gnus-add-current-to-buffer-list) (goto-char (point-min)) (gnus-configure-windows 'score-words)))) @@ -2500,7 +2504,7 @@ GROUP using BNews sys file syntax." (trans (cdr (assq ?: nnheader-file-name-translation-alist))) ofiles not-match regexp) (save-excursion - (set-buffer (get-buffer-create "*gnus score files*")) + (set-buffer (gnus-get-buffer-create "*gnus score files*")) (buffer-disable-undo (current-buffer)) ;; Go through all score file names and create regexp with them ;; as the source. @@ -2792,8 +2796,8 @@ If ADAPT, return the home adaptive file instead." (funcall elem group)) ;; Regexp-file cons ((consp elem) - (when (string-match (car elem) group) - (cadr elem)))))) + (when (string-match (gnus-globalify-regexp (car elem)) group) + (replace-match (cadr elem) t nil group )))))) (when found (nnheader-concat gnus-kill-files-directory found)))) @@ -2813,6 +2817,10 @@ If ADAPT, return the home adaptive file instead." (concat group (if (gnus-use-long-file-name 'not-score) "." "/") gnus-adaptive-file-suffix))) +(defun gnus-current-home-score-file (group) + "Return the \"current\" regular score file." + (car (nreverse (gnus-score-find-alist group)))) + ;;; ;;; Score decays ;;; diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el index 29c2a31..ae9909b 100644 --- a/lisp/gnus-setup.el +++ b/lisp/gnus-setup.el @@ -65,6 +65,8 @@ "site-lisp/bbdb-1.51/") "Directory where Big Brother Database is found.") +(defvar gnus-use-tm running-xemacs + "Set this if you want MIME support for Gnus") (defvar gnus-use-mhe nil "Set this if you want to use MH-E for mail reading") (defvar gnus-use-rmail nil @@ -87,6 +89,19 @@ ;;; We can't do this until we know where Gnus is. (require 'message) +;;; Tools for MIME by +;;; UMEDA Masanobu +;;; MORIOKA Tomohiko + +(when gnus-use-tm + (when (and (not gnus-use-installed-tm) + (null (member gnus-tm-lisp-directory load-path))) + (setq load-path (cons gnus-tm-lisp-directory load-path))) + ;; tm may or may not be dumped with XEmacs. In Sunpro it is, otherwise + ;; it isn't. + (unless (featurep 'mime-setup) + (load "mime-setup"))) + ;;; Mailcrypt by ;;; Jin Choi ;;; Patrick LoPresti diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index be089bf..3d97829 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -133,7 +133,7 @@ If N is nil and any articles have been marked with the process mark, move those articles instead." (interactive "P") (let* ((articles (gnus-summary-work-articles n)) - (tmp-buf (get-buffer-create "*soup work*")) + (tmp-buf (gnus-get-buffer-create "*soup work*")) (area (gnus-soup-area gnus-newsgroup-name)) (prefix (gnus-soup-area-prefix area)) headers) @@ -161,7 +161,8 @@ move those articles instead." (gnus-summary-mark-as-read (car articles) gnus-souped-mark) (setq articles (cdr articles))) (kill-buffer tmp-buf)) - (gnus-soup-save-areas))) + (gnus-soup-save-areas) + (gnus-set-mode-line 'summary))) (defun gnus-soup-pack-packet () "Make a SOUP packet from the SOUP areas." @@ -204,7 +205,9 @@ for matching on group names. For instance, if you want to brew on all the nnml groups, as well as groups with \"emacs\" in the name, you could say something like: -$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" +$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\" + +Note -- this function hasn't been implemented yet." (interactive) nil) @@ -509,7 +512,7 @@ Return whether the unpacking was successful." ".MSG")) (msg-buf (and (file-exists-p msg-file) (nnheader-find-file-noselect msg-file))) - (tmp-buf (get-buffer-create " *soup send*")) + (tmp-buf (gnus-get-buffer-create " *soup send*")) beg end) (cond ((/= (gnus-soup-encoding-format @@ -537,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 23215fb..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)))) @@ -526,7 +530,7 @@ If PROPS, insert the result." (push (cons 'version emacs-version) gnus-format-specs) ;; Mark the .newsrc.eld file as "dirty". - (gnus-dribble-enter " ") + (gnus-dribble-touch) (gnus-message 7 "Compiling user specs...done")))) (defun gnus-set-format (type &optional insertable) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 24e9bfd..21abf17 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -59,15 +59,15 @@ The following specs are understood: (defvar gnus-inserted-opened-servers nil) (defvar gnus-server-line-format-alist - `((?h how ?s) - (?n name ?s) - (?w where ?s) - (?s status ?s))) + `((?h gnus-tmp-how ?s) + (?n gnus-tmp-name ?s) + (?w gnus-tmp-where ?s) + (?s gnus-tmp-status ?s))) (defvar gnus-server-mode-line-format-alist - `((?S news-server ?s) - (?M news-method ?s) - (?u user-defined ?s))) + `((?S gnus-tmp-news-server ?s) + (?M gnus-tmp-news-method ?s) + (?u gnus-tmp-user-defined ?s))) (defvar gnus-server-line-format-spec nil) (defvar gnus-server-mode-line-format-spec nil) @@ -166,11 +166,11 @@ The following commands are available: (setq buffer-read-only t) (gnus-run-hooks 'gnus-server-mode-hook)) -(defun gnus-server-insert-server-line (name method) - (let* ((how (car method)) - (where (nth 1 method)) +(defun gnus-server-insert-server-line (gnus-tmp-name method) + (let* ((gnus-tmp-how (car method)) + (gnus-tmp-where (nth 1 method)) (elem (assoc method gnus-opened-servers)) - (status (cond ((eq (nth 1 elem) 'denied) + (gnus-tmp-status (cond ((eq (nth 1 elem) 'denied) "(denied)") ((or (gnus-server-opened method) (eq (nth 1 elem) 'ok)) @@ -183,7 +183,7 @@ The following commands are available: (prog1 (1+ (point)) ;; Insert the text. (eval gnus-server-line-format-spec)) - (list 'gnus-server (intern name))))) + (list 'gnus-server (intern gnus-tmp-name))))) (defun gnus-enter-server-buffer () "Set up the server buffer." @@ -195,7 +195,7 @@ The following commands are available: "Initialize the server buffer." (unless (get-buffer gnus-server-buffer) (save-excursion - (set-buffer (get-buffer-create gnus-server-buffer)) + (set-buffer (gnus-get-buffer-create gnus-server-buffer)) (gnus-server-mode) (when gnus-carpal (gnus-carpal-setup-buffer 'server))))) @@ -287,7 +287,7 @@ The following commands are available: (error "No server on the current line"))) (unless (assoc server gnus-server-alist) (error "Read-only server %s" server)) - (gnus-dribble-enter "") + (gnus-dribble-touch) (let ((buffer-read-only nil)) (gnus-delete-line)) (push (assoc server gnus-server-alist) gnus-server-killed-servers) @@ -466,9 +466,12 @@ The following commands are available: (defun gnus-server-scan-server (server) "Request a scan from the current server." (interactive (list (gnus-server-server-name))) - (gnus-message 3 "Scanning %s...done" server) - (gnus-request-scan nil (gnus-server-to-method server)) - (gnus-message 3 "Scanning %s...done" server)) + (let ((method (gnus-server-to-method server))) + (if (not (gnus-get-function method 'request-scan)) + (error "Server %s can't scan" (car method)) + (gnus-message 3 "Scanning %s..." server) + (gnus-request-scan nil method) + (gnus-message 3 "Scanning %s...done" server)))) (defun gnus-server-read-server (server) "Browse a server." @@ -534,7 +537,7 @@ The following commands are available: '("Browse" ["Subscribe" gnus-browse-unsubscribe-current-group t] ["Read" gnus-browse-read-group t] - ["Select" gnus-browse-read-group t] + ["Select" gnus-browse-select-group t] ["Next" gnus-browse-next-group t] ["Prev" gnus-browse-next-group t] ["Exit" gnus-browse-exit t])) @@ -568,8 +571,7 @@ The following commands are available: 1 "Couldn't request list: %s" (gnus-status-message method)) nil) (t - (get-buffer-create gnus-browse-buffer) - (gnus-add-current-to-buffer-list) + (gnus-get-buffer-create gnus-browse-buffer) (when gnus-carpal (gnus-carpal-setup-buffer 'browse)) (gnus-configure-windows 'browse) @@ -590,9 +592,11 @@ The following commands are available: (while (re-search-forward "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) (goto-char (match-end 1)) - (push (cons (match-string 1) - (max 0 (- (1+ (read cur)) (read cur)))) - groups)))) + (condition-case () + (push (cons (match-string 1) + (max 0 (- (1+ (read cur)) (read cur)))) + groups) + (error nil))))) (setq groups (sort groups (lambda (l1 l2) (string< (car l1) (car l2))))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 29b6b04..8c73a33 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -254,8 +254,6 @@ for your decision; `gnus-subscribe-killed' kills all new groups; (function-item gnus-subscribe-zombies) function)) -;; Suggested by a bug report by Hallvard B Furuseth. -;; . (defcustom gnus-subscribe-options-newsgroup-method 'gnus-subscribe-alphabetically "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. @@ -388,6 +386,9 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'boolean) +(defvar gnus-startup-file-coding-system 'ctext + "*Coding system for startup file.") + ;;; Internal variables (defvar gnus-newsrc-file-version nil) @@ -581,6 +582,7 @@ the first newsgroup." (defvar gnus-newsgroup-unreads) (defvar nnoo-state-alist) (defvar gnus-current-select-method) + (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. @@ -624,8 +626,9 @@ the first newsgroup." (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) (gnus-kill-buffer nntp-server-buffer) ;; Kill Gnus buffers. - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) + (let ((buffers (gnus-buffers))) + (when buffers + (mapcar 'kill-buffer buffers))) ;; Remove Gnus frames. (gnus-kill-gnus-frames)) @@ -657,8 +660,8 @@ prompt the user for the name of an NNTP server to use." (> arg 0) (max (car gnus-group-list-mode) arg)))) - (gnus-splash) (gnus-clear-system) + (gnus-splash) (gnus-run-hooks 'gnus-before-startup-hook) (nnheader-init-server-buffer) (setq gnus-slave slave) @@ -708,6 +711,8 @@ prompt the user for the name of an NNTP server to use." (gnus-group-first-unread-group) (gnus-configure-windows 'group) (gnus-group-set-mode-line) + ;; For reading Info. + (set-language-info "Japanese" 'gnus-info "gnus-ja") (gnus-run-hooks 'gnus-started-hook)))))) (defun gnus-start-draft-setup () @@ -775,9 +780,8 @@ prompt the user for the name of an NNTP server to use." (let ((dribble-file (gnus-dribble-file-name))) (save-excursion (set-buffer (setq gnus-dribble-buffer - (get-buffer-create + (gnus-get-buffer-create (file-name-nondirectory dribble-file)))) - (gnus-add-current-to-buffer-list) (erase-buffer) (setq buffer-file-name dribble-file) (auto-save-mode t) @@ -937,13 +941,25 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." "Search for new newsgroups and add them. Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' The `-n' option line from .newsrc is respected. -If ARG (the prefix), use the `ask-server' method to query the server -for new groups." - (interactive "P") - (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) - (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - 'ask-server gnus-check-new-newsgroups))) + +With 1 C-u, use the `ask-server' method to query the server for new +groups. +With 2 C-u's, use most complete method possible to query the server +for new groups, and subscribe the new groups as zombies." + (interactive "p") + (let* ((gnus-subscribe-newsgroup-method + gnus-subscribe-newsgroup-method) + (check (cond + ((or (and (= (or arg 1) 4) + (not (listp gnus-check-new-newsgroups))) + (null gnus-read-active-file) + (eq gnus-read-active-file 'some)) + 'ask-server) + ((= (or arg 1) 16) + (setq gnus-subscribe-newsgroup-method + 'gnus-subscribe-zombies) + t) + (t gnus-check-new-newsgroups)))) (unless (gnus-check-first-time-used) (if (or (consp check) (eq check 'ask-server)) @@ -1036,13 +1052,13 @@ for new groups." ;; Go through both primary and secondary select methods and ;; request new newsgroups. (while (setq method (gnus-server-get-method nil (pop methods))) - (setq new-newsgroups nil) - (setq gnus-override-subscribe-method method) + (setq new-newsgroups nil + gnus-override-subscribe-method method) (when (and (gnus-check-server method) (gnus-request-newgroups date method)) (save-excursion - (setq got-new t) - (setq hashtb (gnus-make-hashtable 100)) + (setq got-new t + hashtb (gnus-make-hashtable 100)) (set-buffer nntp-server-buffer) ;; Enter all the new groups into a hashtable. (gnus-active-to-gnus-format method hashtb 'ignore)) @@ -1121,7 +1137,9 @@ for new groups." (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) - (gnus-group-make-help-group) + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-group-make-help-group)) (when gnus-novice-user (gnus-message 7 "`A k' to list killed groups")))))) @@ -1486,7 +1504,7 @@ newsgroup." (when (<= (gnus-info-level info) foreign-level) (setq active (gnus-activate-group group 'scan)) ;; Let the Gnus agent save the active file. - (when (and gnus-agent gnus-plugged) + (when (and gnus-agent gnus-plugged active) (gnus-agent-save-group-info method (gnus-group-real-name group) active)) (unless (inline (gnus-virtual-group-p group)) @@ -1899,7 +1917,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) (condition-case nil - (load ding-file t t t) + (let ((coding-system-for-read gnus-startup-file-coding-system)) + (load ding-file t t t)) (error (ding) (unless (gnus-yes-or-no-p @@ -2249,19 +2268,19 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-gnus-to-newsrc-format) (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) ;; Save .newsrc.eld. - (set-buffer (get-buffer-create " *Gnus-newsrc*")) + (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) (make-local-variable 'version-control) (setq version-control 'never) (setq buffer-file-name (concat gnus-current-startup-file ".eld")) (setq default-directory (file-name-directory buffer-file-name)) - (gnus-add-current-to-buffer-list) (buffer-disable-undo (current-buffer)) (erase-buffer) (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) (gnus-gnus-to-quick-newsrc-format) (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer) + (let ((coding-system-for-write gnus-startup-file-coding-system)) + (save-buffer)) (kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) @@ -2371,6 +2390,13 @@ If FORCE is non-nil, the .newsrc file is read." ;;; Slave functions. ;;; +(defvar gnus-slave-mode nil) + +(defun gnus-slave-mode () + "Minor mode for slave Gnusae." + (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) + (gnus-run-hooks 'gnus-slave-mode-hook)) + (defun gnus-slave-save-newsrc () (save-excursion (set-buffer gnus-dribble-buffer) @@ -2397,7 +2423,7 @@ If FORCE is non-nil, the .newsrc file is read." () ; There are no slave files to read. (gnus-message 7 "Reading slave newsrcs...") (save-excursion - (set-buffer (get-buffer-create " *gnus slave*")) + (set-buffer (gnus-get-buffer-create " *gnus slave*")) (buffer-disable-undo (current-buffer)) (setq slave-files (sort (mapcar (lambda (file) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 0a20c92..cff4f0e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -221,10 +221,10 @@ to expose hidden threads." :group 'gnus-thread :type 'boolean) -(defcustom gnus-thread-ignore-subject nil - "*If non-nil, ignore subjects and do all threading based on the Reference header. -If nil, which is the default, articles that have different subjects -from their parents will start separate threads." +(defcustom gnus-thread-ignore-subject t + "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header. +If nil, articles that have different subjects from their parents will +start separate threads." :group 'gnus-thread :type 'boolean) @@ -285,7 +285,9 @@ will go to the next group without confirmation." (sexp :menu-tag "on" t))) (defcustom gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject." + "*If non-nil, select the next article with the same subject. +If there are no more articles with the same subject, go to +the first unread article." :group 'gnus-summary-maneuvering :type 'boolean) @@ -1149,7 +1151,7 @@ increase the score of each group you read." [delete] gnus-summary-prev-page [backspace] gnus-summary-prev-page "\r" gnus-summary-scroll-up - "\e\r" gnus-summary-scroll-down + "\M-\r" gnus-summary-scroll-down "n" gnus-summary-next-unread-article "p" gnus-summary-prev-unread-article "N" gnus-summary-next-article @@ -1356,6 +1358,7 @@ increase the score of each group you read." [delete] gnus-summary-prev-page "p" gnus-summary-prev-page "\r" gnus-summary-scroll-up + "\M-\r" gnus-summary-scroll-down "<" gnus-summary-beginning-of-article ">" gnus-summary-end-of-article "b" gnus-summary-beginning-of-article @@ -1390,6 +1393,7 @@ increase the score of each group you read." "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation + "C" gnus-article-hide-citation-in-followups "p" gnus-article-hide-pgp "P" gnus-article-hide-pem "\C-c" gnus-article-hide-citation-maybe) @@ -1435,6 +1439,7 @@ increase the score of each group you read." "c" gnus-summary-copy-article "B" gnus-summary-crosspost-article "q" gnus-summary-respool-query + "t" gnus-summary-respool-trace "i" gnus-summary-import-article "p" gnus-summary-article-posted-p) @@ -1556,6 +1561,7 @@ increase the score of each group you read." (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)] ["Query respool" gnus-summary-respool-query t] + ["Trace respool" gnus-summary-respool-trace t] ["Delete expirable articles" gnus-summary-expire-articles-now (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)]) @@ -1621,8 +1627,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] @@ -1739,9 +1745,10 @@ increase the score of each group you read." ["Edit local kill file" gnus-summary-edit-local-kill t] ["Edit main kill file" gnus-summary-edit-global-kill t] ["Edit group parameters" gnus-summary-edit-parameters t] + ["Send a bug report" gnus-bug t] ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] - ["Catchup all and exit" gnus-summary-catchup-and-exit t] + ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ["Exit group" gnus-summary-exit t] ["Exit group without updating" gnus-summary-exit-no-update t] @@ -1980,21 +1987,26 @@ The following commands are available: (when list (let ((data (and after-article (gnus-data-find-list after-article))) (ilist list)) - (or data (not after-article) (error "No such article: %d" after-article)) - ;; Find the last element in the list to be spliced into the main - ;; list. - (while (cdr list) - (setq list (cdr list))) - (if (not data) - (progn - (setcdr list gnus-newsgroup-data) - (setq gnus-newsgroup-data ilist) + (if (not (or data + after-article)) + (let ((odata gnus-newsgroup-data)) + (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data)) (when offset - (gnus-data-update-list (cdr list) offset))) - (setcdr list (cdr data)) - (setcdr data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) + (gnus-data-update-list odata offset))) + ;; Find the last element in the list to be spliced into the main + ;; list. + (while (cdr list) + (setq list (cdr list))) + (if (not data) + (progn + (setcdr list gnus-newsgroup-data) + (setq gnus-newsgroup-data ilist) + (when offset + (gnus-data-update-list (cdr list) offset))) + (setcdr list (cdr data)) + (setcdr data ilist) + (when offset + (gnus-data-update-list (cdr list) offset)))) (setq gnus-newsgroup-data-reverse nil)))) (defun gnus-data-remove (article &optional offset) @@ -2023,20 +2035,25 @@ The following commands are available: (defun gnus-data-update-list (data offset) "Add OFFSET to the POS of all data entries in DATA." + (setq gnus-newsgroup-data-reverse nil) (while data (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) (setq data (cdr data)))) (defun gnus-data-compute-positions () "Compute the positions of all articles." - (let ((data gnus-newsgroup-data) - pos) - (while data - (when (setq pos (text-property-any - (point-min) (point-max) - 'gnus-number (gnus-data-number (car data)))) - (gnus-data-set-pos (car data) (+ pos 3))) - (setq data (cdr data))))) + (setq gnus-newsgroup-data-reverse nil) + (let ((data gnus-newsgroup-data)) + (save-excursion + (gnus-save-hidden-threads + (gnus-summary-show-all-threads) + (goto-char (point-min)) + (while data + (while (get-text-property (point) 'gnus-intangible) + (forward-line 1)) + (gnus-data-set-pos (car data) (+ (point) 3)) + (setq data (cdr data)) + (forward-line 1)))))) (defun gnus-summary-article-pseudo-p (article) "Say whether this article is a pseudo article or not." @@ -2265,8 +2282,7 @@ marks of articles." (setq gnus-summary-buffer (current-buffer)) (not gnus-newsgroup-prepared)) ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) - (gnus-add-current-to-buffer-list) + (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) (gnus-summary-mode group) (when gnus-carpal (gnus-carpal-setup-buffer 'summary)) @@ -2349,7 +2365,7 @@ marks of articles." (gnus-score-over-mark 130) (gnus-download-mark 131) (spec gnus-summary-line-format-spec) - thread gnus-visual pos) + gnus-visual pos) (save-excursion (gnus-set-work-buffer) (let ((gnus-summary-line-format-spec spec) @@ -2511,7 +2527,8 @@ the thread are to be displayed." (set (car elem) (eval (nth 1 elem)))))))) (defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display backward) + kill-buffer no-display backward + select-articles) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. @@ -2522,8 +2539,10 @@ If NO-DISPLAY, don't generate a summary buffer." (let ((gnus-auto-select-next nil)) (or (gnus-summary-read-group-1 group show-all no-article - kill-buffer no-display) - (setq show-all nil))))) + kill-buffer no-display + select-articles) + (setq show-all nil + select-articles nil))))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) ;; The entry function called above goes to the next @@ -2537,7 +2556,8 @@ If NO-DISPLAY, don't generate a summary buffer." result)) (defun gnus-summary-read-group-1 (group show-all no-article - kill-buffer no-display) + kill-buffer no-display + &optional select-articles) ;; Killed foreign groups can't be entered. (when (and (not (gnus-group-native-p group)) (not (gnus-gethash group gnus-newsrc-hashtb))) @@ -2545,7 +2565,8 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup group show-all)))) + (did-select (and new-group (gnus-select-newsgroup + group show-all select-articles)))) (cond ;; This summary buffer exists already, so we just select it. ((not new-group) @@ -2948,8 +2969,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) + (gnus-summary-ignore-duplicates t) header references generation relations - cthread subject child end pthread relation new-child date) + subject child end new-child date) ;; First we create an alist of generations/relations, where ;; generations is how much we trust the relation, and the relation ;; is parent/child. @@ -2966,12 +2988,14 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." generation 0) (while (search-backward ">" nil t) (setq end (1+ (point))) - (if (search-backward "<" nil t) - (push (list (incf generation) - child (setq child new-child) - subject date) - relations))) - (push (list (1+ generation) child nil subject) relations) + (when (search-backward "<" nil t) + (setq new-child (buffer-substring (point) end)) + (push (list (incf generation) + child (setq child new-child) + subject date) + relations))) + (when child + (push (list (1+ generation) child nil subject) relations)) (erase-buffer))) (kill-buffer (current-buffer))) ;; Sort over trustworthiness. @@ -2980,7 +3004,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (when (gnus-dependencies-add-header (make-full-mail-header gnus-reffed-article-number - (nth 3 relation) "" (nth 4 relation) + (nth 3 relation) "" (or (nth 4 relation) "") (nth 1 relation) (or (nth 2 relation) "") 0 0 "") gnus-newsgroup-dependencies nil) @@ -3105,7 +3129,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." "Read all the headers." (let ((gnus-summary-ignore-duplicates t) (dependencies gnus-newsgroup-dependencies) - found header article) + header article) (save-excursion (set-buffer nntp-server-buffer) (let ((case-fold-search nil)) @@ -3116,14 +3140,16 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header (gnus-nov-parse-line article dependencies))) (when header - (push header gnus-newsgroup-headers) - (if (memq (setq article (mail-header-number header)) - gnus-newsgroup-unselected) - (progn - (push article gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delq article gnus-newsgroup-unselected))) - (push article gnus-newsgroup-ancient)) + (save-excursion + (set-buffer gnus-summary-buffer) + (push header gnus-newsgroup-headers) + (if (memq (setq article (mail-header-number header)) + gnus-newsgroup-unselected) + (progn + (push article gnus-newsgroup-unreads) + (setq gnus-newsgroup-unselected + (delq article gnus-newsgroup-unselected))) + (push article gnus-newsgroup-ancient))) (forward-line 1))))))) (defun gnus-summary-update-article-line (article header) @@ -3171,7 +3197,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." (set-buffer gnus-summary-buffer) - (let* ((header (or iheader (gnus-summary-article-header article))) + (let* ((header (gnus-summary-article-header article)) (id (mail-header-id header)) (data (gnus-data-find article)) (thread (gnus-id-to-thread id)) @@ -3184,16 +3210,13 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." references)) "none"))) (buffer-read-only nil) - (old (car thread)) - (number (mail-header-number header)) - pos) + (old (car thread))) (when thread - ;; !!! Should this be in or not? (unless iheader - (setcar thread nil)) - (when parent - (delq thread parent)) - (if (gnus-summary-insert-subject id header iheader) + (setcar thread nil) + (when parent + (delq thread parent))) + (if (gnus-summary-insert-subject id header) ;; Set the (possibly) new article number in the data structure. (gnus-data-set-number data (gnus-id-to-article id)) (setcar thread old) @@ -3245,10 +3268,11 @@ If LINE, insert the rebuilt thread starting on line LINE." ;;!!! then we want to insert at the beginning of the buffer. ;;!!! That happens to be true with Gnus now, but that may ;;!!! change in the future. Perhaps. - (gnus-data-enter-list (if line nil current) data (- (point) old-pos)) - (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)) - (when line - (gnus-data-compute-positions))))) + (gnus-data-enter-list + (if line nil current) data (- (point) old-pos)) + (setq gnus-newsgroup-threads + (nconc threads gnus-newsgroup-threads)) + (gnus-data-compute-positions)))) (defun gnus-number-to-header (number) "Return the header for article NUMBER." @@ -3324,9 +3348,8 @@ If LINE, insert the rebuilt thread starting on line LINE." "Remove the thread that has ID in it." (let (headers thread last-id) ;; First go up in this thread until we find the root. - (setq last-id (gnus-root-id id)) - (setq headers (list (car (gnus-id-to-thread last-id)) - (caadr (gnus-id-to-thread last-id)))) + (setq last-id (gnus-root-id id) + headers (message-flatten-list (gnus-id-to-thread last-id))) ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. @@ -3376,6 +3399,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (while thread (gnus-remove-thread-1 (car thread)) (setq thread (cdr thread)))) + (gnus-summary-show-all-threads) (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) @@ -3398,10 +3422,10 @@ If LINE, insert the rebuilt thread starting on line LINE." "Sort THREADS." (if (not gnus-thread-sort-functions) threads - (gnus-message 7 "Sorting threads...") + (gnus-message 8 "Sorting threads...") (prog1 (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) - (gnus-message 7 "Sorting threads...done")))) + (gnus-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) "Sort ARTICLES." @@ -3815,13 +3839,14 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) -(defun gnus-select-newsgroup (group &optional read-all) +(defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. -If READ-ALL is non-nil, all articles in the group are selected." +If READ-ALL is non-nil, all articles in the group are selected. +If SELECT-ARTICLES, only select those articles from GROUP." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) ;;!!! Dirty hack; should be removed. (gnus-summary-ignore-duplicates - (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) + (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) t gnus-summary-ignore-duplicates)) (info (nth 2 entry)) @@ -3866,10 +3891,13 @@ If READ-ALL is non-nil, all articles in the group are selected." (setq gnus-newsgroup-processable nil) (gnus-update-read-articles group gnus-newsgroup-unreads) - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group)) - (setq articles (gnus-articles-to-read group read-all)) + (if (setq articles select-articles) + (setq gnus-newsgroup-unselected + (gnus-sorted-intersection + gnus-newsgroup-unreads + (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (setq articles (gnus-articles-to-read group read-all))) (cond ((null articles) @@ -3919,15 +3947,15 @@ If READ-ALL is non-nil, all articles in the group are selected." ;; Removed marked articles that do not exist. (gnus-update-missing-marks (gnus-sorted-complement fetched-articles articles)) - ;; Let the Gnus agent mark articles as read. - (when gnus-agent - (gnus-agent-get-undownloaded-list)) ;; We might want to build some more threads first. (when (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)) (if (eq gnus-fetch-old-headers 'invisible) (gnus-build-all-threads) (gnus-build-old-threads))) + ;; Let the Gnus agent mark articles as read. + (when gnus-agent + (gnus-agent-get-undownloaded-list)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) @@ -4353,7 +4381,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (or dependencies (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) - headers id id-dep ref-dep end ref) + headers id end ref) (save-excursion (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. @@ -4446,7 +4474,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ref2 (substring in-reply-to (match-beginning 0) (match-end 0))) (when (> (length ref2) (length ref)) - (setq ref ref2)))) + (setq ref ref2))) + ref) (setq ref nil)))) ;; Chars. (progn @@ -4572,7 +4601,7 @@ the subject line on." (t (gnus-read-header id)))) (number (and (numberp id) id)) - pos d) + d) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. @@ -4659,6 +4688,19 @@ current article will be taken into consideration." ;; Just return the current article. (list (gnus-summary-article-number)))))) +(defmacro gnus-summary-iterate (arg &rest forms) + "Iterate over the process/prefixed articles and do FORMS. +ARG is the interactive prefix given to the command. FORMS will be +executed with point over the summary line of the articles." + (let ((articles (make-symbol "gnus-summary-iterate-articles"))) + `(let ((,articles (gnus-summary-work-articles ,arg))) + (while ,articles + (gnus-summary-goto-subject (car ,articles)) + ,@forms)))) + +(put 'gnus-summary-iterate 'lisp-indent-function 1) +(put 'gnus-summary-iterate 'edebug-form-spec '(form body)) + (defun gnus-summary-save-process-mark () "Push the current set of process marked articles on the stack." (interactive) @@ -4857,12 +4899,12 @@ displayed, no centering will be performed." ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? (if (not (listp (cdr read))) - (setq first (1+ (cdr read))) + (setq first (max (car active) (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) (caar read))) 1) - (setq first 1)) + (setq first (car active))) (while read (when first (while (< first nlast) @@ -5174,12 +5216,6 @@ The state which existed when entering the ephemeral is reset." (select-window (get-buffer-window gnus-article-buffer)) ) -(defun gnus-summary-scroll-down () - "Scroll down one line current article." - (interactive) - (gnus-summary-scroll-up -1) - ) - ;;; Dead summaries. (defvar gnus-dead-summary-mode-map nil) @@ -5749,6 +5785,12 @@ Argument LINES specifies lines to be scrolled up (or down if negative)." (gnus-summary-recenter) (gnus-summary-position-point)) +(defun gnus-summary-scroll-down (lines) + "Scroll down (or up) one line current article. +Argument LINES specifies lines to be scrolled down (or up if negative)." + (interactive "p") + (gnus-summary-scroll-up (- lines))) + (defun gnus-summary-next-same-subject () "Select next article which has the same subject as current one." (interactive) @@ -6059,7 +6101,8 @@ If ALL, mark even excluded ticked and dormants as read." '<) (sort gnus-newsgroup-limit '<))) article) - (setq gnus-newsgroup-unreads gnus-newsgroup-limit) + (setq gnus-newsgroup-unreads + (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit)) (if all (setq gnus-newsgroup-dormant nil gnus-newsgroup-marked nil @@ -6107,6 +6150,7 @@ If ALL, mark even excluded ticked and dormants as read." ;; after the current one. (goto-char (point-max)) (gnus-summary-find-prev)) + (gnus-set-mode-line 'summary) ;; We return how many articles were removed from the summary ;; buffer as a result of the new limit. (- total (length gnus-newsgroup-data)))) @@ -6356,8 +6400,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." (interactive "P") (let ((id (mail-header-id (gnus-summary-article-header))) (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit)) - fmethod root) + gnus-refer-thread-limit))) ;; We want to fetch LIMIT *old* headers, but we also have to ;; re-fetch all the headers in the current buffer, because many of ;; them may be undisplayed. So we adjust LIMIT. @@ -6392,8 +6435,7 @@ or `gnus-select-method', no matter what backend the article comes from." (gnus-summary-article-sparse-p (mail-header-number header)) (memq (mail-header-number header) - gnus-newsgroup-limit))) - h) + gnus-newsgroup-limit)))) (cond ;; If the article is present in the buffer we just go to it. ((and header @@ -6965,15 +7007,10 @@ and `request-accept' functions." (gnus-summary-mark-article article gnus-canceled-mark) (gnus-message 4 "Deleted article %s" article)) (t - (let* ((entry - (or - (gnus-gethash (car art-group) gnus-newsrc-hashtb) - (gnus-gethash - (gnus-group-prefixed-name - (car art-group) - (or select-method - (gnus-find-method-for-group to-newsgroup))) - gnus-newsrc-hashtb))) + (let* ((pto-group (gnus-group-prefixed-name + (car art-group) to-method)) + (entry + (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) (to-group (gnus-info-group info))) ;; Update the group that has been moved to. @@ -7077,7 +7114,7 @@ re-spool using this method." (defcustom gnus-summary-respool-default-method nil "Default method for respooling an article. If nil, use to the current newsgroup method." - :type `(choice (gnus-select-method :value (nnml "")) + :type '(choice (gnus-select-method :value (nnml "")) (const nil)) :group 'gnus-summary-mail) @@ -7137,7 +7174,7 @@ latter case, they will be copied into the relevant groups." (not (file-regular-p file)) (error "Can't read %s" file)) (save-excursion - (set-buffer (get-buffer-create " *import file*")) + (set-buffer (gnus-get-buffer-create " *import file*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (nnheader-insert-file-contents file) @@ -7368,7 +7405,7 @@ groups." ;;; Respooling -(defun gnus-summary-respool-query (&optional silent) +(defun gnus-summary-respool-query (&optional silent trace) "Query where the respool algorithm would put this article." (interactive) (let (gnus-mark-article-hook) @@ -7377,7 +7414,7 @@ groups." (set-buffer gnus-original-article-buffer) (save-restriction (message-narrow-to-head) - (let ((groups (nnmail-article-group 'identity))) + (let ((groups (nnmail-article-group 'identity trace))) (unless silent (if groups (message "This message would go to %s" @@ -7385,6 +7422,12 @@ groups." (message "This message would go to no groups")) groups)))))) +(defun gnus-summary-respool-trace () + "Trace where the respool algorithm would put this article. +Display a buffer showing all fancy splitting patterns which matched." + (interactive) + (gnus-summary-respool-query nil t)) + ;; Summary marking commands. (defun gnus-summary-kill-same-subject-and-select (&optional unmark) @@ -7561,6 +7604,7 @@ the actual number of articles marked is returned." (delq article gnus-newsgroup-processable))) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) + (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) (defun gnus-summary-remove-process-mark (article) @@ -7568,6 +7612,7 @@ the actual number of articles marked is returned." (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) + (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) (defun gnus-summary-set-saved-mark (article) @@ -7625,6 +7670,8 @@ returned." (= mark gnus-read-mark) (= mark gnus-souped-mark) (= mark gnus-duplicate-mark))) (setq mark gnus-expirable-mark) + ;; Let the backend know about the mark change. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (push article gnus-newsgroup-expirable)) ;; Set the mark in the buffer. (gnus-summary-update-mark mark 'unread) @@ -7634,6 +7681,8 @@ returned." "Mark the current article quickly as unread with MARK." (let* ((article (gnus-summary-article-number)) (old-mark (gnus-summary-article-mark article))) + ;; 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) @@ -7689,6 +7738,8 @@ marked." (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number))) (old-mark (gnus-summary-article-mark article))) + ;; 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 @@ -8506,8 +8557,7 @@ save those articles instead." "Pipe the current article through PROGRAM." (interactive "sProgram: ") (gnus-summary-select-article) - (let ((mail-header-separator "") - (art-buf (get-buffer gnus-article-buffer))) + (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 6880f63..3f2b2af 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -74,6 +74,7 @@ with some simple extensions. (defvar gnus-topic-active-topology nil) (defvar gnus-topic-active-alist nil) +(defvar gnus-topic-unreads nil) (defvar gnus-topology-checked-p nil "Whether the topology has been checked in this session.") @@ -109,9 +110,7 @@ with some simple extensions. (defun gnus-topic-unread (topic) "Return the number of unread articles in TOPIC." - (or (save-excursion - (and (gnus-topic-goto-topic topic) - (gnus-group-topic-unread))) + (or (cdr (assoc topic gnus-topic-unreads)) 0)) (defun gnus-group-topic-p () @@ -472,6 +471,7 @@ articles in the topic and its subtopics." (car type) visiblep (not (eq (nth 2 type) 'hidden)) level all-entries unread)) + (gnus-topic-update-unreads (car type) unread) (goto-char end) unread)) @@ -528,6 +528,7 @@ articles in the topic and its subtopics." (number-of-groups (length entries)) (active-topic (eq gnus-topic-alist gnus-topic-active-alist)) gnus-tmp-header) + (gnus-topic-update-unreads name unread) (beginning-of-line) ;; Insert the text. (gnus-add-text-properties @@ -540,6 +541,11 @@ articles in the topic and its subtopics." 'gnus-active active-topic 'gnus-topic-visible visiblep)))) +(defun gnus-topic-update-unreads (topic unreads) + (setq gnus-topic-unreads (delq (assoc topic gnus-topic-unreads) + gnus-topic-unreads)) + (push (cons topic unreads) gnus-topic-unreads)) + (defun gnus-topic-update-topics-containing-group (group) "Update all topics that have GROUP as a member." (when (and (eq major-mode 'gnus-group-mode) @@ -621,7 +627,7 @@ articles in the topic and its subtopics." (parent (gnus-topic-parent-topic topic-name)) (all-entries entries) (unread 0) - old-unread entry) + old-unread entry new-unread) (when (gnus-topic-goto-topic (car type)) ;; Tally all the groups that belong in this topic. (if reads @@ -637,11 +643,14 @@ articles in the topic and its subtopics." (car type) (gnus-topic-visible-p) (not (eq (nth 2 type) 'hidden)) (gnus-group-topic-level) all-entries unread) - (gnus-delete-line)) + (gnus-delete-line) + (forward-line -1) + (setq new-unread (gnus-group-topic-unread))) (when parent (forward-line -1) (gnus-topic-update-topic-line - parent (- (or old-unread 0) (or (gnus-group-topic-unread) 0)))) + parent + (- (or old-unread 0) (or new-unread 0)))) unread)) (defun gnus-topic-group-indentation () @@ -904,6 +913,10 @@ articles in the topic and its subtopics." "Gp" gnus-topic-edit-parameters "#" gnus-topic-mark-topic "\M-#" gnus-topic-unmark-topic + [tab] gnus-topic-indent + [(meta tab)] gnus-topic-unindent + "\C-i" gnus-topic-indent + "\M-\C-i" gnus-topic-unindent gnus-mouse-2 gnus-mouse-pick-topic) ;; Define a new submap. @@ -923,7 +936,7 @@ articles in the topic and its subtopics." "r" gnus-topic-rename "\177" gnus-topic-delete [delete] gnus-topic-delete - "h" gnus-topic-toggle-display-empty-topics) + "H" gnus-topic-toggle-display-empty-topics) (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) "s" gnus-topic-sort-groups @@ -973,7 +986,6 @@ articles in the topic and its subtopics." (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) - (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) (set (make-local-variable 'gnus-group-prepare-function) 'gnus-group-prepare-topics) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 82e7f94..7d9dafa 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -35,6 +35,9 @@ (require 'nnheader) (require 'timezone) (require 'message) +(eval-when-compile + (when (locate-library "rmail") + (require 'rmail))) (eval-and-compile (autoload 'nnmail-date-to-time "nnmail") @@ -75,7 +78,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 @@ -540,7 +546,7 @@ Timezone package is used." (progn (set-buffer gnus-work-buffer) (erase-buffer)) - (set-buffer (get-buffer-create gnus-work-buffer)) + (set-buffer (gnus-get-buffer-create gnus-work-buffer)) (kill-all-local-variables) (buffer-disable-undo (current-buffer)))) @@ -580,6 +586,7 @@ Timezone package is used." Bind `print-quoted' and `print-readably' to t while printing." (let ((print-quoted t) (print-readably t) + (print-escape-multibyte nil) print-level print-length) (prin1 form (current-buffer)))) @@ -722,8 +729,7 @@ with potentially long computations." (setq filename (expand-file-name filename)) (setq rmail-default-rmail-file filename) (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*")) - (coding-system-for-write 'binary)) + (tmpbuf (get-buffer-create " *Gnus-output*"))) (save-excursion (or (get-file-buffer filename) (file-exists-p filename) @@ -759,9 +765,12 @@ with potentially long computations." (when msg (goto-char (point-min)) (widen) - (search-backward "\^_") - (narrow-to-region (point) (point-max)) - (goto-char (1+ (point-min))) + (search-backward "\n\^_") + (narrow-to-region (point) (point-max)) + (rmail-count-new-messages t) + (when (rmail-summary-exists) + (rmail-select-summary + (rmail-update-summary))) (rmail-count-new-messages t) (rmail-show-message msg)) (save-buffer))))) @@ -837,8 +846,7 @@ with potentially long computations." (defun gnus-map-function (funs arg) "Applies the result of the first function in FUNS to the second, and so on. ARG is passed to the first function." - (let ((myfuns funs) - (myarg arg)) + (let ((myfuns funs)) (while myfuns (setq arg (funcall (pop myfuns) arg))) arg)) @@ -856,6 +864,7 @@ ARG is passed to the first function." (defvar gnus-netrc-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?@ "w" table) (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?! "w" table) @@ -878,50 +887,59 @@ ARG is passed to the first function." "password" "account" "macdef" "force")) alist elem result pair) (nnheader-set-temp-buffer " *netrc*") - (set-syntax-table gnus-netrc-syntax-table) - (insert-file-contents file) - (goto-char (point-min)) - ;; Go through the file, line by line. - (while (not (eobp)) - (narrow-to-region (point) (gnus-point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - (unless (eobp) - (setq elem (buffer-substring - (point) (progn (forward-sexp 1) (point)))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. + (unwind-protect + (progn + (set-syntax-table gnus-netrc-syntax-table) + (insert-file-contents file) + (goto-char (point-min)) + ;; Go through the file, line by line. + (while (not (eobp)) + (narrow-to-region (point) (gnus-point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + (unless (eobp) + (setq elem (buffer-substring + (point) (progn (forward-sexp 1) (point)))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil)))))) + (if alist + (push (nreverse alist) result)) + (setq alist nil + pair nil) (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored. - (when (and pair (cdr pair)) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil)))))) - (push alist result) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) - result)))) + (forward-line 1)) + (nreverse result)) + (kill-buffer " *netrc*")))))) (defun gnus-netrc-machine (list machine) - "Return the netrc values from LIST for MACHINE." - (while (and list - (not (equal (cdr (assoc "machine" (car list))) machine))) - (pop list)) - (when list - (car list))) + "Return the netrc values from LIST for MACHINE or for the default entry." + (let ((rest list)) + (while (and list + (not (equal (cdr (assoc "machine" (car list))) machine))) + (pop list)) + (car (or list + (progn (while (and rest (not (assoc "default" (car rest)))) + (pop rest)) + rest))))) (defun gnus-netrc-get (alist type) "Return the value of token TYPE from ALIST." @@ -929,6 +947,7 @@ ARG is passed to the first function." ;;; Various +(defvar gnus-group-buffer) ; Compiler directive (defun gnus-alive-p () "Say whether Gnus is running or not." (and (boundp 'gnus-group-buffer) @@ -949,7 +968,7 @@ ARG is passed to the first function." "Delete elements from LIST that satisfy PREDICATE." (let (out) (while list - (when (funcall predicate (car list)) + (unless (funcall predicate (car list)) (push (car list) out)) (pop list)) (nreverse out))) @@ -967,6 +986,12 @@ ARG is passed to the first function." (error "Not a symbol: %s" alist)) `(setq ,alist (delq (assq ,key ,alist) ,alist))) +(defun gnus-globalify-regexp (re) + "Returns a regexp that matches a whole line, iff RE matches a part of it." + (concat (unless (string-match "^\\^" re) "^.*") + re + (unless (string-match "\\$$" re) ".*$"))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 3a0bf91..19929f3 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -513,12 +513,12 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive "P") (let ((gnus-uu-save-in-digest t) (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward"))) - buf subject from newsgroups) + buf subject from) (gnus-setup-message 'forward (setq gnus-uu-digest-from-subject nil) (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) - (gnus-add-current-to-buffer-list) + (setq buf (switch-to-buffer + (gnus-get-buffer-create " *gnus-uu-forward*"))) (erase-buffer) (insert-file file) (let ((fs gnus-uu-digest-from-subject)) @@ -638,7 +638,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Invert the list of process-marked articles." (interactive) (let ((data gnus-newsgroup-data) - d number) + number) (save-excursion (while data (if (memq (setq number (gnus-data-number (pop data))) @@ -828,16 +828,15 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (mail-header-subject header)) gnus-uu-digest-from-subject)) (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) - (delim (concat "^" (make-string 30 ?-) "$")) beg subj headers headline sorthead body end-string state) (if (or (eq in-state 'first) (eq in-state 'first-and-last)) (progn (setq state (list 'begin)) - (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) + (save-excursion (set-buffer (gnus-get-buffer-create "*gnus-uu-body*")) (erase-buffer)) (save-excursion - (set-buffer (get-buffer-create "*gnus-uu-pre*")) + (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*")) (erase-buffer) (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" @@ -970,7 +969,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) (setq state (list 'wrong-type)) (setq end-char (point)) - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) (insert-buffer-substring process-buffer start-char end-char) (setq file-name (concat gnus-uu-work-dir (cdr gnus-article-current) ".ps")) @@ -1020,45 +1019,36 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-reginize-string (string) ;; Takes a string and puts a \ in front of every special character; - ;; ignores any leading "version numbers" thingies that they use in - ;; the comp.binaries groups, and either replaces anything that looks - ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something - ;; like that, replaces the last two numbers with "[0-9]+". This, in - ;; my experience, should get most postings of a series. - (let ((count 2) - (vernum "v[0-9]+[a-z][0-9]+:") - beg) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (regexp-quote string)) - (setq beg 1) + ;; replaces the last thing that looks like "2/3" with "[0-9]+/3" + ;; or, if it can't find something like that, tries "2 of 3", then + ;; finally just replaces the next to last number with "[0-9]+". + (save-excursion + (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert (regexp-quote string)) - (setq case-fold-search nil) - (goto-char (point-min)) - (when (looking-at vernum) - (replace-match vernum t t) - (setq beg (length vernum))) + (setq case-fold-search nil) - (goto-char beg) - (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) - (replace-match " [0-9]+/[0-9]+") + (end-of-line) + (if (re-search-backward "\\([^0-9]\\)[0-9]+/\\([0-9]+\\)" nil t) + (replace-match "\\1[0-9]+/\\2") - (goto-char beg) - (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) - (replace-match "[0-9]+ of [0-9]+") + (end-of-line) + (if (re-search-backward "\\([^0-9]\\)[0-9]+[ \t]*of[ \t]*\\([0-9]+\\)" + nil t) + (replace-match "\\1[0-9]+ of \\2") - (end-of-line) - (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" - nil t) - (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) + (end-of-line) + (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" + nil t) + (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) - (goto-char beg) - (while (re-search-forward "[ \t]+" nil t) - (replace-match "[ \t]*" t t)) + (goto-char 1) + (while (re-search-forward "[ \t]+" nil t) + (replace-match "[ \t]+" t t)) - (buffer-substring 1 (point-max))))) + (buffer-substring 1 (point-max)))) (defun gnus-uu-get-list-of-articles (n) ;; If N is non-nil, the article numbers of the N next articles @@ -1098,8 +1088,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-reginize-string (gnus-summary-article-subject)))) list-of-subjects) (save-excursion - (if (not subject) - () + (when subject ;; Collect all subjects matching subject. (let ((case-fold-search t) (data gnus-newsgroup-data) @@ -1134,7 +1123,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (let ((out-list string-list) string) (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) (while string-list (erase-buffer) @@ -1221,119 +1210,121 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (not (memq 'end process-state)))) (setq article (pop articles)) - (push article article-series) - - (unless articles - (if (eq state 'first) - (setq state 'first-and-last) - (setq state 'last))) + (when (vectorp (gnus-summary-article-header article)) + (push article article-series) - (let ((part (gnus-uu-part-number article))) - (gnus-message 6 "Getting article %d%s..." - article (if (string= part "") "" (concat ", " part)))) - (gnus-summary-display-article article) + (unless articles + (if (eq state 'first) + (setq state 'first-and-last) + (setq state 'last))) - ;; Push the article to the processing function. - (save-excursion - (set-buffer gnus-original-article-buffer) - (let ((buffer-read-only nil)) - (save-excursion - (set-buffer gnus-summary-buffer) - (setq process-state - (funcall process-function - gnus-original-article-buffer state))))) - - (gnus-summary-remove-process-mark article) - - ;; If this is the beginning of a decoded file, we push it - ;; on to a list. - (when (or (memq 'begin process-state) - (and (or (eq state 'first) - (eq state 'first-and-last)) - (memq 'ok process-state))) - (when has-been-begin - ;; If there is a `result-file' here, that means that the - ;; file was unsuccessfully decoded, so we delete it. - (when (and result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p - (format "Delete unsuccessfully decoded file %s" - result-file)))) - (delete-file result-file))) - (when (memq 'begin process-state) - (setq result-file (car process-state))) - (setq has-been-begin t)) - - ;; Check whether we have decoded one complete file. - (when (memq 'end process-state) - (setq article-series nil) - (setq has-been-begin nil) - (if (stringp result-file) - (setq files (list result-file)) - (setq files result-file)) - (setq result-file (car files)) - (while files - (push (list (cons 'name (pop files)) - (cons 'article article)) - result-files)) - ;; Allow user-defined functions to be run on this file. - (when gnus-uu-grabbed-file-functions - (let ((funcs gnus-uu-grabbed-file-functions)) - (unless (listp funcs) - (setq funcs (list funcs))) - (while funcs - (funcall (pop funcs) result-file)))) - (setq result-file nil) - ;; Check whether we have decoded enough articles. - (and limit (= (length result-files) limit) - (setq articles nil))) - - ;; If this is the last article to be decoded, and - ;; we still haven't reached the end, then we delete - ;; the partially decoded file. - (and (or (eq state 'last) (eq state 'first-and-last)) - (not (memq 'end process-state)) - result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) - (delete-file result-file)) - - ;; If this was a file of the wrong sort, then - (when (and (or (memq 'wrong-type process-state) - (memq 'error process-state)) - gnus-uu-unmark-articles-not-decoded) - (gnus-summary-tick-article article t)) - - ;; Set the new series state. - (if (and (not has-been-begin) - (not sloppy) - (or (memq 'end process-state) - (memq 'middle process-state))) - (progn - (setq process-state (list 'error)) - (gnus-message 2 "No begin part at the beginning") - (sleep-for 2)) - (setq state 'middle))) + (let ((part (gnus-uu-part-number article))) + (gnus-message 6 "Getting article %d%s..." + article (if (string= part "") "" (concat ", " part)))) + (gnus-summary-display-article article) - ;; When there are no result-files, then something must be wrong. - (if result-files - (message "") - (cond - ((not has-been-begin) - (gnus-message 2 "Wrong type file")) - ((memq 'error process-state) - (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) - (memq 'end process-state))) - (gnus-message 2 "End of articles reached before end of file"))) - ;; Make unsuccessfully decoded articles unread. - (when gnus-uu-unmark-articles-not-decoded - (while article-series - (gnus-summary-tick-article (pop article-series) t)))) + ;; Push the article to the processing function. + (save-excursion + (set-buffer gnus-original-article-buffer) + (let ((buffer-read-only nil)) + (save-excursion + (set-buffer gnus-summary-buffer) + (setq process-state + (funcall process-function + gnus-original-article-buffer state))))) + + (gnus-summary-remove-process-mark article) + + ;; If this is the beginning of a decoded file, we push it + ;; on to a list. + (when (or (memq 'begin process-state) + (and (or (eq state 'first) + (eq state 'first-and-last)) + (memq 'ok process-state))) + (when has-been-begin + ;; If there is a `result-file' here, that means that the + ;; file was unsuccessfully decoded, so we delete it. + (when (and result-file + (file-exists-p result-file) + (not gnus-uu-be-dangerous) + (or (eq gnus-uu-be-dangerous t) + (gnus-y-or-n-p + (format "Delete unsuccessfully decoded file %s" + result-file)))) + (delete-file result-file))) + (when (memq 'begin process-state) + (setq result-file (car process-state))) + (setq has-been-begin t)) + + ;; Check whether we have decoded one complete file. + (when (memq 'end process-state) + (setq article-series nil) + (setq has-been-begin nil) + (if (stringp result-file) + (setq files (list result-file)) + (setq files result-file)) + (setq result-file (car files)) + (while files + (push (list (cons 'name (pop files)) + (cons 'article article)) + result-files)) + ;; Allow user-defined functions to be run on this file. + (when gnus-uu-grabbed-file-functions + (let ((funcs gnus-uu-grabbed-file-functions)) + (unless (listp funcs) + (setq funcs (list funcs))) + (while funcs + (funcall (pop funcs) result-file)))) + (setq result-file nil) + ;; Check whether we have decoded enough articles. + (and limit (= (length result-files) limit) + (setq articles nil))) + + ;; If this is the last article to be decoded, and + ;; we still haven't reached the end, then we delete + ;; the partially decoded file. + (and (or (eq state 'last) (eq state 'first-and-last)) + (not (memq 'end process-state)) + result-file + (file-exists-p result-file) + (not gnus-uu-be-dangerous) + (or (eq gnus-uu-be-dangerous t) + (gnus-y-or-n-p + (format "Delete incomplete file %s? " result-file))) + (delete-file result-file)) + + ;; If this was a file of the wrong sort, then + (when (and (or (memq 'wrong-type process-state) + (memq 'error process-state)) + gnus-uu-unmark-articles-not-decoded) + (gnus-summary-tick-article article t)) + + ;; Set the new series state. + (if (and (not has-been-begin) + (not sloppy) + (or (memq 'end process-state) + (memq 'middle process-state))) + (progn + (setq process-state (list 'error)) + (gnus-message 2 "No begin part at the beginning") + (sleep-for 2)) + (setq state 'middle))) + + ;; When there are no result-files, then something must be wrong. + (if result-files + (message "") + (cond + ((not has-been-begin) + (gnus-message 2 "Wrong type file")) + ((memq 'error process-state) + (gnus-message 2 "An error occurred during decoding")) + ((not (or (memq 'ok process-state) + (memq 'end process-state))) + (gnus-message 2 "End of articles reached before end of file"))) + ;; Make unsuccessfully decoded articles unread. + (when gnus-uu-unmark-articles-not-decoded + (while article-series + (gnus-summary-tick-article (pop article-series) t))))) result-files)) @@ -1357,11 +1348,18 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-part-number (article) (let* ((header (gnus-summary-article-header article)) - (subject (and header (mail-header-subject header)))) - (if (and subject - (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) - (match-string 0 subject) - ""))) + (subject (and header (mail-header-subject header))) + (part nil)) + (if subject + (while (string-match "[0-9]+/[0-9]+\\|[0-9]+[ \t]+of[ \t]+[0-9]+" + subject) + (setq part (match-string 0 subject)) + (setq subject (substring subject (match-end 0))))) + (or part + (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject) + (setq part (match-string 0 subject)) + (setq subject (substring subject (match-end 0))))) + (or part ""))) (defun gnus-uu-uudecode-sentinel (process event) (delete-process (get-process process))) @@ -1419,7 +1417,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (setq gnus-uu-uudecode-process (start-process "*uudecode*" - (get-buffer-create gnus-uu-output-buffer-name) + (gnus-get-buffer-create gnus-uu-output-buffer-name) shell-file-name shell-command-switch (format "cd %s %s uudecode" gnus-uu-work-dir gnus-shell-command-separator)))) @@ -1485,7 +1483,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (setq start-char (point)) (call-process-region start-char (point-max) shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) nil + (gnus-get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch (concat "cd " gnus-uu-work-dir " " gnus-shell-command-separator " sh")))) @@ -1548,13 +1546,13 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) (erase-buffer)) (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) (if (= 0 (call-process shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) + (gnus-get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch command)) (message "") (gnus-message 2 "Error during unpacking of archive") @@ -1912,7 +1910,7 @@ If no file has been included, the user will be asked for a file." (unwind-protect (if (save-excursion (set-buffer (setq uubuf - (get-buffer-create uuencode-buffer-name))) + (gnus-get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) (insert-buffer-substring uubuf) @@ -1927,7 +1925,7 @@ If no file has been included, the user will be asked for a file." (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") (separator (concat mail-header-separator "\n\n")) uubuf length parts header i end beg - beg-line minlen buf post-buf whole-len beg-binary end-binary) + beg-line minlen post-buf whole-len beg-binary end-binary) (setq post-buf (current-buffer)) @@ -1945,7 +1943,7 @@ If no file has been included, the user will be asked for a file." (setq end-binary (point-max)) (save-excursion - (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) + (set-buffer (setq uubuf (gnus-get-buffer-create encoded-buffer-name))) (erase-buffer) (insert-buffer-substring post-buf beg-binary end-binary) (goto-char (point-min)) @@ -1977,7 +1975,7 @@ If no file has been included, the user will be asked for a file." (setq i 1) (setq beg 1) (while (not (> i parts)) - (set-buffer (get-buffer-create send-buffer-name)) + (set-buffer (gnus-get-buffer-create send-buffer-name)) (erase-buffer) (insert header) (when (and threaded gnus-uu-post-message-id) diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 5c4eb52..c41fbae 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -154,6 +154,10 @@ (vertical 1.0 (summary 0.5 point) ("*Score Words*" 1.0))) + (split-trace + (vertical 1.0 + (summary 0.5 point) + ("*Split Trace*" 1.0))) (category (vertical 1.0 (category 1.0))) @@ -185,6 +189,7 @@ See the Gnus manual for an explanation of the syntax used.") (picons . gnus-picons-buffer-name) (tree . gnus-tree-buffer) (score-trace . "*Score Trace*") + (split-trace . "*Split Trace*") (info . gnus-info-buffer) (category . gnus-category-buffer) (article-copy . gnus-article-copy) @@ -314,7 +319,7 @@ See the Gnus manual for an explanation of the syntax used.") (t (cdr (assq type gnus-window-to-buffer)))))) (unless buffer (error "Illegal buffer type: %s" type)) - (switch-to-buffer (get-buffer-create + (switch-to-buffer (gnus-get-buffer-create (gnus-window-to-buffer-helper buffer))) (when (memq 'frame-focus split) (setq gnus-window-frame-focus window)) @@ -448,13 +453,7 @@ See the Gnus manual for an explanation of the syntax used.") (defun gnus-delete-windows-in-gnusey-frames () "Do a `delete-other-windows' in all frames that have Gnus windows." - (let ((buffers - (mapcar - (lambda (elem) - (let ((buf (gnus-window-to-buffer-helper (cdr elem)))) - (if (not (null buf)) - (get-buffer buf)))) - gnus-window-to-buffer))) + (let ((buffers (gnus-buffers))) (mapcar (lambda (frame) (unless (eq (cdr (assq 'minibuffer @@ -518,39 +517,22 @@ should have point." (nth 1 (window-edges window))) (defun gnus-remove-some-windows () - (let ((buffers gnus-window-to-buffer) + (let ((buffers (gnus-buffers)) buf bufs lowest-buf lowest) (save-excursion ;; Remove windows on all known Gnus buffers. - (while buffers - (and (setq buf (gnus-window-to-buffer-helper (cdar buffers))) - (get-buffer-window buf) - (progn - (push buf bufs) - (pop-to-buffer buf) - (when (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (setq lowest (gnus-window-top-edge)) - (setq lowest-buf buf)))) - (setq buffers (cdr buffers))) - ;; Remove windows on *all* summary buffers. - (walk-windows - (lambda (win) - (let ((buf (window-buffer win))) - (when (string-match "^\\*\\(Dead \\)?Summary" (buffer-name buf)) - (push buf bufs) - (pop-to-buffer buf) - (when (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (setq lowest-buf buf) - (setq lowest (gnus-window-top-edge))))))) + (while (setq buf (pop buffers)) + (when (get-buffer-window buf) + (push buf bufs) + (pop-to-buffer buf) + (when (or (not lowest) + (< (gnus-window-top-edge) lowest)) + (setq lowest (gnus-window-top-edge) + lowest-buf buf)))) (when lowest-buf (pop-to-buffer lowest-buf) (switch-to-buffer nntp-server-buffer)) - (while bufs - (when (not (eq (car bufs) lowest-buf)) - (delete-windows-on (car bufs))) - (setq bufs (cdr bufs)))))) + (mapcar (lambda (b) (delete-windows-on b t)) bufs)))) (provide 'gnus-win) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 9d3d239..41d5116 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -90,7 +90,6 @@ asynchronously. The compressed face will be piped to this command." (defvar gnus-active-hashtb) (defvar gnus-article-buffer) (defvar gnus-auto-center-summary) -(defvar gnus-buffer-list) (defvar gnus-current-headers) (defvar gnus-level-killed) (defvar gnus-level-zombie) @@ -479,7 +478,30 @@ 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) + `(let ((val (format "%s" ,el))) + (concat val (make-string + (max 0 (- ,pad (string-width val))) ?\ ))) + `(let ((val (format "%s" ,el))) + (concat (make-string + (max 0 (- ,pad (string-width val))) ?\ ) + val))) + (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." @@ -525,8 +547,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 f7e0495..1465159 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,12 +250,15 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "6.7.8" +(defconst gnus-product-name "Semi-gnus" + "Product name of this version of gnus.") + +(defconst gnus-version-number "6.8.20" "Version number for this version of gnus.") (defconst gnus-version - (format "Semi-gnus %s (based on Gnus 5.6.22; for SEMI 1.8/FLIM 1.7)" - gnus-version-number) + (format "%s %s (based on Gnus 5.6.45; for SEMI 1.8, FLIM 1.8/1.9)" + gnus-product-name gnus-version-number) "Version string for this version of gnus.") (defcustom gnus-inhibit-startup-message nil @@ -602,6 +605,33 @@ be set in `.emacs' instead." "Face used for normal interest read articles.") +;;; +;;; Gnus buffers +;;; + +(defvar gnus-buffers nil) + +(defun gnus-get-buffer-create (name) + "Do the same as `get-buffer-create', but store the created buffer." + (or (get-buffer name) + (car (push (get-buffer-create name) gnus-buffers)))) + +(defun gnus-add-buffer () + "Add the current buffer to the list of Gnus buffers." + (push (current-buffer) gnus-buffers)) + +(defun gnus-buffers () + "Return a list of live Gnus buffers." + (while (and gnus-buffers + (not (buffer-name (car gnus-buffers)))) + (pop gnus-buffers)) + (let ((buffers gnus-buffers)) + (while (cdr buffers) + (if (buffer-name (cadr buffers)) + (pop buffers) + (setcdr buffers (cddr buffers))))) + gnus-buffers) + ;;; Splash screen. (defvar gnus-group-buffer "*Group*") @@ -622,7 +652,7 @@ be set in `.emacs' instead." (defun gnus-splash () (save-excursion - (switch-to-buffer (get-buffer-create gnus-group-buffer)) + (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) (let ((buffer-read-only nil)) (erase-buffer) (unless gnus-inhibit-startup-message @@ -690,9 +720,10 @@ be set in `.emacs' instead." (eval-when (load) (let ((command (format "%s" this-command))) - (when (and (string-match "gnus" command) - (not (string-match "gnus-other-frame" command))) - (gnus-splash)))) + (if (and (string-match "gnus" command) + (not (string-match "gnus-other-frame" command))) + (gnus-splash) + (gnus-get-buffer-create gnus-group-buffer)))) ;;; Do the rest. @@ -747,7 +778,7 @@ used to 899, you would say something along these lines: :group 'gnus-files :group 'gnus-server :type 'file) - + ;; This function is used to check both the environment variable ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find ;; an nntp server name default. @@ -755,7 +786,7 @@ used to 899, you would say something along these lines: (or (getenv "NNTPSERVER") (and (file-readable-p gnus-nntpserver-file) (save-excursion - (set-buffer (get-buffer-create " *gnus nntp*")) + (set-buffer (gnus-get-buffer-create " *gnus nntp*")) (buffer-disable-undo (current-buffer)) (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) @@ -840,6 +871,7 @@ that case, just return a fully prefixed name of the group -- \"nnml+private:mail.misc\", for instance." :group 'gnus-message :type '(choice (const :tag "none" nil) + sexp string)) (defcustom gnus-secondary-servers nil @@ -1421,11 +1453,11 @@ want." (defvar gnus-predefined-server-alist `(("cache" - (nnspool "cache" - (nnspool-spool-directory gnus-cache-directory) - (nnspool-nov-directory gnus-cache-directory) - (nnspool-active-file - (nnheader-concat gnus-cache-directory "active"))))) + nnspool "cache" + (nnspool-spool-directory ,gnus-cache-directory) + (nnspool-nov-directory ,gnus-cache-directory) + (nnspool-active-file + ,(nnheader-concat gnus-cache-directory "active")))) "List of predefined (convenience) servers.") (defvar gnus-topic-indentation "") ;; Obsolete variable. @@ -1452,14 +1484,30 @@ 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.") + +(defcustom gnus-info-filename nil + "*Controls language of gnus Info. +If nil and current-language-environment is Japanese, go to gnus-ja. +Otherwise go to corresponding Info. +This variable can be nil, gnus or gnus-ja." + :group 'gnus-start + :type '(choice (const nil) + (const :tag "English" gnus) + (const :tag "Japanese" gnus-ja))) + (defvar gnus-info-nodes - '((gnus-group-mode "(gnus)The Group Buffer") - (gnus-summary-mode "(gnus)The Summary Buffer") - (gnus-article-mode "(gnus)The Article Buffer") - (mime/viewer-mode "(gnus)The Article Buffer") - (gnus-server-mode "(gnus)The Server Buffer") - (gnus-browse-mode "(gnus)Browse Foreign Server") - (gnus-tree-mode "(gnus)Tree Display")) + '((gnus-group-mode "The Group Buffer") + (gnus-summary-mode "The Summary Buffer") + (gnus-article-mode "The Article Buffer") + (mime/viewer-mode "The Article Buffer") + (gnus-server-mode "The Server Buffer") + (gnus-browse-mode "Browse Foreign Server") + (gnus-tree-mode "Tree Display")) "Alist of major modes and related Info nodes.") (defvar gnus-group-buffer "*Group*") @@ -1467,9 +1515,6 @@ want." (defvar gnus-article-buffer "*Article*") (defvar gnus-server-buffer "*Server*") -(defvar gnus-buffer-list nil - "Gnus buffers that should be killed on exit.") - (defvar gnus-slave nil "Whether this Gnus is a slave or not.") @@ -1557,7 +1602,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") timezone-make-sortable-date timezone-make-time-string) ("rmailout" rmail-output) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message) + rmail-show-message rmail-summary-exists + rmail-select-summary rmail-update-summary) ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t @@ -1624,8 +1670,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-uu-decode-binhex gnus-uu-decode-uu-view gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view - gnus-uu-decode-binhex-view) - ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh) + gnus-uu-decode-binhex-view gnus-uu-unmark-thread + gnus-uu-mark-over gnus-uu-post-news gnus-uu-post-news) + ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh + gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) ("gnus-msg" :interactive t @@ -1635,7 +1683,11 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-post-news gnus-summary-reply gnus-summary-reply-with-original gnus-summary-mail-forward gnus-summary-mail-other-window gnus-summary-resend-message gnus-summary-resend-bounced-mail - gnus-bug) + gnus-summary-wide-reply gnus-summary-followup-to-mail + gnus-summary-followup-to-mail-with-original gnus-bug + gnus-summary-wide-reply-with-original + gnus-summary-post-forward gnus-summary-wide-reply-with-original + gnus-summary-post-forward) ("gnus-picon" :interactive t gnus-article-display-picons gnus-group-display-picons gnus-picons-article-display-x-face gnus-picons-display-x-face) @@ -1679,7 +1731,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-start-date-timer gnus-stop-date-timer) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 - gnus-dribble-enter gnus-read-init-file) + gnus-dribble-enter gnus-read-init-file gnus-dribble-touch) ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article gnus-dup-enter-articles) ("gnus-range" gnus-copy-sequence) @@ -1691,6 +1743,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next gnus-async-prefetch-article gnus-async-prefetch-remove-group gnus-async-halt-prefetch) + ("pop3-fma" :interactive t + pop3-fma-set-pop3-password) ("gnus-agent" gnus-open-agent gnus-agent-get-function gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p gnus-agent-get-undownloaded-list gnus-agent-fetch-session @@ -1931,6 +1985,7 @@ This restriction may disappear in later versions of Gnus." ;;; Gnus Utility Functions ;;; + (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. STRINGS will be evaluated in normal `or' order." @@ -1945,43 +2000,27 @@ STRINGS will be evaluated in normal `or' order." (setq strings nil))) string)) -;; Add the current buffer to the list of buffers to be killed on exit. -(defun gnus-add-current-to-buffer-list () - (or (memq (current-buffer) gnus-buffer-list) - (push (current-buffer) gnus-buffer-list))) - (defun gnus-version (&optional arg) "Version number of this version of Gnus. If ARG, insert string at point." (interactive "P") - (let ((methods gnus-valid-select-methods) - (mess gnus-version) - meth) - ;; Go through all the legal select methods and add their version - ;; numbers to the total version string. Only the backends that are - ;; currently in use will have their message numbers taken into - ;; consideration. - (while methods - (setq meth (intern (concat (caar methods) "-version"))) - (and (boundp meth) - (stringp (symbol-value meth)) - (setq mess (concat mess "; " (symbol-value meth)))) - (setq methods (cdr methods))) - (if arg - (insert (message mess)) - (message mess)))) + (if arg + (insert (message gnus-version)) + (message gnus-version))) (defun gnus-continuum-version (version) "Return VERSION as a floating point number." (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) - (let* ((alpha (and (match-beginning 1) (match-string 1 version))) - (number (match-string 2 version)) - major minor least) - (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (setq major (string-to-number (match-string 1 number))) - (setq minor (string-to-number (match-string 2 number))) - (setq least (if (match-beginning 3) + (let ((alpha (and (match-beginning 1) (match-string 1 version))) + (number (match-string 2 version)) + major minor least) + (unless (string-match + "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) + (error "Invalid version string: %s" version)) + (setq major (string-to-number (match-string 1 number)) + minor (string-to-number (match-string 2 number)) + least (if (match-beginning 3) (string-to-number (match-string 3 number)) 0)) (string-to-number @@ -1990,7 +2029,11 @@ If ARG, insert string at point." (cond ((member alpha '("(ding)" "d")) "4.99") ((member alpha '("September" "s")) "5.01") - ((member alpha '("Red" "r")) "5.03")) + ((member alpha '("Red" "r")) "5.03") + ((member alpha '("Quassia" "q")) "5.05") + ((member alpha '("p")) "5.07") + ((member alpha '("o")) "5.09") + ((member alpha '("n")) "5.11")) minor least) (format "%d.%02d%02d" major minor least)))))) @@ -1999,7 +2042,11 @@ If ARG, insert string at point." (interactive) ;; Enlarge info window if needed. (let (gnus-info-buffer) - (Info-goto-node (cadr (assq major-mode gnus-info-nodes))) + (Info-goto-node (format "(%s)%s" + (or gnus-info-filename + (get-language-info current-language-environment 'gnus-info) + "gnus") + (cadr (assq major-mode gnus-info-nodes)))) (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) @@ -2033,7 +2080,7 @@ g -- Group name." (setq prompt (match-string 1 string))) (setq i (match-end 0)) ;; We basically emulate just about everything that - ;; `interactive' does, but adds the "g" and "G" specs. + ;; `interactive' does, but add the specs listed above. (push (cond ((= c ?a) @@ -2174,7 +2221,14 @@ that that variable is buffer-local to the summary buffers." "Return non-nil if GROUP (and ARTICLE) come from a news server." (or (gnus-member-of-valid 'post group) ; Ordinary news group. (and (gnus-member-of-valid 'post-mail group) ; Combined group. - (eq (gnus-request-type group article) 'news)))) + (if (or (null article) + (not (< article 0))) + (eq (gnus-request-type group article) 'news) + (if (not (vectorp article)) + nil + ;; It's a real article. + (eq (gnus-request-type group (mail-header-id article)) + 'news)))))) ;; Returns a list of writable groups. (defun gnus-writable-groups () @@ -2243,9 +2297,11 @@ that that variable is buffer-local to the summary buffers." (gnus-server-to-method method)) ((equal method gnus-select-method) gnus-select-method) - ((and (stringp (car method)) group) + ((and (stringp (car method)) + group) (gnus-server-extend-method group method)) - ((and method (not group) + ((and method + (not group) (equal (cadr method) "")) method) (t @@ -2677,11 +2733,14 @@ Disallow illegal group names." (defun gnus-read-method (prompt) "Prompt the user for a method. Allow completion over sensible values." - (let ((method - (completing-read - prompt (append gnus-valid-select-methods gnus-predefined-server-alist - gnus-server-alist) - nil t nil 'gnus-method-history))) + (let* ((servers + (append gnus-valid-select-methods + gnus-predefined-server-alist + gnus-server-alist)) + (method + (completing-read + prompt servers + nil t nil 'gnus-method-history))) (cond ((equal method "") (setq method gnus-select-method)) @@ -2691,7 +2750,7 @@ Allow completion over sensible values." (assoc method gnus-valid-select-methods)) (read-string "Address: ") ""))) - ((assoc method gnus-server-alist) + ((assoc method servers) method) (t (list (intern method) ""))))) diff --git a/lisp/mailheader.el b/lisp/mailheader.el index 6eb5669..5e2b097 100644 --- a/lisp/mailheader.el +++ b/lisp/mailheader.el @@ -60,7 +60,7 @@ that name." start end) (while (and (setq start (point)) (> (skip-chars-forward "^\0- :") 0) - (eq (char-after) ?:) + (= (following-char) ?:) (setq end (point)) (progn (forward-char) (> (skip-chars-forward " \t") 0))) diff --git a/lisp/message.el b/lisp/message.el index f761af0..10c0a4d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -3,6 +3,8 @@ ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko +;; Shuhei KOBAYASHI +;; Keiichi Suzuki ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -103,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 @@ -132,6 +138,11 @@ mailbox format." :group 'message-sending :type 'function) +(defcustom message-8bit-encoding-list '(8bit binary) + "*8bit encoding type in Content-Transfer-Encoding field." + :group 'message-sending + :type '(repeat (symbol :tag "Type"))) + (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. @@ -146,6 +157,11 @@ If this variable is nil, no such courtesy message will be added." :group 'message-interface :type 'regexp) +(defcustom message-bounce-setup-function 'message-bounce-setup-for-mime-edit + "Function to setup a re-sending bounced message." + :group 'message-sending + :type 'function) + ;;;###autoload (defcustom message-from-style 'default "*Specifies how \"From\" headers look. @@ -182,11 +198,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 @@ -194,10 +210,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)) @@ -220,7 +236,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:" +(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:" "*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." @@ -265,6 +281,15 @@ should return the new buffer name." :group 'message-buffers :type 'boolean) +(defcustom message-kill-buffer-query-function 'yes-or-no-p + "*A function called to query the user whether to kill buffer anyway or not. +If it is t, the buffer will be killed peremptorily." + :type '(radio (function-item yes-or-no-p) + (function-item y-or-n-p) + (function-item nnheader-Y-or-n-p) + (function :tag "Other" t)) + :group 'message-buffers) + (defvar gnus-local-organization) (defcustom message-user-organization (or (and (boundp 'gnus-local-organization) @@ -291,7 +316,7 @@ If t, use `message-user-organization-file'." :type 'string) (defcustom message-forward-end-separator - "" + (concat (mime-make-tag "text" "plain") "\n") "*Delimiter inserted after forwarded messages." :group 'message-forwarding :type 'string) @@ -302,11 +327,32 @@ 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-Transfer-Encoding:\\|^Content-Type:\\|^MIME-Version:" "*Regexp matching headers to be included in forwarded messages." :group 'message-forwarding :type 'regexp) +(defcustom message-make-forward-subject-function + 'message-forward-subject-author-subject + "*A list of functions that are called to generate a subject header for forwarded messages. +The subject generated by the previous function is passed into each +successive function. + +The provided functions are: + +* message-forward-subject-author-subject (Source of article (author or + newsgroup)), in brackets followed by the subject +* message-forward-subject-fwd (Subject of article with 'Fwd:' prepended + to it." + :group 'message-forwarding + :type '(radio (function-item message-forward-subject-author-subject) + (function-item message-forward-subject-fwd))) + +(defcustom message-wash-forwarded-subjects nil + "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward." + :group 'message-forwarding + :type 'boolean) + (defcustom message-ignored-resent-headers "^Return-receipt" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface @@ -408,6 +454,7 @@ might set this variable to '(\"-f\" \"you@some.where\")." (defvar gnus-select-method) (defcustom message-post-method (cond ((and (boundp 'gnus-post-method) + (listp gnus-post-method) gnus-post-method) gnus-post-method) ((boundp 'gnus-select-method) @@ -441,6 +488,12 @@ the signature is inserted." :group 'message-various :type 'hook) +(defcustom message-bounce-setup-hook nil + "Normal hook, run each time a a re-sending bounced message is initialized. +The function `message-bounce' runs this hook." + :group 'message-various + :type 'hook) + (defcustom message-mode-hook nil "Hook run in message mode buffers." :group 'message-various @@ -476,16 +529,12 @@ Used by `message-yank-original' via `message-yank-cite'." :type 'integer) ;;;###autoload -(defcustom message-cite-function - (if (and (boundp 'mail-citation-hook) - mail-citation-hook) - mail-citation-hook - 'message-cite-original) +(defcustom message-cite-function 'message-cite-original "*Function for citing an original message. -Pre-defined functions include `message-cite-original' and -`message-cite-original-without-signature'." +Predefined functions include `message-cite-original' and +`message-cite-original-without-signature'. +Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." :type '(radio (function-item message-cite-original) - (function-item message-cite-original-without-signature) (function-item sc-cite-original) (function :tag "Other")) :group 'message-insertion) @@ -553,6 +602,9 @@ 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) +(defvar message-parameter-alist nil) +(defvar message-startup-parameter-alist nil) (define-widget 'message-header-lines 'text "All header lines must be LFD terminated." @@ -607,6 +659,10 @@ actually occur." :group 'message-sending :type 'sexp) +;;; XXX: This symbol is overloaded! See below. +(defvar message-user-agent nil + "String of the form of PRODUCT/VERSION. Used for User-Agent header field.") + ;; Ignore errors in case this is used in Emacs 19. ;; Don't use ignore-errors because this is copied into loaddefs.el. ;;;###autoload @@ -638,10 +694,10 @@ the prefix.") The default is `abbrev', which uses mailabbrev. nil switches mail aliases off.") -(defcustom message-autosave-directory +(defcustom message-auto-save-directory (nnheader-concat message-directory "drafts/") - "*Directory where Message autosaves buffers if Gnus isn't running. -If nil, Message won't autosave." + "*Directory where Message auto-saves buffers if Gnus isn't running. +If nil, Message won't auto-save." :group 'message-buffers :type 'directory) @@ -837,6 +893,21 @@ 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.") + ;;; Internal variables. (defvar message-buffer-list nil) @@ -927,9 +998,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 @@ -945,6 +1015,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")) @@ -953,6 +1024,22 @@ The cdr of ech entry is a function for applying the face to a region.") ;;; ;;; Utility functions. ;;; +(defun message-eval-parameter (parameter) + (condition-case () + (if (symbolp parameter) + (if (functionp parameter) + (funcall parameter) + (eval parameter)) + parameter) + (error nil))) + +(defsubst message-get-parameter (key &optional alist) + (unless alist + (setq alist message-parameter-alist)) + (cdr (assq key alist))) + +(defmacro message-get-parameter-with-eval (key &optional alist) + `(message-eval-parameter (message-get-parameter ,alist ,key))) (defmacro message-y-or-n-p (question show &rest text) "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW" @@ -1029,11 +1116,12 @@ The cdr of ech entry is a function for applying the face to a region.") (defun message-fetch-reply-field (header) "Fetch FIELD from the message we're replying to." - (when (and message-reply-buffer - (buffer-name message-reply-buffer)) - (save-excursion - (set-buffer message-reply-buffer) - (message-fetch-field header)))) + (let ((buffer (message-eval-parameter message-reply-buffer))) + (when (and buffer + (buffer-name buffer)) + (save-excursion + (set-buffer buffer) + (message-fetch-field header))))) (defun message-set-work-buffer () (if (get-buffer " *message work*") @@ -1173,7 +1261,6 @@ Return the number of headers removed." (- max rank) (1+ max))))) (message-sort-headers-1)))) - ;;; @@ -1222,7 +1309,10 @@ Return the number of headers removed." (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) - (define-key message-mode-map "\t" 'message-tab)) + (define-key message-mode-map "\t" 'message-tab) + + (define-key message-mode-map "\C-x\C-s" 'message-save-drafts) + (define-key message-mode-map "\C-xk" 'message-kill-buffer)) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -1329,13 +1419,15 @@ 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) (make-local-variable 'message-checksum) (setq message-checksum nil) + (make-local-variable 'message-parameter-alist) + (setq message-parameter-alist + (copy-sequence message-startup-parameter-alist)) ;;(when (fboundp 'mail-hist-define-keys) ;; (mail-hist-define-keys)) (when (string-match "XEmacs\\|Lucid" emacs-version) @@ -1432,13 +1524,22 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n") nil t)) +(defun message-goto-eoh () + "Move point to the end of the headers." + (interactive) + (message-goto-body) + (forward-line -2)) + (defun message-goto-signature () - "Move point to the beginning of the message signature." + "Move point to the beginning of the message signature. +If there is no signature in the article, go to the end and +return nil." (interactive) (goto-char (point-min)) (if (re-search-forward message-signature-separator nil t) (forward-line 1) - (goto-char (point-max)))) + (goto-char (point-max)) + nil)) @@ -1478,16 +1579,17 @@ With the prefix argument FORCE, insert the header anyway." (interactive "r") (save-excursion (goto-char end) - (delete-region (point) (progn (message-goto-signature) - (forward-line -2) - (point))) + (delete-region (point) (if (not (message-goto-signature)) + (point) + (forward-line -2) + (point))) (insert "\n") (goto-char beg) (delete-region beg (progn (message-goto-body) (forward-line 2) (point)))) - (message-goto-signature) - (forward-line -2)) + (when (message-goto-signature) + (forward-line -2))) (defun message-kill-to-signature () "Deletes all text up to the signature." @@ -1711,6 +1813,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. @@ -1722,11 +1825,12 @@ This function uses `message-cite-function' to do the actual citing. Just \\[universal-argument] as argument means don't indent, insert no prefix, and don't delete any headers." (interactive "P") - (let ((modified (buffer-modified-p))) - (when (and message-reply-buffer + (let ((modified (buffer-modified-p)) + (buffer (message-eval-parameter message-reply-buffer))) + (when (and buffer message-cite-function) - (delete-windows-on message-reply-buffer t) - (insert-buffer message-reply-buffer) + (delete-windows-on buffer t) + (insert-buffer buffer) (funcall message-cite-function) (message-exchange-point-and-mark) (unless (bolp) @@ -1745,6 +1849,11 @@ prefix, and don't delete any headers." (list message-indent-citation-function))))) (goto-char end) (when (re-search-backward "^-- $" start t) + ;; Also peel off any blank lines before the signature. + (forward-line -1) + (while (looking-at "^[ \t]*$") + (forward-line -1)) + (forward-line 1) (delete-region (point) end)) (goto-char start) (while functions @@ -1754,21 +1863,25 @@ prefix, and don't delete any headers." (insert "\n")) (funcall message-citation-line-function)))) +(defvar mail-citation-hook) ;Compiler directive (defun message-cite-original () "Cite function in the standard Message manner." - (let ((start (point)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function))))) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function)))) + (if (and (boundp 'mail-citation-hook) + mail-citation-hook) + (run-hooks 'mail-citation-hook) + (let ((start (point)) + (functions + (when message-indent-citation-function + (if (listp message-indent-citation-function) + message-indent-citation-function + (list message-indent-citation-function))))) + (goto-char start) + (while functions + (funcall (pop functions))) + (when message-citation-line-function + (unless (bolp) + (insert "\n")) + (funcall message-citation-line-function))))) (defun message-insert-citation-line () "Function that inserts a simple citation line." @@ -1831,11 +1944,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 @@ -1843,26 +1963,70 @@ The text will also be indented the normal way." (bury-buffer buf) (when (eq buf (current-buffer)) (message-bury buf))) - (message-do-actions actions)))) + (message-do-actions actions) + (message-delete-frame frame org-frame) + t))) (defun message-dont-send () "Don't send the message you have been editing." (interactive) (set-buffer-modified-p t) (save-buffer) - (let ((actions message-postpone-actions)) + (let ((actions message-postpone-actions) + (frame (selected-frame)) + (org-frame message-original-frame)) (message-bury (current-buffer)) - (message-do-actions actions))) + (message-do-actions actions) + (message-delete-frame frame org-frame))) (defun message-kill-buffer () "Kill the current buffer." (interactive) (when (or (not (buffer-modified-p)) - (yes-or-no-p "Message modified; kill anyway? ")) - (let ((actions message-kill-actions)) + (eq t message-kill-buffer-query-function) + (funcall message-kill-buffer-query-function + "The buffer modified; kill anyway? ")) + (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))) + (message "")) + +(defun message-mimic-kill-buffer () + "Kill the current buffer with query." + (interactive) + (unless (eq 'message-mode major-mode) + (error "%s must be invoked from a message buffer." this-command)) + (let ((command this-command) + (bufname (read-buffer (format "Kill buffer: (default %s) " + (buffer-name))))) + (if (or (not bufname) + (string-equal bufname "") + (string-equal bufname (buffer-name))) + (message-kill-buffer) + (message "%s must be invoked only for the current buffer." command)))) + +(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." @@ -1889,7 +2053,6 @@ 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 ((message-encoding-buffer @@ -1904,6 +2067,7 @@ the user from the mailer." (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))) @@ -1921,7 +2085,7 @@ the user from the mailer." ;; (mail-hist-put-headers-into-history)) (run-hooks 'message-sent-hook) (message "Sending...done") - ;; Mark the buffer as unmodified and delete autosave. + ;; Mark the buffer as unmodified and delete auto-save. (set-buffer-modified-p nil) (delete-auto-save-file-if-necessary t) (message-disassociate-draft) @@ -1944,7 +2108,13 @@ the user from the mailer." ;; Make sure there's a newline at the end of the message. (goto-char (point-max)) (unless (bolp) - (insert "\n"))) + (insert "\n")) + ;; Make all invisible text visible. + ;;(when (text-property-any (point-min) (point-max) 'invisible t) + ;; (put-text-property (point-min) (point-max) 'invisible nil) + ;; (unless (yes-or-no-p "Invisible text found and made visible; continue posting?") + ;; (error "Invisible text found and made visible"))) + ) (defun message-add-action (action &rest types) "Add ACTION to be performed when doing an exit of type TYPES." @@ -1980,34 +2150,38 @@ the user from the mailer." (message-generate-headers message-required-mail-headers)) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (erase-buffer) - (insert-buffer message-encoding-buffer) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) + (if (not (message-check-mail-syntax)) + (progn + (message "") + ;;(message "Posting not performed") + nil) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer message-encoding-buffer) ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (when (and news - (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 message-edit-buffer) - (push 'mail message-sent-message-via))) + (save-restriction + (message-narrow-to-headers) + (message-remove-header message-ignored-mail-headers t)) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (when (and news + (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 message-edit-buffer) + (push 'mail message-sent-message-via)))) (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." @@ -2037,7 +2211,7 @@ the user from the mailer." (set-buffer errbuf) (erase-buffer)))) (let ((default-directory "/") - (coding-system-for-write 'binary)) + (coding-system-for-write message-send-coding-system)) (apply 'call-process-region (append (list (point-min) (point-max) (if (boundp 'sendmail-program) @@ -2085,7 +2259,7 @@ to find out how to use this." (run-hooks 'message-send-mail-hook) ;; send the message (case - (let ((coding-system-for-write 'binary)) + (let ((coding-system-for-write message-send-coding-system)) (apply 'call-process-region 1 (point-max) message-qmail-inject-program nil nil nil @@ -2603,6 +2777,9 @@ to find out how to use this." (y-or-n-p "The article contains control characters. Really post? ") t)) + ;; Check 8bit characters. + (message-check '8bit + (message-check-8bit)) ;; Check excessive size. (message-check 'size (if (> (buffer-size) 60000) @@ -2630,6 +2807,54 @@ to find out how to use this." (1- (count-lines (point) (point-max))))) t))))) +(defun message-check-mail-syntax () + "Check the syntax of the message." + (save-excursion + (save-restriction + (widen) + (and + ;; We narrow to the headers and check them first. + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-check-mail-header-syntax))) + ;; Check the body. + (save-excursion + (set-buffer message-edit-buffer) + (message-check-mail-body-syntax)))))) + +(defun message-check-mail-header-syntax () + t) + +(defun message-check-mail-body-syntax () + (and + ;; Check 8bit characters. + (message-check '8bit + (message-check-8bit) + ))) + +(defun message-check-8bit () + "Check the article contains 8bit characters." + (save-excursion + (set-buffer message-encoding-buffer) + (message-narrow-to-headers) + (let* ((case-fold-search t) + (field-value (message-fetch-field "content-transfer-encoding"))) + (if (and field-value + (member (downcase field-value) message-8bit-encoding-list)) + t + (widen) + (set-buffer (get-buffer-create " message syntax")) + (erase-buffer) + (goto-char (point-min)) + (set-buffer-multibyte nil) + (insert-buffer message-encoding-buffer) + (goto-char (point-min)) + (if (re-search-forward "[^\x00-\x7f]" nil t) + (y-or-n-p + "The article contains 8bit characters. Really post? ") + t))))) + (defun message-checksum () "Return a \"checksum\" for the current buffer." (let ((sum 0)) @@ -2659,7 +2884,6 @@ to find out how to use this." (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) @@ -2827,17 +3051,21 @@ to find out how to use this." "Return the In-Reply-To header for this message." (when message-reply-headers (let ((from (mail-header-from message-reply-headers)) - (date (mail-header-date message-reply-headers))) - (when from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (concat (if (and stop-pos - (not (zerop stop-pos))) - (substring from 0 stop-pos) from) - "'s message of \"" - (if (or (not date) (string= date "")) - "(unknown date)" date) - "\"")))))) + (date (mail-header-date message-reply-headers)) + (msg-id (mail-header-message-id message-reply-headers))) + (when msg-id + (concat msg-id + (when from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (concat " (" + (if (and stop-pos + (not (zerop stop-pos))) + (substring from 0 stop-pos) from) + "'s message of \"" + (if (or (not date) (string= date "")) + "(unknown date)" date) + "\")")))))))) (defun message-make-distribution () "Make a Distribution header." @@ -2977,6 +3205,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." @@ -2993,9 +3239,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) @@ -3023,7 +3267,13 @@ Headers already prepared in the buffer are not modified." (setq header (car elem))) (setq header elem)) (when (or (not (re-search-forward - (concat "^" (downcase (symbol-name header)) ":") + (concat "^" + (regexp-quote + (downcase + (if (stringp header) + header + (symbol-name header)))) + ":") nil t)) (progn ;; The header was found. We insert a space after the @@ -3065,7 +3315,8 @@ Headers already prepared in the buffer are not modified." (progn ;; This header didn't exist, so we insert it. (goto-char (point-max)) - (insert (symbol-name header) ": " value "\n") + (insert (if (stringp header) header (symbol-name header)) + ": " value "\n") (forward-line -1)) ;; The value of this header was empty, so we clear ;; totally and insert the new value. @@ -3243,7 +3494,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 @@ -3252,9 +3520,12 @@ Headers already prepared in the buffer are not modified." (not (y-or-n-p "Message already being composed; erase? "))) (error "Message being composed"))) - (set-buffer (pop-to-buffer name)))) - (erase-buffer) - (message-mode)) + (set-buffer (pop-to-buffer name))) + (erase-buffer) + (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." @@ -3289,7 +3560,9 @@ Headers already prepared in the buffer are not modified." mc-modes-alist)) (when actions (setq message-send-actions actions)) - (setq message-reply-buffer replybuffer) + (setq message-reply-buffer + (or (message-get-parameter 'reply-buffer) + replybuffer)) (goto-char (point-min)) ;; Insert all the headers. (mail-header-format @@ -3343,12 +3616,12 @@ Headers already prepared in the buffer are not modified." (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." - (when message-autosave-directory + (when message-auto-save-directory (if (gnus-alive-p) (setq message-draft-article (nndraft-request-associate-buffer "drafts")) (setq buffer-file-name (expand-file-name "*message*" - message-autosave-directory)) + message-auto-save-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) (clear-visited-file-modtime))) @@ -3368,7 +3641,8 @@ Headers already prepared in the buffer are not modified." (defun message-mail (&optional to subject other-headers continue switch-function yank-action send-actions) - "Start editing a mail message to be sent." + "Start editing a mail message to be sent. +OTHER-HEADERS is an alist of header/value pairs." (interactive) (let ((message-this-is-mail t)) (message-pop-to-buffer (message-buffer-name "mail" to)) @@ -3665,13 +3939,18 @@ responses here are directed to other newsgroups.")) This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) - (let ((cur (current-buffer))) + (let ((cur (current-buffer)) + (sender (message-fetch-field "sender")) + (from (message-fetch-field "from"))) ;; Check whether the user owns the article that is to be superseded. - (unless (string-equal - (downcase (or (message-fetch-field "sender") - (cadr (mail-extract-address-components - (message-fetch-field "from"))))) - (downcase (message-make-sender))) + (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")) ;; Get a normal message buffer. (message-pop-to-buffer (message-buffer-name "supersede")) @@ -3707,19 +3986,81 @@ header line with the old Message-ID." (insert-file-contents file-name nil))) (t (error "message-recover cancelled"))))) +;;; Washing Subject: + +(defun message-wash-subject (subject) + "Remove junk like \"Re:\", \"(fwd)\", etc. that was added to the subject by previous forwarders, replyers, etc." + (nnheader-temp-write nil + (insert-string subject) + (goto-char (point-min)) + ;; strip Re/Fwd stuff off the beginning + (while (re-search-forward + "\\([Rr][Ee]:\\|[Ff][Ww][Dd]\\(\\[[0-9]*\\]\\)?:\\|[Ff][Ww]:\\)" nil t) + (replace-match "")) + + ;; and gnus-style forwards [foo@bar.com] subject + (goto-char (point-min)) + (while (re-search-forward "\\[[^ \t]*\\(@\\|\\.\\)[^ \t]*\\]" nil t) + (replace-match "")) + + ;; and off the end + (goto-char (point-max)) + (while (re-search-backward "([Ff][Ww][Dd])" nil t) + (replace-match "")) + + ;; and finally, any whitespace that was left-over + (goto-char (point-min)) + (while (re-search-forward "^[ \t]+" nil t) + (replace-match "")) + (goto-char (point-max)) + (while (re-search-backward "[ \t]+$" nil t) + (replace-match "")) + + (buffer-string))) + ;;; Forwarding messages. +(defun message-forward-subject-author-subject (subject) + "Generate a subject for a forwarded message. +The form is: [Source] Subject, where if the original message was mail, +Source is the sender, and if the original message was news, Source is +the list of newsgroups is was posted to." + (concat "[" + (or (message-fetch-field + (if (message-news-p) "newsgroups" "from")) + "(nowhere)") + "] " subject)) + +(defun message-forward-subject-fwd (subject) + "Generate a subject for a forwarded message. +The form is: Fwd: Subject, where Subject is the original subject of +the message." + (concat "Fwd: " subject)) + (defun message-make-forward-subject () "Return a Subject header suitable for the message in the current buffer." (save-excursion (save-restriction (current-buffer) (message-narrow-to-head) - (concat "[" (or (message-fetch-field - (if (message-news-p) "newsgroups" "from")) - "(nowhere)") - "] " (or (eword-decode-unstructured-field-body - (message-fetch-field "Subject") "")))))) + (let ((funcs message-make-forward-subject-function) + (subject (if message-wash-forwarded-subjects + (message-wash-subject + (or (eword-decode-unstructured-field-body + (message-fetch-field "Subject")) "")) + (or (eword-decode-unstructured-field-body + (message-fetch-field "Subject")) "")))) + ;; Make sure funcs is a list. + (and funcs + (not (listp funcs)) + (setq funcs (list funcs))) + ;; Apply funcs in order, passing subject generated by previous + ;; func to the next one. + (while funcs + (when (message-functionp (car funcs)) + (setq subject (funcall (car funcs) subject))) + (setq funcs (cdr funcs))) + subject)))) ;;;###autoload (defun message-forward (&optional news) @@ -3809,6 +4150,13 @@ Optional NEWS will use news to forward instead of mail." (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) +(defun message-bounce-setup-for-mime-edit () + (goto-char (point-min)) + (when (search-forward (concat "\n" mail-header-separator "\n") nil t) + (replace-match "\n\n")) + (set (make-local-variable 'message-setup-hook) nil) + (mime-edit-again)) + ;;;###autoload (defun message-bounce () "Re-mail the current message. @@ -3822,7 +4170,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" @@ -3848,6 +4196,9 @@ you." (message-remove-header message-ignored-bounced-headers t) (goto-char (point-max)) (insert mail-header-separator)) + (when message-bounce-setup-function + (funcall message-bounce-setup-function)) + (run-hooks 'message-bounce-setup-hook) (message-position-point))) ;;; @@ -3980,7 +4331,6 @@ Do a `tab-to-tab-stop' if not in those headers." (point)))) (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) (completions (all-completions string hashtb)) - (cur (current-buffer)) comp) (delete-region b (point)) (cond @@ -4050,7 +4400,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) @@ -4061,7 +4411,6 @@ regexp varstr." (cdr local))))) locals))) - ;;; @ for MIME Edit mode ;;; @@ -4094,8 +4443,9 @@ regexp varstr." (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-reply-buffer + (message-get-parameter-with-eval 'original-buffer)) + (start (point))) (message-yank-original nil) )) @@ -4117,6 +4467,21 @@ regexp varstr." (setq idx (1+ idx))) string)) +(defvar message-save-buffer " *encoding") +(defun message-save-drafts () + (interactive) + (if (not (get-buffer message-save-buffer)) + (get-buffer-create message-save-buffer)) + (let ((filename buffer-file-name) + (buffer (current-buffer))) + (set-buffer message-save-buffer) + (erase-buffer) + (insert-buffer buffer) + (mime-edit-translate-buffer) + (write-region (point-min) (point-max) filename) + (set-buffer buffer) + (set-buffer-modified-p nil))) + (run-hooks 'message-load-hook) (provide 'message) diff --git a/lisp/messcompat.el b/lisp/messcompat.el index 337ab6f..153f76d 100644 --- a/lisp/messcompat.el +++ b/lisp/messcompat.el @@ -82,6 +82,11 @@ these lines.") (defvar message-send-hook mail-send-hook "Hook run before sending messages.") +(defvar message-send-mail-function send-mail-function + "Function to call to send the current buffer as mail. +The headers should be delimited by a line whose contents match the +variable `mail-header-separator'.") + (provide 'messcompat) ;;; messcompat.el ends here diff --git a/lisp/nnagent.el b/lisp/nnagent.el index b42ddf9..1989225 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -73,7 +73,8 @@ (ftp-error (setq err (format "%s" arg))))) (nnagent-close-server) (nnheader-report - 'nnagent (or err "No such file or directory: %s" dir))) + 'nnagent (or err + (format "No such file or directory: %s" dir)))) ((not (file-directory-p (file-truename dir))) (nnagent-close-server) (nnheader-report 'nnagent "Not a directory: %s" dir)) @@ -94,12 +95,13 @@ (t nil)))) (defun nnagent-request-type (group article) - (let ((gnus-plugged t)) - (if (not (gnus-check-backend-function - 'request-type (car gnus-command-method))) - 'unknown - (funcall (gnus-get-function gnus-command-method 'request-type) - (gnus-group-real-name group) article)))) + (unless (stringp article) + (let ((gnus-plugged t)) + (if (not (gnus-check-backend-function + 'request-type (car gnus-command-method))) + 'unknown + (funcall (gnus-get-function gnus-command-method 'request-type) + (gnus-group-real-name group) article))))) (deffoo nnagent-request-newgroups (date server) nil) diff --git a/lisp/nndir.el b/lisp/nndir.el index d9e5c56..a3b5eae 100644 --- a/lisp/nndir.el +++ b/lisp/nndir.el @@ -88,11 +88,11 @@ (nnoo-map-functions nndir (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0) + (nnml-request-article 0 nndir-current-group 0 0) (nnmh-request-group nndir-current-group 0 0) (nnml-close-group nndir-current-group 0) - (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory) - (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) + (nnml-request-list (nnoo-current-server 'nndir) nndir-directory) + (nnml-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) (provide 'nndir) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index c32f50f..0da245a 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -38,7 +38,7 @@ (defvoo nndoc-article-type 'guess "*Type of the file. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', -`rfc934', `rfc822-forward', `mime-digest', `standard-digest', +`rfc934', `rfc822-forward', `mime-digest', `mime-parts', `standard-digest', `slack-digest', `clari-briefs' or `guess'.") (defvoo nndoc-post-type 'mail @@ -87,6 +87,9 @@ from the document.") (body-end . "") (file-end . "") (subtype digest guess)) + (mime-parts + (generate-head-function . nndoc-generate-mime-parts-head) + (article-transform-function . nndoc-transform-mime-parts)) (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+")) (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+")) @@ -128,10 +131,8 @@ from the document.") (subtype nil)))) - (defvoo nndoc-file-begin nil) (defvoo nndoc-first-article nil) -(defvoo nndoc-article-end nil) (defvoo nndoc-article-begin nil) (defvoo nndoc-head-begin nil) (defvoo nndoc-head-end nil) @@ -141,6 +142,11 @@ from the document.") (defvoo nndoc-body-begin-function nil) (defvoo nndoc-head-begin-function nil) (defvoo nndoc-body-end nil) +;; nndoc-dissection-alist is a list of sublists. Each sublist holds the +;; following items. ARTICLE is an ordinal starting at 1. HEAD-BEGIN, +;; HEAD-END, BODY-BEGIN and BODY-END are positions in the `nndoc' buffer. +;; LINE-COUNT is a count of lines in the body. SUBJECT, MESSAGE-ID and +;; REFERENCES, only present for MIME dissections, are field values. (defvoo nndoc-dissection-alist nil) (defvoo nndoc-prepare-body-function nil) (defvoo nndoc-generate-head-function nil) @@ -152,6 +158,8 @@ from the document.") (defvoo nndoc-current-buffer nil "Current nndoc news buffer.") (defvoo nndoc-address nil) +(defvoo nndoc-mime-header nil) +(defvoo nndoc-mime-subject nil) (defconst nndoc-version "nndoc 1.0" "nndoc version.") @@ -293,7 +301,9 @@ from the document.") (save-excursion (set-buffer nndoc-current-buffer) (nndoc-set-delims) - (nndoc-dissect-buffer))) + (if (eq nndoc-article-type 'mime-parts) + (nndoc-dissect-mime-parts) + (nndoc-dissect-buffer)))) (unless nndoc-current-buffer (nndoc-close-server)) ;; Return whether we managed to select a file. @@ -307,7 +317,8 @@ from the document.") "Set the nndoc delimiter variables according to the type of the document." (let ((vars '(nndoc-file-begin nndoc-first-article - nndoc-article-end nndoc-head-begin nndoc-head-end + nndoc-article-begin-function + nndoc-head-begin nndoc-head-end nndoc-file-end nndoc-article-begin nndoc-body-begin nndoc-body-end-function nndoc-body-end nndoc-prepare-body-function nndoc-article-transform-function @@ -436,6 +447,44 @@ from the document.") (defun nndoc-rfc822-forward-body-end-function () (goto-char (point-max))) +(defun nndoc-mime-parts-type-p () + (let ((case-fold-search t) + (limit (search-forward "\n\n" nil t))) + (goto-char (point-min)) + (when (and limit + (re-search-forward + (concat "\ +^Content-Type:[ \t]*multipart/[a-z]+;\\(.*;\\)*" + "[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]") + limit t)) + t))) + +(defun nndoc-transform-mime-parts (article) + (unless (= article 1) + ;; Ensure some MIME-Version. + (goto-char (point-min)) + (search-forward "\n\n") + (let ((case-fold-search nil) + (limit (point))) + (goto-char (point-min)) + (or (save-excursion (re-search-forward "^MIME-Version:" limit t)) + (insert "Mime-Version: 1.0\n"))) + ;; Generate default header before entity fields. + (goto-char (point-min)) + (nndoc-generate-mime-parts-head article t))) + +(defun nndoc-generate-mime-parts-head (article &optional body-present) + (let ((entry (cdr (assq (if body-present 1 article) nndoc-dissection-alist)))) + (let ((subject (if body-present + nndoc-mime-subject + (concat "<" (nth 5 entry) ">"))) + (message-id (nth 6 entry)) + (references (nth 7 entry))) + (insert nndoc-mime-header) + (and subject (insert "Subject: " subject "\n")) + (and message-id (insert "Message-ID: " message-id "\n")) + (and references (insert "References: " references "\n"))))) + (defun nndoc-clari-briefs-type-p () (when (let ((case-fold-search nil)) (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) @@ -473,7 +522,7 @@ from the document.") (when (and (re-search-forward (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" - "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") + "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)") nil t) (match-beginning 1)) (setq boundary-id (match-string 1) @@ -572,7 +621,7 @@ from the document.") (funcall nndoc-head-begin-function)) (nndoc-head-begin (nndoc-search nndoc-head-begin))) - (if (or (>= (point) (point-max)) + (if (or (eobp) (and nndoc-file-end (looking-at nndoc-file-end))) (goto-char (point-max)) @@ -609,6 +658,104 @@ from the document.") (while (re-search-forward "^- -"nil t) (replace-match "-" t t))) +;; Against compiler warnings. +(defvar nndoc-mime-split-ordinal) + +(defun nndoc-dissect-mime-parts () + "Go through a MIME composite article and partition it into sub-articles. +When a MIME entity contains sub-entities, dissection produces one article for +the header of this entity, and one article per sub-entity." + (setq nndoc-dissection-alist nil + nndoc-mime-split-ordinal 0) + (save-excursion + (set-buffer nndoc-current-buffer) + (message-narrow-to-head) + (let ((case-fold-search t) + (message-id (message-fetch-field "Message-ID")) + (references (message-fetch-field "References"))) + (setq nndoc-mime-header (buffer-substring (point-min) (point-max)) + nndoc-mime-subject (message-fetch-field "Subject")) + (while (string-match "\ +^\\(Subject\\|Message-ID\\|References\\|Lines\\|\ +MIME-Version\\|Content-Type\\|Content-Transfer-Encoding\\|\ +\\):.*\n\\([ \t].*\n\\)*" + nndoc-mime-header) + (setq nndoc-mime-header (replace-match "" t t nndoc-mime-header))) + (widen) + (nndoc-dissect-mime-parts-sub (point-min) (point-max) + nil message-id references)))) + +(defun nndoc-dissect-mime-parts-sub (begin end position message-id references) + "Dissect an entity within a composite MIME message. +The article, which corresponds to a MIME entity, extends from BEGIN to END. +The string POSITION holds a dotted decimal representation of the article +position in the hierarchical structure, it is nil for the outer entity. +The generated article should use MESSAGE-ID and REFERENCES field values." + ;; Note: `case-fold-search' is already `t' from the calling function. + (let ((head-begin begin) + (body-end end) + head-end body-begin type subtype composite comment) + (save-excursion + ;; Gracefully handle a missing body. + (goto-char head-begin) + (if (search-forward "\n\n" body-end t) + (setq head-end (1- (point)) + body-begin (point)) + (setq head-end end + body-begin end)) + ;; Save MIME attributes. + (goto-char head-begin) + (if (re-search-forward "\ +^Content-Type: *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" + head-end t) + (setq type (downcase (match-string 1)) + subtype (downcase (match-string 2))) + (setq type "text" + subtype "plain")) + (setq composite (string= type "multipart") + comment (concat position + (when (and position composite) ".") + (when composite "*") + (when (or position composite) " ") + (cond ((string= subtype "plain") type) + ((string= subtype "basic") type) + (t subtype)))) + ;; Generate dissection information for this entity. + (push (list (incf nndoc-mime-split-ordinal) + head-begin head-end body-begin body-end + (count-lines body-begin body-end) + comment message-id references) + nndoc-dissection-alist) + ;; Recurse for all sub-entities, if any. + (goto-char head-begin) + (when (re-search-forward + (concat "\ +^Content-Type: *multipart/\\([a-z]+\\);\\(.*;\\)*" + "[ \t\n]*[ \t]boundary=\"?\\([^\"\n]*[^\" \t\n]\\)") + head-end t) + (let ((boundary (concat "\n--" (match-string 3) "\\(--\\)?[ \t]*\n")) + (part-counter 0) + begin end eof-flag) + (goto-char head-end) + (setq eof-flag (not (re-search-forward boundary body-end t))) + (while (not eof-flag) + (setq begin (point)) + (cond ((re-search-forward boundary body-end t) + (or (not (match-string 1)) + (string= (match-string 1) "") + (setq eof-flag t)) + (forward-line -1) + (setq end (point)) + (forward-line 1)) + (t (setq end body-end + eof-flag t))) + (nndoc-dissect-mime-parts-sub begin end + (concat position (when position ".") + (format "%d" + (incf part-counter))) + (nnmail-message-id) + message-id))))))) + ;;;###autoload (defun nndoc-add-type (definition &optional position) "Add document DEFINITION to the list of nndoc document definitions. diff --git a/lisp/nndraft.el b/lisp/nndraft.el index f7182a5..c6f23c4 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -130,8 +130,6 @@ (when (nndraft-request-article article group server (current-buffer)) (message-remove-header "xref") (message-remove-header "lines") - (let ((gnus-verbose-backends nil)) - (nndraft-request-expire-articles (list article) group server t)) t)) (deffoo nndraft-request-update-info (group info &optional server) diff --git a/lisp/nneething.el b/lisp/nneething.el index 97f5d2f..7da5466 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -64,7 +64,7 @@ If this variable is nil, no files will be excluded.") (defvoo nneething-map nil) (defvoo nneething-read-only nil) (defvoo nneething-active nil) -(defvoo nneething-directory nil) +(defvoo nneething-address nil) @@ -158,8 +158,8 @@ If this variable is nil, no files will be excluded.") (nnheader-init-server-buffer) (if (nneething-server-opened server) t - (unless (assq 'nneething-directory defs) - (setq defs (append defs (list (list 'nneething-directory server))))) + (unless (assq 'nneething-address defs) + (setq defs (append defs (list (list 'nneething-address server))))) (nnoo-change-server 'nneething server defs))) @@ -185,9 +185,9 @@ If this variable is nil, no files will be excluded.") (defun nneething-create-mapping () ;; Read nneething-active and nneething-map. - (when (file-exists-p nneething-directory) + (when (file-exists-p nneething-address) (let ((map-file (nneething-map-file)) - (files (directory-files nneething-directory)) + (files (directory-files nneething-address)) touched map-files) (when (file-exists-p map-file) (ignore-errors @@ -344,7 +344,7 @@ If this variable is nil, no files will be excluded.") (defun nneething-file-name (article) "Return the file name of ARTICLE." - (concat (file-name-as-directory nneething-directory) + (concat (file-name-as-directory nneething-address) (if (numberp article) (cadr (assq article nneething-map)) article))) diff --git a/lisp/nngateway.el b/lisp/nngateway.el index 2139885..c580ac5 100644 --- a/lisp/nngateway.el +++ b/lisp/nngateway.el @@ -25,6 +25,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'nnoo) (require 'message) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index e0de0a4..f0835cd 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -400,7 +400,6 @@ the line could be found." (unless (gnus-buffer-live-p nntp-server-buffer) (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) (set-buffer nntp-server-buffer) - (buffer-disable-undo (current-buffer)) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. @@ -857,6 +856,23 @@ find-file-hooks, etc. (fset 'nnheader-cancel-timer 'cancel-timer) (fset 'nnheader-cancel-function-timers 'cancel-function-timers) +(defun nnheader-Y-or-n-p (prompt) + "Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"." + (let ((cursor-in-echo-area t) + (echo-keystrokes 0) + (inhibit-quit t) + ans) + (let (message-log-max) + (while (not (memq ans '(?\ ?N ?Y ?\C-g ?\e ?\n ?\r ?n ?y))) + (message "%s(Y/n) " prompt) + (setq ans (read-char-exclusive)))) + (if (memq ans '(?\C-g ?N ?n)) + (progn + (message "%s(Y/n) No" prompt) + nil) + (message "%s(Y/n) Yes" prompt) + t))) + (when (string-match "XEmacs\\|Lucid" emacs-version) (require 'nnheaderxm)) diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index f788042..7c1435c 100644 --- a/lisp/nnheaderxm.el +++ b/lisp/nnheaderxm.el @@ -32,9 +32,30 @@ (,function ,@args)) time repeat)) +(defun nnheader-xmas-Y-or-n-p (prompt) + "Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"." + (if (should-use-dialog-box-p) + (yes-or-no-p-dialog-box prompt) + (let ((cursor-in-echo-area t) + (echo-keystrokes 0) + (inhibit-quit t) + event) + (message "%s(Y/n) " prompt) + (while (or (not (key-press-event-p (setq event (next-command-event)))) + (not (or (eq (event-key event) 'escape) + (memq (event-to-character event) + '(?\ ?N ?Y ?\C-g ?\e ?\n ?\r ?n ?y)))))) + (if (memq (event-key event) '(?\C-g ?N ?n)) + (progn + (message "%s(Y/n) No" prompt) + nil) + (message "%s(Y/n) Yes" prompt) + t)))) + (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time) (fset 'nnheader-cancel-timer 'delete-itimer) (fset 'nnheader-cancel-function-timers 'ignore) +(fset 'nnheader-Y-or-n-p 'nnheader-xmas-Y-or-n-p) (provide 'nnheaderxm) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index b122d3e..38a0244 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -331,10 +331,8 @@ Finds out what articles are to be part of the nnkiboze groups." (save-excursion (set-buffer buffer) (goto-char (point-max)) - (let ((xref (mail-header-xref header)) - (prefix (gnus-group-real-prefix group)) + (let ((prefix (gnus-group-real-prefix group)) (oheader (copy-sequence header)) - (first t) article) (if (zerop (forward-line -1)) (progn diff --git a/lisp/nnmail.el b/lisp/nnmail.el index e761868..a323f87 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -31,6 +31,7 @@ (require 'timezone) (require 'message) (require 'custom) +(require 'gnus-util) (eval-and-compile (autoload 'gnus-error "gnus-util") @@ -181,7 +182,8 @@ used as incoming mailboxes. If this variable is a directory (i. e., it's name ends with a \"/\"), treat all files in that directory as incoming spool files." :group 'nnmail-files - :type 'file) + :type '(choice (file :tag "File") + (repeat :tag "Files" file))) (defcustom nnmail-crash-box "~/.gnus-crash-box" "File where Gnus will store mail while processing it." @@ -468,6 +470,9 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-internal-password nil) +(defvar nnmail-split-tracing nil) +(defvar nnmail-split-trace nil) + (defconst nnmail-version "nnmail 1.0" @@ -527,7 +532,8 @@ parameter. It should return nil, `warn' or `delete'." (aref t1 2) (aref t1 1) (aref t1 0) (aref d1 2) (aref d1 1) (aref d1 0) (number-to-string - (* 60 (timezone-zone-to-minute (aref d1 4)))))))) + (* 60 (timezone-zone-to-minute + (or (aref d1 4) (current-time-zone))))))))) ;; If we get an error, then we just return a 0 time. (error (list 0 0)))) @@ -655,6 +661,9 @@ parameter. It should return nil, `warn' or `delete'." (set-file-modes tofile nnmail-default-file-modes)))) ;; Probably a real error. + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq nnmail-internal-password nil) (subst-char-in-region (point-min) (point-max) ?\n ?\ ) (goto-char (point-max)) (skip-chars-backward " \t") @@ -690,8 +699,7 @@ nn*-request-list should have been called before calling this function." group-assoc))) group-assoc)) -(defvar nnmail-active-file-coding-system - 'iso-8859-1 +(defvar nnmail-active-file-coding-system 'binary "*Coding system for active file.") (defun nnmail-save-active (group-assoc file-name) @@ -1043,7 +1051,7 @@ FUNC will be called with the buffer narrowed to each mail." (funcall exit-func)) (kill-buffer (current-buffer))))) -(defun nnmail-article-group (func) +(defun nnmail-article-group (func &optional trace) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." (let ((methods nnmail-split-methods) @@ -1082,6 +1090,8 @@ FUNC will be called with the group name to determine the article number." ;; Allow washing. (goto-char (point-min)) (run-hooks 'nnmail-split-hook) + (when (setq nnmail-split-tracing trace) + (setq nnmail-split-trace nil)) (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) (let ((split @@ -1130,8 +1140,7 @@ FUNC will be called with the group name to determine the article number." ;; group twice. (not (assoc (car method) group-art))) (push (cons (if regrepp - (replace-match - (car method) nil nil (car method)) + (nnmail-expand-newtext (car method)) (car method)) (funcall func (car method))) group-art)) @@ -1141,6 +1150,18 @@ FUNC will be called with the group name to determine the article number." (setq group-art (list (cons (car method) (funcall func (car method))))))))) + ;; Produce a trace if non-empty. + (when (and trace nnmail-split-trace) + (let ((trace (nreverse nnmail-split-trace)) + (restore (current-buffer))) + (nnheader-set-temp-buffer "*Split Trace*") + (gnus-add-buffer) + (while trace + (insert (car trace) "\n") + (setq trace (cdr trace))) + (goto-char (point-min)) + (gnus-configure-windows 'split-trace) + (set-buffer restore))) ;; See whether the split methods returned `junk'. (if (equal group-art '(junk)) nil @@ -1237,81 +1258,87 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-split-it (split) ;; Return a list of groups matching SPLIT. - (cond - ;; nil split - ((null split) - nil) - - ;; A group name. Do the \& and \N subs into the string. - ((stringp split) - (list (nnmail-expand-newtext split))) - - ;; Junk the message. - ((eq split 'junk) - (list 'junk)) - - ;; Builtin & operation. - ((eq (car split) '&) - (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) - - ;; Builtin | operation. - ((eq (car split) '|) - (let (done) - (while (and (not done) (cdr split)) - (setq split (cdr split) - done (nnmail-split-it (car split)))) - done)) - - ;; Builtin : operation. - ((eq (car split) ':) - (nnmail-split-it (save-excursion (eval (cdr split))))) - - ;; Check the cache for the regexp for this split. - ;; FIX FIX FIX could avoid calling assq twice here - ((assq split nnmail-split-cache) - (goto-char (point-max)) - ;; FIX FIX FIX problem with re-search-backward is that if you have - ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1") - ;; and someone mails a message with 'To: foo-bar@gnus.org' and - ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group - ;; if the cc line is a later header, even though the other choice - ;; is probably better. Also, this routine won't do a crosspost - ;; when there are two different matches. - ;; I guess you could just make this more determined, and it could - ;; look for still more matches prior to this one, and recurse - ;; on each of the multiple matches hit. Of course, then you'd - ;; want to make sure that nnmail-article-group or nnmail-split-fancy - ;; removed duplicates, since there might be more of those. - ;; I guess we could also remove duplicates in the & split case, since - ;; that's the only thing that can introduce them. - (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) - ;; Someone might want to do a \N sub on this match, so get the - ;; correct match positions. - (goto-char (match-end 0)) - (let ((value (nth 1 split))) - (re-search-backward (if (symbolp value) - (cdr (assq value nnmail-split-abbrev-alist)) - value) - (match-end 1))) - (nnmail-split-it (nth 2 split)))) - - ;; Not in cache, compute a regexp for the field/value pair. - (t - (let* ((field (nth 0 split)) - (value (nth 1 split)) - (regexp (concat "^\\(\\(" - (if (symbolp field) - (cdr (assq field nnmail-split-abbrev-alist)) - field) - "\\):.*\\)\\<\\(" - (if (symbolp value) - (cdr (assq value nnmail-split-abbrev-alist)) - value) - "\\)\\>"))) - (push (cons split regexp) nnmail-split-cache) - ;; Now that it's in the cache, just call nnmail-split-it again - ;; on the same split, which will find it immediately in the cache. - (nnmail-split-it split))))) + (let (cached-pair) + (cond + ;; nil split + ((null split) + nil) + + ;; A group name. Do the \& and \N subs into the string. + ((stringp split) + (when nnmail-split-tracing + (push (format "\"%s\"" split) nnmail-split-trace)) + (list (nnmail-expand-newtext split))) + + ;; Junk the message. + ((eq split 'junk) + (when nnmail-split-tracing + (push "junk" nnmail-split-trace)) + (list 'junk)) + + ;; Builtin & operation. + ((eq (car split) '&) + (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) + + ;; Builtin | operation. + ((eq (car split) '|) + (let (done) + (while (and (not done) (cdr split)) + (setq split (cdr split) + done (nnmail-split-it (car split)))) + done)) + + ;; Builtin : operation. + ((eq (car split) ':) + (nnmail-split-it (save-excursion (eval (cdr split))))) + + ;; Check the cache for the regexp for this split. + ((setq cached-pair (assq split nnmail-split-cache)) + (goto-char (point-max)) + ;; FIX FIX FIX problem with re-search-backward is that if you have + ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1") + ;; and someone mails a message with 'To: foo-bar@gnus.org' and + ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group + ;; if the cc line is a later header, even though the other choice + ;; is probably better. Also, this routine won't do a crosspost + ;; when there are two different matches. + ;; I guess you could just make this more determined, and it could + ;; look for still more matches prior to this one, and recurse + ;; on each of the multiple matches hit. Of course, then you'd + ;; want to make sure that nnmail-article-group or nnmail-split-fancy + ;; removed duplicates, since there might be more of those. + ;; I guess we could also remove duplicates in the & split case, since + ;; that's the only thing that can introduce them. + (when (re-search-backward (cdr cached-pair) nil t) + (when nnmail-split-tracing + (push (cdr cached-pair) nnmail-split-trace)) + ;; Someone might want to do a \N sub on this match, so get the + ;; correct match positions. + (goto-char (match-end 0)) + (let ((value (nth 1 split))) + (re-search-backward (if (symbolp value) + (cdr (assq value nnmail-split-abbrev-alist)) + value) + (match-end 1))) + (nnmail-split-it (nth 2 split)))) + + ;; Not in cache, compute a regexp for the field/value pair. + (t + (let* ((field (nth 0 split)) + (value (nth 1 split)) + (regexp (concat "^\\(\\(" + (if (symbolp field) + (cdr (assq field nnmail-split-abbrev-alist)) + field) + "\\):.*\\)\\<\\(" + (if (symbolp value) + (cdr (assq value nnmail-split-abbrev-alist)) + value) + "\\)\\>"))) + (push (cons split regexp) nnmail-split-cache) + ;; Now that it's in the cache, just call nnmail-split-it again + ;; on the same split, which will find it immediately in the cache. + (nnmail-split-it split)))))) (defun nnmail-expand-newtext (newtext) (let ((len (length newtext)) @@ -1325,14 +1352,14 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (unless (= beg pos) (push (substring newtext beg pos) expanded)) (when (< pos len) - ;; we hit a \, expand it. - (setq did-expand t) - (setq pos (1+ pos)) - (setq c (aref newtext pos)) + ;; We hit a \; expand it. + (setq did-expand t + pos (1+ pos) + c (aref newtext pos)) (if (not (or (= c ?\&) (and (>= c ?1) (<= c ?9)))) - ;; \ followed by some character we don't expand + ;; \ followed by some character we don't expand. (push (char-to-string c) expanded) ;; \& or \N (if (= c ?\&) @@ -1657,11 +1684,13 @@ If ARGS, PROMPT is used as an argument to `format'." (apply 'format prompt args) prompt))) (unless nnmail-read-passwd - (if (load "passwd" t) + (if (functionp 'read-passwd) (setq nnmail-read-passwd 'read-passwd) - (unless (fboundp 'ange-ftp-read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp")) - (setq nnmail-read-passwd 'ange-ftp-read-passwd))) + (if (load "passwd" t) + (setq nnmail-read-passwd 'read-passwd) + (unless (fboundp 'ange-ftp-read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp")) + (setq nnmail-read-passwd 'ange-ftp-read-passwd)))) (funcall nnmail-read-passwd prompt))) (defun nnmail-check-syntax () @@ -1755,8 +1784,7 @@ If ARGS, PROMPT is used as an argument to `format'." (defun nnmail-purge-split-history (group) "Remove all instances of GROUP from `nnmail-split-history'." - (let ((history nnmail-split-history) - prev) + (let ((history nnmail-split-history)) (while history (setcar history (gnus-delete-if (lambda (e) (string= (car e) group)) (car history))) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index c359e95..8aafd7d 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -242,13 +242,7 @@ (deffoo nnmh-request-expire-articles (articles newsgroup &optional server force) (nnmh-possibly-change-directory newsgroup server) - (let* ((active-articles - (mapcar - (function - (lambda (name) - (string-to-int name))) - (directory-files nnmh-current-directory nil "^[0-9]+$" t))) - (is-old t) + (let* ((is-old t) article rest mod-time) (nnheader-init-server-buffer) diff --git a/lisp/nntp.el b/lisp/nntp.el index 67eafb7..9c5523d 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -45,13 +45,11 @@ (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd -server spawn an nnrpd server. Another useful function to put in this -hook might be `nntp-send-authinfo', which will prompt for a password -to allow posting from the server. Note that this is only necessary to -do on servers that use strict access control.") +server spawn an nnrpd server.") (defvoo nntp-authinfo-function 'nntp-send-authinfo - "Function used to send AUTHINFO to the server.") + "Function used to send AUTHINFO to the server. +It is called with no parameters.") (defvoo nntp-server-action-alist '(("nntpd 1\\.5\\.11t" @@ -181,6 +179,10 @@ server there that you can connect to. See also +(defvoo nntp-connection-timeout nil + "*Number of seconds to wait before an nntp connection times out. +If this variable is nil, which is the default, no timers are set.") + ;;; Internal variables. (defvar nntp-record-commands nil @@ -197,6 +199,7 @@ server there that you can connect to. See also (defvoo nntp-last-command-time nil) (defvoo nntp-last-command nil) (defvoo nntp-authinfo-password nil) +(defvoo nntp-authinfo-user nil) (defvar nntp-connection-list nil) @@ -234,8 +237,10 @@ server there that you can connect to. See also (save-excursion (set-buffer (get-buffer-create "*nntp-log*")) (goto-char (point-max)) - (insert (format-time-string "%Y%m%dT%H%M%S" (current-time)) - " " nntp-address " " string "\n"))) + (let ((time (current-time))) + (insert (format-time-string "%Y%m%dT%H%M%S" time) + "." (format "%03d" (/ (nth 2 time) 1000)) + " " nntp-address " " string "\n")))) (defsubst nntp-wait-for (process wait-for buffer &optional decode discard) "Wait for WAIT-FOR to arrive from PROCESS." @@ -392,18 +397,22 @@ server there that you can connect to. See also (nnoo-define-basics nntp) (defsubst nntp-next-result-arrived-p () - (let ((point (point))) - (cond - ((eq (following-char) ?2) - (if (re-search-forward "\n\\.\r?\n" nil t) - t - (goto-char point) - nil)) - ((looking-at "[34]") - (forward-line 1) - t) - (t - nil)))) + (cond + ;; A result that starts with a 2xx code is terminated by + ;; a line with only a "." on it. + ((eq (following-char) ?2) + (if (re-search-forward "\n\\.\r?\n" nil t) + t + nil)) + ;; A result that starts with a 3xx or 4xx code is terminated + ;; by a newline. + ((looking-at "[34]") + (if (search-forward "\n" nil t) + t + nil)) + ;; No result here. + (t + nil))) (deffoo nntp-retrieve-headers (articles &optional group server fetch-old) "Retrieve the headers of ARTICLES." @@ -540,7 +549,7 @@ server there that you can connect to. See also (nntp-inhibit-erase t) (map (apply 'vector articles)) (point 1) - article alist) + article) (set-buffer buf) (erase-buffer) ;; Send ARTICLE command. @@ -580,7 +589,7 @@ server there that you can connect to. See also (nnheader-message 6 "NNTP: Receiving articles...done")) ;; Now we have all the responses. We go through the results, - ;; washes it and copies it over to the server buffer. + ;; wash it and copy it over to the server buffer. (set-buffer nntp-server-buffer) (erase-buffer) (setq last-point (point-min)) @@ -643,7 +652,7 @@ server there that you can connect to. See also (deffoo nntp-request-group (group &optional server dont-check) (nntp-possibly-change-group nil server) - (when (nntp-send-command "^21.*\n" "GROUP" group) + (when (nntp-send-command "^[245].*\n" "GROUP" group) (let ((entry (nntp-find-connection-entry nntp-server-buffer))) (setcar (cddr entry) group)))) @@ -679,6 +688,10 @@ server there that you can connect to. See also (ignore-errors (nntp-send-string process "QUIT") (unless (eq nntp-open-connection-function 'nntp-open-network-stream) + ;; Ok, this is evil, but when using telnet and stuff + ;; as the connection method, it's important that the + ;; QUIT command actually is sent out before we kill + ;; the process. (sleep-for 1)))) (when (buffer-name (process-buffer process)) (kill-buffer (process-buffer process))) @@ -742,33 +755,40 @@ reading." "Send the AUTHINFO to the nntp server. It will look in the \"~/.authinfo\" file for matching entries. If nothing suitable is found there, it will prompt for a user name -and a password." +and a password. + +If SEND-IF-FORCE, only send authinfo to the server if the +.authinfo file has the FORCE token." (let* ((list (gnus-parse-netrc nntp-authinfo-file)) (alist (gnus-netrc-machine list nntp-address)) (force (gnus-netrc-get alist "force")) - (user (gnus-netrc-get alist "login")) + (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) (passwd (gnus-netrc-get alist "password"))) (when (or (not send-if-force) force) - (nntp-send-command - "^3.*\r?\n" "AUTHINFO USER" - (or user (read-string (format "NNTP (%s) user name: " nntp-address)))) + (unless user + (setq user (read-string (format "NNTP (%s) user name: " nntp-address)) + nntp-authinfo-user user)) + (unless (member user '(nil "")) + (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) + (when t ;???Should check if AUTHINFO succeeded (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" (or passwd nntp-authinfo-password (setq nntp-authinfo-password - (nnmail-read-passwd (format "NNTP (%s) password: " - nntp-address)))))))) + (nnmail-read-passwd (format "NNTP (%s@%s) password: " + user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () "Send the AUTHINFO to the nntp server." - (nntp-send-command - "^3.*\r?\n" "AUTHINFO USER" - (read-string (format "NNTP (%s) user name: " nntp-address))) - (nntp-send-command - "^2.*\r?\n" "AUTHINFO PASS" - (nnmail-read-passwd "NNTP (%s) password: " nntp-address))) + (let ((user (read-string (format "NNTP (%s) user name: " nntp-address)))) + (unless (member user '(nil "")) + (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) + (when t ;???Should check if AUTHINFO succeeded + (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" + (nnmail-read-passwd "NNTP (%s@%s) password: " + user nntp-address)))))) (defun nntp-send-authinfo-from-file () "Send the AUTHINFO to the nntp server. @@ -818,13 +838,24 @@ password contained in '~/.nntp-authinfo'." "Open a connection to PORT on ADDRESS delivering output to BUFFER." (run-hooks 'nntp-prepare-server-hook) (let* ((pbuffer (nntp-make-process-buffer buffer)) + (timer + (and nntp-connection-timeout + (nnheader-run-at-time + nntp-connection-timeout nil + `(lambda () + (when (buffer-name ,pbuffer) + (kill-buffer ,pbuffer)))))) (process (condition-case () - (let ((coding-system-for-read nntp-coding-system-for-read)) + (let ((coding-system-for-read nntp-coding-system-for-read) + (coding-system-for-write nntp-coding-system-for-write)) (funcall nntp-open-connection-function pbuffer)) (error nil) (quit nil)))) - (when process + (when timer + (nnheader-cancel-timer timer)) + (when (and (buffer-name pbuffer) + process) (process-kill-without-query process) (nntp-wait-for process "^.*\n" buffer nil t) (if (memq (process-status process) '(open run)) @@ -948,7 +979,9 @@ password contained in '~/.nntp-authinfo'." (set-buffer (process-buffer (car entry))) (erase-buffer) (nntp-send-string (car entry) (concat "GROUP " group)) - (nntp-wait-for-string "^2.*\n") + ;; allow for unexpected responses, since this can be called + ;; from a timer with quit inhibited + (nntp-wait-for-string "^[245].*\n") (setcar (cddr entry) group) (erase-buffer)))))) @@ -988,10 +1021,7 @@ password contained in '~/.nntp-authinfo'." (while (not (eobp)) (end-of-line) (delete-char 1) - (insert nntp-end-of-line)) - (forward-char -1) - (unless (eq (char-after (1- (point))) ?\r) - (insert "\r")))) + (insert nntp-end-of-line)))) (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (set-buffer nntp-server-buffer) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index d83356d..4829341 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -43,7 +43,7 @@ (nnoo-declare nnvirtual) -(defvoo nnvirtual-always-rescan nil +(defvoo nnvirtual-always-rescan t "*If non-nil, always scan groups for unread articles when entering a group. If this variable is nil (which is the default) and you read articles in a component group after the virtual group has been activated, the @@ -259,12 +259,14 @@ to virtual article number.") (setq nnvirtual-current-group nil) (nnheader-report 'nnvirtual "No component groups in %s" group)) (t + (setq nnvirtual-current-group group) (when (or (not dont-check) nnvirtual-always-rescan) (nnvirtual-create-mapping) (when nnvirtual-always-rescan - (nnvirtual-request-update-info group (gnus-get-info group)))) - (setq nnvirtual-current-group group) + (nnvirtual-request-update-info + (nnvirtual-current-group) + (gnus-get-info (nnvirtual-current-group))))) (nnheader-insert "211 %d 1 %d %s\n" nnvirtual-mapping-len nnvirtual-mapping-len group)))) @@ -272,9 +274,12 @@ to virtual article number.") (deffoo nnvirtual-request-type (group &optional article) (if (not article) 'unknown - (let ((mart (nnvirtual-map-article article))) - (when mart - (gnus-request-type (car mart) (cdr mart)))))) + (if (numberp article) + (let ((mart (nnvirtual-map-article article))) + (if mart + (gnus-request-type (car mart) (cdr mart)))) + (gnus-request-type + nnvirtual-last-accessed-component-group nil)))) (deffoo nnvirtual-request-update-mark (group article mark) (let* ((nart (nnvirtual-map-article article)) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 42dc338..5a673cd 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -34,17 +34,11 @@ (require 'message) (require 'gnus-util) (require 'gnus) +(require 'w3) +(require 'url) (require 'nnmail) -(eval-when-compile - (ignore-errors - (require 'w3) - (require 'url) - (require 'w3-forms))) -;; Report failure to find w3 at load time if appropriate. -(eval '(progn - (require 'w3) - (require 'url) - (require 'w3-forms))) +(ignore-errors + (require 'w3-forms)) (nnoo-declare nnweb) @@ -214,8 +208,7 @@ and `altavista'.") (deffoo nnweb-request-delete-group (group &optional force server) (nnweb-possibly-change-server group server) - (gnus-pull group nnweb-group-alist t) - (nnweb-write-active) + (gnus-pull group nnweb-group-alist) (gnus-delete-file (nnweb-overview-file group)) t) @@ -226,7 +219,7 @@ and `altavista'.") (defun nnweb-read-overview (group) "Read the overview of GROUP and build the map." (when (file-exists-p (nnweb-overview-file group)) - (with-temp-buffer + (nnheader-temp-write nil (nnheader-insert-file-contents (nnweb-overview-file group)) (goto-char (point-min)) (let (header) @@ -240,7 +233,7 @@ and `altavista'.") (defun nnweb-write-overview (group) "Write the overview file for GROUP." - (with-temp-file (nnweb-overview-file group) + (nnheader-temp-write (nnweb-overview-file group) (let ((articles nnweb-articles)) (while articles (nnheader-insert-nov (cadr (pop articles))))))) @@ -261,7 +254,7 @@ and `altavista'.") (defun nnweb-write-active () "Save the active file." - (with-temp-file (nnheader-concat nnweb-directory "active") + (nnheader-temp-write (nnheader-concat nnweb-directory "active") (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer)))) (defun nnweb-read-active () diff --git a/lisp/parse-time.el b/lisp/parse-time.el index f076aea..e25abbb 100644 --- a/lisp/parse-time.el +++ b/lisp/parse-time.el @@ -38,8 +38,10 @@ (eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it -(defvar parse-time-syntax (make-vector 256 nil)) -(defvar parse-time-digits (make-vector 256 nil)) +(put 'parse-time-syntax 'char-table-extra-slots 0) + +(defvar parse-time-syntax (make-char-table 'parse-time-syntax)) +(defvar parse-time-digits (make-char-table 'parse-time-syntax)) ;; Byte-compiler warnings (defvar elt) @@ -47,18 +49,18 @@ (unless (aref parse-time-digits ?0) (loop for i from ?0 to ?9 - do (aset parse-time-digits i (- i ?0)))) + do (set-char-table-range parse-time-digits i (- i ?0)))) (unless (aref parse-time-syntax ?0) (loop for i from ?0 to ?9 - do (aset parse-time-syntax i ?0)) + do (set-char-table-range parse-time-syntax i ?0)) (loop for i from ?A to ?Z - do (aset parse-time-syntax i ?A)) + do (set-char-table-range parse-time-syntax i ?A)) (loop for i from ?a to ?z - do (aset parse-time-syntax i ?a)) - (aset parse-time-syntax ?+ 1) - (aset parse-time-syntax ?- -1) - (aset parse-time-syntax ?: ?d) + do (set-char-table-range parse-time-syntax i ?a)) + (set-char-table-range parse-time-syntax ?+ 1) + (set-char-table-range parse-time-syntax ?- -1) + (set-char-table-range parse-time-syntax ?: ?d) ) (defsubst digit-char-p (char) @@ -87,8 +89,7 @@ (setq integer (+ (* integer 10) digit) index (1+ index))) (if (/= index end) - (signal 'parse-error `("not an integer" - ,(substring string (or start 0) end))) + (signal 'parse-error `("not an integer" ,(substring string (or start 0) end))) (* sign integer)))))) (defun parse-time-tokenize (string) @@ -113,24 +114,24 @@ list))) (nreverse list))) -(defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) - ("apr" . 4) ("may" . 5) ("jun" . 6) - ("jul" . 7) ("aug" . 8) ("sep" . 9) - ("oct" . 10) ("nov" . 11) ("dec" . 12))) -(defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2) - ("wed" . 3) ("thu" . 4) ("fri" . 5) ("sat" . 6))) -(defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0) - ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t) - ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t) - ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t) - ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t)) +(defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) + ("Apr" . 4) ("May" . 5) ("Jun" . 6) + ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) + ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) +(defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) + ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) +(defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0) + ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t) + ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t) + ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t) + ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t)) "(zoneinfo seconds-off daylight-savings-time-p)") (defvar parse-time-rules `(((6) parse-time-weekdays) ((3) (1 31)) ((4) parse-time-months) - ((5) (100 4038)) + ((5) (1970 2038)) ((2 1 0) ,#'(lambda () (and (stringp elt) (= (length elt) 8) @@ -149,34 +150,20 @@ (* 60 (parse-integer elt 1 3))) (if (= (aref elt 0) ?-) -1 1)))) ((5 4 3) - ,#'(lambda () (and (stringp elt) - (= (length elt) 10) - (= (aref elt 4) ?-) - (= (aref elt 7) ?-))) + ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-))) [0 4] [5 7] [8 10]) - ((2 1 0) + ((2 1) ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:))) - [0 2] [3 5] ,#'(lambda () 0)) - ((2 1 0) - ,#'(lambda () (and (stringp elt) - (= (length elt) 4) - (= (aref elt 1) ?:))) - [0 1] [2 4] ,#'(lambda () 0)) - ((2 1 0) - ,#'(lambda () (and (stringp elt) - (= (length elt) 7) - (= (aref elt 1) ?:))) - [0 1] [2 4] [5 7]) - ((5) (50 99) ,#'(lambda () (+ 1900 elt))) - ((5) (0 49) ,#'(lambda () (+ 2000 elt)))) + [0 2] [3 5]) + ((5) (70 99) ,#'(lambda () (+ 1900 elt)))) "(slots predicate extractor...)") (defun parse-time-string (string) "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). The values are identical to those of `decode-time', but any values that are unknown are returned as nil." - (let ((time (list nil nil nil nil nil nil nil nil nil)) - (temp (parse-time-tokenize (downcase string)))) + (let ((time (list nil nil nil nil nil nil nil nil nil nil)) + (temp (parse-time-tokenize string))) (while temp (let ((elt (pop temp)) (rules parse-time-rules) @@ -186,27 +173,25 @@ unknown are returned as nil." (slots (pop rule)) (predicate (pop rule)) (val)) - (when (and (not (nth (car slots) time)) ;not already set - (setq val (cond ((and (consp predicate) - (not (eq (car predicate) - 'lambda))) - (and (numberp elt) - (<= (car predicate) elt) - (<= elt (cadr predicate)) - elt)) - ((symbolp predicate) - (cdr (assoc elt - (symbol-value predicate)))) - ((funcall predicate))))) - (setq exit t) - (while slots - (let ((new-val (and rule - (let ((this (pop rule))) - (if (vectorp this) - (parse-integer - elt (aref this 0) (aref this 1)) - (funcall this)))))) - (rplaca (nthcdr (pop slots) time) (or new-val val))))))))) + (if (and (not (nth (car slots) time)) ;not already set + (setq val (cond ((and (consp predicate) + (not (eq (car predicate) 'lambda))) + (and (numberp elt) + (<= (car predicate) elt) + (<= elt (cadr predicate)) + elt)) + ((symbolp predicate) + (cdr (assoc elt (symbol-value predicate)))) + ((funcall predicate))))) + (progn + (setq exit t) + (while slots + (let ((new-val (and rule + (let ((this (pop rule))) + (if (vectorp this) + (parse-integer elt (aref this 0) (aref this 1)) + (funcall this)))))) + (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))) time)) (provide 'parse-time) diff --git a/lisp/pop3-fma.el b/lisp/pop3-fma.el index 1dbad4c..293efe6 100644 --- a/lisp/pop3-fma.el +++ b/lisp/pop3-fma.el @@ -3,7 +3,7 @@ ;; Yasuo Okabe ;; Author: Tatsuya Ichikawa ;; Yasuo OKABE -;; Version: 1.00 +;; Version: 1.16 ;; Keywords: mail , gnus , pop3 ;; ;; SPECIAL THANKS @@ -41,12 +41,18 @@ ;; (require 'pop3-fma) ;; (setq pop3-fma-spool-file-alist ;; '( -;; "po:username0@mailhost0.your.domain0" -;; "po:username1@mailhost1.your.domain1" +;; ("po:username0@mailhost0.your.domain0" pass) +;; ("po:username1@mailhost1.your.domain1" apop) ;; : ;; : ;; )) ;; +;; pass means normal authentication USER/PASS. +;; apop means authentication using APOP. +;; +;; When using apop , Please set pop3-fma-movemail-type 'lisp. +;; movemail.exe does not work on APOP protocol. +;; ;; Variables ;; ;; pop3-fma-spool-file-alist ... Spool file alist of POP3 protocol @@ -72,30 +78,21 @@ (` (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.00") +(defconst pop3-fma-version-number "1.16") (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" ; 0.xx -;; "Star ring" ; 0.xx -;; "Goodbye Game" ; 0.xx +;; "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 ) (defconst pop3-fma-version (format "Multiple POP3 account utiliy for Gnus v%s - \"%s\"" pop3-fma-version-number @@ -105,9 +102,10 @@ "*Spool file to get mail using pop3 protocol. You should specify this variable like '( - \"po:user1@mailhost1\" - \"po:user2@mailhost2\" - )" + (\"po:user1@mailhost1\" type) + (\"po:user2@mailhost2\" type) + ) +Type must be pass or apop." :group 'pop3-fma :type 'alist) @@ -130,20 +128,57 @@ 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 "movemail.exe" - "*External program name your movemail. -Please do not set this valiable non-nil if you do not use Meadow.") +(defvar pop3-fma-movemail-program + (if (eq system-type 'windows-nt) + "movemail.exe" + "movemail") + "*External program name your movemail.") + ;; 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)) @@ -167,30 +202,53 @@ Please do not set this valiable non-nil if you do not use Meadow.") (substring inbox (match-end (string-match "^po:" inbox)) (- (match-end (string-match "^.*@" inbox)) 1))) (pop3-mailhost - (substring inbox (match-end (string-match "^.*@" inbox))))) - (let ((pop3-password - (pop3-fma-read-passwd pop3-mailhost))) - (message "Checking new mail user %s at %s..." pop3-maildrop pop3-mailhost) - (if (and (eq system-type 'windows-nt) - (eq pop3-fma-movemail-type 'exe)) - (progn - (setenv "MAILHOST" pop3-mailhost) - (if (and (not (memq pop3-password pop3-fma-movemail-arguments)) - (not (memq (concat "po:" pop3-maildrop) pop3-fma-movemail-arguments))) + (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-authentication-scheme + (nth 1 (assoc inbox pop3-fma-spool-file-alist))) + (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox))) + (if (eq pop3-authentication-scheme 'pass) + (message "Checking new mail user %s at %s using USER/PASS ..." pop3-maildrop pop3-mailhost) + (message "Checking new mail user %s at %s using APOP ..." pop3-maildrop pop3-mailhost)) + (if (and (eq system-type 'windows-nt) + (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))) + (progn + (setq pop3-fma-commandline-arguments + (append + pop3-fma-movemail-arguments + (list + (concat "po:" pop3-maildrop) + crashbox + pop3-password))))) + (if (not (get-buffer movemail-output-buffer)) + (get-buffer-create movemail-output-buffer)) + (set-buffer movemail-output-buffer) + (erase-buffer) + (apply 'call-process (concat + exec-directory + pop3-fma-movemail-program) + nil movemail-output-buffer nil + pop3-fma-commandline-arguments) + (let ((string (buffer-string))) + (if (> (length string) 0) (progn - (setq pop3-fma-movemail-arguments nil) - (setq pop3-fma-movemail-arguments - (append pop3-fma-movemail-options - (list - (concat "po:" pop3-maildrop) - crashbox - pop3-password))))) - (apply 'call-process (concat - exec-directory - pop3-fma-movemail-program) - nil nil nil - pop3-fma-movemail-arguments)) - (pop3-movemail crashbox))))) + (if (y-or-n-p + (concat (substring string 0 + (- (length string) 1)) + " continue ??")) + nil + nil))))) + (pop3-movemail crashbox)))) (message "Checking new mail at %s ... " inbox) (call-process (concat exec-directory pop3-fma-movemail-program) nil @@ -203,9 +261,14 @@ Please do not set this valiable non-nil if you do not use Meadow.") ;; (defun pop3-fma-read-passwd (mailhost) (setq passwd (nth 2 (assoc mailhost pop3-fma-password))) - (pop3-fma-decode-string passwd)) + passwd) -(setq pop3-read-passwd 'pop3-fma-read-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) ;; ;; Set multiple pop3 server's password (defun pop3-fma-store-password (passwd) @@ -219,29 +282,50 @@ Please do not set this valiable non-nil if you do not use Meadow.") (list pop3-mailhost pop3-maildrop - (pop3-fma-encode-string passwd))))) + passwd))))) (setcar (cdr (cdr (assoc pop3-mailhost pop3-fma-password))) - (pop3-fma-encode-string passwd))) - (message "POP password registered.") - (pop3-fma-encode-string passwd)) + passwd) + (message "POP password registered.") + passwd) ;; ;;;###autoload (defun pop3-fma-set-pop3-password() (interactive) - (mapcar - (lambda (x) - (let ((pop3-maildrop - (substring x (match-end (string-match "^po:" x)) - (- (match-end (string-match "^.*@" x)) 1))) - (pop3-mailhost - (substring x (match-end (string-match "^.*@" x))))) - (call-interactively 'pop3-fma-store-password))) - pop3-fma-spool-file-alist) + (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))) (setq nnmail-movemail-program 'pop3-fma-movemail) ;; (setq nnmail-spool-file pop3-fma-spool-file-alist)) (setq nnmail-spool-file (append pop3-fma-local-spool-file-alist - pop3-fma-spool-file-alist))) + (mapcar + (lambda (spool) + (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. @@ -261,15 +345,15 @@ Argument PROMPT ." (and (> truncate 0) (setq msg (concat "$" (substring msg (1+ truncate)))))) (message msg) - (setq c (read-char-exclusive)) - (cond ((= c ?\C-g) + (setq c (pop3-fma-read-char-exclusive)) + (cond ((eq ?\C-g c) (setq quit-flag t done t)) - ((or (= c ?\r) (= c ?\n) (= c ?\e)) + ((memq c '(?\r ?\n ?\e)) (setq done t)) - ((= c ?\C-u) + ((eq ?\C-u c) (setq ans "")) - ((and (/= c ?\b) (/= c ?\177)) + ((and (/= ?\b c) (/= ?\177 c)) (setq ans (concat ans (char-to-string c)))) ((> (length ans) 0) (setq ans (substring ans 0 -1))))) @@ -288,7 +372,6 @@ Argument PROMPT ." ;; ;; Add your custom header. -;; (defun pop3-fma-add-custom-header (header string) (let ((delimline (progn (goto-char (point-min)) @@ -306,6 +389,14 @@ Argument PROMPT ." (setq hdr (concat str "\n")) (insert-string hdr))))) ;; +;; +(defun pop3-fma-get-movemail-type (inbox) + (if (eq (nth 1 (assoc inbox pop3-fma-spool-file-alist)) 'apop) + 'lisp + pop3-fma-movemail-type)) +;; (provide 'pop3-fma) ;; ;; pop3-fma.el ends here. + + diff --git a/lisp/pop3.el b/lisp/pop3.el index 1bfd8ec..55c2f65 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,10 +1,10 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 -;; Version: 1.3l+ +;; Version: 1.3m+ ;; This file is part of GNU Emacs. @@ -37,7 +37,7 @@ (require 'mail-utils) (provide 'pop3) -(defconst pop3-version "1.3l+") +(defconst pop3-version "1.3m+") (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil) "*POP3 maildrop.") @@ -116,7 +116,9 @@ Returns the process associated with the connection." (let ((process-buffer (get-buffer-create (format "trace of POP session to %s" mailhost))) (process) - (coding-system-for-read 'binary)) + (coding-system-for-read 'binary) ;; because 0000n0000 S000l 0a0 + (coding-system-for-write 'binary) ;; is st00pid + ) (save-excursion (set-buffer process-buffer) (erase-buffer) @@ -192,10 +194,12 @@ Return the response string if optional second argument is non-nil." (defvar pop3-read-passwd nil) (defun pop3-read-passwd (prompt) (if (not pop3-read-passwd) - (if (load "passwd" t) + (if (functionp 'read-passwd) (setq pop3-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pop3-read-passwd 'ange-ftp-read-passwd))) + (if (load "passwd" t) + (setq pop3-read-passwd 'read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp") + (setq pop3-read-passwd 'ange-ftp-read-passwd)))) (funcall pop3-read-passwd prompt)) (defun pop3-clean-region (start end) diff --git a/lisp/score-mode.el b/lisp/score-mode.el index e2160eb..24c31f6 100644 --- a/lisp/score-mode.el +++ b/lisp/score-mode.el @@ -26,6 +26,7 @@ ;;; Code: (require 'easymenu) +(require 'timezone) (eval-when-compile (require 'cl)) (defvar gnus-score-mode-hook nil @@ -39,8 +40,7 @@ (defvar gnus-score-mode-map nil) (unless gnus-score-mode-map - (setq gnus-score-mode-map (make-sparse-keymap)) - (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map) + (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) @@ -51,8 +51,6 @@ table) "Syntax table used in score-mode buffers.") -(defvar score-mode-coding-system 'binary) - ;;;###autoload (defun gnus-score-mode () "Mode for editing Gnus score files. @@ -83,7 +81,7 @@ This mode is an extended emacs-lisp mode. (defun gnus-score-edit-insert-date () "Insert date in numerical format." (interactive) - (princ (time-to-days (current-time)) (current-buffer))) + (princ (gnus-score-day-number (current-time)) (current-buffer))) (defun gnus-score-pretty-print () "Format the current score file." @@ -100,8 +98,7 @@ This mode is an extended emacs-lisp mode. (interactive) (unless (file-exists-p (file-name-directory (buffer-file-name))) (make-directory (file-name-directory (buffer-file-name)) t)) - (let ((coding-system-for-write score-mode-coding-system)) - (save-buffer)) + (save-buffer) (bury-buffer (current-buffer)) (let ((buf (current-buffer))) (when gnus-score-edit-exit-function @@ -109,6 +106,11 @@ This mode is an extended emacs-lisp mode. (when (eq buf (current-buffer)) (switch-to-buffer (other-buffer (current-buffer)))))) +(defun gnus-score-day-number (time) + (let ((dat (decode-time time))) + (timezone-absolute-from-gregorian + (nth 4 dat) (nth 3 dat) (nth 5 dat)))) + (provide 'score-mode) ;;; score-mode.el ends here diff --git a/lisp/smiley.el b/lisp/smiley.el index ac1a65f..e6c13f7 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -294,10 +294,10 @@ Mouse button3 - menu")) (save-excursion (goto-char start) (when (and (re-search-backward "[()]" nil t) - (eq (char-after) ?\() + (= (following-char) ?\() (goto-char end) (or (not (re-search-forward "[()]" nil t)) - (eq (char-after (1- (point))) ?\())) + (= (char-after (1- (point))) ?\())) t))) (defvar gnus-article-buffer) diff --git a/lisp/smtp.el b/lisp/smtp.el index 7dde447..3d2e113 100644 --- a/lisp/smtp.el +++ b/lisp/smtp.el @@ -361,7 +361,7 @@ don't define this value." (setq this-line-end (point)) (setq sending-data nil) (setq sending-data (buffer-substring this-line this-line-end)) - (if (/= (forward-line 1) 0) + (if (or (/= (forward-line 1) 0) (eobp)) (setq data-continue nil))) (smtp-send-data-1 process sending-data) diff --git a/make.bat b/make.bat index b203277..4a6b8a0 100755 --- a/make.bat +++ b/make.bat @@ -22,10 +22,6 @@ rem rem which will allow the batch file to accept an unlimited number of rem parameters. -rem Clear PWD so emacs doesn't get confused -set GNUS_PWD_SAVE=%PWD% -set PWD= - if "%1" == "" goto usage cd lisp @@ -58,7 +54,4 @@ echo eg. d:\emacs\19.34 echo copy indicates that the compiled files should be copied to your echo emacs lisp, info, and etc directories -rem Restore PWD so whoever called this batch file doesn't get confused -set PWD=%GNUS_PWD_SAVE% -set GNUS_PWD_SAVE= :end diff --git a/texi/ChangeLog b/texi/ChangeLog index 980c667..fd2879c 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,117 @@ +1998-08-27 07:29:17 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Folders): Addition. + +1998-08-25 08:06:28 Lars Magne Ingebrigtsen + + * gnus.texi (Posting Styles): Document this-is. + (Virtual Groups): Addition. + +1998-08-18 00:30:05 Lars Magne Ingebrigtsen + + * gnus.texi (Article Hiding): Addition. + +1998-08-16 14:53:45 Lars Magne Ingebrigtsen + + * gnus.texi (NNTP): Reinstated. + (Asynchronous Fetching): No header prefetch. + +1998-08-15 13:01:41 Lars Magne Ingebrigtsen + + * gnus.texi (Summary Score Commands): Change. + +1998-08-14 01:31:36 Simon Josefsson + + * gnus.texi (Posting Styles): New 'body style. + +1998-08-13 21:17:00 Lars Magne Ingebrigtsen + + * gnus.texi (Paging the Article): Addition. + +1998-08-13 00:13:47 Simon Josefsson + + * gnus.texi (Mail Group Commands): Typo. + +1998-08-12 21:28:09 Simon Josefsson + + * gnus.texi (Article Caching): gnus-cacheable-groups. + (Newest Features): remove gnus-cacheable-groups. + +1998-08-12 22:01:12 Lars Magne Ingebrigtsen + + * message.texi (Forwarding): Addition. + +1998-08-11 20:33:53 Justin Zaglio + + * gnus.texi (Group Maintenance): Fix. + +1998-08-11 11:44:20 Lars Magne Ingebrigtsen + + * gnus.texi (Group Maintenance): Fix. + +1998-08-10 08:59:25 Lars Magne Ingebrigtsen + + * gnus.texi (Article Highlighting): Addition. + (Article Fontisizing): Fix. + (Article Hiding): Change. + (Article Hiding): Fix. + +1998-08-09 15:32:24 Lars Magne Ingebrigtsen + + * gnus.texi (Hiding Headers): Fix. + (Article Hiding): Addition. + (Document Groups): Addition. + +1998-08-08 06:06:37 Lars Magne Ingebrigtsen + + * gnus.texi (Fancy Mail Splitting): Change. + +1998-08-06 02:12:04 Lars Magne Ingebrigtsen + + * gnus.texi: De-legalize. + + * message.texi: De-legalize. + + * gnus.texi (Summary Maneuvering): Fix. + +1998-07-21 17:51 Simon Josefsson + + * gnus.texi (Splitting Mail): junk is fancy splitting only + + * gnus.texi (Fancy Mail Splitting): warn about junk + +1998-07-27 02:28:33 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Fix. + +1998-07-27 02:23:17 Robert Bihlmeyer + + * gnus.texi (Score Decays): Fix. + +Sun Jul 12 04:03:27 1998 Lars Magne Ingebrigtsen + + * gnus.texi (Home Score File): Addition. + +Fri Jul 10 04:26:23 1998 Lars Magne Ingebrigtsen + + * gnus.texi (NNTP): Addition. + +Sat Jul 4 14:24:29 1998 Lars Magne Ingebrigtsen + + * gnus.texi (Gnus Utility Functions): Addition. + +Thu Jul 2 11:37:51 1998 Lars Magne Ingebrigtsen + + * gnus.texi (Posting Styles): Ununcommented. + +Wed Jul 1 17:57:54 1998 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Addition. + +Tue Jun 30 16:11:27 1998 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Addition. + Mon Jun 29 21:46:13 1998 Lars Magne Ingebrigtsen * gnus.texi (Article Keymap): Typo. @@ -278,7 +392,7 @@ Sat Sep 20 20:53:43 1997 Lars Magne Ingebrigtsen Wed Sep 17 02:32:56 1997 Lars Magne Ingebrigtsen - * gnus.texi (Customizing Threading): Broken up into five nodes. + * gnus.texi (Customizing Threading): Broken up into five nodes. (Article Washing): Addition. * message.texi (Various Commands): Add. @@ -305,7 +419,7 @@ Sat Jul 19 23:02:03 1997 Lars Magne Ingebrigtsen Sat Jul 12 16:29:35 1997 Lars Magne Ingebrigtsen - * gnus.texi (Picon Configuration): Moved Picons to under XEmacs. + * gnus.texi (Picon Configuration): Moved Picons to under XEmacs. (Smileys): New section. Fri Jul 11 11:58:20 1997 Lars Magne Ingebrigtsen @@ -487,7 +601,7 @@ Mon Feb 3 07:31:47 1997 Lars Magne Ingebrigtsen Mon Jan 27 17:51:29 1997 Lars Magne Ingebrigtsen * gnus.texi (Highlighting and Menus): Removed - `gnus-display-type'. + `gnus-display-type'. Sat Jan 25 08:09:30 1997 Lars Magne Ingebrigtsen @@ -610,7 +724,7 @@ Fri Oct 25 09:04:59 1996 Lars Magne Ingebrigtsen Wed Oct 23 08:28:29 1996 Hrvoje Niksic - * gnus.texi (Fancy Mail Splitting): Removed trailing garbage. + * gnus.texi (Fancy Mail Splitting): Removed trailing garbage. Tue Oct 22 07:36:02 1996 Lars Magne Ingebrigtsen @@ -888,4 +1002,3 @@ Mon Jul 29 10:12:24 1996 Lars Magne Ingebrigtsen (Advanced Scoring Example): New. (Advanced Scoring Syntax): New. (Advanced Scoring): New. - diff --git a/texi/Makefile.in b/texi/Makefile.in index c205abe..77db83e 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -16,9 +16,12 @@ PERL=perl INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ SHELL = /bin/sh +PAPERTYPE=a4 all: gnus message +ja: gnus-ja message-ja + most: texi2latex.elc latex latexps .SUFFIXES: .texi .dvi .ps @@ -73,7 +76,7 @@ latexps: cat postamble.tex >> gnus.tmplatexi $(LATEX) gnus.tmplatexi $(LATEX) gnus.tmplatexi - $(DVIPS) -f gnus.dvi > gnus.ps + $(DVIPS) -t $(PAPERTYPE) -f gnus.dvi > gnus.ps pss: make latex @@ -87,25 +90,25 @@ psout: latexboth: rm -f gnus-manual-a4.ps.gz gnus-manual-standard.ps.gz make latexps - mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-a4.ps - gzip /local/tmp/larsi/gnus-manual-a4.ps - sed 's/,a4paper//' gnus.latexi > gnus-standard.latexi + mv gnus.ps gnus-manual-a4.ps + gzip gnus-manual-a4.ps + sed 's/,a4paper/,letterpaper/' gnus.latexi > gnus-standard.latexi mv gnus-standard.latexi gnus.latexi - make latexps - mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-standard.ps - gzip /local/tmp/larsi/gnus-manual-standard.ps + make latexps PAPERTYPE=letter + mv gnus.ps gnus-manual-standard.ps + gzip gnus-manual-standard.ps out: - cp /local/tmp/larsi/gnus-manual-standard.ps.gz \ - /local/tmp/larsi/gnus-manual-a4.ps.gz \ + cp gnus-manual-standard.ps.gz \ + gnus-manual-a4.ps.gz \ /local/ftp/pub/emacs/gnus/manual - mv /local/tmp/larsi/gnus-manual-standard.ps.gz \ - /local/tmp/larsi/gnus-manual-a4.ps.gz \ + mv gnus-manual-standard.ps.gz \ + gnus-manual-a4.ps.gz \ /hom/larsi/www_docs/www.gnus.org/documents veryclean: make clean - rm -f gnus.dvi gnus.ps + rm -f gnus.dvi gnus.ps texi2latex.elc distclean: make clean @@ -114,7 +117,7 @@ distclean: install: $(SHELL) $(top_srcdir)/mkinstalldirs $(infodir) - @for file in gnus message; do \ + @for file in gnus message gnus-ja message-ja; do \ for ifile in `echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \ if test -f $$ifile; then \ echo " $(INSTALL_DATA) $$ifile $(infodir)/$$ifile"; \ diff --git a/texi/dir b/texi/dir index 08eb94d..a169da0 100644 --- a/texi/dir +++ b/texi/dir @@ -5,6 +5,5 @@ File: dir Node: Top This is the Gnus Info tree * Menu: -* Gnus: (gnus). The news reader Gnus. -* Message: (message). The Message sending thingamabob. -* Emacs MIME: (emacs-mime). Libraries for handling MIME. +* Gnus: (gnus). The news reader Gnus. +* Message: (message). The Message sending thingamabob. diff --git a/texi/gnus-faq-ja.texi b/texi/gnus-faq-ja.texi new file mode 100644 index 0000000..31e588e --- /dev/null +++ b/texi/gnus-faq-ja.texi @@ -0,0 +1,468 @@ +@c Insert "\input texinfo" at 1st line before texing this file alone. +@c -*-texinfo-*- +@c Copyright (C) 1998 Keiichi Suzuki +@setfilename gnus-faq-ja.info + +@node Frequently Asked Questions +@section $BIQHK$K?R$M$i$l$kR2p!#(B +* Installation FAQ:: Gnus $B$NF3F~!#(B +* Customization FAQ:: Gnus $B$N%+%9%?%^%$%:!#(B +* Reading News FAQ:: $B%K%e!<%9$rFI$`;v$K4X$9$kR2p(B +$B$3$NJ8=q$O!"(B Semi-gnus $B$KBP$9$k$h$/$"$ke$GF0:n$9$k%M%C%H%K%e!<%9!&%j!<%@!<(B / $BEE;R%a!<%k!&%f!<(B +$B%6!$=$&$H7h0U$7$^$7$?!#(B + +$B$7$+$7!"(B Gnus $BC1FH$G$O(B MIME $B2=$5$l$?5-;v!&%a!<%k$rFI$`$3$H$O$G$-$^$;$s!#(B +$B$=$3$G!"(B Emacs $B>e$G(B MIME $B%5%]!<%H$r$9$k$?$a$N%Q%C%1!<%8$G$"$k(B SEMI $B$r;H(B +$BMQ$7$F0lIt$N?M$?$A$,(B Gnus $B$r;HMQ$9$k$h$&$K$J$j$^$7$?!#$7$+$7!"$3$l$K$O(B +Gnus $B$K(B patch $B$r$"$F$kI,MW$,$"$k>e$K%*%j%8%J%k$N(B Gnus ($B$3$A$i$b(B +Quassia-Gnus $B$H8F$P$l3+H/ESCf$G$7$?(B)$B$NJQ99FbMF$K$h$C$F$O$=$N(B patch $B<+BN(B +$B$b:n$jD>$5$J$1$l$P$J$j$^$;$s$G$7$?!#$=$s$J(B 1997$BG/$N(B11$B7n!" $B$O<~0O(B($B9%$-/62I]$r46$8$k$+$bCN$l$^$;$s!"$7$+$7!"(B +$B$"$J$?$,$=$N5!G=$rI,MW$K$J$k$^$G$OJ#;($J5!G=$N$[$H$s$I$rL5;k$9$k$3$H$,$G(B +$B$-$^$9!#(B $B$b$7!"$"$J$?$,$^$"$^$"$NNL$N%a%$%k$ro$KN.NL$NB?$$%a!<%j%s%0%j%9%H$K;22C(B +$B$7$F$$$k$N$G$"$l$P!"$"$J$?$O(B Semi-gnus $B$G%a%$%k$rFI$`$?$a$ND4::$r$O$8$a(B +$B$?$/$J$k$G$7$g$&!#(B + +$B$3$N(B FAQ $B$O!"NkLZ7=0l$K$h$C$FJ]$NJ}K!(B($B%a%$%k!"%M%C%H%K%e!<%9Ey(B)$B$G>pJs$rF@$h$&$H$9$kA0$K!"$^$:$3$N(B FAQ +$B$r8+$F$_$F$/$@$5$$!#(B + +$B$3$N>pJs$O(B Semi-gnus (Ja) $B%a%$%j%s%0!&%j%9%H$N1g=u$r!"(B APEL $B$,I,MW$K$J$j$^$9$,!"I,MW$J%P!<%8%g(B +$B%s$O(B FLIM / SEMI (WEMI) $B%Q%C%1!<%8Fb$N(B README $B$r;2>H$7$F$/$@$5$$!#(B + +Semi-gnus $B$N%P!<%8%g%s$O!"I,MW$J(B SEMI (WEMI) $B$*$h$S(B FLIM $B$N%P!<%8%g%s$K(B +$B?<$/4X78$7$F$$$^$9!#(B $BI,$:!"(B Semi-gnus $B$N%P!<%8%g%s$K$"$C$?(B SEMI (WEMI) +$B$*$h$S(B FLIM $B$r;HMQ$7$F$/$@$5$$!#(B + +$B8=:_!"$+$J$j$N%O%$%Z!<%9$G%P!<%8%g%s$,>e$,$C$F$$$^$9!#(B CVS $B$N(B main trunk +(tag $BL5$7(B) $B$,0BDj%P!<%8%g%s$G$9!#(B + +@item +Q1.2: $BF~l=j$+$il=j$+$ie!#(B + +@item +XEmacs + +$B%P!<%8%g%s(B 20.2 $B0J>e$N(BMule $B5!G=IU$-(B + +@item +Meadow + +$B%P!<%8%g%s(B 1.00 $B0J>e!#(B(Mule for Windows $B$G$OF0$-$^$;$s!#(B) +@end itemize + +$B;32,9nH~$5$s(B $B:n$NHs8x<0$N(B +@file{semi-mule23@@1934-YYMMDD.tar.gz} $B$r;HMQ$9$l$P(B Mule 2.3 / Emacs +19.34 $B$G$OF0:n$9$k$G$7$g$&!#(B + +$B$3$l$O!"J}$GF0$+$9$3$H$O$G$-$^$9$+(B? + +$B%=!<%9!&%l%Y%k(B( *.el )$B$G$O2DG=$G$9!#(B + +$B$7$+$7!"%P%$%H!&%3%s%Q%$%k$7$?%U%!%$%k(B ( *.elc ) $B$O6&M-$G$-$^$;$s$N$G!"(B +$B$=$l$>$l;HMQ$9$k(B emacs $B$G%P%$%H%3%s%Q%$%k$9$kI,MW$,$"$j$^$9!#(B + +@item +Q1.5: Semi-gnus $B$K$D$$$F$N>pJs8;$O(B? + +@table @var + +@item $B%K%e!<%9%0%k!<%W(B + +fj.news.reader.gnus $B$,$"$j$^$9$,!"(B Semi-gnus $B$K4X$7$F$N\$7$/$O!"(B@xref{Mailing list FAQ, $B%a!<%j%s%0%j%9%H(B}, $B$r;2>H$7$F$/$@$5$$!#(B + +$B8=:_!"$3$l$,$b$C$H$b3NpJs8;$G$7$g$&!#(B Semi-gnus $B$r;H$&$N$G$"$l$P!"(B +$B@'Hs;22C$9$k$3$H$r$*$9$9$a$7$^$9!#(B + +$B%@%$%8%'%9%HHG%5!<%S%9$O$"$j$^$;$s!#(B + +@item WWW + +$B8x<0$N(B Semi-gnus $B%[!<%`%Z!<%8$,$G$-$kM=Dj$G$9!#<9I.$J(B Jamie Zawinski $B$N:n$G!"(BGNU +Emacs $BMQ$N(Brolodex-like $B$J%G!<%?%Y!<%9%W%m%0%i%`$G$9!#(B Jamie $B$O(B BBDB $B$N(B +Web $B%Z!<%8$r;}$C$F$$$^$9!#(B @file{http://people.netscape.com/jwz/bbdb/}$B$3(B +$B$l$O!"l=j$K$"$j$^$9!#(B +@file{http://www.netcom.com/%7Esimmonmt/index.html} + +Semi-gnus $B$G;HMQ$9$k>l9g$K$O!"I,$:(B Q2.1 $B$r;2>H$7$F$/$@$5$$!#(B + +@item gnus-offline +gnus-offline $B$O!";T@nC#:H(B $B$N:n$G!"(B Semi-gnus +$B$r$$$o$f$k!V%*%U%i%$%s;HMQ!W(B($B%K%e!<%95-;v!"%a%$%k$NAwuBV$G9T$&(B)$B$9$k$3$H$rMF(B +$B0W$K$9$k$?$a$N%Q%C%1!<%8$G$9!#(B + +$BF~H$7$F2<$5$$!#(B + +@item +Q1.8: Semi-gnus $B$N5/F0$rAa$/$9$k$K$O(B? + +$B9XFI$7$F$$$J$$%0%k!<%W$r(B ``kill'' (*Group* $B%P%C%U%!!<$G(B C-k) $B$7$F$"$k$3(B +$B$H$r3NG'$7$F$/$@$5$$!#$=$7$F!">o$K(B ``.newsrc'' $B$r>.$5$/J]$D$h$&$K$7$F$/(B +$B$@$5$$!#(B + +@end itemize + +@node Customization FAQ +@subsection $B%+%9%?%^%$%:$K4X$9$k(B FAQ + +@itemize @bullet +@item +Q2.1: Semi-gnus $B$N%P!<%8%g%s$r$"$2$?$i(B BBDB $B$,F0$+$J$/$J$C$F$7$^$$$^$7$?!#(B + +Semi-gnus 6.8 $B0J9_$N%P!<%8%g%s$G$O!"%*%j%8%J%k$N(B bbdb-gnus.el $B$OF0:n$7$^(B +$B$;$s!#(B $BH$9$k$h$&$K$9$k!#(B + +$B$b$7!"%*%j%8%J%k$N(B Gnus (September $B0J9_(B) $B$r;H$C$F$$$k$N$G$"$l$P!"$3$NJ}(B +$BK!$,NI$$$G$7$g$&!#(B + +@item +bbdb/gnus-update-record $B$r(B gnus-article-prepare-hook $B$NBe$j$K(B +gnus-article-display-hook $B$KDI2C$9$k!#(B + +@end enumerate + +a $B$NJ}K!!"$*$h$S(B bbdb-user-mail-names $B$KBP1~$7$?(B BBDB 2.00.01 $B$KBP$9$k(B +patch $B!"4pK\E*$J@_DjNc$,!"(B +@file{http://www.mdcnet.co.jp/~keiichi/bbdb.shtml} $B$K$"$j$^$9!#(B + +@item +Q2.2: hook $B$r@_Dj$7$?$i(B Semi-gnus $B$NF0:n$,$*$+$7$/$J$C$?(B + +$BDL>o$NJQ?t$G$bF1MM$G$9$,!"(B Semi-gnus $B$G$OB?$/$N(B hook $B$K=i4|CM$,@_Dj$5$l(B +$B$F$$$^$9!#(B + +$B$3$NCM$rJQ99$7$h$&$H$7$F!"JQ?t$,Dj5A$5$l$F$$$k%U%!%$%k$r%m!<%I$9$kA0$K(B +setq / add-hook $BEy$r9T$&$H!"$3$l$i$N=i4|CM$,@_Dj$5$l$:!"(B Semi-gnus $B$,@5(B +$B>o$KF0:n$7$J$/$J$k>l9g$,$"$j$^$9!#(B($BFC$K(B Semi-gnus $B$N%P!<%8%g%s$,JQ$C$?>l(B +$B9g(B) + +$B$3$l$rKI$0$?$a$K$b!"(B Semi-gnus $B$K4X$9$k@_Dj$O$G$-$k$@$1(B ~/.gnus.el $BFb$G(B +$B9T$&$h$&$K$7$F$/$@$5$$!#(B + +@item +Q2.3: $B08@h$K$h$C$F(B Signature $B$rJQ99$9$k$K$O(B? + +SEMI $B$K$O(B signature.el $B$H$$$&$3$N$?$a$N%D!<%k$,IUB0$7$F$$$^$9!#;HMQJ}K!$O0J2<$N$H$*$j$G$9!#(B + +tm $B$N(B info $B$NFbMF$r(B SEMI $B$K9g$o$;$FJQ99$7$?$b$N$G$9!#(B + +SEMI $B$K$O(B *signature* $B$H$$$&(B signature $B$N<+F0@ZBX$((B tool $B$,ImB0$7$F$*$j!"(B +`semi-setup.el' $B$O$3$N@_Dj$b9T$J$$$^$9!#(Bmessage header $B$N(B field $B$K9g$o$;(B +$B$F(B signature $B$N<+F0@ZBX$r9T$J$$$?$$>l9g$O(B `~/.emacs' $B$K0J2<$N$h$&$J$b$N(B +$B$rF~$l$F2<$5$$!#!J>\$7$/$O(B signature.el $B$N@bL@=q$r;2>H$7$F2<$5$$!K(B + +@lisp +(setq signature-file-alist + '((("Newsgroups" . "jokes") . "~/.signature-jokes") + (("Newsgroups" . ("zxr" "nzr")) . "~/.signature-sun") + (("To" . ("ishimaru" "z-suzuki")) . "~/.signature-sun") + (("To" . "tea") . "~/.signature-jokes") + (("To" . ("sim" "oku" "takuo")) . "~/.signature-formal") + )) +@end lisp + +@defvar mime-setup-use-signature + +$B$3$NJQ?t$,(B @code{nil} $B0J30$N;~!"(B@file{signature.el} $B$r;H$$$^$9!#=i4|CM$O(B +@code{t} $B$G$9!#(B +@end defvar + +@defvar mime-setup-signature-key-alist + +$B3F(B major-mode $B$K$*$$$F(B signature $BA^F~L?Na$r@_Dj$9$Y$-(B key $B$r;XDj$7$^$9!#(B +$B=i4|CM$O(B + +@lisp + ((mail-mode . "\C-c\C-w")) +@end lisp + +$B$G$9!#(B + +$B$3$l$rJQ99$7$?$$>l9g$O!"4X?t(B set-alist $B$J$I$r;H$C$F$3$NJQ?t$r=q$-49$((B +$B$F2<$5$$!#(B + +@lisp +(set-alist 'mime-setup-signature-key-alist + 'news-reply-mode "\C-c\C-w") +@end lisp + +@end defvar + +@defvar mime-setup-default-signature-key + +$B$"$k(B major-mode $B$K$*$$$F(B signature $BA^F~L?Na$r@_Dj$9$Y$-(B key $B$,8+$D$+$i$J(B +$B$$>l9g!"$3$NJQ?t$K@_Dj$5$l$?(B key $B$,MQ$$$i$l$^$9!#=i4|CM$O!"(B +@code{"\C-c\C-s"} $B$G$9!#(B +@end defvar + +gnus-posting-style $B$r;HMQ$9$k;v$b$G$-$^$9!#(B + +@end itemize + +@node Reading News FAQ +@subsection $B%K%e!<%9$rFI$`(B + +@node Reading Mail FAQ +@subsection $B%a!<%k$rFI$`(B + +@node Mailing list FAQ +@subsection $B%a!<%j%s%0%j%9%H(B + +@itemize bullet +@item +Q5.1: $B%a%$%j%s%0!&%j%9%H$+$iC&B`$9$k$K$O(B? + +@table @var +@item $BF|K\8lMQ(B +@file{semi-gnus-ja-unsubscribe@@meadow.scphys.kyoto-u.ac.jp} $B$K6u$N%a%$(B +$B%k$rAw$C$F2<$5$$!#(B(Subject $B$bITMW$G$9!#(B) + +@item $B1Q8lMQ(B +@file{semi-gnus-en-unsubscribe@@meadow.scphys.kyoto-u.ac.jp} $B$K6u$N%a%$(B +$B%k$rAw$C$F2<$5$$!#(B(Subject $B$bITMW$G$9!#(B) + +@end table + +@item +Q5.2: $B%a%$%j%s%0!&%j%9%H$K;22C$9$k$K$O(B? + +Semi-gnus $B$G$O!"MxMQMh$NB?$/$N%Q%C%1!<%8$G:NMQ$5$l$F$$(B +$B$k3+H/BN@)$O$C$F$/$/$@$5$$!#(B(Subject $B$bITMW$G$9!#(B) + +@item $B1Q8lMQ(B +@file{semi-gnus-en-help@@meadow.scphys.kyoto-u.ac.jp} $B$K6u$N%a!<%k$rAw$C(B +$B$F!"Aw$i$l$F$/$k%a!<%k$N;X<($K=>$C$F$/$@$5$$!#(B(Subject $B$bITMW$G$9!#(B) + +@end table + +@item +Q5.3: Semi-gnus $B$K4X$9$kJ}?K7hDj$O(B? + +Semi-gnus $B$N3+H/Ey$K4X$9$kJ}?K$N7hDj$OA4$F(B Semi-gnus-ja/en $B%a!<%j%s%0%j(B +$B%9%HFb$G9T$o$l$^$9!#(B $B3F%a%s%P!<$+$i$NDs0F$O%"%s%1!<%H$N7A$GDs0F$5$l7h5D(B +$B$5$l$^$9$,!"$=$NJ}K!$Ol9g$KE,MQ$5$l$k!#(B $B;dE*$J;^$dHG$K4X(B +$B$7$F$OE,MQ$5$l$J$$!#(B + +@item +$B8xE*$J0F7o$NDs0F$*$h$S5DO@$O(B semi-gnus-ja@@meadow.scphys.kyoto-u.ac.jp $B$b(B +$B$7$/$O(Bsemi-gnus-en@@meadow.scphys.kyoto-u.ac.jp $B$G9T$&!#(B + +@item +$B:G=*E*$JJ}?K$O%"%s%1!<%H7k2L$NB??t0U8+$r:NMQ$9$k!#(B + +@item +$BDs0Fe$G$J$1$l(B +$B$P$J$i$J$$!#(B + +@item +$BDs0Fl9g!"Ds0FF|$h$j#1=54V8e$r2s(B +$BEz4|8B$H$9$k!#(B + +@item +$BDs0F0J>e$N2sEz$,$"$C(B +$B$?;~E@$G%"%s%1!<%H$N=*N;$r@k8@$G$-$k!#(B $B$3$N>l9g!"%"%s%1!<%H$NB??t0U8+$r(B +$B7kO@$H$9$k!#(B + +@item +$B2sEz4|8B$,2a$.$F$b!"#5L>0J>e$N2sEz$,$J$$>l9g$O!"Ds0Fe$N;22Cl9g!"2sEz4|8B$O1dD9(B +$B$5$l$k!#(B +@end enumerate + +@end itemize