From 3a75505b36e914f05480b86020edd727c6abe2fb Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 20 Jan 2002 22:23:06 +0000 Subject: [PATCH] Importing Oort Gnus v0.05. --- ChangeLog | 10 + GNUS-NEWS | 33 +- contrib/ChangeLog | 5 + lisp/ChangeLog | 1260 +++++++++++++++++++++++++++++++++++++++++++++----- lisp/Makefile.in | 2 +- lisp/canlock.el | 24 +- lisp/compface.el | 57 +++ lisp/flow-fill.el | 47 +- lisp/gnus-agent.el | 444 ++++++++++++++++-- lisp/gnus-art.el | 534 +++++++++++++-------- lisp/gnus-delay.el | 20 +- lisp/gnus-diary.el | 22 +- lisp/gnus-ems.el | 106 +---- lisp/gnus-fun.el | 231 +++++++++ lisp/gnus-group.el | 68 +-- lisp/gnus-int.el | 51 +- lisp/gnus-logic.el | 39 +- lisp/gnus-msg.el | 88 +++- lisp/gnus-picon.el | 172 +++---- lisp/gnus-score.el | 5 +- lisp/gnus-spec.el | 106 +++-- lisp/gnus-srvr.el | 43 +- lisp/gnus-start.el | 49 +- lisp/gnus-sum.el | 367 ++++++++++----- lisp/gnus-topic.el | 45 +- lisp/gnus-util.el | 81 +++- lisp/gnus-xmas.el | 96 ++-- lisp/gnus.el | 96 ++-- lisp/imap.el | 159 ++++--- lisp/message.el | 146 ++++-- lisp/mm-encode.el | 3 +- lisp/mm-util.el | 92 ++-- lisp/mm-view.el | 3 +- lisp/mml-smime.el | 5 +- lisp/mml.el | 90 +++- lisp/nnagent.el | 46 +- lisp/nneething.el | 68 ++- lisp/nnfolder.el | 15 +- lisp/nnimap.el | 47 +- lisp/nnkiboze.el | 19 +- lisp/nnmail.el | 24 +- lisp/nnmaildir.el | 101 ++-- lisp/nnml.el | 15 +- lisp/nnslashdot.el | 26 +- lisp/nnspool.el | 6 +- lisp/nntp.el | 107 +++-- lisp/nnvirtual.el | 17 +- lisp/rfc2047.el | 23 +- lisp/smiley-ems.el | 40 +- lisp/smiley.el | 8 +- texi/.cvsignore | 1 + texi/ChangeLog | 129 ++++++ texi/Makefile.in | 13 +- texi/emacs-mime.texi | 27 +- texi/gnus-faq.texi | 4 +- texi/gnus.texi | 740 ++++++++++++++++++++++------- texi/message.texi | 136 +++++- 57 files changed, 4712 insertions(+), 1499 deletions(-) create mode 100644 lisp/compface.el create mode 100644 lisp/gnus-fun.el diff --git a/ChangeLog b/ChangeLog index 7451506..b5e8a62 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2002-01-05 Lars Magne Ingebrigtsen + + * etc/gnus/oort.xface (X-Face): Oort X-Face from + Raymond Scholz . + +2002-01-02 ShengHuo ZHU + + * etc/gnus/describe-group.xpm: Set pixels of first line to + background color. A bug in Emacs? + 2001-12-18 Josh Huber * ChangeLog, todo: (oops) changed buffer-file-coding-system back diff --git a/GNUS-NEWS b/GNUS-NEWS index 4b8d5b5..dfbcd18 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -8,9 +8,40 @@ For older news, see Gnus info node "New Features". * Changes in Oort Gnus +** message-ignored-news-headers and message-ignored-mail-headers + +X-Draft-From and X-Gnus-Agent-Meta-Information have been added into +these two variables. If you customized those, perhaps you need add +those two headers too. + +** Gnus reads the NOV and articles in the Agent if plugged. + +If one reads an article while plugged, and the article already exists +in the Agent, it won't get downloaded once more. (setq +gnus-agent-cache nil) reverts to the old behavior. + +** Gnus supports the "format=flowed" (RFC 2646) parameter. + +On composing messages, it is enabled by `use-hard-newlines'. Decoding +format=flowed was present but not documented in earlier versions. + +** Gnus supports the generation of RFC 2298 Disposition Notification requests. + +This is invoked with the C-c M-n key binding from message mode. + +** Gnus supports Maildir groups. + +Gnus includes a new backend nnmaildir.el. + +** Printing capabilities are enhanced. + +Gnus supports Muttprint natively with O P from the Summary and Article +buffers. Also, each individual MIME part can be printed using p on +the MIME button. + ** Message supports the Importance: header. -In the message buffer, C-c C-p cycles through the valid values. +In the message buffer, C-c C-f C-i or C-u cycles through the valid values. ** Gnus supports Cancel Locks in News. diff --git a/contrib/ChangeLog b/contrib/ChangeLog index 2868fdb..9f58afd 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,8 @@ +2002-01-01 Lars Magne Ingebrigtsen + + * gnus-mdrtn.el (gnus-moderation-cancel-article): Insert an extra + newline. + 2001-12-26 Florian Weimer * gpg.el (gpg-command-default-alist): Using gpg-2comp is no longer diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d3071d5..48d7cb6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,1021 @@ +2002-01-20 05:33:30 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.05 is released. + +2002-01-20 Lars Magne Ingebrigtsen + + * nnkiboze.el (nnkiboze-generate-group): Make sure the directory + exists. + + * gnus-spec.el (gnus-string-width-function): New function. + (gnus-tilde-cut-form): Use it. + (gnus-tilde-max-form): Ditto. + (gnus-use-correct-string-widths): Default to (featurep 'xemacs). + (gnus-substring-function): Use it. + (gnus-tilde-cut-form): Ditto. + (gnus-substring-function): New function. + + * message.el (message-check-news-header-syntax): New message. + + * gnus.el (gnus-slave-no-server): Doc fix. + + * gnus-spec.el (gnus-use-correct-string-widths): Default to t. + +2002-01-15 Katsumi Yamaoka + + * gnus-sum.el (gnus-adjust-marked-articles): Fix the record for + `seen' if it looks like (seen NUM1 . NUM2). It should be + (seen (NUM1 . NUM2)). + +2002-01-20 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-catchup-articles): Update article + number in closed topics. + +2002-01-19 Daniel Pittman + + * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): New + functions. + +2002-01-19 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-find-parameter): Clean up. + + * gnus-sum.el (gnus-summary-goto-subject): Error on non-numerical + articles. + + * gnus-util.el (gnus-completing-read-with-default): Renamed. + + * nnmail.el (nnmail-article-group): Clean up. + +2002-01-19 Paul Stodghill + + * gnus-agent.el (gnus-category-name): Intern the category name. + +2002-01-19 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-move-group): Use gnus-topic-history. + + * gnus-util.el (gnus-completing-read): New function. + +2002-01-19 ShengHuo ZHU + + * gnus-art.el (gnus-add-wash-type): Use add-to-list. + + * smiley-ems.el (smiley-region): Register smiley. + (smiley-toggle-buffer): Rewrite the function. + (smiley-active): Removed. + +2002-01-19 Simon Josefsson + + * gnus-util.el (gnus-parent-id): Optimize null n case. From + Jesper Harder . + +2002-01-18 TSUCHIYA Masatoshi + + * gnus-art.el (gnus-request-article-this-buffer): Call + `nneething-get-file-name' to extract the file name from the + message id. + + * nneething.el (nneething-encode-file-name): New function. + (nneething-decode-file-name): Ditto. + (nneething-get-file-name): Ditto. + (nneething-make-head): Encode the file name and encapsulate it + into the field of the message id. + +2002-01-18 Simon Josefsson + + * nnml.el (nnml-request-update-info): Don't erase flags that isn't + stored in .marks. + + * nnfolder.el (nnfolder-request-update-info): Ditto. + +2002-01-18 ShengHuo ZHU + + * gnus-art.el (gnus-url-parse-query-string): Allow new line in value. + +2002-01-18 Simon Josefsson + + * imap.el (imap-starttls-p): Don't check for binary. + (imap-gssapi-auth-p): Ditto. + (imap-kerberos4-auth-p): Ditto. + (imap-open): Change logic. Iterate through all possible streams, + instead of bailing out after first failure. Move authenticator + decision to `imap-authenticate'. + (imap-authenticate): Change logic, now finds the authenticator to + use, was previously in `imap-open'. + (imap-open): Return nil on failure. + (imap-open): Setup temp buffer correctly. + (imap-open): Return buffer only on success. + (imap-interactive-login, imap-interactive-login): Tell the user + which stream/authenticator is used for the queried + username/password. + (imap-open, imap-authenticate): Set variables. + (imap-gssapi-auth-p, imap-kerberos4-auth-p): Fix typo. + (imap-open): Don't assume how `with-temp-buffer' is implemented. + +2002-01-17 Lars Magne Ingebrigtsen + + * gnus-fun.el (gnus-grab-cam-x-face): New function. + +2002-01-16 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-emphasis-alist): Allow matching "*this*.)". + +2002-01-17 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-toggle-group-plugged): New function. + (gnus-agent-group-mode-map): Bind it to "Jo". + (gnus-agent-group-make-menu-bar): Add it into menu bar. + +2002-01-17 Karl Kleinpaste + + * gnus-xmas.el (gnus-group-toolbar): Add .newsrc save button. + (gnus-summary-mail-toolbar): Add mail article deletion button. + + * smiley.el (smiley-deformed-regexp-alist): Eliminate noseless + false positives for lines of "^^^^". + + * gnus-picon.el (gnus-picon-find-face): faces database is all + lowercase. + +2002-01-17 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-retrieve-headers): Use correct buffer. + (gnus-agent-braid-nov): Switch back to nntp-server-buffer. Remove + duplications. + (gnus-agent-batch): Bind gnus-agent-confirmation-function. + +2002-01-16 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-initial-limit): Inline + gnus-summary-limit-children. + (gnus-summary-initial-limit): Don't limit if + gnus-newsgroup-display is nil. + (gnus-summary-initial-limit): No, don't. + + * gnus-util.el + (gnus-put-text-property-excluding-characters-with-faces): Inline + gnus-put-text-property. + + * gnus-spec.el (gnus-default-format-specs): New variable. + + * gnus-start.el (gnus-read-newsrc-file): Don't clear + gnus-format-specs. + (gnus-read-newsrc-el-file): Default to gnus-default-format-specs. + + * gnus-spec.el (gnus-update-format-specifications): Really check + the Gnus version of the .newsrc.eld file. + (gnus-format-specs): Save the new default summary format. + + * gnus-util.el (gnus-parent-id): Check whether references is empty + before splitting. + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Inline some + functions. + (gnus-gather-threads-by-references): Inline + `gnus-split-references'. + + * gnus-spec.el (gnus-summary-line-format-spec): New, optimized + default value of gnus-summary-line-format-spec. + +2002-01-15 ShengHuo ZHU + + * nnslashdot.el (nnslashdot-retrieve-headers-1): A better error + message. + (nnslashdot-request-list): Ditto. + (nnslashdot-sid-strip): Removed. + +2002-01-15 Simon Josefsson + + * nnimap.el (nnimap-close-asynchronous): Enable. + (nnimap-close-group): Expunge. + +2002-01-15 ShengHuo ZHU + + * gnus-util.el (gnus-user-date-format-alist): Typo. + From: Frank Schmitt + +2002-01-15 TSUCHIYA Masatoshi + + * nneething.el (nneething-request-article): Set + `nnmail-file-coding-system' to `binary' locally, in order to read + files without any conversion. + +2002-01-15 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-retrieve-headers): Use + nnheader-file-coding-system and nnmail-active-file-coding-system. + (gnus-agent-regenerate-group): Ditto. + (gnus-agent-regenerate): Ditto. + (gnus-agent-write-active): Ditto. + Suggested by Katsumi Yamaoka + +2002-01-14 ShengHuo ZHU + + * gnus-art.el (gnus-button-alist): Don't highlight + +2002-01-14 ShengHuo ZHU + + * gnus.el: We don't need gnus-article-show-all-headers. + + * gnus-art.el (article-show-all, gnus-article-show-all-header): + Ditto. + + * gnus-sum.el (gnus-summary-select-article): Don't call + show-all-headers, because hidden headers are not hidden text any + more. + +2002-01-13 Simon Josefsson + + * message.el (message-newline-and-reformat): Use `newline' instead + of inserting \n, so that the newline is marked as hard. + + * gnus-spec.el (gnus-pad-form): Don't evaluate EL multiple times. + From Jesper Harder . + +2002-01-12 ShengHuo ZHU + + * imap.el (imap-close): Keep going if quit. + + * gnus-agent.el (gnus-agent-retrieve-headers): Erase + nntp-server-buffer. + +2002-01-12 Lars Magne Ingebrigtsen + + * mm-view.el (mm-display-inline-fontify): Require font-lock to + avoid unbinding shadowed variables. + + * gnus-art.el (gnus-picon-databases): Moved here. + (gnus-picons-installed-p): Moved here. + (gnus-article-reply-with-original): Use `mark'. + + * gnus.el (gnus-picon): Moved here and renamed. + + * gnus-art.el (gnus-treat-from-picon): Only be on if picons are + installed. + (gnus-treat-mail-picon): Ditto. + (gnus-treat-newsgroups-picon): Ditto. + + * gnus-picon.el (gnus-picons-installed-p): New function. + +2002-01-12 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-go-online): Fix doc. + +2002-01-12 Simon Josefsson + + * nnimap.el (nnimap-need-unselect-to-notice-new-mail) + (nnimap-before-find-minmax-bugworkaround): Use it. + (nnimap-find-minmax-uid): Don't reselect current mailbox. + (nnimap-dont-close): New variable. + (nnimap-close-group): Use it. + +2002-01-12 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-reply-with-original): Use + `mark-active'. + + * gnus-msg.el (gnus-summary-reply): Don't bug out on regions. + + * gnus-logic.el (gnus-advanced-score-rule): Thinko fix. + (gnus-score-advanced): Clean up. + (gnus-score-advanced): Accept a multiple of the score. + +2002-01-12 Simon Josefsson + + * flow-fill.el (fill-flowed-display-column) + (fill-flowed-encode-columnq): New variables. Suggested by + Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,A_(Bjohann). + (fill-flowed-encode, fill-flowed): Use them. + + * message.el (message-send-news, message-send-mail): Use + m-b-s-n-p-e-h-n. + + * mml.el (autoload): Autoload fill-flowed-encode. + (mml-buffer-substring-no-properties-except-hard-newlines): New + function. + (mml-read-part): Use it. + (mml-generate-mime-1): Encode format=flowed if appropriate. + (mml-insert-mime-headers): Insert format=flowed. + + * flow-fill.el (fill-flowed-encode): New function. + (fill-flowed): Bind fill-column to window width. + +2002-01-12 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-buffer-name): Return the dead name if + it exists. + (gnus-summary-setup-buffer): Wake up dead summary buffers. + (gnus-summary-buffer-name): Don't return the dead name after all. + (gnus-summary-setup-buffer): Kill the dead buffer. + + * gnus-art.el (gnus-article-followup-with-original): Store the + value of the mark before deactivating it. + +2002-01-11 ShengHuo ZHU + + * gnus-fun.el (gnus-display-x-face-in-from): Fake it. + From: Karl Kleinpaste + + * gnus-art.el (article-display-x-face): Ditto. + (gnus-article-reply-with-original): Use gnus-region-active-p. + (gnus-article-followup-with-original): Ditto. + + * gnus-sum.el (gnus-summary-read-group-1): Don't select + downloadable article either. + +2002-01-11 ShengHuo ZHU + + * gnus-art.el (article-display-x-face): Insert From:. + + * gnus-sum.el (gnus-summary-move-article): Don't draw the + article. Bind gnus-display-mime-function and + gnus-article-prepare-hook. + + * gnus-agent.el (gnus-agent-retrieve-headers): Load agentview. + (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move + gnus-agent-possibly-synchronize-flags to the last. + (gnus-agent-go-online): New function. New variable. + +2002-01-11 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-regenerate-group): Add clean option. + (gnus-agent-regenerate): Ditto. + +2002-01-11 ShengHuo ZHU + + * message.el (message-ignored-news-headers) + (message-ignored-mail-headers): Add X-Gnus-Agent-Meta-Information:. + Suggested by ARISAWA Akihiro + + * gnus.el (gnus-gethash-safe): New macro. + + * gnus-agent.el (gnus-agent-regenerate-history): New function. + (gnus-agent-regenerate): Show messages. + +2002-01-11 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-regenerate-group): New function. + (gnus-agent-regenerate): New function. + (gnus-agent-save-alist): Sort. + (gnus-agent-copy-nov-line): Test eobp. + (gnus-agent-retrieve-headers): Erase buffer. + +2002-01-10 ShengHuo ZHU + + * mm-util.el (mm-charset-to-coding-system): Change charset to cs. + From: Torsten Hilbrich + + * gnus.el (gnus-agent-covered-methods): Move here. + (gnus-online): New function. + (gnus-agent-method-p): Move here. + + * nnagent.el (nnagent-retrieve-headers): Check whether arts is + nil. Remove articles-alist. + + * gnus-start.el (gnus-get-unread-articles): Check online. + (gnus-groups-to-gnus-format): Ditto. + (gnus-active-to-gnus-format): Ditto. + + * gnus-agent.el (gnus-agent-get-function): Use it. + (gnus-agent-get-undownloaded-list): Ditto. + (gnus-agent-fetch-session): Only fetch online methods. + + * gnus-srvr.el (gnus-server-make-menu-bar): Add offline. + (gnus-server-mode-map): Ditto. + (gnus-server-offline-face): New face. + (gnus-server-offline-face): New variable. + (gnus-server-font-lock-keywords): Add offline. + (gnus-server-insert-server-line): Ditto. + (gnus-server-offline-server): New function. + + * gnus-int.el (gnus-open-server): Turn to offline. + (gnus-server-unopen-status): New variable. + +2002-01-10 ShengHuo ZHU + + * nnkiboze.el (nnkiboze-request-article): Use + gnus-agent-request-article. + + * nnagent.el (nnagent-retrieve-headers): Don't use nnml + function. Insert undownloaded NOV. + + * gnus-agent.el (gnus-agent-retrieve-headers): New function. + (gnus-agent-request-article): New function. + + * gnus.el (gnus-agent-cache): New variable. + + * gnus-int.el (gnus-retrieve-headers): Use + gnus-agent-retrieve-headers. + (gnus-request-head): Use gnus-agent-request-article. + (gnus-request-body): Ditto. + + * gnus-art.el (gnus-request-article-this-buffer): Use + gnus-agent-request-article. + + * gnus-sum.el (gnus-summary-read-group-1): Don't show the first + article if it is undownloaded. + +2002-01-10 Katsumi Yamaoka + + * gnus-spec.el (gnus-spec-tab): Deal with wide characters. + +2002-01-09 Katsumi Yamaoka + + * canlock.el (canlock-string-as-unibyte): New macro. + (canlock-sha1-with-openssl): Return a unibyte string. + (canlock-make-cancel-key): Treat Message-ID as a unibyte string. + +2002-01-09 ShengHuo ZHU + + * gnus.el (gnus-expand-group-parameters): Match \N or \& only. + +2002-01-08 ShengHuo ZHU + + * mm-encode.el (mm-content-transfer-encoding-defaults): Add + application/x-emacs-lisp. + + * gnus-msg.el (gnus-bug): Use application/emacs-lisp. + + * nntp.el (nntp-request-article): Add group parameter. + (nntp-request-head): Ditto. + (nntp-find-group-and-number): Add parameter group. Figure out + number if the status line doesn't give (e.g. quimby.gnus.org). + +2002-01-08 Simon Josefsson + + * mml.el (mml-generate-mime-1): Set recipient correctly. + +2002-01-08 ShengHuo ZHU + + * message.el (message-read-from-minibuffer): Add parameter + initial-contents. + * gnus-msg.el (gnus-summary-resend-message): Use it. + + * gnus-group.el (gnus-group-read-ephemeral-group): Restore the old + behavior of quit-config. + + * message.el (message-make-from): Don't quote fullname. + From: Bj,Ax(Brn Mork + + * gnus-group.el (gnus-group-suspend): Don't kill message buffers. + From: + +2002-01-07 ShengHuo ZHU + + * gnus-group.el (gnus-group-mark-article-read): Typo. Increase n. + + * gnus-art.el (gnus-header-button-alist): Handle mailto. + + * mml.el (mml-preview): Bind gnus-original-article-buffer because + article-decode-group-name uses it. Bind gnus-article-prepare-hook + because bbdb may use it. + +2002-01-07 TSUCHIYA Masatoshi + + * nneething.el (nneething-request-article): When a non-text file + is converted to an article, its data is encoded in base64. Call + `nneething-make-head' with options to specify MIME types. + (nneething-make-head): Add optional arguments to specify MIME + types. + +2002-01-06 ShengHuo ZHU + + * gnus-fun.el (gnus-display-x-face-in-from): Fake a "From: " + header if there is not. + + * gnus-xmas.el (gnus-xmas-put-image): Insert " " if bobp. + + * gnus-msg.el (gnus-gcc-mark-as-read): New variable. + (gnus-inews-mark-gcc-as-read): Obsolete variable. + (gnus-inews-do-gcc): Use them. + + * gnus-group.el (gnus-group-mark-article-read): Put holes into + gnus-newsgroup-unselected. + +2002-01-06 Simon Josefsson + + * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): Use + condition-case, not ignore-errors. + +2002-01-06 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-insert-old-articles): Bind + gnus-fetch-old-headers. + + * gnus-art.el (article-display-x-face): Use the current buffer + unless `W f'. Otherwise, X-Face may be shown in the header of a + forwarded part. + (gnus-treatment-function-alist): Treat xface before hiding + headers. + +2002-01-06 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-read-ephemeral-group): Fix + parameters. + +2002-01-06 ShengHuo ZHU + + * mm-util.el (mm-multibyte-p): Define conditionally when load. + (mm-guess-charset): New function. + (mm-charset-after): Use it. + (mm-detect-coding-region): New function. + (mm-detect-mime-charset-region): New function. + + * gnus-sum.el (gnus-summary-show-article): Use + mm-detect-coding-region. + +2002-01-06 Lars Magne Ingebrigtsen + + * message.el (message-make-fqdn): Be less violent. + + * gnus.el (gnus-logo-color-style): Compute custom form + automatically. + + * gnus-sum.el (gnus-summary-enter-digest-group): Feed the adaptive + score file of the parent to the document group. + + * gnus-group.el (gnus-group-read-ephemeral-group): Add an optional + parameters parameter. + + * gnus-score.el (gnus-score-load-file): Clean up. + +2002-01-06 ShengHuo ZHU + + * gnus-sum.el (gnus-thread-sort-by-most-recent-number): Fix typo. + From: Damien Wyart + + * gnus-util.el (gnus-local-map-property): In Emacs 21, use keymap. + +2002-01-05 ShengHuo ZHU + + * gnus-sum.el (gnus-select-group-hook): Typo. + + * rfc2047.el (rfc2047-decode-string): Return immediately if there + is no quoted-printable-encoded STRING. + From: Jesper Harder + + (rfc2047-decode-string): Decode it. + +2002-01-05 Lars Magne Ingebrigtsen + + * gnus.el (gnus-logo-color-alist): Added more colors from Luis. + +2002-01-05 Keiichi Suzuki + + * nntp.el (nntp-possibly-change-group): Erase contents of nntp + buffer to get rid of junk line. + +2002-01-05 Simon Josefsson + + * message.el (message-mode-map): Bind message-goto-from to C-c C-f + C-o. + (message-mode-map): Bind message-insert-or-toggle-importance to + C-c C-u. + (message-mode-map): Bind message-disposition-notification-to to + C-c M-n. + (message-mode-menu): Add m-d-n-t. + (message-mode-field-menu): Add m-goto-from. + (message-mode): Doc fix. + (message-goto-from): New function. + (message-insert-disposition-notification-to): New function. + (message-tool-bar-map): Add receipt button. + +2002-01-05 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-thread-latest-date): New function. + (gnus-thread-sort-by-most-recent-number): Renamed. + (gnus-thread-sort-functions): Doc fix. + (gnus-select-group-hook): Don't use setq on a hook. + (gnus-thread-latest-date): Use date, not number + + * gnus-agent.el (gnus-agent-expire-days): Doc fix. + (gnus-agent-expire): Allow regexp of expire-days. + + * gnus-art.el (gnus-article-reply-with-original): Deactivate + region. + (gnus-article-followup-with-original): Ditto. + + * gnus-sum.el (gnus-thread-highest-number): Doc fix. + + * gnus-art.el (gnus-mime-display-alternative): Use + gnus-local-map-property. + (gnus-mime-display-alternative): Ditto. + (gnus-insert-mime-security-button): Ditto. + (gnus-insert-next-page-button): Ditto. + (gnus-button-prev-page): Take optional args. + (gnus-insert-prev-page-button): widget-convert. + + * gnus-util.el (gnus-local-map-property): New function. + + * gnus-art.el (gnus-prev-page-map): Use parent map. + (gnus-next-page-map): Ditto. + + * gnus-spec.el (gnus-parse-format): Clean up. + (gnus-parse-format): Do complex formatting for %=. + + * gnus-fun.el (gnus-display-x-face-in-from): Add the string + "X-Face: " to the data in the built-in scenario. + + * gnus-spec.el (gnus-parse-simple-format): Use gnus-pad-form. + (gnus-correct-pad-form): Renamed. + (gnus-tilde-max-form): Clean up. + (gnus-pad-form): Use gnus-use-correct-string-widths. + + * gnus-fun.el (gnus-display-x-face-in-from): Use native xface + support if that is available. + + * gnus-sum.el (gnus-thread-highest-number): New function. + (gnus-thread-sort-by-most-recent-thread): New function. + (gnus-thread-sort-functions): Doc fix. + +2002-01-04 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-select-article): Disable multibyte in + all cases. + (gnus-summary-mode): Enable it in all cases. + (gnus-summary-display-article): Ditto. + (gnus-summary-edit-article): Ditto. + + * gnus-ems.el (gnus-put-image): Really return glyph. + + * gnus-art.el (gnus-article-x-face-command): Fix :type. + (gnus-treat-smiley): Don't take "P" in the interactive form. + +2002-01-04 Lars Magne Ingebrigtsen + + * compface.el (uncompface): XEmacs and Emacs have differing + capabilities. + + * gnus-fun.el (gnus-display-x-face-in-from): Use face. + + * gnus-ems.el (gnus-article-xface-ring-internal): Removed. + (gnus-article-xface-ring-size): Removed. + (gnus-article-display-xface): Removed. + (gnus-remove-image): Cleaned up. + + * gnus-xmas.el (gnus-xmas-create-image): Convert pbm to xbm. + (gnus-xmas-create-image): Take pbm files. + (gnus-x-face): Removed. + (gnus-xmas-article-display-xface): Removed. + + * gnus-fun.el (gnus-display-x-face-in-from): Bind + default-enable-multibyte-characters. + + * compface.el (uncompface): Doc fix. + + * gnus-art.el (gnus-article-x-face-command): Use + gnus-display-x-face-in-from. + + * gnus-xmas.el (gnus-xmas-put-image): Return the image. + + * gnus-ems.el (gnus-put-image): Return the image. + + * gnus-fun.el (gnus-display-x-face-in-from): New function. + (gnus-x-face): Moved here. + +2002-01-04 ShengHuo ZHU + + * gnus-xmas.el (gnus-xmas-put-image): Don't insert SPC or make + invisible if string is nil. + (gnus-xmas-article-display-xface): Use it. + + * gnus-ems.el (gnus-put-image): Explicitly use SPC, and add text + property when string is nil. + (gnus-article-display-xface): Use it. + +2002-01-04 Lars Magne Ingebrigtsen + + * gnus-art.el (article-display-x-face): Check whether valid grey + face was returned. + (article-display-x-face): Place image in the right spot. + + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Get rid of + stderr. + (gnus-convert-gray-x-face-to-xpm): Check whether output is valid. + +2002-01-03 Lars Magne Ingebrigtsen + + * gnus-xmas.el (gnus-xmas-create-image): Take optional + parameters. + (gnus-xmas-put-image): Allow non-strings to be passed. + + * gnus-art.el (article-display-x-face): Use optional parameters. + + * gnus-ems.el (gnus-create-image): Take optional parameters. + + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface. + + * compface.el (compface-xbm-p): Removed. + + * gnus-ems.el (gnus-article-compface-xbm): Removed. + (gnus-article-display-xface): Use compface. + + * compface.el: New file. + + * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Remove quotes. + (gnus-convert-image-to-x-face-command): Ditto. + (gnus-random-x-face): Quote argument. + (gnus-x-face-from-file): Ditto. + +2002-01-03 Paul Jarc + + * nnmaildir.el (nnmaildir-request-expire-articles): evaluate + the expire-group parameter once per article rather than once + per group; bind `nnmaildir-article-file-name' and `article' + for convenience. Leave article alone when expire-group + specifies the current group. + (nnmaildir--update-nov): be more concurrency-friendly with + temp file names. + +2002-01-03 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-read-init-file): Cleaned up. + +2002-01-03 Dave Love + + * gnus-start.el (gnus-startup-file-coding-system): Removed. + (gnus-read-init-file): Don't use it. + +2002-01-03 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-session): Run hook. + +2002-01-03 Kai Gro,A_(Bjohann + + * gnus-start.el (gnus-read-init-file): Don't force coding system + for ~/.gnus. From Dave Love . + +2002-01-03 ShengHuo ZHU + + * nntp.el (nntp-send-buffer): Use mm-with-unibyte-current-buffer. + * nnspool.el (nnspool-request-post): Ditto. + + * mm-util.el (mm-use-find-coding-systems-region): New variable. + (mm-find-mime-charset-region): Use it. + +2002-01-03 Per Abrahamsen + + * gnus.el (gnus-summary-line-format): Added :link. + * gnus-topic.el (gnus-topic-line-format): Ditto. + * gnus-sum.el (gnus-summary-dummy-line-format): Ditto. + * gnus-srvr.el (gnus-server-line-format): Ditto. + * gnus-group.el (gnus-group-line-format): Ditto. + + * gnus-sum.el (gnus-summary-make-menu-bar): Use correct syntax for + :keys, it works on both Emacsen. + +2002-01-03 ShengHuo ZHU + + * mm-util.el (mm-charset-to-coding-system): Don't setq charset. + +2002-01-03 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-summary-send-map): Fix binding for very-wide. + +2002-01-03 Reiner Steib + + * gnus-sum.el (gnus-summary-make-menu-bar): Menu bar entries for + very wide reply. + +2002-01-03 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picon-transform-address): Cache stuff. + (gnus-picon-cache): New variable. + (gnus-picon-transform-newsgroups): Cache stuff. + + * gnus-art.el (gnus-article-reply-with-original): New command. + (gnus-article-followup-with-original): New command. + + * gnus-msg.el (gnus-copy-article-buffer): Take optional BEG and + END parameters. + (gnus-summary-followup): Take a list of list of articles. + (gnus-inews-yank-articles): Allow lists of article/regions. + + * gnus-art.el (gnus-article-read-summary-keys): `R' and `F' are no + longer the usual commands. + + * gnus-fun.el (gnus-convert-image-to-gray-x-face): Use pnmnoraw. + (gnus-convert-gray-x-face-to-xpm): Don't use six parameters to + shell-command-on-region. + +2002-01-02 ShengHuo ZHU + + * gnus-picon.el (gnus-picon-transform-newsgroups): Fix for the case + "Newsgroups: rec.music.beatles.moderated, rec.music.beatles". + +2002-01-03 Steve Youngs + + * gnus-sum.el (gnus-summary-make-menu-bar): XEmacs doesn't + understand ':keys', wrap it in an featurep 'xemacs. + +2002-01-02 ShengHuo ZHU + + * gnus-ems.el (gnus-article-display-xface): Show xface in the + order of headers (Actually, it is called in a reversed order). Add + 'gnus-image-text-deletable property. + (gnus-remove-image): Remove text with such a property. + + * gnus-xmas.el (gnus-xmas-article-display-xface): Don't use + gnus-put-image. + + * gnus-art.el (gnus-article-treat-fold-newsgroups): Replace ", *" + with ", " + +2002-01-02 Lars Magne Ingebrigtsen + + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed. + + * gnus-art.el (gnus-ignored-headers): Hide all X-Faces. + (article-display-x-face): Display grey X-Faces. + + * gnus-fun.el (gnus-convert-gray-x-face-region): New function. + (gnus-convert-gray-x-face-to-ppm): Ditto. + (gnus-convert-image-to-gray-x-face): Ditto. + + * gnus-sum.el (gnus-summary-make-menu-bar): Add a :keys to + gnus-summary0show-raw-article. + +2002-01-02 ShengHuo ZHU + + Display picons in XEmacs without showing text. + + * gnus-xmas.el (gnus-xmas-create-image): Don't use + mm-create-image-xemacs to create xbm glyph, because it deletes + temporary files. + (gnus-xmas-put-image): Use end-glyph. Make text invisible. + (gnus-xmas-remove-image): Make text visible, remove glyph. + + * gnus-picon.el (gnus-picon-transform-newsgroups) + (gnus-picon-transform-address): Insert spec backward, due to the + incompatibility of gnus-xmas-put-image. + +2002-01-02 Pavel Jan,Bm(Bk + + * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Doc fix. + +2002-01-02 Lars Magne Ingebrigtsen + + * gnus.el: Doc fix. + + * gnus-art.el: Doc fix. + + * gnus-agent.el: Doc fix. + +2002-01-01 ShengHuo ZHU + + * gnus-diary.el, gnus-delay.el: Fix copyright lines. + +2002-01-01 Paul Jarc + + * nnmaildir.el (nnmaildir--update-nov): automatically parse + NOV data out of the message again if nnmail-extra-headers has + changed. + +2002-01-02 Lars Magne Ingebrigtsen + + * gnus-fun.el: New file. + (gnus-convert-image-to-x-face-command): New variable. + (gnus-insert-x-face): New function. + (gnus-random-x-face): Renamed. + (gnus-x-face-from-file): Renamed. + + * gnus-art.el (gnus-body-boundary-delimiter): Changed default to + "_". + (gnus-body-boundary-delimiter): Typo fix. + +2002-01-02 Simon Josefsson + + * gnus-art.el (gnus-article-treat-body-boundary): Handle nil. + (gnus-body-boundary-delimiter): Fix type. + +2002-01-01 Simon Josefsson + + * gnus-art.el (gnus-treat-buttonize, gnus-treat-buttonize-head) + (gnus-treat-emphasize, gnus-treat-strip-cr) + (gnus-treat-leading-whitespace, gnus-treat-hide-headers) + (gnus-treat-hide-boring-headers, gnus-treat-hide-signature) + (gnus-treat-fill-article, gnus-treat-hide-citation) + (gnus-treat-hide-citation-maybe) + (gnus-treat-strip-list-identifiers, gnus-treat-strip-pgp) + (gnus-treat-strip-pem, gnus-treat-strip-banner) + (gnus-treat-highlight-headers, gnus-treat-highlight-citation) + (gnus-treat-date-ut, gnus-treat-date-local) + (gnus-treat-date-english, gnus-treat-date-lapsed) + (gnus-treat-date-original, gnus-treat-date-iso8601) + (gnus-treat-date-user-defined, gnus-treat-strip-headers-in-body) + (gnus-treat-strip-trailing-blank-lines) + (gnus-treat-strip-leading-blank-lines) + (gnus-treat-strip-multiple-blank-lines) + (gnus-treat-unfold-headers, gnus-treat-fold-headers) + (gnus-treat-fold-newsgroups, gnus-treat-overstrike) + (gnus-treat-display-xface, gnus-treat-display-smileys) + (gnus-treat-from-picon, gnus-treat-mail-picon) + (gnus-treat-newsgroups-picon, gnus-treat-body-boundary) + (gnus-treat-capitalize-sentences, gnus-treat-fill-long-lines) + (gnus-treat-play-sounds, gnus-treat-translate) + (gnus-treat-x-pgp-sig): Doc fix, add link to manual. + + * gnus-art.el (gnus-body-boundary-delimiter): New variable. + (gnus-article-treat-body-boundary): Use it. + + * message.el (message-mode): Fix doc. + (message-mode-menu): Fix names. + +2002-01-01 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-first-subject): Really go to unseen + articles. + + * gnus-picon.el (gnus-picon-find-face): Search MISC for all types. + (gnus-picon-transform-address): Search for unknown faces as well. + (gnus-picon-find-face): Don't search "news" for MISC. + (gnus-picon-user-directories): Changed default back to exclude + "unknown". + + * gnus-sum.el (gnus-summary-hide-all-threads): Reversed logic. + + * gnus-picon.el (gnus-picon-find-face): Search through all + databases. + (gnus-picon-find-face): New implementation. + + * gnus-topic.el (gnus-topic-goto-previous-topic): New command and + keystroke. + (gnus-topic-goto-next-topic): Ditto. + + * gnus.el (gnus-summary-line-format): Changed default. + + * nnmail.el (nnmail-extra-headers): Change default. + + * gnus-sum.el (gnus-extra-headers): Change default. + + * message.el (message-news-other-window): Changed "news" to + "posting". + (message-news-other-frame): Ditto. + (message-do-send-housekeeping): Ditto. + + * gnus-sum.el (gnus-summary-maybe-hide-threads): Use predicate + function. + (gnus-article-unread-p): New function. + (gnus-article-unseen-p): New function. + (gnus-dead-summary-mode-map): Typo. + + * gnus-util.el (gnus-make-predicate): New function. + (gnus-make-predicate-1): New function. + + * gnus-sum.el: New function. + (gnus-map-articles): New function. + + * gnus-art.el (gnus-treat-fold-headers): New variable. + (gnus-article-treat-fold-headers): New command and keystroke. + + * gnus-sum.el (gnus-dead-summary-mode-map): Clean up. + (gnus-dead-summary-mode-map): Bind q to bury-buffer. + +2002-01-01 ShengHuo ZHU + + * message.el (message-fcc-externalize-attachments): New variable. + (message-do-fcc): Use it. + + * gnus-msg.el (gnus-gcc-externalize-attachments): New variable. + (gnus-inews-do-gcc): Use it. + + * mml.el (mml-tweak-sexp-alist): New variable. + (mml-externalize-attachments): New variable. + (mml-tweak-part): Use mml-tweak-sexp-alist. + (mml-tweak-externalize-attachments): New function. + +2002-01-01 Steve Youngs + + * gnus-xmas.el (gnus-xmas-article-display-xface): Uncomment + 'set-glyph-face' so x-face back/foreground can be set. + +2001-12-31 ShengHuo ZHU + + * message.el (message-fix-before-sending): Fix a typo. + +2002-01-01 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-smiley): Renamed command. + (gnus-article-remove-images): New command and keystroke. + + * gnus-sum.el (gnus-summary-toggle-smiley): Removed. + + * smiley-ems.el (gnus-smiley-display): Removed. + + * gnus.el (gnus-version-number): Update version. + + * message.el (message-text-with-property): Renamed and moved + here. + (message-fix-before-sending): Highlight invisible text and place + point there. + +2002-01-01 02:32:53 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.04 is released. + 2002-01-01 Lars Magne Ingebrigtsen * gnus-delay.el (gnus-delay-send-queue): Renamed. @@ -5,30 +1023,30 @@ * gnus-art.el (gnus-ignored-headers): More headers, * ietf-drums.el (ietf-drums-parse-addresses): Use `error' instead - of `scan-error', since XEmacs doesn't seem to support that. + of `scan-error', since XEmacs doesn't seem to support that. 2001-12-31 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-best-unread-article): Take a prefix - arg. + arg. (gnus-summary-best-unread-subject): Ditto. (gnus-summary-best-unread-subject): No, don't. (gnus-summary-better-unread-subject): New command. - * gnus-xmas.el (gnus-xmas-put-image): Insert the string itself. + * gnus-xmas.el (gnus-xmas-put-image): Insert the string itself. * lpath.el ((featurep 'xemacs)): fbind url function. * gnus-xmas.el (gnus-xmas-article-display-xface): Use data, not - buffer. - (gnus-xmas-remove-image): Implementation that does something. + buffer. + (gnus-xmas-remove-image): Implementation that does something. (gnus-xmas-article-display-xface): Mark images properly. - * gnus-art.el (gnus-mime-print-part): Use mm-temp-directory. + * gnus-art.el (gnus-mime-print-part): Use mm-temp-directory. 2001-12-31 Florian Weimer - * gnus.el (gnus): Warn if trying to run Gnus un-byte-compiled. + * gnus.el (gnus): Warn if trying to run Gnus un-byte-compiled. 2001-12-31 Lars Magne Ingebrigtsen @@ -36,7 +1054,7 @@ value. * gnus-util.el (gnus-text-with-property): The smallest point is - point-min. + point-min. * smiley-ems.el (smiley-region): Return images. (gnus-smiley-display): Allow toggling. @@ -63,7 +1081,7 @@ * gnus-art.el (gnus-delete-images): New function. - * gnus-ems.el (gnus-article-display-xface): Mark and store image. + * gnus-ems.el (gnus-article-display-xface): Mark and store image. * gnus-art.el (gnus-article-wash-status-entry): Renamed. (gnus-article-wash-status): Use it. @@ -76,7 +1094,7 @@ * gnus-ems.el (gnus-article-display-xface): Use new interface. * gnus-xmas.el (gnus-xmas-article-display-xface): Use new - interface. + interface. * gnus-art.el (article-display-x-face): Cleaned up. @@ -98,7 +1116,7 @@ looked for when REQUEST is a string. * gnus-art.el (gnus-mime-button-commands): Add printing - keystroke. + keystroke. (gnus-mime-copy-part): Doc fix. (gnus-mime-print-part): New command. @@ -119,7 +1137,7 @@ 2001-12-30 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-treat-fold-newsgroups): Don't - infloop. + infloop. * gnus-sum.el (t): New `W D' map. @@ -136,7 +1154,7 @@ * rfc2047.el (rfc2047-fold-line): New function. (rfc2047-unfold-line): Ditto. - (rfc2047-fold-region): Don't fold just after the header name. + (rfc2047-fold-region): Don't fold just after the header name. * mail-parse.el (mail-header-fold-line): New alias. (mail-header-unfold-line): Ditto. @@ -163,16 +1181,16 @@ 2001-12-30 Lars Magne Ingebrigtsen * gnus-art.el (gnus-body-separator-face): New variable. - (gnus-article-treat-body-boundary): Use a blank, colored line. + (gnus-article-treat-body-boundary): Use a blank, colored line. * gnus-picon.el (gnus-picon-find-face): Look into misc/MISC as - well. + well. * gnus-art.el (gnus-treat-body-boundary): New variable. (gnus-article-treat-unfold-headers): Use helper macro. (gnus-article-treat-body-boundary): New command. - * gnus.el (gnus-logo-color-style): Change the default color. + * gnus.el (gnus-logo-color-style): Change the default color. (gnus-splash-face): Gray, gray. * gnus-xmas.el (gnus-xmas-group-startup-message): Use general @@ -184,13 +1202,13 @@ * gnus-picon.el (gnus-picon-create-glyph): Cache glyphs. - * gnus-art.el (gnus-treat-newsgroups-picon): New variable. + * gnus-art.el (gnus-treat-newsgroups-picon): New variable. * gnus-picon.el (gnus-treat-newsgroups-picon): New function. (gnus-picon-transform-newsgroups): New function. * ietf-drums.el (ietf-drums-parse-addresses): Accept a nil - string. + string. * gnus-picon.el (gnus-treat-mail-picon): Renamed. @@ -207,7 +1225,7 @@ (gnus-treat-cc-picon): New command. * mm-decode.el (mm-create-image-xemacs): Separated out into - function. + function. (mm-get-image): Use it. * gnus-art.el (gnus-treat-display-picons): Simplify. @@ -239,11 +1257,11 @@ * gnus-art.el (gnus-treat-unfold-lines): New variable. (gnus-treat-unfold-headers): Remamed. - (gnus-article-treat-unfold-headers): New command and keystroke. + (gnus-article-treat-unfold-headers): New command and keystroke. * rfc2047.el (rfc2047-encode-message-header): Clean up. - * gnus-int.el (gnus-open-server): Mark quit-ed server as denied. + * gnus-int.el (gnus-open-server): Mark quit-ed server as denied. 2001-12-29 ShengHuo ZHU @@ -257,7 +1275,7 @@ 2001-12-29 Lars Magne Ingebrigtsen * gnus-picon.el (gnus-picons-news-directories): Removed obsolete - alias. + alias. (gnus-picons-database): Default to list. (gnus-picons-lookup-internal): Use it. @@ -268,56 +1286,56 @@ 2001-12-29 Sascha L,A|(Bdecke - * gnus-win.el (gnus-configure-windows): Minimize tree buffer. + * gnus-win.el (gnus-configure-windows): Minimize tree buffer. 2001-12-29 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-update-marks): Don't uncompress the seen - lists. + lists. (gnus-select-newsgroup): Don't append; push. (gnus-adjust-marked-articles): Remove obsolete ranges from - `seen'. + `seen'. (gnus-update-marks): Clean up. (gnus-select-newsgroup): Don't stomp gnus-newsgroup-seen. 2001-12-29 Frank Schmitt - * gnus-sum.el (gnus-summary-limit-to-age): Allow negative days. + * gnus-sum.el (gnus-summary-limit-to-age): Allow negative days. 2001-12-29 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-auto-select-subject): New variable. (gnus-summary-best-unread-subject): New function. (gnus-summary-best-unread-article): Use it. - (gnus-summary-first-unseen-subject): New function and command. + (gnus-summary-first-unseen-subject): New function and command. * gnus-art.el (gnus-treatment-function-alist): Emphasize after other treatments. * gnus-util.el (gnus-put-overlay-excluding-newlines): New - function. + function. * gnus-art.el (gnus-article-show-hidden-text): Remove the type - from the list of hidden types. + from the list of hidden types. * mm-view.el (mm-inline-text): Ditto. (mm-inline-text): Ditto. (mm-w3-prepare-buffer): Ditto. - * gnus-art.el (article-wash-html): Inhibit more remote fetching. + * gnus-art.el (article-wash-html): Inhibit more remote fetching. 2001-12-29 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-ignored-headers): Added more headers. + * gnus-art.el (gnus-ignored-headers): Added more headers. 2001-12-29 Jesper Harder * gnus-srvr.el (gnus-browse-foreign-server): Compute the prefix - once. + once. 2001-12-29 Lars Magne Ingebrigtsen - * gnus-srvr.el (gnus-server-browse-in-group-buffer): Doc fix. + * gnus-srvr.el (gnus-server-browse-in-group-buffer): Doc fix. 2001-12-28 Simon Josefsson @@ -340,7 +1358,7 @@ From Jesper Harder 2001-12-26 Paul Jarc - + * nnmaildir.el (nnmaildir-save-mail): create the destination groups if they do not exist. @@ -360,17 +1378,17 @@ return it. 2001-12-21 Paul Jarc - + * gnus.el (gnus-valid-select-methods): Include nnmaildir. * nnmaildir.el (top-level): Add commentary. (nnmaildir-version): Indicate that nnmaildir is now a standard - part of Gnus, not separately released. - + part of Gnus, not separately released. + 2001-12-21 08:00:00 ShengHuo ZHU * gnus-art.el, gnus-picon.el, gnus-sieve.el, gnus-sum.el: * gnus-xmas.el, imap.el, mailcap.el, mm-util.el, nnfolder.el: - * nnheader.el, nnmail.el: Nil/NIL vs. nil. + * nnheader.el, nnmail.el: Nil/NIL vs. nil. From Pavel Jan,Bm(Bk 2001-12-20 15:00:00 ShengHuo ZHU @@ -386,7 +1404,7 @@ 2001-12-19 17:00:00 ShengHuo ZHU - * nnmaildir.el: New. + * nnmaildir.el: New file. From Paul Jarc . 2001-12-19 16:00:00 ShengHuo ZHU @@ -400,7 +1418,7 @@ 2001-12-19 01:00:00 ShengHuo ZHU - * gnus-win.el (gnus-frames-on-display-list): New. + * gnus-win.el (gnus-frames-on-display-list): New function. (gnus-get-buffer-window): Use it. 2001-12-19 00:00:00 ShengHuo ZHU @@ -410,15 +1428,15 @@ 2001-12-18 11:00:00 ShengHuo ZHU * gnus-win.el (gnus-get-buffer-window): Use gnus-delete-if. - + 2001-12-18 11:00:00 ShengHuo ZHU From Harald Meland * gnus-win.el (gnus-get-buffer-window): New function. (gnus-all-windows-visible-p): Use it. - * gnus-util.el (gnus-horizontal-recenter) - (gnus-horizontal-recenter, gnus-horizontal-recenter) + * gnus-util.el (gnus-horizontal-recenter) + (gnus-horizontal-recenter, gnus-horizontal-recenter) (gnus-horizontal-recenter, gnus-set-window-start): Use it. * gnus-score.el (gnus-score-insert-help): Use it. @@ -498,26 +1516,26 @@ 2001-12-13 20:00:00 ShengHuo ZHU - * uudecode.el (uudecode-use-external): New. + * uudecode.el (uudecode-use-external): New variable. (uudecode-decode-region): Automatically detect external program. - * binhex.el (binhex-use-external): New. - (binhex-decode-region-internal): New. + * binhex.el (binhex-use-external): New variable. + (binhex-decode-region-internal): New function. (binhex-decode-region): Automatically detect external program. - - * mm-uu.el (mm-uu-decode-function): - (mm-uu-binhex-decode-function): Use them. + + * mm-uu.el (mm-uu-decode-function,mm-uu-binhex-decode-function): + Use them. 2001-12-12 Simon Josefsson - * nnvirtual.el (nnvirtual-always-rescan) + * nnvirtual.el (nnvirtual-always-rescan) (nnvirtual-component-regexp): Fix doc. * nnoo.el (defvoo): Add doc to defvoo variables. - * nnml.el (nnml-directory, nnml-active-file) - (nnml-newsgroups-file, nnml-get-new-mail, nnml-nov-is-evil) - (nnml-marks-is-evil, nnml-filenames-are-evil) + * nnml.el (nnml-directory, nnml-active-file) + (nnml-newsgroups-file, nnml-get-new-mail, nnml-nov-is-evil) + (nnml-marks-is-evil, nnml-filenames-are-evil) (nnml-prepare-save-mail-hook, nnml-inhibit-expiry): Fix doc. * nnmh.el (nnmh-directory, nnmh-get-new-mail) @@ -525,15 +1543,15 @@ (nnmh-possibly-change-directory): Use `nnheader-report' instead of `error'. - * nnmbox.el (nnmbox-mbox-file, nnmbox-active-file) - (nnmbox-get-new-mail, nnmbox-prepare-save-mail-hook): + * nnmbox.el (nnmbox-mbox-file, nnmbox-active-file) + (nnmbox-get-new-mail, nnmbox-prepare-save-mail-hook): - * nnfolder.el (nnfolder-directory, nnfolder-active-file) - (nnfolder-newsgroups-file, nnfolder-get-new-mail) - (nnfolder-save-buffer-hook, nnfolder-inhibit-expiry) + * nnfolder.el (nnfolder-directory, nnfolder-active-file) + (nnfolder-newsgroups-file, nnfolder-get-new-mail) + (nnfolder-save-buffer-hook, nnfolder-inhibit-expiry) (nnfolder-nov-is-evil, nnfolder-marks-is-evil): Fix doc. - * nnbabyl.el (nnbabyl-mbox-file, nnbabyl-active-file) + * nnbabyl.el (nnbabyl-mbox-file, nnbabyl-active-file) (nnbabyl-get-new-mail, nnbabyl-prepare-save-mail-hook): Fix doc. * imap.el, nnimap.el: Fix indentation. @@ -605,7 +1623,7 @@ 2001-12-07 01:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-print-truncate-and-quote): New. + * gnus-sum.el (gnus-summary-print-truncate-and-quote): New function. (gnus-summary-print-article): Use it. * gnus-util.el (gnus-replace-in-string): Typo. @@ -659,7 +1677,7 @@ 2001-12-03 09:00:00 ShengHuo ZHU - * mm-url.el: New. + * mm-url.el: New file. * nnslashdot.el: Use it. * mm-extern.el (mm-extern-url): Use it. @@ -821,8 +1839,8 @@ 2001-11-20 09:00:00 ShengHuo ZHU - * mm-util.el (mm-coding-system-priorities): New. - (mm-sort-coding-systems-predicate): New. + * mm-util.el (mm-coding-system-priorities): New variable. + (mm-sort-coding-systems-predicate): New function. (mm-find-mime-charset-region): Resort coding systems if needed. Suggested by Katsumi Yamaoka . @@ -1162,7 +2180,7 @@ not-subscribed -> subscribed. 2001-10-31 08:00:00 ShengHuo ZHU - From: Josh Huber + From: Josh Huber * message.el (message-subscribed-address-functions): New variable. (message-subscribed-addresses): New variable. @@ -1171,7 +2189,7 @@ (message-send-mail): Add Mail-Followup-To. (message-make-mft): New function. - * gnus.el (gnus-find-subscribed-addresses): New. + * gnus.el (gnus-find-subscribed-addresses): New function. 2001-10-31 07:00:00 ShengHuo ZHU @@ -1191,7 +2209,7 @@ mm-coding-system-p. Don't correct it only in XEmacs. (mm-charset-to-coding-system): Use mm-coding-system-p and mm-get-coding-system-list. - (mm-emacs-mule, mm-mule4-p): New. + (mm-emacs-mule, mm-mule4-p): New variables. (mm-enable-multibyte, mm-disable-multibyte, mm-enable-multibyte-mule4, mm-disable-multibyte-mule4, mm-with-unibyte-current-buffer, @@ -1258,8 +2276,8 @@ message-news-p, which widens the buffer. (message-forward-make-body): New function. (message-forward): Use it. - (message-insinuate-rmail): New. - (message-forward-rmail-make-body): New. + (message-insinuate-rmail): New function. + (message-forward-rmail-make-body): New function. 2001-10-30 02:00:00 ShengHuo ZHU @@ -2253,7 +3271,7 @@ * nnslashdot.el (nnslashdot-retrieve-headers-1): Replace nnslashdot-*-retrieve-headers. (nnslashdot-request-article): Fix for slashcode 2.2. - (nnslashdot-make-tuple): New. + (nnslashdot-make-tuple): New function. (nnslashdot-read-groups): Use it. 2001-08-20 01:34:03 Lars Magne Ingebrigtsen @@ -2358,7 +3376,7 @@ * gnus.el (gnus-expand-group-parameters): Fix. - * gnus-spec.el (gnus-char-width): New. + * gnus-spec.el (gnus-char-width): New function. (gnus-correct-substring, gnus-correct-length): Use it. * message.el (message-required-mail-headers): Fix doc. @@ -2408,7 +3426,7 @@ * gnus.el (gnus-info-find-node): Take an argument. - * gnus-art.el (gnus-button-handle-info): New. + * gnus-art.el (gnus-button-handle-info): New function. (gnus-url-unhex-string): Replace "+" with " ". 2001-08-17 21:00:00 ShengHuo ZHU @@ -2447,7 +3465,7 @@ 2001-08-17 14:00:00 ShengHuo ZHU * smime.el (smime-point-at-eol): eval-and-compile. - (smime-make-temp-file): New. + (smime-make-temp-file): New function. (smime-sign-region, smime-encrypt-region, smime-decrypt-region): Use it. @@ -2558,12 +3576,12 @@ 2001-08-10 21:00:00 ShengHuo ZHU * nndoc.el (nndoc-article-type): Fix doc. - (nndoc-generate-article-function): New. - (nndoc-dissection-function): New. + (nndoc-generate-article-function): New variable. + (nndoc-dissection-function): New variable. (nndoc-type-alist): Add oe-dbx. - (nndoc-oe-dbx-type-p): New. - (nndoc-oe-dbx-dissection): New. - (nndoc-oe-dbx-generate-article): New. + (nndoc-oe-dbx-type-p): New function. + (nndoc-oe-dbx-dissection): New function. + (nndoc-oe-dbx-generate-article): New function. 2001-08-11 Kai Gro,A_(Bjohann @@ -2582,7 +3600,7 @@ 2001-08-10 01:00:00 ShengHuo ZHU - * message.el (message-bogus-system-names): New. + * message.el (message-bogus-system-names): New variable. (message-make-fqdn): Use it. 2001-08-09 15:00:00 ShengHuo ZHU @@ -2795,7 +3813,7 @@ 2001-07-31 17:00:00 ShengHuo ZHU Originally from Pavel Jan,Bm(Bk - * gnus-agent.el (gnus-agent-make-mode-line-string): New. + * gnus-agent.el (gnus-agent-make-mode-line-string): New function. (gnus-agent-toggle-plugged): Use it. 2001-07-31 ShengHuo ZHU @@ -2813,8 +3831,8 @@ 2001-07-30 15:00:00 ShengHuo ZHU Originally from Andreas Fuchs - * mml2015.el (mml2015-trust-boundaries-alist) - (mml2015-gpg-pretty-print-fpr): New. + * mml2015.el (mml2015-trust-boundaries-alist): New variable. + (mml2015-gpg-pretty-print-fpr): New function. (mml2015-gpg-extract-signature-details): More details, rename from `m-g-e-from'. (mml2015-gpg-verify): Use them. @@ -2921,12 +3939,12 @@ 2001-07-27 23:00:00 ShengHuo ZHU - * mm-decode.el (mm-image-type-from-buffer): New. + * mm-decode.el (mm-image-type-from-buffer): New function. (mm-get-image): Use it. 2001-07-27 18:00:00 ShengHuo ZHU - * gnus.el (gnus-large-newsgroup): If it is nil, ... + * gnus.el (gnus-large-newsgroup): Add doc, "If it is nil, ..." * gnus-art.el (gnus-mime-view-all-parts): buffer-read-only covers mm-display-parts too. @@ -2947,9 +3965,9 @@ 2001-07-27 07:00:00 ShengHuo ZHU - * mml.el (mml-tweak-type-alist): New. - (mml-tweak-function-alist): New. - (mml-tweak-part): New. + * mml.el (mml-tweak-type-alist): New variable. + (mml-tweak-function-alist): New variable. + (mml-tweak-part): New function. (mml-generate-mime-1): Use it. 2001-07-26 22:00:00 ShengHuo ZHU @@ -2980,7 +3998,7 @@ 2001-07-26 14:00:00 ShengHuo ZHU - * mm-decode.el (mm-readable-p): New. + * mm-decode.el (mm-readable-p): New function. (mm-inline-media-tests): Fix the default testers. 2001-07-26 Simon Josefsson @@ -3023,8 +4041,8 @@ 2001-07-25 11:00:00 ShengHuo ZHU - * gnus-util.el (gnus-byte-compile): New. - (gnus-use-byte-compile): New. + * gnus-util.el (gnus-byte-compile): New function. + (gnus-use-byte-compile): New variable. (gnus-make-sort-function): Use it. * nnmail.el (nnmail-get-new-mail): Use it. @@ -3062,7 +4080,7 @@ * message.el (message-bounce): If no Return-Path, the whole content is considered as the original message. - * nnml.el (nnml-check-directory-twice): New. + * nnml.el (nnml-check-directory-twice): New variable. (nnml-article-to-file): Use it. (nnml-retrieve-headers): Hack it. @@ -3093,13 +4111,13 @@ * gnus-sum.el (gnus-articles-to-read): Use gnus-group-decoded-name. - * mm-util.el (mm-string-as-multibyte): New. + * mm-util.el (mm-string-as-multibyte): New function. * nnmh.el (nnmh-request-list-1): Encode, not decode! 2001-07-23 18:00:00 ShengHuo ZHU - * mm-util.el (mm-universal-coding-system): New. + * mm-util.el (mm-universal-coding-system): New variable. * gnus-start.el (gnus-startup-file-coding-system): Use it. @@ -3191,8 +4209,8 @@ 2001-07-18 11:00:00 ShengHuo ZHU - * mml.el (mml-content-type-parameters): New. - (mml-content-disposition-parameters): New. + * mml.el (mml-content-type-parameters): New variable. + (mml-content-disposition-parameters): New variable. (mml-insert-mime-headers): Use them. (mml-parse-1): Accept charset. @@ -3270,8 +4288,8 @@ * gnus-msg.el (gnus-msg-treat-broken-reply-to): Add force. (gnus-summary-reply): Use it. - (gnus-summary-reply-broken-reply-to): New. - (gnus-msg-force-broken-reply-to): New. + (gnus-summary-reply-broken-reply-to): New function. + (gnus-msg-force-broken-reply-to): New function. * mm-view.el (mm-inline-text): Showing as text/plain when error. @@ -3669,7 +4687,7 @@ 2001-06-03 Dale Hagglund * gnus-mlspl.el (gnus-group-split-fancy): Fix generation of split - restrict clauses. + restrict clauses. 2001-06-07 16:00:00 ShengHuo ZHU @@ -3813,7 +4831,7 @@ * nnrss.el (nnrss-request-expire-articles): Correct the return value. * nnslashdot.el (nnslashdot-request-list): Add time. - (nnslashdot-request-expire-articles): New. + (nnslashdot-request-expire-articles): New function. * gnus-start.el (gnus-check-bogus-newsgroups): Remove bogus secondary methods too. @@ -4132,11 +5150,9 @@ 2001-03-21 Didier Verna - * gnus-start.el: * gnus-start.el (gnus-subscribe-newsgroup-hooks): New. * gnus-start.el (gnus-subscribe-newsgroup): use it. - 2001-03-15 09:47:23 Lars Magne Ingebrigtsen * nnultimate.el (nnultimate-retrieve-headers): Understand @@ -4320,7 +5336,7 @@ 2001-02-23 23:00:00 ShengHuo ZHU - * nnslashdot.el (nnslashdot-backslash-url): New. + * nnslashdot.el (nnslashdot-backslash-url): New variable. (nnslashdot-request-list): Use it. 2001-02-23 22:00:00 ShengHuo ZHU @@ -4329,9 +5345,9 @@ no file. * gnus-sum.el (gnus-summary-import-article): Display it. Enable edit. - (gnus-summary-create-article): New. + (gnus-summary-create-article): New function. - * gnus-group.el (gnus-group-mark-article-read): New. + * gnus-group.el (gnus-group-mark-article-read): New function. * gnus-msg.el (gnus-inews-do-gcc): Use it. @@ -4343,9 +5359,9 @@ gnus-article-edit-exit. (gnus-article-edit-exit): Confirm and insert original-article-buffer. - * gnus.el (gnus-parameters): New. + * gnus.el (gnus-parameters): New variable. Suggested by NAGY Andras . - (gnus-parameters-get-parameter): New. + (gnus-parameters-get-parameter): New function. (gnus-group-find-parameter): Use it. 2001-02-23 Simon Josefsson @@ -4365,11 +5381,11 @@ 2001-02-22 22:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-fetch-headers): New. + * gnus-sum.el (gnus-fetch-headers): New function. (gnus-select-newsgroup): Use it. - (gnus-summary-insert-articles): New. - (gnus-summary-insert-old-articles): New. - (gnus-summary-insert-new-articles): New. + (gnus-summary-insert-articles): New function. + (gnus-summary-insert-old-articles): New function. + (gnus-summary-insert-new-articles): New function. * gnus-group.el (gnus-group-prepare-flat-list-dead): Use decoded-name. (gnus-group-list-active): Ditto. @@ -4391,8 +5407,8 @@ * gnus-msg.el (gnus-inews-do-gcc): Activate group anyway. * gnus-art.el (gnus-mime-display-multipart-alternative-as-mixed): - New. - (gnus-mime-display-multipart-related-as-mixed): New. + New variable. + (gnus-mime-display-multipart-related-as-mixed): New variable. (gnus-mime-display-part): Use them. 2001-02-20 16:00:00 ShengHuo ZHU @@ -4460,9 +5476,9 @@ * gnus-srvr.el (gnus-server-regenerate-server): Use gnus-get-function. - * nnagent.el (nnagent-request-regenerate): New. + * nnagent.el (nnagent-request-regenerate): New function. - * nnfolder.el (nnfolder-request-regenerate): Deffoo. + * nnfolder.el (nnfolder-request-regenerate): New deffoo. * nnml.el (nnml-generate-nov-databases): Accept argument server. Don't open server if it is opened. @@ -4505,9 +5521,9 @@ 2001-02-13 19:00:00 ShengHuo ZHU - * gnus-draft.el (gnus-draft-reminder): New. + * gnus-draft.el (gnus-draft-reminder): New function. - * gnus-art.el (gnus-sender-save-name): New. + * gnus-art.el (gnus-sender-save-name): New function. 2001-02-13 18:00:00 ShengHuo ZHU @@ -4522,7 +5538,7 @@ * gnus-topic.el (gnus-subscribe-topics): Return nil if not subscribe. - * gnus-start.el (gnus-call-subscribe-functions): New. + * gnus-start.el (gnus-call-subscribe-functions): New function. (gnus-find-new-newsgroups): Use it. (gnus-ask-server-for-new-groups): Use it. (gnus-check-first-time-used): Use it. @@ -4547,9 +5563,9 @@ * gnus-group.el (gnus-group-suspend): Offer save summaries. - * gnus-art.el (gnus-treat-leading-whitespace): New. + * gnus-art.el (gnus-treat-leading-whitespace): New variable. (gnus-treatment-function-alist): Use it. - (article-remove-leading-whitespace): New. + (article-remove-leading-whitespace): New function. (gnus-article-make-menu-bar): Use it. * gnus-sum.el (gnus-summary-wash-empty-map): Add @@ -4634,7 +5650,7 @@ 2001-02-06 21:00:00 ShengHuo ZHU - * gnus-group.el (gnus-group-listing-limit): New. + * gnus-group.el (gnus-group-listing-limit): New variable. (gnus-group-prepare-flat-list-dead): Use old trick to speed up. * gnus-topic.el (gnus-group-prepare-topics): Use gnus-killed-hashtb. @@ -4843,7 +5859,7 @@ 2001-01-20 09:00:00 ShengHuo ZHU - * mm-util.el (mm-string-as-unibyte): New. + * mm-util.el (mm-string-as-unibyte): New function. * message.el (message-forward): Use it. @@ -5329,7 +6345,7 @@ * message.el (message-tool-bar-map): Use it. - * Makefile.in (install-el): New. + * Makefile.in (install-el): New rule. 2000-12-21 Katsumi Yamaoka @@ -6738,7 +7754,7 @@ * mml2015.el (mml2015-function-alist): Clear verify and decrypt. * mm-uu.el: Reorganized. Add gnatsweb, pgp-signed, pgp-encrypted. - * mm-decode.el (mm-snarf-option): New. + * mm-decode.el (mm-snarf-option): New variable. 2000-11-04 13:08:02 ShengHuo ZHU diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 374a730..9db33b1 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -26,7 +26,7 @@ warn: clean-some gnus-load.el # The "clever" rule is unsafe, since redefined macros are loaded from # .elc files, and not the .el file. -clever some: gnus-load.el +clever some l: gnus-load.el $(EMACS_COMP) -f dgnushack-compile install: install-el install-elc diff --git a/lisp/canlock.el b/lisp/canlock.el index 9b8dfb6..845095f 100644 --- a/lisp/canlock.el +++ b/lisp/canlock.el @@ -1,5 +1,6 @@ ;;; canlock.el --- functions for Cancel-Lock feature -;; Copyright (C) 1998, 1999, 2001 Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2001, 2002 Free Software Foundation, Inc. ;; Author: Katsumi Yamaoka ;; Keywords: news, cancel-lock, hmac, sha1, rfc2104 @@ -95,6 +96,13 @@ buffer does not look like a news message." :type 'boolean :group 'canlock) +(eval-when-compile + (defmacro canlock-string-as-unibyte (string) + "Return a unibyte string with the same individual bytes as STRING." + (if (fboundp 'string-as-unibyte) + (list 'string-as-unibyte string) + string))) + (defun canlock-sha1-with-openssl (message) "Make a SHA-1 digest of MESSAGE using OpenSSL." (let (default-enable-multibyte-characters) @@ -112,7 +120,7 @@ buffer does not look like a news message." (replace-match (concat "\\\\x" (match-string 0)))) (insert "\"") (goto-char (point-min)) - (read (current-buffer)))))) + (canlock-string-as-unibyte (read (current-buffer))))))) (defvar canlock-read-passwd nil) (defun canlock-read-passwd (prompt &rest args) @@ -145,11 +153,13 @@ If ARGS, PROMPT is used as an argument to `format'." (opad (mapconcat (lambda (char) (char-to-string (logxor 92 char))) password ""))) - (base64-encode-string (funcall canlock-sha1-function - (concat - opad - (funcall canlock-sha1-function - (concat ipad message-id))))))) + (base64-encode-string + (funcall canlock-sha1-function + (concat + opad + (funcall canlock-sha1-function + (concat ipad + (canlock-string-as-unibyte message-id)))))))) (defun canlock-narrow-to-header () "Narrow the buffer to the head of the message." diff --git a/lisp/compface.el b/lisp/compface.el new file mode 100644 index 0000000..185f949 --- /dev/null +++ b/lisp/compface.el @@ -0,0 +1,57 @@ +;;; compface.el --- functions for converting X-Face headers +;; Copyright (C) 2002 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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. + +;;; Commentary: + +;;; Code: + +;;;### +(defun uncompface (face) + "Convert FACE to pbm. +Requires the external programs `uncompface', and `icontopbm'. On a +GNU/Linux system these might be in packages with names like `compface' +or `faces-xface' and `netpbm' or `libgr-progs', for instance." + (with-temp-buffer + (insert face) + (and (eq 0 (apply 'call-process-region (point-min) (point-max) + "uncompface" + 'delete '(t nil) nil)) + (progn + (goto-char (point-min)) + (insert "/* Width=48, Height=48 */\n") + ;; I just can't get "icontopbm" to work correctly on its + ;; own in XEmacs. And Emacs doesn't understand un-raw pbm + ;; files. + (if (not (featurep 'xemacs)) + (eq 0 (call-process-region (point-min) (point-max) + "icontopbm" + 'delete '(t nil))) + (shell-command-on-region (point-min) (point-max) + "icontopbm | pnmnoraw" + (current-buffer) t) + t)) + (buffer-string)))) + +(provide 'compface) + +;;; compface.el ends here diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index de3dd4b..e7ca680 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -1,6 +1,6 @@ ;;; flow-fill.el --- interprete RFC2646 "flowed" text -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: mail @@ -35,7 +35,7 @@ ;; paragraph and we let `fill-region' fill the long line into several ;; lines with the quote prefix as `fill-prefix'. -;; Todo: encoding, implement basic `fill-region' (Emacs and XEmacs +;; Todo: implement basic `fill-region' (Emacs and XEmacs ;; implementations differ..) ;;; History: @@ -46,11 +46,29 @@ ;; 2000-03-26 commited to gnus cvs ;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule ;; work when first line is at level 0. +;; 2002-01-12 probably incomplete encoding support ;;; Code: (eval-when-compile (require 'cl)) +(defcustom fill-flowed-display-column 'fill-column + "Column beyond which format=flowed lines are wrapped, when displayed. +This can be a lisp expression or an integer." + :type '(choice (const :tag "Standard `fill-column'" fill-column) + (const :tag "Fit Window" (- (window-width) 5)) + (sexp) + (integer))) + +(defcustom fill-flowed-encode-column 66 + "Column beyond which format=flowed lines are wrapped, in outgoing messages. +This can be a lisp expression or an integer. +RFC 2646 suggests 66 characters for readability." + :type '(choice (const :tag "Standard fill-column" fill-column) + (const :tag "RFC 2646 default (66)" 66) + (sexp) + (integer))) + (eval-and-compile (defalias 'fill-flowed-point-at-bol (if (fboundp 'point-at-bol) @@ -62,6 +80,27 @@ 'point-at-eol 'line-end-position))) +(defun fill-flowed-encode (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + ;; No point in doing this unless hard newlines is used. + (when use-hard-newlines + (let ((start (point-min)) end) + ;; Go through each paragraph, filling it and adding SPC + ;; as the last character on each line. + (while (setq end (text-property-any start (point-max) 'hard 't)) + (let ((fill-column (eval fill-flowed-encode-column))) + (fill-region start end t 'nosqueeze 'to-eop)) + (goto-char start) + ;; `fill-region' probably distorted end. + (setq end (text-property-any start (point-max) 'hard 't)) + (while (and (< (point) end) + (re-search-forward "$" (1- end) t)) + (insert " ") + (setq end (1+ end)) + (forward-char)) + (goto-char (setq start (1+ end))))) + t))) + (defun fill-flowed (&optional buffer) (save-excursion (set-buffer (or (current-buffer) buffer)) @@ -79,6 +118,7 @@ (beginning-of-line) (when (> (skip-chars-forward ">") 0) (insert " ")))) + ;; XXX slightly buggy handling of "-- " (while (and (save-excursion (ignore-errors (backward-char 3)) (setq sig (looking-at "-- ")) @@ -93,7 +133,8 @@ (backward-delete-char -1) (end-of-line)) (unless sig - (let ((fill-prefix (when quote (concat quote " ")))) + (let ((fill-prefix (when quote (concat quote " "))) + (fill-column (eval fill-flowed-display-column))) (fill-region (fill-flowed-point-at-bol) (min (1+ (fill-flowed-point-at-eol)) (point-max)) 'left 'nosqueeze)))))))) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 6595802..ef85946 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -29,6 +29,7 @@ (require 'nnvirtual) (require 'gnus-sum) (require 'gnus-score) +(require 'gnus-srvr) (eval-when-compile (if (featurep 'xemacs) (require 'itimer) @@ -53,13 +54,20 @@ :group 'gnus-agent :type 'hook) +(defcustom gnus-agent-fetched-hook nil + "Hook run after finishing fetching articles." + :group 'gnus-agent + :type 'hook) + (defcustom gnus-agent-handle-level gnus-level-subscribed "Groups on levels higher than this variable will be ignored by the Agent." :group 'gnus-agent :type 'integer) (defcustom gnus-agent-expire-days 7 - "Read articles older than this will be expired." + "Read articles older than this will be expired. +This can also be a list of regexp/day pairs. The regexps will +be matched against group names." :group 'gnus-agent :type 'integer) @@ -111,13 +119,21 @@ If this is `ask' the hook will query the user." (const :tag "Ask" ask)) :group 'gnus-agent) +(defcustom gnus-agent-go-online 'ask + "Indicate if offline servers go online when you plug in. +If this is `ask' the hook will query the user." + :version "21.1" + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "Ask" ask)) + :group 'gnus-agent) + ;;; Internal variables (defvar gnus-agent-history-buffers nil) (defvar gnus-agent-buffer-alist nil) (defvar gnus-agent-article-alist nil) (defvar gnus-agent-group-alist nil) -(defvar gnus-agent-covered-methods nil) (defvar gnus-category-alist nil) (defvar gnus-agent-current-history nil) (defvar gnus-agent-overview-buffer nil) @@ -262,7 +278,8 @@ If this is `ask' the hook will query the user." "JY" gnus-agent-synchronize-flags "JS" gnus-group-send-queue "Ja" gnus-agent-add-group - "Jr" gnus-agent-remove-group) + "Jr" gnus-agent-remove-group + "Jo" gnus-agent-toggle-group-plugged) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -270,6 +287,7 @@ If this is `ask' the hook will query the user." gnus-agent-group-menu gnus-agent-group-mode-map "" '("Agent" ["Toggle plugged" gnus-agent-toggle-plugged t] + ["Toggle group plugged" gnus-agent-toggle-group-plugged t] ["List categories" gnus-enter-category-buffer t] ["Send queue" gnus-group-send-queue gnus-plugged] ("Fetch" @@ -325,12 +343,13 @@ If this is `ask' the hook will query the user." (if plugged (progn (setq gnus-plugged plugged) - (gnus-agent-possibly-synchronize-flags) (gnus-run-hooks 'gnus-agent-plugged-hook) (setcar (cdr gnus-agent-mode-status) (gnus-agent-make-mode-line-string " Plugged" 'mouse-2 - 'gnus-agent-toggle-plugged))) + 'gnus-agent-toggle-plugged)) + (gnus-agent-go-online gnus-agent-go-online) + (gnus-agent-possibly-synchronize-flags)) (gnus-agent-close-connections) (setq gnus-plugged plugged) (gnus-run-hooks 'gnus-agent-unplugged-hook) @@ -659,7 +678,7 @@ the actual number of articles toggled is returned." (defun gnus-agent-get-undownloaded-list () "Mark all unfetched articles as read." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (and (not gnus-plugged) + (when (and (not (gnus-online gnus-command-method)) (gnus-agent-method-p gnus-command-method)) (gnus-agent-load-alist gnus-newsgroup-name) ;; First mark all undownloaded articles as undownloaded. @@ -747,7 +766,7 @@ the actual number of articles toggled is returned." (set (intern (symbol-name sym) orig) (symbol-value sym))))) new)) (gnus-make-directory (file-name-directory file)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) + (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) ;; The hashtable contains real names of groups, no more prefix ;; removing, so set `full' to `t'. (gnus-write-active-file file orig t)))) @@ -797,17 +816,11 @@ the actual number of articles toggled is returned." -(defun gnus-agent-method-p (method) - "Say whether METHOD is covered by the agent." - (member method gnus-agent-covered-methods)) - (defun gnus-agent-get-function (method) - (if (and (not gnus-plugged) - (gnus-agent-method-p method)) - (progn - (require 'nnagent) - 'nnagent) - (car method))) + (if (gnus-online method) + (car method) + (require 'nnagent) + 'nnagent)) ;;; History functions @@ -999,7 +1012,8 @@ the actual number of articles toggled is returned." (defun gnus-agent-fetch-headers (group &optional force) (let ((articles (gnus-list-of-unread-articles group)) (gnus-decode-encoded-word-function 'identity) - (file (gnus-agent-article-name ".overview" group))) + (file (gnus-agent-article-name ".overview" group)) + gnus-agent-cache) ;; Add article with marks to list of article headers we want to fetch. (dolist (arts (gnus-info-marks (gnus-get-info group))) (setq articles (gnus-range-add articles (cdr arts)))) @@ -1037,14 +1051,15 @@ the actual number of articles toggled is returned." (defsubst gnus-agent-copy-nov-line (article) (let (b e) (set-buffer gnus-agent-overview-buffer) - (setq b (point)) - (if (eq article (read (current-buffer))) - (setq e (progn (forward-line 1) (point))) - (progn - (beginning-of-line) - (setq e b))) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e))) + (unless (eobp) + (setq b (point)) + (if (eq article (read (current-buffer))) + (setq e (progn (forward-line 1) (point))) + (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) (set-buffer gnus-agent-overview-buffer) @@ -1075,11 +1090,16 @@ the actual number of articles toggled is returned." (unless (eobp) (gnus-agent-copy-nov-line (car articles)) (setq articles (cdr articles)))) + (set-buffer nntp-server-buffer) (when articles (let (b e) (set-buffer gnus-agent-overview-buffer) (setq b (point) e (point-max)) + (while (and (not (eobp)) + (<= (read (current-buffer)) (car articles))) + (forward-line 1) + (setq b (point))) (set-buffer nntp-server-buffer) (insert-buffer-substring gnus-agent-overview-buffer b e))))) @@ -1094,16 +1114,18 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." (let ((file-name-coding-system nnmail-pathname-coding-system) - print-level print-length) - (with-temp-file (if dir - (expand-file-name ".agentview" dir) - (gnus-agent-article-name ".agentview" group)) - (princ (setq gnus-agent-article-alist - (nconc gnus-agent-article-alist - (mapcar (lambda (article) (cons article state)) - articles))) - (current-buffer)) - (insert "\n")))) + print-level print-length item) + (dolist (art articles) + (if (setq item (memq art gnus-agent-article-alist)) + (setcdr item state) + (push (cons art state) gnus-agent-article-alist))) + (setq gnus-agent-article-alist + (sort gnus-agent-article-alist 'car-less-than-car)) + (with-temp-file (if dir + (expand-file-name ".agentview" dir) + (gnus-agent-article-name ".agentview" group)) + (princ gnus-agent-article-alist (current-buffer)) + (insert "\n")))) (defun gnus-agent-article-name (article group) (expand-file-name (if (stringp article) article (string-to-number article)) @@ -1139,8 +1161,9 @@ the actual number of articles toggled is returned." (condition-case err (progn (setq gnus-command-method (car methods)) - (when (or (gnus-server-opened gnus-command-method) - (gnus-open-server gnus-command-method)) + (when (and (or (gnus-server-opened gnus-command-method) + (gnus-open-server gnus-command-method)) + (gnus-online gnus-command-method)) (setq groups (gnus-groups-from-server (car methods))) (gnus-agent-with-fetch (while (setq group (pop groups)) @@ -1156,6 +1179,7 @@ the actual number of articles toggled is returned." err)) (signal 'quit "Cannot fetch articles into the Gnus agent")))) (pop methods)) + (run-hooks 'gnus-agent-fetch-hook) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) (defun gnus-agent-fetch-group-1 (group method) @@ -1243,7 +1267,14 @@ the actual number of articles toggled is returned." "Hook run in `gnus-category-mode' buffers.") (defvar gnus-category-line-format " %(%20c%): %g\n" - "Format of category lines.") + "Format of category lines. + +Valid specifiers include: +%c Topic name (string) +%g The number of groups in the topic (integer) + +General format specifiers can also be used. See +(gnus)Formatting Variables.") (defvar gnus-category-mode-line-format "Gnus: %%b" "The format specification for the category mode line.") @@ -1378,7 +1409,7 @@ The following commands are available: (gnus-category-position-point))) (defun gnus-category-name () - (or (get-text-property (gnus-point-at-bol) 'gnus-category) + (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category)) (error "No category on the current line"))) (defun gnus-category-read () @@ -1571,10 +1602,13 @@ The following commands are available: "Expire all old articles." (interactive) (let ((methods gnus-agent-covered-methods) - (day (- (time-to-days (current-time)) gnus-agent-expire-days)) + (day (if (numberp gnus-agent-expire-days) + (- (time-to-days (current-time)) gnus-agent-expire-days) + nil)) + (current-day (time-to-days (current-time))) gnus-command-method sym group articles history overview file histories elem art nov-file low info - unreads marked article orig lowest highest) + unreads marked article orig lowest highest found days) (save-excursion (setq overview (gnus-get-buffer-create " *expire overview*")) (while (setq gnus-command-method (pop methods)) @@ -1597,7 +1631,19 @@ The following commands are available: (skip-chars-forward "^\t") (if (let ((fetch-date (read (current-buffer)))) (if (numberp fetch-date) - (> fetch-date day) + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + (if (numberp day) + (> fetch-date day) + (skip-chars-forward "\t") + (setq found nil + days gnus-agent-expire-days) + (while (and (not found) + days) + (when (looking-at (caar days)) + (setq found (cadar days))) + (pop days)) + (> fetch-date (- current-day found))) ;; History file is corrupted. (gnus-message 5 @@ -1713,9 +1759,10 @@ The following commands are available: (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. + ;; 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 info expired (or (not (caar gnus-agent-article-alist)) @@ -1751,8 +1798,309 @@ The following commands are available: (let ((init-file-user "") (gnus-always-read-dribble-file t)) (gnus)) - (gnus-group-send-queue) - (gnus-agent-fetch-session)) + (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation)) + (gnus-group-send-queue) + (gnus-agent-fetch-session))) + +(defun gnus-agent-retrieve-headers (articles group &optional fetch-old) + (save-excursion + (gnus-agent-create-buffer) + (let ((gnus-decode-encoded-word-function 'identity) + (file (gnus-agent-article-name ".overview" group)) + cached-articles uncached-articles) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t)) + (when (file-exists-p file) + (with-current-buffer gnus-agent-overview-buffer + (erase-buffer) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file)) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[0-9]") + (push (read (current-buffer)) cached-articles)) + (forward-line 1)) + (setq cached-articles (sort cached-articles '<)))) + (if (setq uncached-articles + (gnus-set-difference articles cached-articles)) + (progn + (set-buffer nntp-server-buffer) + (erase-buffer) + (let (gnus-agent-cache) + (unless (eq 'nov + (gnus-retrieve-headers + uncached-articles group fetch-old)) + (nnvirtual-convert-headers))) + (set-buffer gnus-agent-overview-buffer) + (erase-buffer) + (set-buffer nntp-server-buffer) + (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + (when (and uncached-articles (file-exists-p file)) + (gnus-agent-braid-nov group uncached-articles file)) + (set-buffer nntp-server-buffer) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent)) + (gnus-agent-load-alist group) + (gnus-agent-save-alist group uncached-articles nil) + (gnus-agent-open-history) + (setq gnus-agent-current-history (gnus-agent-history-buffer)) + (gnus-agent-enter-history + "last-header-fetched-for-session" + (list (cons group (nth (- (length articles) 1) articles))) + (time-to-days (current-time))) + (gnus-agent-save-history)) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring gnus-agent-overview-buffer))) + (if (and fetch-old + (not (numberp fetch-old))) + t ; Don't remove anything. + (nnheader-nov-delete-outside-range + (if fetch-old (max 1 (- (car articles) fetch-old)) + (car articles)) + (car (last articles))) + t) + 'nov)) + +(defun gnus-agent-request-article (article group) + "Retrieve ARTICLE in GROUP from the agent cache." + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (file (concat + (gnus-agent-directory) + (gnus-agent-group-path group) "/" + (number-to-string article))) + (buffer-read-only nil)) + (when (file-exists-p file) + (erase-buffer) + (gnus-kill-all-overlays) + (let ((coding-system-for-read gnus-cache-coding-system)) + (insert-file-contents file)) + t))) + +(defun gnus-agent-regenerate-group (group &optional clean) + "Regenerate GROUP." + (let ((dir (concat (gnus-agent-directory) + (gnus-agent-group-path group) "/")) + (file (gnus-agent-article-name ".overview" group)) + n point arts alist header new-alist changed) + (when (file-exists-p dir) + (setq arts + (sort (mapcar (lambda (name) (string-to-int name)) + (directory-files dir nil "^[0-9]+$" t)) + '<))) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t)) + (mm-with-unibyte-buffer + (if (file-exists-p file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))) + (goto-char (point-min)) + (while (not (eobp)) + (while (not (or (eobp) (looking-at "[0-9]"))) + (setq point (point)) + (forward-line 1) + (delete-region point (point))) + (unless (eobp) + (setq n (read (current-buffer))) + (when (and arts (> n (car arts))) + (beginning-of-line) + (while (and arts (> n (car arts))) + (message "Regenerating NOV %s %d..." group (car arts)) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents + (concat dir (number-to-string (car arts)))) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (goto-char (point-max))) + (setq header (nnheader-parse-head t))) + (mail-header-set-number header (car arts)) + (nnheader-insert-nov header) + (setq changed t) + (push (cons (car arts) t) alist) + (pop arts))) + (if (and arts (= n (car arts))) + (progn + (push (cons n t) alist) + (pop arts)) + (push (cons n nil) alist)) + (forward-line 1))) + (if changed + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent)))) + (setq gnus-agent-article-alist nil) + (unless clean + (gnus-agent-load-alist group)) + (setq alist (sort alist 'car-less-than-car)) + (setq gnus-agent-article-alist (sort gnus-agent-article-alist + 'car-less-than-car)) + (while (and alist gnus-agent-article-alist) + (cond + ((< (caar alist) (caar gnus-agent-article-alist)) + (push (pop alist) new-alist)) + ((> (caar alist) (caar gnus-agent-article-alist)) + (push (list (car (pop gnus-agent-article-alist))) new-alist)) + (t + (pop gnus-agent-article-alist) + (while (and gnus-agent-article-alist + (= (caar alist) (caar gnus-agent-article-alist))) + (pop gnus-agent-article-alist)) + (push (pop alist) new-alist)))) + (while alist + (push (pop alist) new-alist)) + (while gnus-agent-article-alist + (push (list (car (pop gnus-agent-article-alist))) new-alist)) + (setq gnus-agent-article-alist (nreverse new-alist)) + (gnus-agent-save-alist group))) + +(defun gnus-agent-regenerate-history (group article) + (let ((file (concat (gnus-agent-directory) + (gnus-agent-group-path group) "/" + (number-to-string article))) id) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (message-narrow-to-head) + (goto-char (point-min)) + (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) + (setq id "No-Message-ID-in-article") + (setq id (buffer-substring (match-beginning 1) (match-end 1)))) + (gnus-agent-enter-history + id (list (cons group article)) + (time-to-days (nth 5 (file-attributes file))))))) + +;;;###autoload +(defun gnus-agent-regenerate (&optional clean) + "Regenerate all agent covered files. +If CLEAN, don't read existing active and agentview files." + (interactive "P") + (message "Regenerating Gnus agent files...") + (dolist (gnus-command-method gnus-agent-covered-methods) + (let ((active-file (gnus-agent-lib-file "active")) + history-hashtb active-hashtb active-changed + history-changed point) + (gnus-make-directory (file-name-directory active-file)) + (if clean + (setq active-hashtb (gnus-make-hashtable 1000)) + (mm-with-unibyte-buffer + (if (file-exists-p active-file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents active-file)) + (setq active-changed t)) + (gnus-active-to-gnus-format + nil (setq active-hashtb + (gnus-make-hashtable + (count-lines (point-min) (point-max))))))) + (gnus-agent-open-history) + (setq history-hashtb (gnus-make-hashtable 1000)) + (with-current-buffer + (setq gnus-agent-current-history (gnus-agent-history-buffer)) + (goto-char (point-min)) + (forward-line 1) + (while (not (eobp)) + (if (looking-at + "\\([^\t\n]+\\)\t[0-9]+\t\\([^ \n]+\\) \\([0-9]+\\)") + (progn + (unless (string= (match-string 1) + "last-header-fetched-for-session") + (gnus-sethash (match-string 2) + (cons (string-to-number (match-string 3)) + (gnus-gethash-safe (match-string 2) + history-hashtb)) + history-hashtb)) + (forward-line 1)) + (setq point (point)) + (forward-line 1) + (delete-region point (point)) + (setq history-changed t)))) + (dolist (group (gnus-groups-from-server gnus-command-method)) + (gnus-agent-regenerate-group group clean) + (let ((min (or (caar gnus-agent-article-alist) 1)) + (max (or (caar (last gnus-agent-article-alist)) 0)) + (active (gnus-gethash-safe (gnus-group-real-name group) + active-hashtb))) + (if (not active) + (progn + (setq active (cons min max) + active-changed t) + (gnus-sethash group active active-hashtb)) + (when (> (car active) min) + (setcar active min) + (setq active-changed t)) + (when (< (cdr active) max) + (setcdr active max) + (setq active-changed t)))) + (let ((arts (sort (gnus-gethash-safe group history-hashtb) '<)) + n) + (gnus-sethash group arts history-hashtb) + (while (and arts gnus-agent-article-alist) + (cond + ((> (car arts) (caar gnus-agent-article-alist)) + (when (cdar gnus-agent-article-alist) + (gnus-agent-regenerate-history + group (caar gnus-agent-article-alist)) + (setq history-changed t)) + (setq n (car (pop gnus-agent-article-alist))) + (while (and gnus-agent-article-alist + (= n (caar gnus-agent-article-alist))) + (pop gnus-agent-article-alist))) + ((< (car arts) (caar gnus-agent-article-alist)) + (setq n (pop arts)) + (while (and arts (= n (car arts))) + (pop arts))) + (t + (setq n (car (pop gnus-agent-article-alist))) + (while (and gnus-agent-article-alist + (= n (caar gnus-agent-article-alist))) + (pop gnus-agent-article-alist)) + (setq n (pop arts)) + (while (and arts (= n (car arts))) + (pop arts))))) + (while gnus-agent-article-alist + (when (cdar gnus-agent-article-alist) + (gnus-agent-regenerate-history + group (caar gnus-agent-article-alist)) + (setq history-changed t)) + (pop gnus-agent-article-alist)))) + (when history-changed + (message "Regenerate the history file of %s:%s" + (car gnus-command-method) + (cadr gnus-command-method)) + (gnus-agent-save-history)) + (gnus-agent-close-history) + (when active-changed + (message "Regenerate %s" active-file) + (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) + (gnus-write-active-file active-file active-hashtb))))) + (message "Regenerating Gnus agent files...done")) + +(defun gnus-agent-go-online (&optional force) + "Switch servers into online status." + (interactive (list t)) + (dolist (server gnus-opened-servers) + (when (eq (nth 1 server) 'offline) + (if (if (eq force 'ask) + (gnus-y-or-n-p + (format "Switch %s:%s into online status? " + (caar server) (cadar server))) + force) + (setcar (nthcdr 1 server) 'close))))) + +(defun gnus-agent-toggle-group-plugged (group) + "Toggle the status of the server of the current group." + (interactive (list (gnus-group-group-name))) + (let* ((method (gnus-find-method-for-group group)) + (status (cadr (assoc method gnus-opened-servers)))) + (if (eq status 'offline) + (gnus-server-set-status method 'closed) + (gnus-close-server method) + (gnus-server-set-status method 'offline)) + (message "Turn %s:%s from %s to %s." (car method) (cadr method) + (if (eq status 'offline) 'offline 'online) + (if (eq status 'offline) 'online 'offline)))) (provide 'gnus-agent) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 0dad544..7888afe 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -111,7 +111,7 @@ "^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-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.*:" @@ -141,7 +141,8 @@ "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:" "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:" "^X-Virus-Scanned:" "^X-Delivery-Agent:" "^Posted-Date:" "^X-Gateway:" - "^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:") + "^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:" + "^X-Received-Date:") "*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." @@ -227,23 +228,18 @@ regexp. If it matches, the text in question is not a signature." (defcustom gnus-article-x-face-command (if (featurep 'xemacs) (if (or (gnus-image-type-available-p 'xface) - (gnus-image-type-available-p 'xpm)) - 'gnus-xmas-article-display-xface + (gnus-image-type-available-p 'pbm)) + 'gnus-display-x-face-in-from "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -") - (if (gnus-image-type-available-p 'xbm) - 'gnus-article-display-xface - (if gnus-article-compface-xbm - "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -" - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ -display -"))) + (if (gnus-image-type-available-p 'pbm) + 'gnus-display-x-face-in-from + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ +display -")) "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." :type `(choice string - (function-item - ,(if (featurep 'xemacs) - 'gnus-xmas-article-display-xface - 'gnus-article-display-xface)) + (function-item gnus-display-x-face-in-from) function) :version "21.1" :group 'gnus-article-washing) @@ -284,23 +280,23 @@ directly.") (defcustom gnus-emphasis-alist (let ((format - "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)") + "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") (types - '(("_" "_" underline) + '(("\\*" "\\*" bold) + ("_" "_" underline) ("/" "/" italic) - ("\\*" "\\*" bold) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) ("_\\*/" "/\\*_" underline-bold-italic)))) - `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline) - ,@(mapcar + `(,@(mapcar (lambda (spec) (list (format format (car spec) (cadr spec)) 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types))) + types) + ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline))) "*Alist that says how to fontify certain phrases. Each item looks like this: @@ -700,6 +696,29 @@ To see e.g. security buttons you could set this to :group 'gnus-article-mime :type '(repeat regexp)) +(defcustom gnus-body-boundary-delimiter "_" + "String used to delimit header and body. +This variable is used by `gnus-article-treat-body-boundary' which can +be controlled by `gnus-treat-body-boundary'." + :group 'gnus-article-various + :type '(choice (item :tag "None" :value nil) + string)) + +(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") + "*Defines the location of the faces database. +For information on obtaining this database of pretty pictures, please +see http://www.cs.indiana.edu/picons/ftp/index.html" + :type 'directory + :group 'gnus-picon) + +(defun gnus-picons-installed-p () + "Say whether picons are installed on your machine." + (let ((installed nil)) + (dolist (database gnus-picon-databases) + (when (file-exists-p database) + (setq installed t))) + installed)) + (defcustom gnus-article-mime-part-function nil "Function called with a MIME handle as the argument. This is meant for people who want to do something automatic based @@ -807,7 +826,7 @@ See Info node `(gnus)Customizing Articles'." (defcustom gnus-treat-buttonize 100000 "Add buttons. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-buttonize 'highlight t) @@ -815,7 +834,7 @@ See the manual for details." (defcustom gnus-treat-buttonize-head 'head "Add buttons to the head. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) @@ -827,7 +846,7 @@ See the manual for details." 50000) "Emphasize text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-emphasize 'highlight t) @@ -835,63 +854,63 @@ See the manual for details." (defcustom gnus-treat-strip-cr nil "Remove carriage returns. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-leading-whitespace nil "Remove leading whitespace in headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-hide-headers 'head "Hide headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-boring-headers nil "Hide boring headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-signature nil "Hide the signature. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-fill-article nil "Fill the article. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation nil "Hide cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation-maybe nil "Hide cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-list-identifiers 'head "Strip list identifiers from `gnus-list-identifiers`. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -899,14 +918,14 @@ See the manual for details." (defcustom gnus-treat-strip-pgp t "Strip PGP signatures. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-pem nil "Strip PEM signatures. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -914,14 +933,14 @@ See the manual for details." "Strip banners from articles. The banner to be stripped is specified in the `banner' group parameter. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-highlight-headers 'head "Highlight the headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (put 'gnus-treat-highlight-headers 'highlight t) @@ -929,7 +948,7 @@ See the manual for details." (defcustom gnus-treat-highlight-citation t "Highlight cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-highlight-citation 'highlight t) @@ -937,42 +956,42 @@ See the manual for details." (defcustom gnus-treat-date-ut nil "Display the Date in UT (GMT). Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-local nil "Display the Date in the local timezone. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-english nil "Display the Date in a format that can be read aloud in English. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-lapsed nil "Display the Date header in a way that says how much time has elapsed. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-original nil "Display the date in the original timezone. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-iso8601 nil "Display the date in the ISO8601 format. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-head-custom) @@ -981,14 +1000,14 @@ See the manual for details." "Display the date in a user-defined format. The format is defined by the `gnus-article-time-format' variable. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-strip-headers-in-body t "Strip the X-No-Archive header line from the beginning of the body. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -996,42 +1015,49 @@ See the manual for details." (defcustom gnus-treat-strip-trailing-blank-lines nil "Strip trailing blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-leading-blank-lines nil "Strip leading blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-multiple-blank-lines nil "Strip multiple blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-unfold-headers 'head "Unfold folded header lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-fold-headers nil + "Fold headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-fold-newsgroups 'head "Fold the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-overstrike t "Treat overstrike highlighting. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) @@ -1045,7 +1071,8 @@ See the manual for details." 'head) "Display X-Face headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)X-Face' for details." :group 'gnus-article-treat :version "21.1" :type gnus-article-treat-head-custom) @@ -1059,38 +1086,45 @@ See the manual for details." t nil) "Display smileys. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Smileys' for details." :group 'gnus-article-treat :version "21.1" :type gnus-article-treat-custom) (put 'gnus-treat-display-smileys 'highlight t) (defcustom gnus-treat-from-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the From header. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (put 'gnus-treat-from-picon 'highlight t) (defcustom gnus-treat-mail-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in To and Cc headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (put 'gnus-treat-mail-picon 'highlight t) (defcustom gnus-treat-newsgroups-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (put 'gnus-treat-newsgroups-picon 'highlight t) @@ -1102,7 +1136,7 @@ See the manual for details." 'head nil) "Draw a boundary at the end of the headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1110,7 +1144,7 @@ See the manual for details." (defcustom gnus-treat-capitalize-sentences nil "Capitalize sentence-starting words. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1118,14 +1152,14 @@ See the manual for details." (defcustom gnus-treat-fill-long-lines nil "Fill long lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-play-sounds nil "Play sounds. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1133,7 +1167,7 @@ See the manual for details." (defcustom gnus-treat-translate nil "Translate articles from one language to another. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1142,7 +1176,7 @@ See the manual for details." "Verify X-PGP-Sig. To automatically treat X-PGP-Sig, set it to head. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :group 'mime-security :type gnus-article-treat-custom) @@ -1186,6 +1220,7 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-date-original gnus-article-date-original) (gnus-treat-date-user-defined gnus-article-date-user) (gnus-treat-date-iso8601 gnus-article-date-iso8601) + (gnus-treat-display-xface gnus-article-display-x-face) (gnus-treat-hide-headers gnus-article-maybe-hide-headers) (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) (gnus-treat-hide-signature gnus-article-hide-signature) @@ -1209,12 +1244,12 @@ It is a string, such as \"PGP\". If nil, ask user." gnus-article-strip-multiple-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) + (gnus-treat-fold-headers gnus-article-treat-fold-headers) (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) - (gnus-treat-display-smileys gnus-smiley-display) + (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) (gnus-treat-emphasize gnus-article-emphasize) - (gnus-treat-display-xface gnus-article-display-x-face) (gnus-treat-body-boundary gnus-article-treat-body-boundary) (gnus-treat-play-sounds gnus-earcon-display))) @@ -1639,6 +1674,36 @@ unfolded." (replace-match " " t t))) (goto-char (point-max))))))) +(defun gnus-article-treat-fold-headers () + "Fold message headers." + (interactive) + (gnus-with-article-headers + (while (not (eobp)) + (save-restriction + (mail-header-narrow-to-field) + (mail-header-fold-field) + (goto-char (point-max)))))) + +(defun gnus-treat-smiley () + "Display textual emoticons (\"smileys\") as small graphical icons." + (interactive) + (gnus-with-article-buffer + (if (memq 'smiley gnus-article-wash-types) + (gnus-delete-images 'smiley) + (article-goto-body) + (let ((images (smiley-region (point) (point-max)))) + (when images + (gnus-add-wash-type 'smiley) + (dolist (image images) + (gnus-add-image 'smiley image))))))) + +(defun gnus-article-remove-images () + "Remove all images from the article buffer." + (interactive) + (gnus-with-article-buffer + (dolist (elem gnus-article-image-alist) + (gnus-delete-images (car elem))))) + (defun gnus-article-treat-fold-newsgroups () "Unfold folded message headers. Only the headers that fit into the current window width will be @@ -1648,7 +1713,7 @@ unfolded." (while (gnus-article-goto-header "newsgroups\\|followup-to") (save-restriction (mail-header-narrow-to-field) - (while (search-forward "," nil t) + (while (re-search-forward ", *" nil t) (replace-match ", " t t)) (mail-header-fold-field) (goto-char (point-max)))))) @@ -1656,13 +1721,18 @@ unfolded." (defun gnus-article-treat-body-boundary () "Place a boundary line at the end of the headers." (interactive) - (gnus-with-article-headers - (goto-char (point-max)) - (let ((start (point))) - (insert "X-Boundary: ") - (gnus-add-text-properties start (point) '(invisible t intangible t)) - (insert (make-string (1- (window-width)) ?-) - "\n")))) + (when (and gnus-body-boundary-delimiter + (> (length gnus-body-boundary-delimiter) 0)) + (gnus-with-article-headers + (goto-char (point-max)) + (let ((start (point))) + (insert "X-Boundary: ") + (gnus-add-text-properties start (point) '(invisible t intangible t)) + (insert (let (str) + (while (>= (1- (window-width)) (length str)) + (setq str (concat str gnus-body-boundary-delimiter))) + (substring str 0 (1- (window-width)))) + "\n"))))) (defun article-fill-long-lines () "Fill lines that are wider than the window width." @@ -1725,52 +1795,77 @@ unfolded." (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." (interactive (list 'force)) - (gnus-with-article-headers - ;; Delete the old process, if any. - (when (process-status "article-x-face") - (delete-process "article-x-face")) - (if (memq 'xface gnus-article-wash-types) - ;; We have already displayed X-Faces, so we remove them - ;; instead. - (gnus-delete-images 'xface) - ;; Display X-Faces. - (let (x-faces from face) - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (mail-narrow-to-head) - (while (gnus-article-goto-header "x-face") - (push (mail-header-field-value) x-faces)) - (setq from (message-fetch-field "from")))) - ;; Sending multiple EOFs to xv doesn't work, so we only do a - ;; single external face. - (when (stringp gnus-article-x-face-command) - (setq x-faces (list (car x-faces)))) - (while (and (setq face (pop x-faces)) - gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from))))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command face) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (with-temp-buffer - (insert face) - (process-send-region "article-x-face" (point-min) (point-max))) - (process-send-eof "article-x-face")))))))) + (let ((wash-face-p buffer-read-only)) ;; When type `W f' + (gnus-with-article-headers + ;; Delete the old process, if any. + (when (process-status "article-x-face") + (delete-process "article-x-face")) + (if (memq 'xface gnus-article-wash-types) + ;; We have already displayed X-Faces, so we remove them + ;; instead. + (gnus-delete-images 'xface) + ;; Display X-Faces. + (let (x-faces from face grey) + (save-excursion + (when (and wash-face-p + (progn + (goto-char (point-min)) + (not (re-search-forward + "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t))) + (gnus-buffer-live-p gnus-original-article-buffer)) + ;; If type `W f', use gnus-original-article-buffer, + ;; otherwise use the current buffer because displaying + ;; RFC822 parts calls this function too. + (set-buffer gnus-original-article-buffer)) + (save-restriction + (mail-narrow-to-head) + (while (gnus-article-goto-header "x-face\\(-[0-9]+\\)?") + (when (match-beginning 2) + (setq grey t)) + (push (mail-header-field-value) x-faces)) + (setq from (message-fetch-field "from")))) + (if grey + (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces)) + image) + (when xpm + (setq image (gnus-create-image xpm 'xpm t)) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-wash-type 'xface) + (gnus-add-image 'xface image) + (gnus-put-image image))) + ;; Sending multiple EOFs to xv doesn't work, so we only do a + ;; single external face. + (when (stringp gnus-article-x-face-command) + (setq x-faces (list (car x-faces)))) + (while (and (setq face (pop x-faces)) + gnus-article-x-face-command + (or force + ;; Check whether this face is censored. + (not gnus-article-x-face-too-ugly) + (and gnus-article-x-face-too-ugly from + (not (string-match gnus-article-x-face-too-ugly + from))))) + ;; We display the face. + (if (symbolp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (if (gnus-functionp gnus-article-x-face-command) + (funcall gnus-article-x-face-command face) + (error "%s is not a function" gnus-article-x-face-command)) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name shell-command-switch + gnus-article-x-face-command)) + (with-temp-buffer + (insert face) + (process-send-region "article-x-face" + (point-min) (point-max))) + (process-send-eof "article-x-face")))))))))) (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." @@ -2561,12 +2656,12 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (list t)) (article-date-ut 'iso8601 highlight)) -(defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max))))) +;; (defun article-show-all () +;; "Show all hidden text in the article buffer." +;; (interactive) +;; (save-excursion +;; (let ((buffer-read-only nil)) +;; (gnus-article-unhide-text (point-min) (point-max))))) (defun article-remove-leading-whitespace () "Remove excessive whitespace from all headers." @@ -3074,7 +3169,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-emphasize article-treat-dumbquotes article-normalize-headers - (article-show-all . gnus-article-show-all-headers)))) +;; (article-show-all . gnus-article-show-all-headers) + ))) ;;; ;;; Gnus article mode @@ -3099,6 +3195,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ">" end-of-buffer "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug + "R" gnus-article-reply-with-original + "F" gnus-article-followup-with-original "\C-hk" gnus-article-describe-key "\C-hc" gnus-article-describe-key-briefly @@ -3383,14 +3481,19 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;;; (defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" - "The following specs can be used: + "Format of the MIME buttons. + +Valid specifiers include: %t The MIME type %T MIME type, along with additional info %n The `name' parameter %d The description, if any %l The length of the encoded part %p The part identifier number -%e Dots if the part isn't displayed") +%e Dots if the part isn't displayed + +General format specifiers can also be used. See +(gnus)Formatting Variables.") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) @@ -3901,14 +4004,11 @@ If no internal viewer is available, use an external viewer." (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist - `(keymap ,gnus-mime-button-map - ,@(if (>= (string-to-number emacs-version) 21) - nil - (list 'local-map gnus-mime-button-map)) - gnus-callback gnus-mm-display-part - gnus-part ,gnus-tmp-id - article-type annotation - gnus-data ,handle)) + `(,@(gnus-local-map-property gnus-mime-button-map) + gnus-callback gnus-mm-display-part + gnus-part ,gnus-tmp-id + article-type annotation + gnus-data ,handle)) (setq e (point)) (widget-convert-button 'link b e @@ -4161,12 +4261,9 @@ If no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',not-pref ',begend ,id)) - ,@(if (>= (string-to-number emacs-version) 21) - nil ;; XEmacs doesn't care - (list 'local-map gnus-mime-button-map)) + ,@(gnus-local-map-property gnus-mime-button-map) ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face - keymap ,gnus-mime-button-map gnus-part ,id gnus-data ,handle)) (widget-convert-button 'link from (point) @@ -4188,12 +4285,9 @@ If no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) - ,@(if (>= (string-to-number emacs-version) 21) - nil ;; XEmacs doesn't care - (list 'local-map gnus-mime-button-map)) + ,@(gnus-local-map-property gnus-mime-button-map) ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face - keymap ,gnus-mime-button-map gnus-part ,id gnus-data ,handle)) (widget-convert-button 'link from (point) @@ -4279,7 +4373,7 @@ is the string to use when it is inactive.") (defun gnus-add-wash-type (type) "Add a washing of TYPE to the current status." - (push type gnus-article-wash-types)) + (add-to-list 'gnus-article-wash-types type)) (defun gnus-delete-wash-type (type) "Add a washing of TYPE to the current status." @@ -4485,7 +4579,7 @@ Argument LINES specifies lines to be scrolled down." (interactive "P") (gnus-article-check-buffer) (let ((nosaves - '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" + '("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f" "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "^" "\M-^" "|")) (nosave-but-article @@ -4599,6 +4693,39 @@ Argument LINES specifies lines to be scrolled down." (describe-key-briefly key insert)) (describe-key-briefly key insert))) +(defun gnus-article-reply-with-original (&optional wide) + "Start composing a reply mail to the current message. +The text in the region will be yanked. If the region isn't active, +the entire article will be yanked." + (interactive "P") + (let ((article (cdr gnus-article-current)) cont) + (if (not (mark)) + (gnus-summary-reply (list (list article)) wide) + (setq cont (buffer-substring (point) (mark))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (gnus-summary-reply + (list (list article cont)) wide)))) + +(defun gnus-article-followup-with-original () + "Compose a followup to the current article. +The text in the region will be yanked. If the region isn't active, +the entire article will be yanked." + (interactive) + (let ((article (cdr gnus-article-current)) + cont) + (if (not (gnus-region-active-p)) + (gnus-summary-followup (list (list article))) + (setq cont (buffer-substring (point) (mark))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (gnus-summary-followup + (list (list article cont)))))) + (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. This means that PGP stuff, signatures, cited text and (some) @@ -4623,6 +4750,9 @@ If given a prefix, show the hidden text instead." (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) +(eval-when-compile + (autoload 'nneething-get-file-name "nneething")) + (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." (let (do-update-line sparse-header) @@ -4672,12 +4802,10 @@ If given a prefix, show the hidden text instead." gnus-newsgroup-name))) (when (and (eq (car method) 'nneething) (vectorp header)) - (let ((dir (expand-file-name - (mail-header-subject header) - (file-name-as-directory - (or (cadr (assq 'nneething-address method)) - (nth 1 method)))))) - (when (file-directory-p dir) + (let ((dir (nneething-get-file-name + (mail-header-id header)))) + (when (and (stringp dir) + (file-directory-p dir)) (setq article 'nneething) (gnus-group-enter-directory dir)))))))) @@ -4716,6 +4844,11 @@ If given a prefix, show the hidden text instead." (numberp article) (gnus-cache-request-article article group)) 'article) + ;; Check the agent cache. + ((and gnus-agent gnus-agent-cache gnus-plugged + (numberp article) + (gnus-agent-request-article article group)) + 'article) ;; Get the article and put into the article buffer. ((or (stringp article) (numberp article)) @@ -4962,7 +5095,7 @@ groups." ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-handle-info 2) ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 0 t gnus-button-embedded-url 1) + ("]*\\)>" 1 t gnus-button-embedded-url 1) ;; Raw URLs. (,gnus-button-url-regexp 0 t browse-url 0)) "*Alist of regexps matching buttons in article bodies. @@ -4995,6 +5128,7 @@ variable it the real callback function." ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0) ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0) ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0) + ("^[^:]+:" "\\bmailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t gnus-button-message-id 3)) "*Alist of headers and regexps to match buttons in article heads. @@ -5383,7 +5517,7 @@ specified by `gnus-button-alist'." (if (not (string-match "=" cur)) nil ; Grace (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) - val (gnus-url-unhex-string (substring cur (match-end 0) nil))) + val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) (if downcase (setq key (downcase key))) (setq cur (assoc key retval)) @@ -5425,28 +5559,48 @@ specified by `gnus-button-alist'." (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") -(defvar gnus-prev-page-map nil) -(unless gnus-prev-page-map - (setq gnus-prev-page-map (make-sparse-keymap)) - (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) - (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) +(defvar gnus-prev-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-prev-page) + (define-key map "\r" 'gnus-button-prev-page) + map)) (defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil)) + (let ((b (point)) + (buffer-read-only nil)) (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 - article-type annotation)))) - -(defvar gnus-next-page-map nil) -(unless gnus-next-page-map - (setq gnus-next-page-map (make-keymap)) - (suppress-keymap gnus-prev-page-map) - (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) - (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) - -(defun gnus-button-next-page () + `(,@(gnus-local-map-property gnus-prev-page-map) + gnus-prev t + gnus-callback gnus-article-button-prev-page + article-type annotation)) + (widget-convert-button + 'link b (point) + :action 'gnus-button-prev-page + :button-keymap gnus-prev-page-map))) + +(defvar gnus-prev-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-prev-page) + (define-key map "\r" 'gnus-button-prev-page) + map)) + +(defvar gnus-next-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-next-page) + (define-key map "\r" 'gnus-button-next-page) + map)) + +(defun gnus-button-next-page (&optional args more-args) "Go to the next page." (interactive) (let ((win (selected-window))) @@ -5454,7 +5608,7 @@ specified by `gnus-button-alist'." (gnus-article-next-page) (select-window win))) -(defun gnus-button-prev-page () +(defun gnus-button-prev-page (&optional args more-args) "Go to the prev page." (interactive) (let ((win (selected-window))) @@ -5463,12 +5617,17 @@ specified by `gnus-button-alist'." (select-window win))) (defun gnus-insert-next-page-button () - (let ((buffer-read-only nil)) + (let ((b (point)) + (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 - article-type annotation)))) + `(,@(gnus-local-map-property gnus-next-page-map) + gnus-next t + gnus-callback gnus-article-button-next-page + article-type annotation)) + (widget-convert-button + 'link b (point) + :action 'gnus-button-next-page + :button-keymap gnus-next-page-map))) (defun gnus-article-button-next-page (arg) "Go to the next page." @@ -5797,14 +5956,11 @@ For example: (gnus-eval-format gnus-mime-security-button-line-format gnus-mime-security-button-line-format-alist - `(keymap ,gnus-mime-security-button-map - ,@(if (>= (string-to-number emacs-version) 21) - nil ;; XEmacs doesn't care - (list 'local-map gnus-mime-security-button-map)) - gnus-callback gnus-mime-security-press-button - gnus-line-format ,gnus-mime-security-button-line-format - article-type annotation - gnus-data ,handle)) + `(,@(gnus-local-map-property gnus-mime-security-button-map) + gnus-callback gnus-mime-security-press-button + gnus-line-format ,gnus-mime-security-button-line-format + article-type annotation + gnus-data ,handle)) (setq e (point)) (widget-convert-button 'link b e diff --git a/lisp/gnus-delay.el b/lisp/gnus-delay.el index c7652da..7e712b8 100644 --- a/lisp/gnus-delay.el +++ b/lisp/gnus-delay.el @@ -5,15 +5,17 @@ ;; Author: Kai Großjohann ;; Keywords: mail, news, extensions -;; This file 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 file 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. +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 diff --git a/lisp/gnus-diary.el b/lisp/gnus-diary.el index 2e434c6..11a2b83 100644 --- a/lisp/gnus-diary.el +++ b/lisp/gnus-diary.el @@ -1,24 +1,24 @@ ;;; gnus-diary.el --- Wrapper around the NNDiary Gnus backend -;; Copyright (C) 1999-2001 Didier Verna. +;; Copyright (c) 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001 Didier Verna. ;; Author: Didier Verna ;; Maintainer: Didier Verna ;; Created: Tue Jul 20 10:42:55 1999 -;; Last Revision: Wed Sep 12 12:31:09 2001 ;; Keywords: calendar mail news -;; This file is part of Gnus. +;; This file is part of GNU Emacs. -;; Gnus 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 of the License, or -;; (at your option) any later version. +;; GNU Emacs 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 of the License, +;; or (at your option) any later version. -;; Gnus 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. +;; GNU Emacs 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 this program; if not, write to the Free Software diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 61ab874..f3fd5a9 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,5 +1,5 @@ ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -48,8 +48,8 @@ (autoload 'appt-select-lowest-window "appt")) (if (featurep 'xemacs) - (autoload 'gnus-smiley-display "smiley") - (autoload 'gnus-smiley-display "smiley-ems")) ; override XEmacs version + (autoload 'smiley-region "smiley") + (autoload 'smiley-region "smiley-ems")) ; override XEmacs version (defun gnus-kill-all-overlays () "Delete all overlays in the current buffer." @@ -209,102 +209,32 @@ (goto-char (point-min)) (sit-for 0)))))) -(defvar gnus-article-xface-ring-internal nil - "Cache for face data.") - -;; Worth customizing? -(defvar gnus-article-xface-ring-size 6 - "Length of the ring used for `gnus-article-xface-ring-internal'.") - -(defvar gnus-article-compface-xbm - (condition-case () - (eq 0 (string-match "#define" - (shell-command-to-string "uncompface -X"))) - (error nil)) - "Non-nil means the compface program supports the -X option. -That produces XBM output.") - -(defun gnus-article-display-xface (data) - "Display the XFace header FACE in the current buffer. -Requires support for images in your Emacs and the external programs -`uncompface', and `icontopbm'. On a GNU/Linux system these -might be in packages with names like `compface' or `faces-xface' and -`netpbm' or `libgr-progs', for instance. See also -`gnus-article-compface-xbm'. - -This function is for Emacs 21+. See `gnus-xmas-article-display-xface' -for XEmacs." - ;; It might be worth converting uncompface's output in Lisp. - - (when (if (fboundp 'display-graphic-p) - (display-graphic-p)) - (unless gnus-article-xface-ring-internal ; Only load ring when needed. - (setq gnus-article-xface-ring-internal - (make-ring gnus-article-xface-ring-size))) - (save-excursion - (let* ((cur (current-buffer)) - (image (cdr-safe (assoc data (ring-elements - gnus-article-xface-ring-internal)))) - default-enable-multibyte-characters) - (unless image - (with-temp-buffer - (insert data) - (and (eq 0 (apply #'call-process-region (point-min) (point-max) - "uncompface" - 'delete '(t nil) nil - (if gnus-article-compface-xbm - '("-X")))) - (if gnus-article-compface-xbm - t - (goto-char (point-min)) - (progn (insert "/* Width=48, Height=48 */\n") t) - (eq 0 (call-process-region (point-min) (point-max) - "icontopbm" - 'delete '(t nil)))) - ;; Miles Bader says that faces don't look right as - ;; light on dark. - (if (eq 'dark (cdr-safe (assq 'background-mode - (frame-parameters)))) - (setq image (create-image (buffer-string) - (if gnus-article-compface-xbm - 'xbm - 'pbm) - t - :ascent 'center - :foreground "black" - :background "white")) - (setq image (create-image (buffer-string) - (if gnus-article-compface-xbm - 'xbm - 'pbm) - t - :ascent 'center))))) - (ring-insert gnus-article-xface-ring-internal (cons data image))) - (when image - (goto-char (point-min)) - (re-search-forward "^From:" nil 'move) - (while (get-text-property (point) 'display) - (goto-char (next-single-property-change (point) 'display))) - (gnus-add-wash-type 'xface) - (gnus-add-image 'xface image) - (insert-image image)))))) - ;;; Image functions. (defun gnus-image-type-available-p (type) (and (fboundp 'image-type-available-p) (image-type-available-p type))) -(defun gnus-create-image (file) - (create-image file)) +(defun gnus-create-image (file &optional type data-p &rest props) + (let ((face (plist-get props :face))) + (when face + (setq props (plist-put props :foreground (face-foreground face))) + (setq props (plist-put props :background (face-background face)))) + (apply 'create-image file type data-p props))) (defun gnus-put-image (glyph &optional string) - (insert-image glyph string)) + (insert-image glyph (or string " ")) + (unless string + (put-text-property (1- (point)) (point) + 'gnus-image-text-deletable t)) + glyph) (defun gnus-remove-image (image) - (dolist (position (gnus-text-with-property 'display)) + (dolist (position (message-text-with-property 'display)) (when (equal (get-text-property position 'display) image) - (put-text-property position (1+ position) 'display nil)))) + (put-text-property position (1+ position) 'display nil) + (when (get-text-property position 'gnus-image-text-deletable) + (delete-region position (1+ position)))))) (provide 'gnus-ems) diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el new file mode 100644 index 0000000..000a26c --- /dev/null +++ b/lisp/gnus-fun.el @@ -0,0 +1,231 @@ +;;; gnus-fun.el --- various frivoluos extension functions to Gnus +;; Copyright (C) 2002 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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. + +;;; Commentary: + +;;; Code: + +(defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory) + "*Directory where X-Face PBM files are stored." + :group 'gnus-fun + :type 'directory) + +(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" + "Command for converting a PBM to an X-Face." + :group 'gnus-fun + :type 'string) + +(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm 2>/dev/null | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface" + "Command for converting a GIF to an X-Face." + :group 'gnus-fun + :type 'string) + +;;;###autoload +(defun gnus-random-x-face () + "Insert a random X-Face header from `gnus-x-face-directory'." + (interactive) + (when (file-exists-p gnus-x-face-directory) + (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$")) + (file (nth (random (length files)) files))) + (when file + (shell-command-to-string + (format gnus-convert-pbm-to-x-face-command + (shell-quote-argument file))))))) + +;;;###autoload +(defun gnus-x-face-from-file (file) + "Insert an X-Face header based on an image file." + (interactive "fImage file name:" ) + (when (file-exists-p file) + (shell-command-to-string + (format gnus-convert-image-to-x-face-command + (shell-quote-argument file))))) + +(defun gnus-convert-image-to-gray-x-face (file depth) + (let* ((mapfile (make-temp-name (expand-file-name "gnus." mm-tmp-directory))) + (levels (expt 2 depth)) + (step (/ 255 (1- levels))) + color-alist bits bits-list mask pixel x-faces) + (with-temp-file mapfile + (insert "P3\n") + (insert (format "%d 1\n" levels)) + (insert "255\n") + (dotimes (i levels) + (insert (format "%d %d %d\n" + (* step i) (* step i) (* step i))) + (push (cons (* step i) i) color-alist))) + (when (file-exists-p file) + (with-temp-buffer + (insert (shell-command-to-string + (format "giftopnm %s | ppmnorm 2>/dev/null | pnmscale -width 48 -height 48 | ppmquant -fs -map %s 2>/dev/null | ppmtopgm | pnmnoraw" + (shell-quote-argument file) + mapfile))) + (goto-char (point-min)) + (forward-line 3) + (while (setq pixel (ignore-errors (read (current-buffer)))) + (push (cdr (assq pixel color-alist)) bits-list)) + (setq bits-list (nreverse bits-list)) + (dotimes (bit-number depth) + (setq mask (expt 2 bit-number)) + (with-temp-buffer + (insert "P1\n48 48\n") + (dolist (bits bits-list) + (insert (if (zerop (logand bits mask)) "0 " "1 "))) + (shell-command-on-region + (point-min) (point-max) + "pbmtoxbm | compface" + (current-buffer) t) + (push (buffer-string) x-faces)))) + (dotimes (i (length x-faces)) + (insert (if (zerop i) "X-Face:" (format "X-Face-%s:" i)) + (nth i x-faces)))) + (delete-file mapfile))) + +;;;###autoload +(defun gnus-convert-gray-x-face-to-xpm (faces) + (let* ((depth (length faces)) + (scale (/ 255 (1- (expt 2 depth)))) + (ok-p t) + bit-list bit-lists pixels pixel) + (dolist (face faces) + (setq bit-list nil) + (with-temp-buffer + (insert (uncompface face)) + (shell-command-on-region + (point-min) (point-max) + "pnmnoraw 2>/dev/null" + (current-buffer) t) + (goto-char (point-min)) + (forward-line 2) + (while (not (eobp)) + (cond + ((eq (following-char) ?0) + (push 0 bit-list)) + ((eq (following-char) ?1) + (push 1 bit-list))) + (forward-char 1))) + (unless (= (length bit-list) (* 48 48)) + (setq ok-p nil)) + (push bit-list bit-lists)) + (when ok-p + (dotimes (i (* 48 48)) + (setq pixel 0) + (dotimes (plane depth) + (setq pixel (+ (* pixel 2) (nth i (nth plane bit-lists))))) + (push pixel pixels)) + (with-temp-buffer + (insert "P2\n48 48\n255\n") + (dolist (pixel pixels) + (insert (number-to-string (* scale pixel)) " ")) + (shell-command-on-region + (point-min) (point-max) + "ppmtoxpm 2>/dev/null" + (current-buffer) t) + (buffer-string))))) + +;;;###autoload +(defun gnus-convert-gray-x-face-region (beg end) + "Convert the X-Faces in region to a PPM file." + (interactive "r") + (let ((input (buffer-substring beg end)) + faces) + (with-temp-buffer + (insert input) + (goto-char (point-min)) + (while (not (eobp)) + (save-restriction + (mail-header-narrow-to-field) + (push (mail-header-field-value) faces) + (goto-char (point-max))))) + (gnus-convert-gray-x-face-to-xpm faces))) + +(defface gnus-x-face '((t (:foreground "black" :background "white"))) + "Face to show X-Face. +The colors from this face are used as the foreground and background +colors of the displayed X-Faces." + :group 'gnus-article-headers) + +(defun gnus-display-x-face-in-from (data) + "Display the X-Face DATA in the From header." + (let ((default-enable-multibyte-characters nil) + pbm) + (when (or (gnus-image-type-available-p 'xface) + (and (gnus-image-type-available-p 'pbm) + (setq pbm (uncompface data)))) + (save-excursion + (save-restriction + (article-narrow-to-head) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-image + 'xface + (gnus-put-image + (if (gnus-image-type-available-p 'xface) + (gnus-create-image + (concat "X-Face: " data) + 'xface t :ascent 'center :face 'gnus-x-face) + (gnus-create-image + pbm 'pbm t :ascent 'center :face 'gnus-x-face)))) + (gnus-add-wash-type 'xface)))))) + +(defun gnus-grab-cam-x-face () + "Grab a picture off the camera and make it into an X-Face." + (interactive) + (shell-command "xawtv-remote snap ppm") + (let ((file nil)) + (while (null (setq file (directory-files "/tftpboot/sparky/tmp" + t "snap.*ppm"))) + (sleep-for 1)) + (setq file (car file)) + (with-temp-buffer + (shell-command + (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface" + file) + (current-buffer)) + ;;(sleep-for 3) + (delete-file file) + (buffer-string)))) + +(defun gnus-grab-gray-x-face () + "Grab a picture off the camera and make it into an X-Face." + (interactive) + (shell-command "xawtv-remote snap ppm") + (let ((file nil)) + (while (null (setq file (directory-files "/tftpboot/sparky/tmp" + t "snap.*ppm"))) + (sleep-for 1)) + (setq file (car file)) + (with-temp-buffer + (shell-command + (format "pnmcut -left 70 -top 100 -width 144 -height 144 '%s' | ppmquant 256 2>/dev/null | ppmtogif > '%s.gif'" + file file) + (current-buffer)) + (delete-file file)) + (gnus-convert-image-to-gray-x-face (concat file ".gif") 3) + (delete-file (concat file ".gif")))) + +(provide 'gnus-fun) + +;;; gnus-fun.el ends here diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index fe15317..9278e09 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -178,9 +178,6 @@ with some simple extensions. will be inserted into the buffer just like information from any other group specifier. -Text between %( and %) will be highlighted with `gnus-mouse-face' when -the mouse point move inside the area. There can only be one such area. - Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification is ignored altogether. If the spec is changed considerably, your @@ -191,7 +188,11 @@ If you use %o or %O, reading the active file will be slower and quite a bit of extra memory will be used. %D will also worsen performance. Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into -effect." +effect. + +General format specifiers can also be used. +See (gnus)Formatting Variables." + :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-group-visual :type 'string) @@ -412,7 +413,7 @@ For example: (defcustom gnus-group-name-charset-group-alist (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8)) - (and (fboundp 'coding-system-p) (coding-system-p 'utf-8))) + (and (fboundp 'coding-system-p) (coding-system-p 'utf-8))) '((".*" . utf-8)) nil) "Alist of group regexp and the charset for group names. @@ -1868,13 +1869,15 @@ Returns whether the fetching was successful or not." ;; if selection was successful. (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only - select-articles) + select-articles + parameters) "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. +If PARAMETERS, use those as the group parameters. Return the name of the group if selection was successful." ;; Transform the select method into a unique server. @@ -1891,10 +1894,13 @@ Return the name of the group if selection was successful." group `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method - ((quit-config . - ,(if quit-config quit-config - (cons gnus-summary-buffer - gnus-current-window-configuration)))))) + ,(cons + (if quit-config + (cons 'quit-config quit-config) + (cons 'quit-config + (cons gnus-summary-buffer + gnus-current-window-configuration))) + parameters))) gnus-newsrc-hashtb) (push method gnus-ephemeral-servers) (set-buffer gnus-group-buffer) @@ -3686,7 +3692,11 @@ The hook gnus-suspend-gnus-hook is called before actually suspending." ;; Kill Gnus buffers except for group mode buffer. (let ((group-buf (get-buffer gnus-group-buffer))) (mapcar (lambda (buf) - (unless (member buf (list group-buf gnus-dribble-buffer)) + (unless (or (member buf (list group-buf gnus-dribble-buffer)) + (progn + (save-excursion + (set-buffer buf) + (eq major-mode 'message-mode)))) (gnus-kill-buffer buf))) (gnus-buffers)) (gnus-kill-gnus-frames) @@ -4006,22 +4016,28 @@ This command may read the active file." (defun gnus-group-mark-article-read (group article) "Mark ARTICLE read." - (gnus-activate-group group) (let ((buffer (gnus-summary-buffer-name group)) - (mark gnus-read-mark)) - (unless - (and - (get-buffer buffer) - (with-current-buffer buffer - (when gnus-newsgroup-prepared - (when (and gnus-newsgroup-auto-expire - (memq mark gnus-auto-expirable-marks)) - (setq mark gnus-expirable-mark)) - (setq mark (gnus-request-update-mark - group article mark)) - (gnus-mark-article-as-read article mark) - (setq gnus-newsgroup-active (gnus-active group)) - t))) + (mark gnus-read-mark) + active n) + (if (get-buffer buffer) + (with-current-buffer buffer + (setq active gnus-newsgroup-active) + (gnus-activate-group group) + (when gnus-newsgroup-prepared + (when (and gnus-newsgroup-auto-expire + (memq mark gnus-auto-expirable-marks)) + (setq mark gnus-expirable-mark)) + (setq mark (gnus-request-update-mark + group article mark)) + (gnus-mark-article-as-read article mark) + (setq gnus-newsgroup-active (gnus-active group)) + (when active + (setq n (1+ (cdr active))) + (while (<= n (cdr gnus-newsgroup-active)) + (unless (eq n article) + (push n gnus-newsgroup-unselected)) + (setq n (1+ n)))))) + (gnus-activate-group group) (gnus-group-make-articles-read group (list article)) (when (gnus-group-auto-expirable-p group) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index fbb50db..91c687a 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,5 +1,5 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -35,6 +35,13 @@ :group 'gnus-start :type 'hook) +(defvar gnus-server-unopen-status nil + "The default status if the server is not able to open. +If the server is covered by Gnus agent, the possible values are +`denied', set the server denied; `offline', set the server offline; +`nil', ask user. If the server is not covered by Gnus agent, set the +server denied.") + ;;; ;;; Server Communication ;;; @@ -195,9 +202,25 @@ If it is down, start it up (again)." (setq elem (list gnus-command-method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. - (setcar (cdr elem) (if result 'ok 'denied)) + (setcar (cdr elem) + (if result + (if (eq (cadr elem) 'offline) + 'offline + 'ok) + (if (and gnus-agent + (not (eq (cadr elem) 'offline)) + (gnus-agent-method-p gnus-command-method)) + (or gnus-server-unopen-status + (if (gnus-y-or-n-p + (format "Unable to open %s:%s, go offline? " + (car gnus-command-method) + (cadr gnus-command-method))) + 'offline + 'denied)) + 'denied))) ;; Return the result from the "open" call. - result)))) + (or (eq (cadr elem) 'offline) + result))))) (defun gnus-close-server (gnus-command-method) "Close the connection to GNUS-COMMAND-METHOD." @@ -300,11 +323,16 @@ this group uses will be queried." "Request headers for ARTICLES in GROUP. If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (let ((gnus-command-method (gnus-find-method-for-group group))) - (if (and gnus-use-cache (numberp (car articles))) - (gnus-cache-retrieve-headers articles group fetch-old) + (cond + ((and gnus-use-cache (numberp (car articles))) + (gnus-cache-retrieve-headers articles group fetch-old)) + ((and gnus-agent gnus-agent-cache (gnus-online gnus-command-method) + (gnus-agent-method-p gnus-command-method)) + (gnus-agent-retrieve-headers articles group fetch-old)) + (t (funcall (gnus-get-function gnus-command-method 'retrieve-headers) articles (gnus-group-real-name group) - (nth 1 gnus-command-method) fetch-old)))) + (nth 1 gnus-command-method) fetch-old))))) (defun gnus-retrieve-articles (articles group) "Request ARTICLES in GROUP." @@ -369,6 +397,11 @@ If BUFFER, insert the article in that group." (gnus-cache-request-article article group)) (setq res (cons group article) clean-up t)) + ((and gnus-agent gnus-agent-cache gnus-plugged + (numberp article) + (gnus-agent-request-article article group)) + (setq res (cons group article) + clean-up t)) ;; Use `head' function. ((fboundp head) (setq res (funcall head article (gnus-group-real-name group) @@ -398,6 +431,12 @@ If BUFFER, insert the article in that group." (gnus-cache-request-article article group)) (setq res (cons group article) clean-up t)) + ;; Check the agent cache. + ((and gnus-agent gnus-agent-cache gnus-plugged + (numberp article) + (gnus-agent-request-article article group)) + (setq res (cons group article) + clean-up t)) ;; Use `head' function. ((fboundp head) (setq res (funcall head article (gnus-group-real-name group) diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index 13c9a20..77fc948 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -1,5 +1,5 @@ ;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -59,21 +59,21 @@ (defun gnus-score-advanced (rule &optional trace) "Apply advanced scoring RULE to all the articles in the current group." - (let ((headers gnus-newsgroup-headers) - gnus-advanced-headers score) - (while (setq gnus-advanced-headers (pop headers)) - (when (gnus-advanced-score-rule (car rule)) - ;; This rule was successful, so we add the score to - ;; this article. + (let (new-score score multiple) + (dolist (gnus-advanced-headers gnus-newsgroup-headers) + (when (setq multiple (gnus-advanced-score-rule (car rule))) + (setq new-score (or (nth 1 rule) + gnus-score-interactive-default-score)) + (when (numberp multiple) + (setq new-score (* multiple new-score))) + ;; This rule was successful, so we add the score to this + ;; article. (if (setq score (assq (mail-header-number gnus-advanced-headers) gnus-newsgroup-scored)) (setcdr score - (+ (cdr score) - (or (nth 1 rule) - gnus-score-interactive-default-score))) + (+ (cdr score) new-score)) (push (cons (mail-header-number gnus-advanced-headers) - (or (nth 1 rule) - gnus-score-interactive-default-score)) + new-score) gnus-newsgroup-scored) (when trace (push (cons "A file" rule) @@ -116,7 +116,7 @@ ;; 1- type redirection. (string-to-number (substring (symbol-name type) - (match-beginning 0) (match-end 0))) + (match-beginning 1) (match-end 1))) ;; ^^^ type redirection. (length (symbol-name type)))))) (when gnus-advanced-headers @@ -129,9 +129,8 @@ (error "Unknown advanced score type: %s" rule))))) (defun gnus-advanced-score-article (rule) - ;; `rule' is a semi-normal score rule, so we find out - ;; what function that's supposed to do the actual - ;; processing. + ;; `rule' is a semi-normal score rule, so we find out what function + ;; that's supposed to do the actual processing. (let* ((header (car rule)) (func (assoc (downcase header) gnus-advanced-index))) (if (not func) @@ -189,8 +188,8 @@ 'gnus-request-body) (t 'gnus-request-article))) ofunc article) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. + ;; Not all backends support partial fetching. In that case, we + ;; just fetch the entire article. (unless (gnus-check-backend-function (intern (concat "request-" header)) gnus-newsgroup-name) @@ -201,8 +200,8 @@ (when (funcall request-func article gnus-newsgroup-name) (goto-char (point-min)) ;; If just parts of the article is to be searched and the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. + ;; backend didn't support partial fetching, we just narrow to + ;; the relevant parts. (when ofunc (if (eq ofunc 'gnus-request-head) (narrow-to-region diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index af72688..5e863eb 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,5 @@ ;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -132,11 +132,27 @@ See Info node `(gnus)Posting Styles'." (variable) (sexp))))))) -(defcustom gnus-inews-mark-gcc-as-read nil +(defcustom gnus-gcc-mark-as-read nil "If non-nil, automatically mark Gcc articles as read." :group 'gnus-message :type 'boolean) +(defvar gnus-inews-mark-gcc-as-read nil + "Obsolete variable. Use `gnus-gcc-mark-as-read' instead.") + +(make-obsolete-variable 'gnus-inews-mark-gcc-as-read + 'gnus-gcc-mark-as-read) + +(defcustom gnus-gcc-externalize-attachments nil + "Should local-file attachments be included as external parts in Gcc copies? +If it is `all', attach files as external parts; +if a regexp and matches the Gcc group name, attach files as external parts; +If nil, attach files as normal parts." + :group 'gnus-message + :type '(choice (const nil :tag "None") + (const all :tag "Any") + (string :tag "Regexp"))) + (defcustom gnus-group-posting-charset-alist '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) @@ -228,7 +244,7 @@ Thank you for your help in stamping out bugs. "w" gnus-summary-wide-reply "W" gnus-summary-wide-reply-with-original "v" gnus-summary-very-wide-reply - "W" gnus-summary-very-wide-reply-with-original + "V" gnus-summary-very-wide-reply-with-original "n" gnus-summary-followup-to-mail "N" gnus-summary-followup-to-mail-with-original "m" gnus-summary-mail-other-window @@ -550,12 +566,19 @@ a news." (defun gnus-summary-followup (yank &optional force-news) "Compose a followup to an article. -If prefix argument YANK is non-nil, original article is yanked automatically." +If prefix argument YANK is non-nil, the original article is yanked +automatically. +YANK is a list of elements, where the car of each element is the +article number, and the two following numbers is the region to be +yanked." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (when yank - (gnus-summary-goto-subject (car yank))) + (gnus-summary-goto-subject + (if (listp (car yank)) + (caar yank) + (car yank)))) (save-window-excursion (gnus-summary-select-article)) (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) @@ -583,18 +606,21 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (gnus-summary-followup (gnus-summary-work-articles arg) t)) (defun gnus-inews-yank-articles (articles) - (let (beg article) + (let (beg article yank-string) (message-goto-body) (while (setq article (pop articles)) + (when (listp article) + (setq yank-string (nth 1 article) + article (nth 0 article))) (save-window-excursion (set-buffer gnus-summary-buffer) (gnus-summary-select-article nil nil nil article) (gnus-summary-remove-process-mark article)) - (gnus-copy-article-buffer) + (gnus-copy-article-buffer nil yank-string) (let ((message-reply-buffer gnus-article-copy) (message-reply-headers + ;; The headers are decoded. (with-current-buffer gnus-article-copy - ;; The headers are decoded. (nnheader-parse-head t)))) (message-yank-original) (setq beg (or beg (mark t)))) @@ -644,7 +670,7 @@ header line with the old Message-ID." -(defun gnus-copy-article-buffer (&optional article-buffer) +(defun gnus-copy-article-buffer (&optional article-buffer yank-string) ;; make a copy of the article buffer with all text properties removed ;; this copy is in the buffer gnus-article-copy. ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used @@ -671,6 +697,10 @@ header line with the old Message-ID." (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-buffer gnus-article-copy) + (when yank-string + (message-goto-body) + (delete-region (point) (point-max)) + (insert yank-string)) (gnus-article-delete-text-of-type 'annotation) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) @@ -683,8 +713,8 @@ header line with the old Message-ID." (goto-char (point-min)) (while (looking-at message-unix-mail-delimiter) (forward-line 1)) - (setq beg (point)) - (setq end (or (message-goto-body) beg)) + (setq beg (point) + end (or (message-goto-body) beg)) ;; Delete the headers from the displayed articles. (set-buffer gnus-article-copy) (delete-region (goto-char (point-min)) @@ -892,11 +922,15 @@ If VERY-WIDE, make a very wide reply." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (when yank - (gnus-summary-goto-subject (car yank))) - (let ((gnus-article-reply (or yank (gnus-summary-article-number))) - (headers "")) + (let* ((article + (if (listp (car yank)) + (caar yank) + (car yank))) + (gnus-article-reply (or article (gnus-summary-article-number))) + (headers "")) + ;; Stripping headers should be specified with mail-yank-ignored-headers. + (when yank + (gnus-summary-goto-subject article)) (gnus-setup-message (if yank 'reply-yank 'reply) (if (not very-wide) (gnus-summary-select-article) @@ -1020,7 +1054,14 @@ For the `inline' alternatives, also see the variable (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." (interactive - (list (message-read-from-minibuffer "Resend message(s) to: ") + (list (message-read-from-minibuffer + "Resend message(s) to: " + (when (gnus-buffer-live-p gnus-original-article-buffer) + ;; If some other article is currently selected, the + ;; initial-contents is wrong. Whatever, it is just the + ;; initial-contents. + (with-current-buffer gnus-original-article-buffer + (nnmail-fetch-field "to")))) current-prefix-arg)) (let ((articles (gnus-summary-work-articles n)) article) @@ -1207,7 +1248,7 @@ If YANK is non-nil, include the original article." (erase-buffer) (gnus-debug) (setq text (buffer-string))) - (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) + (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) @@ -1335,7 +1376,8 @@ this is a reply." (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) (cur (current-buffer)) - groups group method group-art) + groups group method group-art + mml-externalize-attachments) (when gcc (message-remove-header "gcc") (widen) @@ -1349,6 +1391,10 @@ this is a reply." (car method)))) (unless (gnus-request-group group nil method) (gnus-request-create-group group method)) + (setq mml-externalize-attachments + (if (stringp gnus-gcc-externalize-attachments) + (string-match gnus-gcc-externalize-attachments group) + gnus-gcc-externalize-attachments)) (save-excursion (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) @@ -1391,7 +1437,9 @@ this is a reply." (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) - (when (and group-art gnus-inews-mark-gcc-as-read) + (when (and group-art + (or gnus-gcc-mark-as-read + gnus-inews-mark-gcc-as-read)) (gnus-group-mark-article-read group (cdr group-art))) (kill-buffer (current-buffer))))))))) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 5cb616d..e273667 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -1,6 +1,6 @@ ;;; gnus-picon.el --- displaying pretty icons in Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Wes Hardaker @@ -44,32 +44,21 @@ ;;; User variables: -(defgroup picon nil - "Show pictures of people, domains, and newsgroups." - :group 'gnus-visual) - -(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") - "*Defines the location of the faces database. -For information on obtaining this database of pretty pictures, please -see http://www.cs.indiana.edu/picons/ftp/index.html" - :type 'directory - :group 'picon) - (defcustom gnus-picon-news-directories '("news") "*List of directories to search for newsgroups faces." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defcustom gnus-picon-user-directories '("users" "usenix" "local" "misc") "*List of directories to search for user faces." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defcustom gnus-picon-domain-directories '("domains") "*List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defcustom gnus-picon-file-types (let ((types (list "xbm"))) @@ -80,15 +69,15 @@ Some people may want to add \"unknown\" to this list." types) "*List of suffixes on picon file names to try." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defface gnus-picon-xbm-face '((t (:foreground "black" :background "white"))) "Face to show xbm picon in." - :group 'picon) + :group 'gnus-picon) (defface gnus-picon-face '((t (:foreground "black" :background "white"))) "Face to show picon in." - :group 'picon) + :group 'gnus-picon) ;;; Internal variables: @@ -96,6 +85,7 @@ Some people may want to add \"unknown\" to this list." (defvar gnus-picon-glyph-alist nil "Picon glyphs cache. List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") +(defvar gnus-picon-cache nil) ;;; Functions: @@ -107,29 +97,30 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") (split-string (car address) "\\.")))) (defun gnus-picon-find-face (address directories &optional exact) - (let* ((databases gnus-picon-databases) - (address (gnus-picon-split-address address)) + (let* ((address (gnus-picon-split-address address)) (user (pop address)) - database directory found instance base) - (while (and (not found) - (setq database (pop databases))) - (while (and (not found) - (setq directory (pop directories))) - (setq base (expand-file-name directory database)) - ;; Kludge to search misc/MISC for users. - (when (string= directory "misc") - (setq address '("MISC"))) - (while (and (not found) - address) - (setq found (gnus-picon-find-image - (concat base "/" (mapconcat 'identity - (reverse address) - "/") - "/" user "/"))) - (if exact - (setq address nil) - (pop address))))) - found)) + (faddress address) + database directory result instance base) + (catch 'found + (dolist (database gnus-picon-databases) + (dolist (directory directories) + (setq address faddress + base (expand-file-name directory database)) + (while address + (when (setq result (gnus-picon-find-image + (concat base "/" (mapconcat 'downcase + (reverse address) + "/") + "/" (downcase user) "/"))) + (throw 'found result)) + (if exact + (setq address nil) + (pop address))) + ;; Kludge to search MISC as well. But not in "news". + (unless (string= directory "news") + (when (setq result (gnus-picon-find-image + (concat base "/MISC/" user "/"))) + (throw 'found result)))))))) (defun gnus-picon-find-image (directory) (let ((types gnus-picon-file-types) @@ -161,67 +152,78 @@ GLYPH can be either a glyph or a string." (gnus-with-article-headers (let ((addresses (mail-header-parse-addresses (mail-fetch-field header))) - first spec file) + spec file point cache) (dolist (address addresses) - (setq address (car address) - first t) + (setq address (car address)) (when (and (stringp address) (setq spec (gnus-picon-split-address address))) - (when (setq file (gnus-picon-find-face - address gnus-picon-user-directories)) - (setcar spec (cons (gnus-picon-create-glyph file) - (car spec)))) - (dotimes (i (1- (length spec))) - (when (setq file (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (nthcdr (1+ i) spec) ".")) - gnus-picon-domain-directories t)) - (setcar (nthcdr (1+ i) spec) - (cons (gnus-picon-create-glyph file) - (nth (1+ i) spec))))) + (if (setq cache (cdr (assoc address gnus-picon-cache))) + (setq spec cache) + (when (setq file (or (gnus-picon-find-face + address gnus-picon-user-directories) + (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (cdr spec) ".")) + gnus-picon-user-directories))) + (setcar spec (cons (gnus-picon-create-glyph file) + (car spec)))) + + (dotimes (i (1- (length spec))) + (when (setq file (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (nthcdr (1+ i) spec) ".")) + gnus-picon-domain-directories t)) + (setcar (nthcdr (1+ i) spec) + (cons (gnus-picon-create-glyph file) + (nth (1+ i) spec))))) + (setq spec (nreverse spec)) + (push (cons address spec) gnus-picon-cache)) (gnus-article-goto-header header) (mail-header-narrow-to-field) (when (search-forward address nil t) (delete-region (match-beginning 0) (match-end 0)) + (setq point (point)) (while spec - (gnus-picon-insert-glyph (pop spec) category) - (when spec - (if (not first) - (insert ".") - (insert "@") - (setq first nil)))))))))) + (goto-char point) + (if (> (length spec) 2) + (insert ".") + (if (= (length spec) 2) + (insert "@"))) + (gnus-picon-insert-glyph (pop spec) category)))))))) (defun gnus-picon-transform-newsgroups (header) (interactive) (gnus-with-article-headers - (let ((groups - (sort - (message-tokenize-header (mail-fetch-field header)) - (lambda (g1 g2) (> (length g1) (length g2))))) - spec file) + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (let ((groups (message-tokenize-header (mail-fetch-field header))) + spec file point) (dolist (group groups) - (setq spec (nreverse (split-string group "[.]"))) - (dotimes (i (length spec)) - (when (setq file (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (nthcdr i spec) ".")) - gnus-picon-news-directories t)) - (setcar (nthcdr i spec) - (cons (gnus-picon-create-glyph file) - (nth i spec))))) - - (gnus-article-goto-header header) - (mail-header-narrow-to-field) + (unless (setq spec (cdr (assoc group gnus-picon-cache))) + (setq spec (nreverse (split-string group "[.]"))) + (dotimes (i (length spec)) + (when (setq file (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (nthcdr i spec) ".")) + gnus-picon-news-directories t)) + (setcar (nthcdr i spec) + (cons (gnus-picon-create-glyph file) + (nth i spec))))) + (push (cons group spec) gnus-picon-cache)) (when (search-forward group nil t) (delete-region (match-beginning 0) (match-end 0)) - (setq spec (nreverse spec)) - (while spec - (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon) - (when spec - (insert ".")))))))) + (save-restriction + (narrow-to-region (point) (point)) + (while spec + (goto-char (point-min)) + (if (> (length spec) 1) + (insert ".")) + (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)) + (goto-char (point-max)))))))) ;;; Commands: diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index fe7db38..a10fb63 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,5 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen @@ -643,7 +643,7 @@ used as score." (and gnus-extra-headers (equal (nth 1 entry) "extra") (intern ; need symbol - (gnus-completing-read + (gnus-completing-read-with-default (symbol-name (car gnus-extra-headers)) ; default response "Score extra header:" ; prompt (mapcar (lambda (x) ; completion list @@ -1208,7 +1208,6 @@ EXTRA is the possible non-standard header." (setq gnus-newsgroup-adaptive t) adapt) (t - ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) (setq gnus-thread-expunge-below (or thread-mark-and-expunge gnus-thread-expunge-below)) diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 92a9e80..c9f0e5a 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,5 +1,5 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -30,7 +30,7 @@ (require 'gnus) -(defcustom gnus-use-correct-string-widths t +(defcustom gnus-use-correct-string-widths (featurep 'xemacs) "*If non-nil, use correct functions for dealing with wide characters." :group 'gnus-format :type 'boolean) @@ -74,6 +74,8 @@ (defvar gnus-tmp-article-number) (defvar gnus-mouse-face) (defvar gnus-mouse-face-prop) +(defvar gnus-tmp-header) +(defvar gnus-tmp-from) (defun gnus-summary-line-format-spec () (insert gnus-tmp-unread gnus-tmp-replied @@ -82,13 +84,15 @@ (point) (progn (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (substring gnus-tmp-name 0 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) + (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines + (let ((val + (inline + (gnus-summary-from-or-to-or-newsgroups + gnus-tmp-header gnus-tmp-from)))) + (if (> (length val) 23) + (substring val 0 23) + val)) + gnus-tmp-closing-bracket)) (point)) gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject-or-nil "\n")) @@ -129,10 +133,12 @@ (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) (summary-dummy "* %(: :%) %S\n" ,gnus-summary-dummy-line-format-spec) - (summary "%U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n" + (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" ,gnus-summary-line-format-spec)) "Alist of format specs.") +(defvar gnus-default-format-specs gnus-format-specs) + (defvar gnus-article-mode-line-format-spec nil) (defvar gnus-summary-mode-line-format-spec nil) (defvar gnus-group-mode-line-format-spec nil) @@ -175,8 +181,9 @@ ;; Make the indentation array. ;; See whether all the stored info needs to be flushed. (when (or force + (not gnus-newsrc-file-version) (not (equal (gnus-continuum-version) - (cdr (assq 'gnus-version gnus-format-specs)))) + (gnus-continuum-version gnus-newsrc-file-version))) (not (equal emacs-version (cdr (assq 'version gnus-format-specs))))) (setq gnus-format-specs nil)) @@ -257,12 +264,20 @@ (defun gnus-spec-tab (column) (if (> column 0) `(insert (make-string (max (- ,column (current-column)) 0) ? )) - `(progn - (if (> (current-column) ,(abs column)) - (delete-region (point) - (- (point) (- (current-column) ,(abs column)))) - (insert (make-string (max (- ,(abs column) (current-column)) 0) - ? )))))) + (let ((column (abs column))) + (if gnus-use-correct-string-widths + `(progn + (if (> (current-column) ,column) + (while (progn + (delete-backward-char 1) + (> (current-column) ,column)))) + (insert (make-string (max (- ,column (current-column)) 0) ? ))) + `(progn + (if (> (current-column) ,column) + (delete-region (point) + (- (point) (- (current-column) ,column))) + (insert (make-string (max (- ,column (current-column)) 0) + ? )))))))) (defun gnus-correct-length (string) "Return the correct width of STRING." @@ -292,15 +307,29 @@ (setq wend seek) (substring string wstart (1- wend)))) +(defun gnus-string-width-function () + (cond + (gnus-use-correct-string-widths + 'gnus-correct-length) + ((fboundp 'string-width) + 'string-width) + (t + 'length))) + +(defun gnus-substring-function () + (cond + (gnus-use-correct-string-widths + 'gnus-correct-substring) + ((fboundp 'string-width) + 'gnus-correct-substring) + (t + 'substring))) + (defun gnus-tilde-max-form (el max-width) "Return a form that limits EL to MAX-WIDTH." (let ((max (abs max-width)) - (length-fun (if gnus-use-correct-string-widths - 'gnus-correct-length - 'length)) - (substring-fun (if gnus-use-correct-string-widths - 'gnus-correct-substring - 'substring))) + (length-fun (gnus-string-width-function)) + (substring-fun (gnus-substring-function))) (if (symbolp el) `(if (> (,length-fun ,el) ,max) ,(if (< max-width 0) @@ -317,12 +346,8 @@ (defun gnus-tilde-cut-form (el cut-width) "Return a form that cuts CUT-WIDTH off of EL." (let ((cut (abs cut-width)) - (length-fun (if gnus-use-correct-string-widths - 'gnus-correct-length - 'length)) - (substring-fun (if gnus-use-correct-string-widths - 'gnus-correct-substring - 'substring))) + (length-fun (gnus-string-width-function)) + (substring-fun (gnus-substring-function))) (if (symbolp el) `(if (> (,length-fun ,el) ,cut) ,(if (< cut-width 0) @@ -345,26 +370,31 @@ (if (equal val ,ignore-value) "" val)))) -(defun gnus-correct-pad-form (el pad-width) +(defun gnus-pad-form (el pad-width) "Return a form that pads EL to PAD-WIDTH accounting for multi-column characters correctly. This is because `format' may pad to columns or to characters when given a pad value." (let ((pad (abs pad-width)) (side (< 0 pad-width))) (if (symbolp el) - `(let ((need (- ,pad (gnus-correct-length ,el)))) + `(let ((need (- ,pad (,(if gnus-use-correct-string-widths + 'gnus-correct-length + 'length) + ,el)))) (if (> need 0) (concat ,(when side '(make-string need ?\ )) ,el ,(when (not side) '(make-string need ?\ ))) ,el)) `(let* ((val (eval ,el)) - (need (- ,pad (gnus-correct-length ,el)))) + (need (- ,pad (,(if gnus-use-correct-string-widths + 'gnus-correct-length + 'length) val)))) (if (> need 0) (concat ,(when side '(make-string need ?\ )) - ,el + val ,(when (not side) '(make-string need ?\ ))) - ,el))))) + val))))) (defun gnus-parse-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the @@ -375,9 +405,9 @@ characters when given a pad value." ;; them will have the balloon-help text property. (let ((case-fold-search nil)) (if (string-match - "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'" - format) - (gnus-parse-complex-format format spec-alist) + "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=" + format) + (gnus-parse-complex-format format spec-alist) ;; This is a simple format. (gnus-parse-simple-format format spec-alist insert)))) @@ -572,7 +602,7 @@ characters when given a pad value." (when max-width (setq el (gnus-tilde-max-form el max-width))) (when pad-width - (setq el (gnus-correct-pad-form el pad-width))) + (setq el (gnus-pad-form el pad-width))) (push el flist))) (insert elem-type) (push (car elem) flist)))) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index dbf3776..736d61a 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -1,5 +1,5 @@ ;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -55,7 +55,11 @@ The following specs are understood: %n name %w address %s status -%a agent covered" +%a agent covered + +General format specifiers can also be used. +See (gnus)Formatting Variables." + :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-server-visual :type 'string) @@ -117,6 +121,7 @@ If nil, a faster, but more primitive, buffer is used instead." '("Connections" ["Open" gnus-server-open-server t] ["Close" gnus-server-close-server t] + ["Offline" gnus-server-offline-server t] ["Deny" gnus-server-deny-server t] "---" ["Open All" gnus-server-open-all-servers t] @@ -150,6 +155,7 @@ If nil, a faster, but more primitive, buffer is used instead." "C" gnus-server-close-server "\M-c" gnus-server-close-all-servers "D" gnus-server-deny-server + "L" gnus-server-offline-server "R" gnus-server-remove-denials "n" next-line @@ -189,6 +195,13 @@ If nil, a faster, but more primitive, buffer is used instead." "Face used for displaying DENIED servers" :group 'gnus-server-visual) +(defface gnus-server-offline-face + '((((class color) (background light)) (:foreground "Orange" :bold t)) + (((class color) (background dark)) (:foreground "Yellow" :bold t)) + (t (:inverse-video t :bold t))) + "Face used for displaying OFFLINE servers" + :group 'gnus-server-visual) + (defcustom gnus-server-agent-face 'gnus-server-agent-face "Face name to use on AGENTIZED servers." :group 'gnus-server-visual @@ -209,11 +222,17 @@ If nil, a faster, but more primitive, buffer is used instead." :group 'gnus-server-visual :type 'face) +(defcustom gnus-server-offline-face 'gnus-server-offline-face + "Face name to use on OFFLINE servers." + :group 'gnus-server-visual + :type 'face) + (defvar gnus-server-font-lock-keywords (list '("(\\(agent\\))" 1 gnus-server-agent-face) '("(\\(opened\\))" 1 gnus-server-opened-face) '("(\\(closed\\))" 1 gnus-server-closed-face) + '("(\\(offline\\))" 1 gnus-server-offline-face) '("(\\(denied\\))" 1 gnus-server-denied-face))) (defun gnus-server-mode () @@ -251,14 +270,16 @@ The following commands are available: (gnus-tmp-where (nth 1 method)) (elem (assoc method gnus-opened-servers)) (gnus-tmp-status - (if (eq (nth 1 elem) 'denied) - "(denied)" + (cond + ((eq (nth 1 elem) 'denied) "(denied)") + ((eq (nth 1 elem) 'offline) "(offline)") + (t (condition-case nil (if (or (gnus-server-opened method) (eq (nth 1 elem) 'ok)) "(opened)" "(closed)") - ((error) "(error)")))) + ((error) "(error)"))))) (gnus-tmp-agent (if (and gnus-agent (member method gnus-agent-covered-methods)) @@ -477,6 +498,18 @@ The following commands are available: (gnus-server-update-server server) (gnus-server-position-point)))) +(defun gnus-server-offline-server (server) + "Set SERVER to offline." + (interactive (list (gnus-server-server-name))) + (let ((method (gnus-server-to-method server))) + (unless method + (error "No such server: %s" server)) + (prog1 + (gnus-close-server method) + (gnus-server-set-status method 'offline) + (gnus-server-update-server server) + (gnus-server-position-point)))) + (defun gnus-server-close-all-servers () "Close all servers." (interactive) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 01d5351..295d4c9 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,5 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -409,11 +409,8 @@ Can be used to turn version control on or off." ;;; Internal variables -(defvar gnus-startup-file-coding-system 'binary - "*Coding system for startup file.") - (defvar gnus-ding-file-coding-system mm-universal-coding-system - "*Coding system for ding file.") + "Coding system for ding file.") (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) @@ -441,25 +438,15 @@ Can be used to turn version control on or off." (if gnus-init-inhibit (setq gnus-init-inhibit nil) (setq gnus-init-inhibit inhibit-next) - (let ((files (list gnus-site-init-file gnus-init-file)) - file) - (while files - (and (setq file (pop files)) - (or (and (file-exists-p file) - ;; Don't try to load a directory. - (not (file-directory-p file))) - (file-exists-p (concat file ".el")) - (file-exists-p (concat file ".elc"))) - (if (or debug-on-error debug-on-quit) - (let ((coding-system-for-read - gnus-startup-file-coding-system)) - (load file nil t)) - (condition-case var - (let ((coding-system-for-read - gnus-startup-file-coding-system)) - (load file nil t)) - (error - (error "Error in %s: %s" file var)))))))))) + (dolist (file (list gnus-site-init-file gnus-init-file)) + (when (and file + (locate-library file)) + (if (or debug-on-error debug-on-quit) + (load file nil t) + (condition-case var + (load file nil t) + (error + (error "Error in %s: %s" file var))))))))) ;; For subscribing new newsgroup @@ -624,7 +611,7 @@ the first newsgroup." (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) + (let ((variables (delete 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) @@ -1603,7 +1590,7 @@ newsgroup." (when (and (<= (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 active) + (when (and gnus-agent active (gnus-online method)) (gnus-agent-save-group-info method (gnus-group-real-name group) active)) (unless (inline (gnus-virtual-group-p group)) @@ -1910,7 +1897,7 @@ newsgroup." (insert ?\\))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active gnus-plugged) + (when (and gnus-agent real-active (gnus-online method)) (gnus-agent-save-active method)) ;; If these are groups from a foreign select method, we insert the @@ -1986,7 +1973,7 @@ newsgroup." ;; Let the Gnus agent save the active file. (if (and gnus-agent real-active - gnus-plugged + (gnus-online method) (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) @@ -2027,7 +2014,7 @@ newsgroup." "Read startup file. If FORCE is non-nil, the .newsrc file is read." ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables gnus-variable-list)) + (let ((variables (delete 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) @@ -2112,8 +2099,8 @@ If FORCE is non-nil, the .newsrc file is read." (and gnus-newsrc-file-version (gnus-continuum-version gnus-newsrc-file-version)))) (when (or (not version) - (< version 5.090002)) - (setq gnus-format-specs nil))) + (< version 5.090009)) + (setq gnus-format-specs gnus-default-format-specs))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc))) (gnus-make-hashtable-from-newsrc-alist) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 7960b8d..0df3f3f 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,5 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -234,6 +234,7 @@ simplification is selected." (defcustom gnus-thread-hide-subtree nil "*If non-nil, hide all threads initially. +This can be a predicate specifier which says which threads to hide. If threads are hidden, you have to run the command `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' to expose hidden threads." @@ -294,13 +295,16 @@ This variable can either be the symbols `first' (place point on the first subject), `unread' (place point on the subject line of the first unread article), `best' (place point on the subject line of the higest-scored article), `unseen' (place point on the subject line of -the first unseen article), or a function to be called to place point on -some subject line.." +the first unseen article), 'unseen-or-unread' (place point on the subject +line of the first unseen article or, if all article have been seen, on the +subject line of the first unread article), or a function to be called to +place point on some subject line.." :group 'gnus-group-select :type '(choice (const best) (const unread) (const first) - (const unseen))) + (const unseen) + (const unseen-or-unread))) (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. @@ -570,7 +574,11 @@ list of parameters to that command." It works along the same lines as a normal formatting string, with some simple extensions. -%S The subject" +%S The subject + +General format specifiers can also be used. +See (gnus)Formatting Variables." + :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-threading :type 'string) @@ -655,7 +663,9 @@ was sent, sorting by number means sorting by arrival time.) Ready-made functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', -`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and +`gnus-thread-sort-by-date', `gnus-thread-sort-by-score', +`gnus-thread-sort-by-most-recent-number', +`gnus-thread-sort-by-most-recent-date', and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). When threading is turned off, the variable @@ -747,15 +757,14 @@ If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the following hook: - (setq gnus-select-group-hook - (list - (lambda () - (mapcar (lambda (header) - (mail-header-set-subject - header - (gnus-simplify-subject - (mail-header-subject header) 're-only))) - gnus-newsgroup-headers))))" + (add-hook gnus-select-group-hook + (lambda () + (mapcar (lambda (header) + (mail-header-set-subject + header + (gnus-simplify-subject + (mail-header-subject header) 're-only))) + gnus-newsgroup-headers)))" :group 'gnus-group-select :type 'hook) @@ -894,7 +903,7 @@ which it may alter in any way.") (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string "Variable that says which function should be used to decode a string with encoded words.") -(defcustom gnus-extra-headers nil +(defcustom gnus-extra-headers '(To Newsgroups) "*Extra headers to parse." :version "21.1" :group 'gnus-summary @@ -1725,9 +1734,7 @@ increase the score of each group you read." "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message "t" gnus-summary-toggle-header - "g" gnus-summary-toggle-smiley - "u" gnus-article-treat-unfold-headers - "n" gnus-article-treat-fold-newsgroups + "g" gnus-treat-smiley "v" gnus-summary-verbose-headers "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive "p" gnus-article-verify-x-pgp-sig @@ -1752,9 +1759,15 @@ increase the score of each group you read." "c" gnus-article-highlight-citation "s" gnus-article-highlight-signature) + (gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map) + "f" gnus-article-treat-fold-headers + "u" gnus-article-treat-unfold-headers + "n" gnus-article-treat-fold-newsgroups) + (gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map) "x" gnus-article-display-x-face - "s" gnus-summary-toggle-smiley + "s" gnus-treat-smiley + "D" gnus-article-remove-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon "n" gnus-treat-newsgroups-picon) @@ -1902,7 +1915,8 @@ increase the score of each group you read." ["Lapsed" gnus-article-date-lapsed t] ["User-defined" gnus-article-date-user t]) ("Display" - ["Toggle smiley" gnus-summary-toggle-smiley t] + ["Remove images" gnus-article-remove-images t] + ["Toggle smiley" gnus-treat-smiley t] ["Show X-Face" gnus-article-display-x-face t] ["Show picons in From" gnus-treat-from-picon t] ["Show picons in mail headers" gnus-treat-mail-picon t] @@ -2004,7 +2018,7 @@ increase the score of each group you read." ["Fetch article with id..." gnus-summary-refer-article t] ["Setup Mailing List Params" gnus-mailing-list-insinuate t] ["Redisplay" gnus-summary-show-article t] - ["Raw article" gnus-summary-show-raw-article t]))) + ["Raw article" gnus-summary-show-raw-article :keys "C-u g"]))) (easy-menu-define gnus-summary-article-menu gnus-summary-mode-map "" (cons "Article" innards)) @@ -2059,6 +2073,10 @@ increase the score of each group you read." ["Wide reply and yank" gnus-summary-wide-reply-with-original ,@(if (featurep 'xemacs) '(t) '(:help "Mail a reply, quoting this article"))] + ["Very wide reply" gnus-summary-very-wide-reply t] + ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original + ,@(if (featurep 'xemacs) '(t) + '(:help "Mail a very wide reply, quoting this article"))] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] ["Digest and mail" gnus-uu-digest-mail-forward t] @@ -2408,7 +2426,7 @@ The following commands are available: (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-hooks 'gnus-summary-mode-hook) (turn-on-gnus-mailing-list-mode) - (mm-enable-multibyte-mule4) + (mm-enable-multibyte) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -2807,7 +2825,12 @@ display only a single character." (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." - (let ((buffer (gnus-summary-buffer-name group))) + (let ((buffer (gnus-summary-buffer-name group)) + (dead-name (concat "*Dead Summary " + (gnus-group-decoded-name group) "*"))) + ;; If a dead summary buffer exists, we kill it. + (when (gnus-buffer-live-p dead-name) + (gnus-kill-buffer dead-name)) (if (get-buffer buffer) (progn (set-buffer buffer) @@ -2967,11 +2990,12 @@ buffer that was in action when the last article was fetched." (cond ((setq to (cdr (assq 'To extra-headers))) (concat "-> " - (gnus-summary-extract-address-component - (funcall gnus-decode-encoded-word-function to)))) + (inline + (gnus-summary-extract-address-component + (funcall gnus-decode-encoded-word-function to))))) ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) (concat "=> " newsgroups))))) - (gnus-summary-extract-address-component gnus-tmp-from)))) + (inline (gnus-summary-extract-address-component gnus-tmp-from))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -3264,9 +3288,7 @@ If NO-DISPLAY, don't generate a summary buffer." ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) + (gnus-summary-maybe-hide-threads) (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) (gnus-summary-auto-select-subject) @@ -3277,7 +3299,10 @@ If NO-DISPLAY, don't generate a summary buffer." gnus-auto-select-first) (progn (gnus-configure-windows 'summary) - (gnus-summary-goto-article (gnus-summary-article-number))) + (let ((art (gnus-summary-article-number))) + (unless (or (memq art gnus-newsgroup-undownloaded) + (memq art gnus-newsgroup-downloadable)) + (gnus-summary-goto-article art)))) ;; Don't select any articles. (gnus-summary-position-point) (gnus-configure-windows 'summary 'force) @@ -3305,6 +3330,8 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-summary-first-unread-subject)) ((eq gnus-auto-select-subject 'unseen) (gnus-summary-first-unseen-subject)) + ((eq gnus-auto-select-subject 'unseen-or-unread) + (gnus-summary-first-unseen-or-unread-subject)) ((eq gnus-auto-select-subject 'first) ;; Do nothing. ) @@ -3406,7 +3433,7 @@ If NO-DISPLAY, don't generate a summary buffer." (while threads (when (setq references (mail-header-references (caar threads))) (setq id (mail-header-id (caar threads)) - ids (gnus-split-references references) + ids (inline (gnus-split-references references)) entered nil) (while (setq ref (pop ids)) (setq ids (delete ref ids)) @@ -4142,15 +4169,47 @@ Unscored articles will be counted as having a score of zero." (defun gnus-thread-total-score (thread) ;; This function find the total score of THREAD. - (cond ((null thread) - 0) - ((consp thread) - (if (stringp (car thread)) - (apply gnus-thread-score-function 0 - (mapcar 'gnus-thread-total-score-1 (cdr thread))) - (gnus-thread-total-score-1 thread))) - (t - (gnus-thread-total-score-1 (list thread))))) + (cond + ((null thread) + 0) + ((consp thread) + (if (stringp (car thread)) + (apply gnus-thread-score-function 0 + (mapcar 'gnus-thread-total-score-1 (cdr thread))) + (gnus-thread-total-score-1 thread))) + (t + (gnus-thread-total-score-1 (list thread))))) + +(defun gnus-thread-sort-by-most-recent-number (h1 h2) + "Sort threads such that the thread with the most recently arrived article comes first." + (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2))) + +(defun gnus-thread-highest-number (thread) + "Return the highest article number in THREAD." + (apply 'max (mapcar (lambda (header) + (mail-header-number header)) + (message-flatten-list thread)))) + +(defun gnus-thread-sort-by-most-recent-date (h1 h2) + "Sort threads such that the thread with the most recently dated article comes first." + (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2))) + +(defun gnus-thread-latest-date (thread) + "Return the highest article date in THREAD." + (let ((previous-time 0)) + (apply 'max (mapcar + (lambda (header) + (setq previous-time + (time-to-seconds + (mail-header-parse-date + (condition-case () + (mail-header-date header) + (error previous-time)))))) + (sort + (message-flatten-list thread) + (lambda (h1 h2) + (< (mail-header-number h1) + (mail-header-number h2)))))))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. @@ -4928,6 +4987,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." ((eq mark-type 'range) (cond ((eq mark 'seen) + ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2). + ;; It should be (seen (NUM1 . NUM2)). + (when (numberp (cddr marks)) + (setcdr marks (list (cdr marks)))) (setq articles (cdr marks)) (while (and articles (or (and (consp (car articles)) @@ -6150,10 +6213,11 @@ The state which existed when entering the ephemeral is reset." (suppress-keymap gnus-dead-summary-mode-map) (substitute-key-definition 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) - (let ((keys '("\C-d" "\r" "\177" [delete]))) - (while keys - (define-key gnus-dead-summary-mode-map - (pop keys) 'gnus-summary-wake-up-the-dead)))) + (dolist (key '("\C-d" "\r" "\177" [delete])) + (define-key gnus-dead-summary-mode-map + key 'gnus-summary-wake-up-the-dead)) + (dolist (key '("q" "Q")) + (define-key gnus-dead-summary-mode-map key 'bury-buffer))) (defvar gnus-dead-summary-mode nil "Minor mode for Gnus summary buffers.") @@ -6199,17 +6263,20 @@ The state which existed when entering the ephemeral is reset." (set-buffer buffer) (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer))) - (cond (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (gnus-buffer-exists-p buffer)) - (save-excursion - (set-buffer buffer) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((gnus-buffer-exists-p buffer) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary)))))) + (cond + ;; Kill the buffer. + (gnus-kill-summary-on-exit + (when (and gnus-use-trees + (gnus-buffer-exists-p buffer)) + (save-excursion + (set-buffer buffer) + (gnus-tree-close gnus-newsgroup-name))) + (gnus-kill-buffer buffer)) + ;; Deaden the buffer. + ((gnus-buffer-exists-p buffer) + (save-excursion + (set-buffer buffer) + (gnus-deaden-summary)))))) (defun gnus-summary-wake-up-the-dead (&rest args) "Wake up the dead summary buffer." @@ -6335,9 +6402,12 @@ Returns the article selected or nil if there are no unread articles." (and (not (and undownloaded (eq gnus-undownloaded-mark (gnus-data-mark (car data))))) - (not (and unseen - (memq (car data) gnus-newsgroup-unseen))) - (not (gnus-data-unread-p (car data))))) + (if unseen + (or (not (memq + (gnus-data-number (car data)) + gnus-newsgroup-unseen)) + (not (gnus-data-unread-p (car data)))) + (not (gnus-data-unread-p (car data)))))) (setq data (cdr data))) (when data (goto-char (gnus-data-pos (car data))) @@ -6387,6 +6457,8 @@ If optional argument UNREAD is non-nil, only unread article is selected." "Go the subject line of ARTICLE. If FORCE, also allow jumping to articles not currently shown." (interactive "nArticle number: ") + (unless (numberp article) + (error "Article %s is not a number" article)) (let ((b (point)) (data (gnus-data-find article))) ;; We read in the article if we have to. @@ -6423,13 +6495,13 @@ Given a prefix, will force an `article' buffer configuration." "Display ARTICLE in article buffer." (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer - (mm-enable-multibyte-mule4))) + (mm-enable-multibyte))) (gnus-set-global-variables) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer (setq gnus-article-charset gnus-newsgroup-charset) (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) - (mm-enable-multibyte-mule4))) + (mm-enable-multibyte))) (if (null article) nil (prog1 @@ -6476,20 +6548,21 @@ be displayed." (or (null gnus-current-article) (not (eq gnus-current-article article)))) force) - ;; The requested article is different from the current article. + ;; The requested article is different from the current article. (progn (gnus-summary-display-article article all-headers) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer (if (not gnus-article-decoded-p) ;; a local variable - (mm-disable-multibyte-mule4)))) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) + (mm-disable-multibyte)))) +;;; Hidden headers are not hidden text any more. +;; (when (or all-headers gnus-show-all-headers) +;; (gnus-article-show-all-headers)) (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))) article) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) +;; (when (or all-headers gnus-show-all-headers) +;; (gnus-article-show-all-headers)) 'old)))) (defun gnus-summary-force-verify-and-decrypt () @@ -6788,6 +6861,19 @@ Return nil if there are no unseen articles." (gnus-summary-first-subject t t t)) (gnus-summary-position-point))) +(defun gnus-summary-first-unseen-or-unread-subject () + "Place the point on the subject line of the first unseen article. +Return nil if there are no unseen articles." + (interactive) + (prog1 + (unless (when (gnus-summary-first-subject t t t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t t t)) + (when (gnus-summary-first-subject t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t))) + (gnus-summary-position-point))) + (defun gnus-summary-first-article () "Select the first article. Return nil if there are no articles." @@ -6999,7 +7085,7 @@ articles that are younger than AGE days." (interactive (let ((header (intern - (gnus-completing-read + (gnus-completing-read-with-default (symbol-name (car gnus-extra-headers)) (if current-prefix-arg "Exclude extra header:" @@ -7210,9 +7296,7 @@ If ALL, mark even excluded ticked and dormants as read." ;; according to the new limit. (gnus-summary-prepare) ;; Hide any threads, possibly. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) + (gnus-summary-maybe-hide-threads) ;; Try to return to the article you were at, or one in the ;; neighborhood. (when data @@ -7625,8 +7709,11 @@ to guess what the document format is." (gnus-group-read-ephemeral-group name `(nndoc ,name (nndoc-address ,(get-buffer dig)) (nndoc-article-type - ,(if force 'mbox 'guess))) t)) - ;; Make all postings to this group go to the parent group. + ,(if force 'mbox 'guess))) + t nil nil nil + `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name + "ADAPT"))))) + ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) params) ;; Couldn't select this doc group. @@ -7975,13 +8062,10 @@ are `C-u g'." (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (mm-read-coding-system - "View as charset: " + "View as charset: " ;; actually it is coding system. (save-excursion (set-buffer gnus-article-buffer) - (let ((coding-systems - (detect-coding-region (point) (point-max)))) - (or (car-safe coding-systems) - coding-systems)))))) + (mm-detect-coding-region (point) (point-max)))))) (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) (let ((deps gnus-newsgroup-dependencies) @@ -8169,7 +8253,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; `gnus-read-move-group-name' an opportunity to suggest an ;; appropriate default. (unless (gnus-buffer-live-p gnus-original-article-buffer) - (gnus-summary-select-article nil nil nil (car articles))) + (let ((gnus-display-mime-function nil) + (gnus-article-prepare-hook nil)) + (gnus-summary-select-article nil nil nil (car articles)))) ;; Read the newsgroup name. (when (and (not to-newsgroup) (not select-method)) @@ -8394,7 +8480,7 @@ latter case, they will be copied into the relevant groups." (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method - (gnus-completing-read + (gnus-completing-read-with-default methname "What backend do you want to use when respooling?" methods nil t nil 'gnus-mail-method-history)) ms) @@ -8613,18 +8699,22 @@ groups." (let (force raw current-handles) (cond ((null arg)) - ((eq arg 1) (setq raw t)) - ((eq arg 2) (setq raw t - force t)) - ((eq arg 3) (setq current-handles - (and (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (prog1 - gnus-article-mime-handles - (setq gnus-article-mime-handles nil)))))) - (t (setq force t))) - (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) - (error "Can't edit the raw article in group nndraft:drafts")) + ((eq arg 1) + (setq raw t)) + ((eq arg 2) + (setq raw t + force t)) + ((eq arg 3) + (setq current-handles + (and (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (prog1 + gnus-article-mime-handles + (setq gnus-article-mime-handles nil)))))) + (t + (setq force t))) + (when (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) + (error "Can't edit the raw article in group nndraft:drafts")) (save-excursion (set-buffer gnus-summary-buffer) (let ((mail-parse-charset gnus-newsgroup-charset) @@ -8636,7 +8726,7 @@ groups." (gnus-summary-show-article t) (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer)) (with-current-buffer gnus-article-buffer - (mm-enable-multibyte-mule4))) + (mm-enable-multibyte))) (if (equal gnus-newsgroup-name "nndraft:drafts") (setq raw t)) (gnus-article-edit-article @@ -8768,14 +8858,6 @@ groups." (execute-kbd-macro (concat (this-command-keys) key)) (gnus-article-edit-done)) - -(defun gnus-summary-toggle-smiley (&optional arg) - "Toggle the display of smilies as small graphical icons." - (interactive "P") - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-smiley-display arg))) - ;;; Respooling (defun gnus-summary-respool-query (&optional silent trace) @@ -9692,18 +9774,49 @@ Returns nil if no thread was there to be shown." (goto-char orig) (gnus-summary-position-point)))) -(defun gnus-summary-hide-all-threads () - "Hide all thread subtrees." +(defun gnus-summary-maybe-hide-threads () + "If requested, hide the threads that should be hidden." + (when (and gnus-show-threads + gnus-thread-hide-subtree) + (gnus-summary-hide-all-threads + (if (or (consp gnus-thread-hide-subtree) + (gnus-functionp gnus-thread-hide-subtree)) + (gnus-make-predicate gnus-thread-hide-subtree) + nil)))) + +;;; Hiding predicates. + +(defun gnus-article-unread-p (header) + (memq (mail-header-number header) gnus-newsgroup-unreads)) + +(defun gnus-article-unseen-p (header) + (memq (mail-header-number header) gnus-newsgroup-unseen)) + +(defun gnus-map-articles (predicate articles) + "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil." + (apply 'gnus-or (mapcar predicate + (mapcar 'gnus-summary-article-header articles)))) + +(defun gnus-summary-hide-all-threads (&optional predicate) + "Hide all thread subtrees. +If PREDICATE is supplied, threads that satisfy this predicate +will not be hidden." (interactive) (save-excursion (goto-char (point-min)) - (gnus-summary-hide-thread) - (while (zerop (gnus-summary-next-thread 1 t)) - (gnus-summary-hide-thread))) + (let ((end nil)) + (while (not end) + (when (or (not predicate) + (gnus-map-articles + predicate (gnus-summary-article-children))) + (gnus-summary-hide-thread)) + (setq end (not (zerop (gnus-summary-next-thread 1 t))))))) (gnus-summary-position-point)) (defun gnus-summary-hide-thread () "Hide thread subtrees. +If PREDICATE is supplied, threads that satisfy this predicate +will not be hidden. Returns nil if no threads were there to be hidden." (interactive) (let ((buffer-read-only nil) @@ -9899,8 +10012,7 @@ Argument REVERSE means reverse order." ;; We do the sorting by regenerating the threads. (gnus-summary-prepare) ;; Hide subthreads if needed. - (when (and gnus-show-threads gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads)))) + (gnus-summary-maybe-hide-threads))) (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." @@ -9923,8 +10035,7 @@ Argument REVERSE means reverse order." ;; We do the sorting by regenerating the threads. (gnus-summary-prepare) ;; Hide subthreads if needed. - (when (and gnus-show-threads gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads)))) + (gnus-summary-maybe-hide-threads))) ;; Summary saving commands. @@ -10116,23 +10227,26 @@ save those articles instead." (to-newsgroup (cond ((null split-name) - (gnus-completing-read default prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil prefix - 'gnus-group-history)) + (gnus-completing-read-with-default + default prom + gnus-active-hashtb + 'gnus-valid-move-group-p + nil prefix + 'gnus-group-history)) ((= 1 (length split-name)) - (gnus-completing-read (car split-name) prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil nil - 'gnus-group-history)) + (gnus-completing-read-with-default + (car split-name) prom + gnus-active-hashtb + 'gnus-valid-move-group-p + nil nil + 'gnus-group-history)) (t - (gnus-completing-read nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history)))) + (gnus-completing-read-with-default + nil prom + (mapcar (lambda (el) (list el)) + (nreverse split-name)) + nil nil nil + 'gnus-group-history)))) (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") @@ -10752,7 +10866,8 @@ If ALL is a number, fetch this number of articles." (setq older (subseq older 0 all)))))))) (if (not older) (message "No old news.") - (gnus-summary-insert-articles older) + (let ((gnus-fetch-old-headers t)) + (gnus-summary-insert-articles older)) (gnus-summary-limit (gnus-union older old)))) (gnus-summary-position-point))) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 63f08c7..1c493c6 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,5 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Ilja Weis @@ -60,7 +60,10 @@ with some simple extensions. %g Number of groups in the topic. %a Number of unread articles in the groups in the topic. %A Number of unread articles in the groups in the topic and its subtopics. -" + +General format specifiers can also be used. +See (gnus)Formatting Variables." + :link '(custom-manual "(gnus)Formatting Variables") :type 'string :group 'gnus-topic) @@ -249,6 +252,28 @@ If RECURSIVE is t, return groups in its subtopics too." (cdr recursive))) visible-groups)) +(defun gnus-topic-goto-previous-topic (n) + "Go to the N'th previous topic." + (interactive "p") + (gnus-topic-goto-next-topic (- n))) + +(defun gnus-topic-goto-next-topic (n) + "Go to the N'th next topic." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n)) + (topic (gnus-current-topic))) + (while (and (> n 0) + (setq topic + (if backward + (gnus-topic-previous-topic topic) + (gnus-topic-next-topic topic)))) + (gnus-topic-goto-topic topic) + (setq n (1- n))) + (when (/= 0 n) + (gnus-message 7 "No more topics")) + n)) + (defun gnus-topic-previous-topic (topic) "Return the previous topic on the same level as TOPIC." (let ((top (cddr (gnus-topic-find-topology @@ -1028,6 +1053,8 @@ articles in the topic and its subtopics." "j" gnus-topic-jump-to-topic "M" gnus-topic-move-matching "C" gnus-topic-copy-matching + "\M-p" gnus-topic-goto-previous-topic + "\M-n" gnus-topic-goto-next-topic "\C-i" gnus-topic-indent [tab] gnus-topic-indent "r" gnus-topic-rename @@ -1067,6 +1094,8 @@ articles in the topic and its subtopics." ["Mark" gnus-topic-mark-topic t] ["Indent" gnus-topic-indent t] ["Sort" gnus-topic-sort-topics t] + ["Previous topic" gnus-topic-goto-previous-topic t] + ["Next topic" gnus-topic-goto-next-topic t] ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t] ["Edit parameters" gnus-topic-edit-parameters t]) ["List active" gnus-topic-list-active t])))) @@ -1164,10 +1193,13 @@ Also see `gnus-group-catchup'." (if (not topic) (call-interactively 'gnus-group-catchup-current) (save-excursion - (let ((gnus-group-marked + (let* ((groups (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t)))) - (gnus-group-catchup-current))))) + (gnus-topic-find-groups topic gnus-level-killed t))) + (buffer-read-only nil) + (gnus-group-marked groups)) + (gnus-group-catchup-current) + (mapcar 'gnus-topic-update-topics-containing-group groups))))) (defun gnus-topic-read-group (&optional all no-article group) "Read news in this newsgroup. @@ -1225,7 +1257,8 @@ When used interactively, PARENT will be the topic under point." If COPYP, copy the groups instead." (interactive (list current-prefix-arg - (completing-read "Move to topic: " gnus-topic-alist nil t))) + (gnus-completing-read "Move to topic" gnus-topic-alist nil t + 'gnus-topic-history))) (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) (groups (gnus-group-process-prefix n)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 2193f3b..1213225 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,5 +1,5 @@ ;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -221,17 +221,6 @@ (delete-char 1)) (goto-char (next-single-property-change (point) prop nil (point-max)))))) -(defun gnus-text-with-property (prop) - "Return a list of all points where the text has PROP." - (let ((points nil) - (point (point-min))) - (save-excursion - (while (< point (point-max)) - (when (get-text-property point prop) - (push point points)) - (incf point))) - (nreverse points))) - (require 'nnheader) (defun gnus-newsgroup-directory-form (newsgroup) "Make hierarchical directory name from NEWSGROUP name." @@ -305,7 +294,7 @@ (define-key keymap key (pop plist)) (pop plist))))) -(defun gnus-completing-read (default prompt &rest args) +(defun gnus-completing-read-with-default (default prompt &rest args) ;; Like `completing-read', except that DEFAULT is the default argument. (let* ((prompt (if default (concat prompt " (default " default ") ") @@ -354,7 +343,8 @@ (604800 . "%a %k:%M") ;;that's one week ((gnus-seconds-month) . "%a %d") ((gnus-seconds-year) . "%b %d") - (t . "%b %m '%y")) ;;this one is used when no other does match + (t . "%b %d '%y")) ;;this one is used when no + ;;other does match "Alist of time in seconds and format specification used to display dates not older. The first element must be a number or a function returning a number. The second element is a format-specification as described in @@ -487,11 +477,15 @@ jabbering all the time." (defsubst gnus-parent-id (references &optional n) "Return the last Message-ID in REFERENCES. If N, return the Nth ancestor instead." - (when references - (let ((ids (inline (gnus-split-references references)))) - (while (nthcdr (or n 1) ids) - (setq ids (cdr ids))) - (car ids)))) + (when (and references + (not (zerop (length references)))) + (if n + (let ((ids (inline (gnus-split-references references)))) + (while (nthcdr n ids) + (setq ids (cdr ids))) + (car ids)) + (when (string-match "<[^> \t]+>\\'" references) + (match-string 0 references))))) (defun gnus-buffer-live-p (buffer) "Say whether BUFFER is alive or not." @@ -685,9 +679,10 @@ Bind `print-quoted' and `print-readably' to t while printing." (when (get-text-property b 'gnus-face) (setq b (next-single-property-change b 'gnus-face nil end))) (when (/= b end) - (gnus-put-text-property - b (setq b (next-single-property-change b 'gnus-face nil end)) - prop val))))) + (inline + (gnus-put-text-property + b (setq b (next-single-property-change b 'gnus-face nil end)) + prop val)))))) ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 ;;; The primary idea here is to try to protect internal datastructures @@ -1217,6 +1212,48 @@ forbidden in URL encoding." (setq tmp (concat tmp str)) tmp)) +(defun gnus-make-predicate (spec) + "Transform SPEC into a function that can be called. +SPEC is a predicate specifier that contains stuff like `or', `and', +`not', lists and functions. The functions all take one parameter." + `(lambda (elem) ,(gnus-make-predicate-1 spec))) + +(defun gnus-make-predicate-1 (spec) + (cond + ((symbolp spec) + `(,spec elem)) + ((listp spec) + (if (memq (car spec) '(or and not)) + `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) + (error "Invalid predicate specifier: %s" spec))))) + +(defun gnus-local-map-property (map) + "Return a list suitable for a text property list specifying keymap MAP." + (cond + ((featurep 'xemacs) + (list 'keymap map)) + ((>= emacs-major-version 21) + (list 'keymap map)) + (t + (list 'local-map map)))) + +(defun gnus-completing-read (prompt table &optional predicate require-match + history inherit-input-method) + (when (and history + (not (boundp history))) + (set history nil)) + (completing-read + (if (symbol-value history) + (concat prompt " (" (car (symbol-value history)) "): ") + (concat prompt ": ")) + table + predicate + require-match + nil + history + (car (symbol-value history)) + inherit-input-method)) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 36b2b20..188fb97 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -1,6 +1,6 @@ ;;; gnus-xmas.el --- Gnus functions for XEmacs -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -555,6 +555,8 @@ If it is non-nil, it must be a toolbar. The five valid values are [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"] [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"] [gnus-group-kill-group gnus-group-kill-group t "Kill group"] + [gnus-summary-mail-save + gnus-group-save-newsrc t "Save .newsrc files"] ; borrowed icon. [gnus-group-exit gnus-group-exit t "Exit Gnus"]) "The group buffer toolbar.") @@ -612,6 +614,8 @@ If it is non-nil, it must be a toolbar. The five valid values are gnus-summary-save-article-file t "Save article in file"] [gnus-summary-save-article gnus-summary-save-article t "Save article"] + [gnus-summary-cancel-article ; usenet : cancellation :: mail : deletion. + gnus-summary-delete-article t "Delete message"] [gnus-summary-catchup gnus-summary-catchup t "Catchup"] [gnus-summary-catchup-and-exit @@ -645,41 +649,6 @@ XEmacs compatibility workaround." 'call-process-region (point-min) (point-max) command t '(t nil) nil args)) -(defface gnus-x-face '((t (:foreground "black" :background "white"))) - "Face to show X face" - :group 'gnus-xmas) - -(defun gnus-xmas-article-display-xface (data) - "Display the XFace in DATA." - (save-excursion - (let ((xface-glyph - (cond - ((featurep 'xface) - (make-glyph (vector 'xface :data - (concat "X-Face: " data)))) - ((featurep 'xpm) - (let ((cur (current-buffer))) - (save-excursion - (gnus-set-work-buffer) - (insert data) - (let ((coding-system-for-read 'binary) - (coding-system-for-write 'binary)) - (gnus-xmas-call-region "uncompface") - (goto-char (point-min)) - (insert "/* Width=48, Height=48 */\n") - (gnus-xmas-call-region "icontopbm") - (gnus-xmas-call-region "ppmtoxpm") - (make-glyph - (vector 'xpm :data (buffer-string))))))) - (t - (make-glyph [nothing]))))) - ;;(set-glyph-face xface-glyph 'gnus-x-face) - - (gnus-article-goto-header "from") - (gnus-put-image xface-glyph " ") - (gnus-add-wash-type 'xface) - (gnus-add-image 'xface xface-glyph)))) - (defvar gnus-xmas-modeline-left-extent (let ((ext (copy-extent modeline-buffer-id-left-extent))) ext)) @@ -820,27 +789,66 @@ XEmacs compatibility workaround." gnus-mailing-list-menu)) (defun gnus-xmas-image-type-available-p (type) + (when (eq type 'pbm) + (setq type 'xbm)) (featurep type)) -(defun gnus-xmas-create-image (file) - (with-temp-buffer - (insert-file-contents file) - (mm-create-image-xemacs (car (last (split-string file "[.]")))))) +(defun gnus-xmas-create-image (file &optional type data-p &rest props) + (let ((type (if type + (symbol-name type) + (car (last (split-string file "[.]"))))) + (face (plist-get props :face)) + glyph) + (when (equal type "pbm") + (with-temp-buffer + (if data-p + (insert file) + (insert-file-contents file)) + (shell-command-on-region (point-min) (point-max) + "ppmtoxpm 2>/dev/null" t) + (setq file (buffer-string) + type "xpm" + data-p t))) + (setq glyph + (if (equal type "xbm") + (make-glyph (list (cons 'x file))) + (with-temp-buffer + (if data-p + (insert file) + (insert-file-contents file)) + (make-glyph + (vector + (or (intern type) + (mm-image-type-from-buffer)) + :data (buffer-string)))))) + (when face + (set-glyph-face glyph face)) + glyph)) (defun gnus-xmas-put-image (glyph &optional string) + "Insert STRING, but display GLYPH. +Warning: Don't insert text immediately after the image." (let ((begin (point)) extent) - (insert string) + (if (and (bobp) (not string)) + (setq string " ")) + (if string + (insert string) + (setq begin (1- begin))) (setq extent (make-extent begin (point))) (set-extent-property extent 'gnus-image t) (set-extent-property extent 'duplicable t) - (set-extent-property extent 'begin-glyph glyph))) + (if string + (set-extent-property extent 'invisible t)) + (set-extent-property extent 'end-glyph glyph)) + glyph) (defun gnus-xmas-remove-image (image) (map-extents (lambda (ext unused) - (when (equal (extent-begin-glyph ext) image) - (set-extent-property ext 'begin-glyph nil)) + (when (equal (extent-end-glyph ext) image) + (set-extent-property ext 'invisible nil) + (set-extent-property ext 'end-glyph nil)) nil) nil nil nil nil nil 'gnus-image)) diff --git a/lisp/gnus.el b/lisp/gnus.el index f20cb00..2b17690 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,6 +1,7 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc. + +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, +;; 1998, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -138,6 +139,10 @@ :link '(custom-manual "(gnus)Summary Maneuvering") :group 'gnus-summary) +(defgroup gnus-picon nil + "Show pictures of people, domains, and newsgroups." + :group 'gnus-visual) + (defgroup gnus-summary-mail nil "Mail group commands." :link '(custom-manual "(gnus)Mail Group Commands") @@ -267,7 +272,12 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.04" +(defgroup gnus-fun nil + "Frivolous Gnus extensions." + :link '(custom-manual "(gnus)Exiting Gnus") + :group 'gnus) + +(defconst gnus-version-number "0.05" "Version number for this version of Gnus.") (defconst gnus-version (format "Oort Gnus v%s" gnus-version-number) @@ -796,17 +806,17 @@ be set in `.emacs' instead." (berry "#cc6485" "#ff7db5") (dino "#724214" "#1e3f03") (oort "#cccccc" "#888888") + (storm "#666699" "#99ccff") + (pdino "#9999cc" "#99ccff") + (purp "#9999cc" "#666699") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") (defcustom gnus-logo-color-style 'oort "*Color styles used for the Gnus logo." - :type '(choice (const flame) (const pine) (const moss) - (const irish) (const sky) (const tin) - (const velvet) (const grape) (const labia) - (const berry) (const neutral) (const september) - (const dino)) + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + gnus-logo-color-alist)) :group 'gnus-xmas) (defvar gnus-logo-colors @@ -1754,6 +1764,9 @@ face." (defvar gnus-plugged t "Whether Gnus is plugged or not.") +(defvar gnus-agent-cache t + "Whether Gnus use agent cache.") + (defcustom gnus-default-charset 'iso-8859-1 "Default charset assumed to be used when viewing non-ASCII characters. This variable is overridden on a group-to-group basis by the @@ -1779,6 +1792,8 @@ covered by that variable." (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") +(defvar gnus-agent-covered-methods nil) + (defvar gnus-command-method nil "Dynamically bound variable that says what the current backend is.") @@ -1982,6 +1997,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-demon-remove-handler) ("gnus-demon" :interactive t gnus-demon-init gnus-demon-cancel) + ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from + gnus-convert-image-to-gray-x-face) ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close @@ -2055,7 +2072,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("gnus-picon" :interactive t gnus-treat-from-picon) ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) - ("smiley" :interactive t gnus-smiley-display) + ("smiley" :interactive t smiley-region) ("gnus-win" gnus-configure-windows gnus-add-configuration) ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group gnus-list-of-unread-articles gnus-list-of-read-articles @@ -2089,7 +2106,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed - gnus-article-show-all-headers +;; gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer @@ -2111,11 +2128,13 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("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 - gnus-summary-set-agent-mark gnus-agent-save-group-info) + gnus-summary-set-agent-mark gnus-agent-save-group-info + gnus-agent-request-article gnus-agent-retrieve-headers) ("gnus-agent" :interactive t gnus-unplugged gnus-agentize gnus-agent-batch) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm) + ("compface" uncompface) ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue) ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) ("gnus-mlspl" :interactive t gnus-group-split-setup @@ -2124,7 +2143,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ;;; gnus-sum.el thingies -(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23n%]%) %s\n" +(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" "*The format specification of the lines in the summary buffer. It works along the same lines as a normal formatting string, @@ -2172,10 +2191,6 @@ with some simple extensions. will be inserted into the summary just like information from any other summary specifier. -Text between %( and %) will be highlighted with `gnus-mouse-face' -when the mouse point is placed inside the area. There can only be one -such area. - The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and \"hard-code\" that. This means that @@ -2186,7 +2201,11 @@ which is bad enough. The smart choice is to have these specs as far to the left as possible. -This restriction may disappear in later versions of Gnus." +This restriction may disappear in later versions of Gnus. + +General format specifiers can also be used. +See (gnus)Formatting Variables." + :link '(custom-manual "(gnus)Formatting Variables") :type 'string :group 'gnus-summary-format) @@ -2230,6 +2249,12 @@ This restriction may disappear in later versions of Gnus." "Get hash value of STRING in HASHTABLE." `(symbol-value (intern-soft ,string ,hashtable))) +(defmacro gnus-gethash-safe (string hashtable) + "Get hash value of STRING in HASHTABLE. +Return nil if not defined." + `(let ((sym (intern-soft ,string ,hashtable))) + (and (boundp sym) (symbol-value sym)))) + (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(set (intern ,string ,hashtable) ,value)) @@ -2862,7 +2887,7 @@ You should probably use `gnus-find-method-for-group' instead." (let (new) (dolist (elem parameters) (if (and (stringp (cdr elem)) - (string-match "\\\\" (cdr elem))) + (string-match "\\\\[0-9&]" (cdr elem))) (push (cons (car elem) (gnus-expand-group-parameter match (cdr elem) group)) new) @@ -2911,12 +2936,10 @@ If you call this function inside a loop, consider using the faster (set-buffer gnus-group-buffer) (if symbol (gnus-group-fast-parameter group symbol allow-list) - (let ((parameters - (nconc - (copy-sequence - (funcall gnus-group-get-parameter-function group)) - (gnus-parameters-get-parameter group)))) - parameters)))) + (nconc + (copy-sequence + (funcall gnus-group-get-parameter-function group)) + (gnus-parameters-get-parameter group))))) (defun gnus-group-get-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. @@ -3246,22 +3269,35 @@ Allow completion over sensible values." (t (list (intern method) ""))))) +;;; Agent functions + +(defun gnus-agent-method-p (method) + "Say whether METHOD is covered by the agent." + (member method gnus-agent-covered-methods)) + +(defun gnus-online (method) + (not + (if gnus-plugged + (eq (cadr (assoc method gnus-opened-servers)) 'offline) + (gnus-agent-method-p method)))) + ;;; User-level commands. ;;;###autoload (defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to local server." + "Read network news as a slave, without connecting to the local server." (interactive "P") (gnus-no-server arg t)) ;;;###autoload (defun gnus-no-server (&optional arg slave) "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." +If ARG is a positive number, Gnus will use that as the startup +level. If ARG is nil, Gnus will be started at level 2. If ARG is +non-nil and not a positive number, Gnus will prompt the user for the +name of an NNTP server to use. +As opposed to `gnus', this command will not connect to the local +server." (interactive "P") (gnus-no-server-1 arg slave)) diff --git a/lisp/imap.el b/lisp/imap.el index 642ff4d..15894ff 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -1,5 +1,5 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998, 1999, 2000, 2001 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson @@ -601,7 +601,9 @@ If ARGS, PROMPT is used as an argument to `format'." (let ((cmds (if (listp imap-ssl-program) imap-ssl-program (list imap-ssl-program))) cmd done) - (ignore-errors (require 'ssl)) + (condition-case () + (require 'ssl) + (error)) (while (and (not done) (setq cmd (pop cmds))) (message "imap: Opening SSL connection with `%s'..." cmd) (let* ((port (or port imap-default-ssl-port)) @@ -614,8 +616,9 @@ If ARGS, PROMPT is used as an argument to `format'." ?s server ?p (number-to-string port))))) process) - (when (setq process (ignore-errors (open-ssl-stream - name buffer server port))) + (when (setq process (condition-case () + (open-ssl-stream name buffer server port) + (error))) (with-current-buffer buffer (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) @@ -710,12 +713,7 @@ If ARGS, PROMPT is used as an argument to `format'." nil))) (defun imap-starttls-p (buffer) - (and (imap-capability 'STARTTLS buffer) - (condition-case () - (progn - (require 'starttls) - (call-process "starttls")) - (error nil)))) + (imap-capability 'STARTTLS buffer)) (defun imap-starttls-open (name buffer server port) (let* ((port (or port imap-default-port)) @@ -768,12 +766,15 @@ Returns t if login was successful, nil otherwise." (while (or (not user) (not passwd)) (setq user (or imap-username (read-from-minibuffer - (concat "IMAP username for " imap-server ": ") + (concat "IMAP username for " imap-server + " (using stream `" (symbol-name imap-stream) + "'): ") (or user imap-default-user)))) (setq passwd (or imap-password (imap-read-passwd (concat "IMAP password for " user "@" - imap-server ": ")))) + imap-server " (using authenticator `" + (symbol-name imap-auth) "'): ")))) (when (and user passwd) (if (funcall loginfunc user passwd) (progn @@ -795,13 +796,7 @@ Returns t if login was successful, nil otherwise." (defun imap-gssapi-auth-p (buffer) (and (imap-capability 'AUTH=GSSAPI buffer) - (catch 'imtest-found - (let (prg (prgs imap-gssapi-program)) - (while (setq prg (pop prgs)) - (condition-case () - (and (call-process (substring prg 0 (string-match " " prg))) - (throw 'imtest-found t)) - (error nil))))))) + (eq imap-stream 'gssapi))) (defun imap-gssapi-auth (buffer) (message "imap: Authenticating using GSSAPI...%s" @@ -810,13 +805,7 @@ Returns t if login was successful, nil otherwise." (defun imap-kerberos4-auth-p (buffer) (and (imap-capability 'AUTH=KERBEROS_V4 buffer) - (catch 'imtest-found - (let (prg (prgs imap-kerberos4-program)) - (while (setq prg (pop prgs)) - (condition-case () - (and (call-process (substring prg 0 (string-match " " prg))) - (throw 'imtest-found t)) - (error nil))))))) + (eq imap-stream 'kerberos4))) (defun imap-kerberos4-auth (buffer) (message "imap: Authenticating using Kerberos 4...%s" @@ -949,46 +938,53 @@ necessery. If nil, the buffer name is generated." (setq imap-auth (or auth imap-auth)) (setq imap-stream (or stream imap-stream)) (message "imap: Connecting to %s..." imap-server) - (if (let ((imap-stream (or imap-stream imap-default-stream))) - (imap-open-1 buffer)) - ;; Choose stream. - (let (stream-changed) - (message "imap: Connecting to %s...done" imap-server) - (when (null imap-stream) - (let ((streams imap-streams)) - (while (setq stream (pop streams)) - (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer) - (setq stream-changed (not (eq (or imap-stream - imap-default-stream) - stream)) - imap-stream stream - streams nil))) - (unless imap-stream - (error "Couldn't figure out a stream for server")))) - (when stream-changed - (message "imap: Reconnecting with stream `%s'..." imap-stream) - (imap-close buffer) - (if (imap-open-1 buffer) - (message "imap: Reconnecting with stream `%s'...done" - imap-stream) - (message "imap: Reconnecting with stream `%s'...failed" - imap-stream)) - (setq imap-capability nil)) - (if (imap-opened buffer) - ;; Choose authenticator - (when (and (null imap-auth) (not (eq imap-state 'auth))) - (let ((auths imap-authenticators)) - (while (setq auth (pop auths)) - (if (funcall (nth 1 (assq auth imap-authenticator-alist)) - buffer) - (setq imap-auth auth - auths nil))) - (unless imap-auth - (error "Couldn't figure out authenticator for server")))))) - (message "imap: Connecting to %s...failed" imap-server)) - (when (imap-opened buffer) - (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)) - buffer))) + (if (null (let ((imap-stream (or imap-stream imap-default-stream))) + (imap-open-1 buffer))) + (progn + (message "imap: Connecting to %s...failed" imap-server) + nil) + (when (null imap-stream) + ;; Need to choose stream. + (let ((streams imap-streams)) + (while (setq stream (pop streams)) + ;; OK to use this stream? + (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer) + ;; Stream changed? + (if (not (eq imap-default-stream stream)) + (with-current-buffer (get-buffer-create + (generate-new-buffer-name " *temp*")) + (mapcar 'make-local-variable imap-local-variables) + (imap-disable-multibyte) + (buffer-disable-undo) + (setq imap-server (or server imap-server)) + (setq imap-port imap-port) + (setq imap-auth imap-auth) + (message "imap: Reconnecting with stream `%s'..." stream) + (if (null (let ((imap-stream stream)) + (imap-open-1 (current-buffer)))) + (progn + (kill-buffer (current-buffer)) + (message + "imap: Reconnecting with stream `%s'...failed" + stream)) + ;; We're done, kill the first connection + (imap-close buffer) + (kill-buffer buffer) + (rename-buffer buffer) + (message "imap: Reconnecting with stream `%s'...done" + stream) + (setq imap-stream stream) + (setq imap-capability nil) + (setq streams nil))) + ;; We're done + (message "imap: Connecting to %s...done" imap-server) + (setq imap-stream stream) + (setq imap-capability nil) + (setq streams nil)))))) + (when (imap-opened buffer) + (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) + (when imap-stream + buffer)))) (defun imap-opened (&optional buffer) "Return non-nil if connection to imap server in BUFFER is open. @@ -1015,15 +1011,36 @@ password is remembered in the buffer." (make-local-variable 'imap-password) (if user (setq imap-username user)) (if passwd (setq imap-password passwd)) - (if (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer) - (setq imap-state 'auth))))) + (if imap-auth + (and (funcall (nth 2 (assq imap-auth + imap-authenticator-alist)) buffer) + (setq imap-state 'auth)) + ;; Choose authenticator. + (let ((auths imap-authenticators) + auth) + (while (setq auth (pop auths)) + ;; OK to use authenticator? + (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer) + (message "imap: Authenticating to `%s' using `%s'..." + imap-server auth) + (setq imap-auth auth) + (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer) + (progn + (message "imap: Authenticating to `%s' using `%s'...done" + imap-server auth) + (setq auths nil)) + (message "imap: Authenticating to `%s' using `%s'...failed" + imap-server auth))))) + imap-state)))) (defun imap-close (&optional buffer) "Close connection to server in BUFFER. If BUFFER is nil, the current buffer is used." (with-current-buffer (or buffer (current-buffer)) (when (imap-opened) - (imap-send-command-wait "LOGOUT")) + (condition-case nil + (imap-send-command-wait "LOGOUT") + (quit nil))) (when (and imap-process (memq (process-status imap-process) '(open run))) (delete-process imap-process)) @@ -2205,7 +2222,9 @@ Return nil if no complete line has arrived." (let ((token (read (current-buffer)))) (imap-forward) (cond ((eq token 'UID) - (setq uid (ignore-errors (read (current-buffer))))) + (setq uid (condition-case () + (read (current-buffer)) + (error)))) ((eq token 'FLAGS) (setq flags (imap-parse-flag-list)) (if (not flags) diff --git a/lisp/message.el b/lisp/message.el index 346461c..2365e6d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,5 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -127,6 +127,11 @@ mailbox format." (function :tag "Other")) :group 'message-sending) +(defcustom message-fcc-externalize-attachments nil + "If non-nil, attachments are included as external parts in Fcc copies." + :type 'boolean + :group 'message-sending) + (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. @@ -206,14 +211,14 @@ included. Organization, Lines and User-Agent are optional." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers :type 'regexp) (defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:" + "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers @@ -1511,6 +1516,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) + (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) @@ -1529,6 +1535,9 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-t" 'message-insert-to) (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) + (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) + (define-key message-mode-map "\C-c\M-n" 'message-insert-disposition-notification-to) + (define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) @@ -1570,12 +1579,16 @@ Point is left at the beginning of the narrowed-to region." ["Kill To Signature" message-kill-to-signature t] ["Newline and Reformat" message-newline-and-reformat t] ["Rename buffer" message-rename-buffer t] - ["Flag as important" message-insert-importance-high + ["Flag As Important" message-insert-importance-high ,@(if (featurep 'xemacs) '(t) '(:help "Mark this message as important"))] - ["Flag as unimportant" message-insert-importance-low + ["Flag As Unimportant" message-insert-importance-low ,@(if (featurep 'xemacs) '(t) '(:help "Mark this message as unimportant"))] + ["Request Receipt" + message-insert-disposition-notification-to + ,@(if (featurep 'xemacs) '(t) + '(:help "Request a Disposition Notification of this article"))] ["Spellcheck" ispell-message ,@(if (featurep 'xemacs) '(t) '(:help "Spellcheck this message"))] @@ -1600,6 +1613,7 @@ Point is left at the beginning of the narrowed-to region." ["Fetch Newsgroups" message-insert-newsgroups t] "----" ["To" message-goto-to t] + ["From" message-goto-from t] ["Subject" message-goto-subject t] ["Cc" message-goto-cc t] ["Reply-To" message-goto-reply-to t] @@ -1687,6 +1701,7 @@ C-c C-f move to a header field (and create it if there isn't): C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution C-c C-f C-f move to Followup-To C-c C-f C-m move to Mail-Followup-To + C-c C-f C-i cycle through Importance values C-c C-t `message-insert-to' (add a To header to a news followup) C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) C-c C-b `message-goto-body' (move to beginning of message text). @@ -1699,7 +1714,8 @@ C-c C-v `message-delete-not-region' (remove the text outside the region). C-c C-z `message-kill-to-signature' (kill the text up to the signature). C-c C-r `message-caesar-buffer-body' (rot13 the message body). C-c C-a `mml-attach-file' (attach a file as MIME). -C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance) +C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance). +C-c M-n `message-insert-disposition-notification-to' (request receipt). M-RET `message-newline-and-reformat' (break the line and reformat)." (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) @@ -1805,6 +1821,11 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (interactive) (message-position-on-field "To")) +(defun message-goto-from () + "Move point to the From header." + (interactive) + (message-position-on-field "From")) + (defun message-goto-subject () "Move point to the Subject header." (interactive) @@ -2043,10 +2064,14 @@ Prefix arg means justify as well." (if not-break (setq point nil) (if bolp - (insert "\n") - (insert "\n\n")) + (newline) + (newline) + (newline)) (setq point (point)) - (insert "\n\n") + ;; (newline 2) doesn't mark both newline's as hard, so call + ;; newline twice. -jas + (newline) + (newline) (delete-region (point) (re-search-forward "[ \t]*")) (when (and quoted (not bolp)) (insert quoted leading-space))) @@ -2155,6 +2180,16 @@ and `low'." (message-goto-eoh) (insert (format "Importance: %s\n" new))))) +(defun message-insert-disposition-notification-to () + "Request a disposition notification (return receipt) to this message. +Note that this should not be used in newsgroups." + (interactive) + (save-excursion + (message-remove-header "Disposition-Notification-To") + (message-goto-eoh) + (insert (format "Disposition-Notification-To: %s\n" + (or (message-fetch-field "From") (message-make-from)))))) + (defun message-elide-region (b e) "Elide the text in the region. An ellipsis (from `message-elide-ellipsis') will be inserted where the @@ -2600,6 +2635,17 @@ It should typically alter the sending method in some way or other." (put 'message-check 'lisp-indent-function 1) (put 'message-check 'edebug-form-spec '(form body)) +(defun message-text-with-property (prop) + "Return a list of all points where the text has PROP." + (let ((points nil) + (point (point-min))) + (save-excursion + (while (< point (point-max)) + (when (get-text-property point prop) + (push point points)) + (incf point))) + (nreverse points))) + (defun message-fix-before-sending () "Do various things to make the message nice before sending it." ;; Make sure there's a newline at the end of the message. @@ -2608,11 +2654,15 @@ It should typically alter the sending method in some way or other." (insert "\n")) ;; Delete all invisible text. (message-check 'invisible-text - (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"))))) + (let ((points (message-text-with-property 'invisible))) + (when points + (goto-char (car points)) + (dolist (point points) + (add-text-properties point (1+ point) + '(invisible nil highlight t))) + (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." @@ -2743,9 +2793,10 @@ It should typically alter the sending method in some way or other." (save-excursion (set-buffer tembuf) (erase-buffer) - ;; Avoid copying text props. + ;; Avoid copying text props (except hard newlines). (insert (with-current-buffer mailbuf - (buffer-substring-no-properties (point-min) (point-max)))) + (mml-buffer-substring-no-properties-except-hard-newlines + (point-min) (point-max)))) ;; Remove some headers. (message-encode-message-body) (save-restriction @@ -2995,10 +3046,11 @@ Otherwise, generate and save a value for `canlock-password' first." (set-buffer tembuf) (buffer-disable-undo) (erase-buffer) - ;; Avoid copying text props. - (insert (with-current-buffer messbuf - (buffer-substring-no-properties - (point-min) (point-max)))) + ;; Avoid copying text props (except hard newlines). + (insert + (with-current-buffer messbuf + (mml-buffer-substring-no-properties-except-hard-newlines + (point-min) (point-max)))) (message-encode-message-body) ;; Remove some headers. (save-restriction @@ -3122,7 +3174,7 @@ Otherwise, generate and save a value for `canlock-password' first." (zerop (length (setq to (completing-read - "Followups to: (default all groups) " + "Followups to (default: no Followup-To header) " (mapcar (lambda (g) (list g)) (cons "poster" (message-tokenize-header @@ -3418,7 +3470,8 @@ Otherwise, generate and save a value for `canlock-password' first." "Process Fcc headers in the current buffer." (let ((case-fold-search t) (buf (current-buffer)) - list file) + list file + (mml-externalize-attachments message-fcc-externalize-attachments)) (save-excursion (save-restriction (message-narrow-to-headers) @@ -3567,7 +3620,7 @@ If NOW, use that time instead." (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) + (message-number-base36 (+ (car tm) (lsh (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) (lsh (/ message-unique-id-char 25) 16)) 4) @@ -3685,16 +3738,6 @@ If NOW, use that time instead." (aset tmp (1- (match-end 0)) ?-)) (string-match "[\\()]" tmp))))) (insert fullname) - (goto-char (point-min)) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) - ;; Quote fullname, escaping specials. - (goto-char (point-min)) - (insert "\"") - (while (re-search-forward "[\"\\]" nil 1) - (replace-match "\\\\\\&" t)) - (insert "\"")) (insert " <" login ">")) (t ; 'parens or default (insert login " (") @@ -3756,7 +3799,7 @@ give as trustworthy answer as possible." (match-string 1 user-mail)) ;; Default to this bogus thing. (t - (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me"))))) + (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me"))))) (defun message-make-host-name () "Return the name of the host." @@ -3901,7 +3944,11 @@ Headers already prepared in the buffer are not modified." ;; This header didn't exist, so we insert it. (goto-char (point-max)) (insert (if (stringp header) header (symbol-name header)) - ": " value "\n") + ": " value) + ;; We check whether the value was ended by a + ;; newline. If now, we insert one. + (unless (bolp) + (insert "\n")) (forward-line -1)) ;; The value of this header was empty, so we clear ;; totally and insert the new value. @@ -4172,7 +4219,7 @@ than 988 characters long, and if they are not, trim them until they are." to group) (if (not (or (null name) (string-equal name "mail") - (string-equal name "news"))) + (string-equal name "posting"))) (setq name (concat "*sent " name "*")) (message-narrow-to-headers) (setq to (message-fetch-field "to")) @@ -4184,7 +4231,7 @@ than 988 characters long, and if they are not, trim them until they are." (or (car (mail-extract-address-components to)) to) "*")) ((and group (not (string= group ""))) - (concat "*sent news on " group "*")) + (concat "*sent posting on " group "*")) (t "*sent mail*")))) (unless (string-equal name (buffer-name)) (rename-buffer name t))))) @@ -4363,7 +4410,7 @@ OTHER-HEADERS is an alist of header/value pairs." "Start editing a news article to be sent." (interactive) (let ((message-this-is-news t)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5103,7 +5150,7 @@ you." (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5117,7 +5164,7 @@ you." (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5191,6 +5238,9 @@ which specify the range to operate on." (tool-bar-add-item-from-menu 'message-insert-importance-low "unimportant" message-mode-map) + (tool-bar-add-item-from-menu + 'message-insert-disposition-notification-to "receipt" + message-mode-map) tool-bar-map))))) ;;; Group name completion. @@ -5377,11 +5427,11 @@ regexp varstr." (message-narrow-to-headers-or-head) (message-remove-first-header "Content-Type") (message-remove-first-header "Content-Transfer-Encoding")) - ;; We always make sure that the message has a Content-Type header. - ;; This is because some broken MTAs and MUAs get awfully confused - ;; when confronted with a message with a MIME-Version header and - ;; without a Content-Type header. For instance, Solaris' - ;; /usr/bin/mail. + ;; We always make sure that the message has a Content-Type + ;; header. This is because some broken MTAs and MUAs get + ;; awfully confused when confronted with a message with a + ;; MIME-Version header and without a Content-Type header. For + ;; instance, Solaris' /usr/bin/mail. (unless content-type-p (goto-char (point-min)) ;; For unknown reason, MIME-Version doesn't exist. @@ -5389,16 +5439,16 @@ regexp varstr." (forward-line 1) (insert "Content-Type: text/plain; charset=us-ascii\n")))))) -(defun message-read-from-minibuffer (prompt) +(defun message-read-from-minibuffer (prompt &optional initial-contents) "Read from the minibuffer while providing abbrev expansion." (if (fboundp 'mail-abbrevs-setup) (let ((mail-abbrev-mode-regexp "") (minibuffer-setup-hook 'mail-abbrevs-setup) (minibuffer-local-map message-minibuffer-local-map)) - (read-from-minibuffer prompt)) + (read-from-minibuffer prompt initial-contents)) (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) (minibuffer-local-map message-minibuffer-local-map)) - (read-string prompt)))) + (read-string prompt initial-contents)))) (defun message-use-alternative-email-as-from () (require 'mail-utils) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 04a067f..1658299 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -1,5 +1,5 @@ ;;; mm-encode.el --- Functions for encoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -35,6 +35,7 @@ ("text/.*" qp-or-base64) ("message/rfc822" 8bit) ("application/emacs-lisp" 8bit) + ("application/x-emacs-lisp" 8bit) ("application/x-patch" 8bit) (".*" base64)) "Alist of regexps that match MIME types and their encodings. diff --git a/lisp/mm-util.el b/lisp/mm-util.el index f597cb2..e64e325 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,5 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -281,6 +281,10 @@ prefer iso-2022-jp to japanese-shift-jis: '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8)) ") +(defvar mm-use-find-coding-systems-region + (fboundp 'find-coding-systems-region) + "Use `find-coding-systems-region' to find proper coding systems.") + ;;; Internal variables: ;;; Functions: @@ -331,10 +335,8 @@ used as the line break code type of the coding system." ) charset) ;; Translate invalid charsets. - ((mm-coding-system-p (setq charset - (cdr (assq charset - mm-charset-synonym-alist)))) - charset) + ((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) + (and cs (mm-coding-system-p cs) cs))) ;; Last resort: search the coding system list for entries which ;; have the right mime-charset in case the canonical name isn't ;; defined (though it should be). @@ -396,6 +398,26 @@ Only used in Emacs Mule 4." (or (get-charset-property charset 'preferred-coding-system) (get-charset-property charset 'prefered-coding-system))) +(defsubst mm-guess-charset () + "Guess Mule charset from the language environment." + (or + mail-parse-mule-charset ;; cached mule-charset + (progn + (setq mail-parse-mule-charset + (and (boundp 'current-language-environment) + (car (last + (assq 'charset + (assoc current-language-environment + language-info-alist)))))) + (if (or (not mail-parse-mule-charset) + (eq mail-parse-mule-charset 'ascii)) + (setq mail-parse-mule-charset + (or (car (last (assq mail-parse-charset + mm-mime-mule-charset-alist))) + ;; default + 'latin-iso8859-1))) + mail-parse-mule-charset))) + (defun mm-charset-after (&optional pos) "Return charset of a character in current buffer at position POS. If POS is nil, it defauls to the current point. @@ -412,23 +434,7 @@ If the charset is `composition', return the actual one." (if (and charset (not (memq charset '(ascii eight-bit-control eight-bit-graphic)))) charset - (or - mail-parse-mule-charset ;; cached mule-charset - (progn - (setq mail-parse-mule-charset - (and (boundp 'current-language-environment) - (car (last - (assq 'charset - (assoc current-language-environment - language-info-alist)))))) - (if (or (not mail-parse-mule-charset) - (eq mail-parse-mule-charset 'ascii)) - (setq mail-parse-mule-charset - (or (car (last (assq mail-parse-charset - mm-mime-mule-charset-alist))) - ;; Fixme: don't fix that! - 'latin-iso8859-1))) - mail-parse-mule-charset))))))) + (mm-guess-charset)))))) (defun mm-mime-charset (charset) "Return the MIME charset corresponding to the given Mule CHARSET." @@ -456,14 +462,13 @@ If the charset is `composition', return the actual one." (setq result (cons head result))) (nreverse result))) -;; It's not clear whether this is supposed to mean the global or local -;; setting. I think it's used inconsistently. -- fx -(defsubst mm-multibyte-p () - "Say whether multibyte is enabled." - (if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - enable-multibyte-characters - (featurep 'mule))) +(if (and (not (featurep 'xemacs)) + (boundp 'enable-multibyte-characters)) + (defalias 'mm-multibyte-p + (lambda () + "Say whether multibyte is enabled in the current buffer." + enable-multibyte-characters)) + (defalias 'mm-multibyte-p (lambda () (featurep 'mule)))) (defun mm-iso-8859-x-to-15-region (&optional b e) (if (fboundp 'char-charset) @@ -497,7 +502,7 @@ charset, and a longer list means no appropriate charset." (let (charsets) ;; The return possibilities of this function are a mess... (or (and (mm-multibyte-p) - (fboundp 'find-coding-systems-region) + mm-use-find-coding-systems-region ;; Find the mime-charset of the most preferred coding ;; system that has one. (let ((systems (find-coding-systems-region b e))) @@ -722,6 +727,31 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." (push dir result)) (push path result)))) +(if (fboundp 'detect-coding-region) + (defun mm-detect-coding-region (start end) + "Like 'detect-coding-region' except returning the best one." + (let ((coding-systems + (detect-coding-region (point) (point-max)))) + (or (car-safe coding-systems) + coding-systems))) + (defun mm-detect-coding-region (start end) + (let ((point (point))) + (goto-char start) + (skip-chars-forward "\0-\177" end) + (prog1 + (if (eq (point) end) 'ascii (mm-guess-charset)) + (goto-char point))))) + +(if (fboundp 'coding-system-get) + (defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + (coding-system-get cs 'mime-charset))) + (defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + cs))) + (provide 'mm-util) ;;; mm-util.el ends here diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 840ad4c..06a6c71 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -1,5 +1,5 @@ ;;; mm-view.el --- functions for viewing MIME objects -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -296,6 +296,7 @@ (buffer-disable-undo) (mm-insert-part handle) (funcall mode) + (require 'font-lock) (let ((font-lock-verbose nil)) ;; I find font-lock a bit too verbose. (font-lock-fontify-buffer)) diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index ac87492..d5baf3f 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -112,8 +112,9 @@ ;; todo: try dns/ldap automatically first, before prompting user (let (certs done) (while (not done) - (ecase (read (gnus-completing-read "dns" "Fetch certificate from" - '(("dns") ("file")) nil t)) + (ecase (read (gnus-completing-read-with-default + "dns" "Fetch certificate from" + '(("dns") ("file")) nil t)) (dns (setq certs (append certs (mml-smime-get-dns-cert)))) (file (setq certs (append certs diff --git a/lisp/mml.el b/lisp/mml.el index 2fabf3e..eb43ea2 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -1,5 +1,5 @@ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -35,6 +35,7 @@ (autoload 'gnus-setup-posting-charset "gnus-msg") (autoload 'gnus-add-minor-mode "gnus-ems") (autoload 'message-fetch-field "message") + (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message")) (defcustom mml-content-type-parameters @@ -64,6 +65,16 @@ NAME is a string containing the name of the TWEAK parameter in the MML handle. FUNCTION is a Lisp function which is called with the MML handle to tweak the part.") +(defvar mml-tweak-sexp-alist + '((mml-externalize-attachments . mml-tweak-externalize-attachments)) + "A list of (SEXP . FUNCTION) for tweaking MML parts. +SEXP is a s-expression. If the evaluation of SEXP is non-nil, FUNCTION +is called. FUNCTION is a Lisp function which is called with the MML +handle to tweak the part.") + +(defvar mml-externalize-attachments nil + "*If non-nil, local-file attachments are generated as external parts.") + (defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. Each entry has the form (NAME . FUNCTION), where @@ -276,6 +287,15 @@ A message part needs to be split into %d charset parts. Really send? " (setq contents (append (list (cons 'tag-location orig-point)) contents)) (cons (intern name) (nreverse contents)))) +(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) + (let ((str (buffer-substring-no-properties start end)) + (bufstart start) tmp) + (while (setq tmp (text-property-any start end 'hard 't)) + (set-text-properties (- tmp bufstart) (- tmp bufstart -1) + '(hard t) str) + (setq start (1+ tmp))) + str)) + (defun mml-read-part (&optional mml) "Return the buffer up till the next part, multipart or closing part or multipart. If MML is non-nil, return the buffer up till the correspondent mml tag." @@ -289,19 +309,22 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (re-search-forward "<#\\(/\\)?mml." nil t) (setq count (+ count (if (match-beginning 1) -1 1))) (goto-char (point-max)))) - (buffer-substring-no-properties beg (if (> count 0) - (point) - (match-beginning 0)))) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (if (> count 0) + (point) + (match-beginning 0)))) (if (re-search-forward "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) (prog1 - (buffer-substring-no-properties beg (match-beginning 0)) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (match-beginning 0)) (if (or (not (match-beginning 1)) (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) - (buffer-substring-no-properties beg (goto-char (point-max))))))) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (goto-char (point-max))))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") @@ -330,7 +353,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let ((raw (cdr (assq 'raw cont))) - coded encoding charset filename type) + coded encoding charset filename type flowed) (setq type (or (cdr (assq 'type cont)) "text/plain")) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) @@ -377,8 +400,24 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (setq charset (mm-encode-body charset)) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) + ;; Only perform format=flowed filling on text/plain + ;; parts where there either isn't a format parameter + ;; in the mml tag or it says "flowed" and there + ;; actually are hard newlines in the text. + (let (use-hard-newlines) + (when (and (string= type "text/plain") + (or (null (assq 'format cont)) + (string= (assq 'format cont) "flowed")) + (setq use-hard-newlines + (text-property-any + (point-min) (point-max) 'hard 't))) + (fill-flowed-encode) + ;; Indicate that `mml-insert-mime-headers' should + ;; insert a "; format=flowed" string unless the + ;; user has already specified it. + (setq flowed (null (assq 'format cont))))) (setq coded (buffer-string))) - (mml-insert-mime-headers cont type charset encoding) + (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (mm-with-unibyte-buffer @@ -393,7 +432,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (insert (cdr (assq 'contents cont))))) (setq encoding (mm-encode-buffer type) coded (mm-string-as-multibyte (buffer-string)))) - (mml-insert-mime-headers cont type charset encoding) + (mml-insert-mime-headers cont type charset encoding nil) (insert "\n") (mm-with-unibyte-current-buffer (insert coded))))) @@ -462,7 +501,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (setq sender (cdr (assq 'sender cont))) (message-options-set 'message-sender sender)) (if (setq recipients (cdr (assq 'recipients cont))) - (message-options-set 'message-sender recipients)) + (message-options-set 'message-recipients recipients)) (funcall (nth 1 item) cont))) (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) @@ -470,7 +509,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (setq sender (cdr (assq 'sender cont))) (message-options-set 'message-sender sender)) (if (setq recipients (cdr (assq 'recipients cont))) - (message-options-set 'message-sender recipients)) + (message-options-set 'message-recipients recipients)) (funcall (nth 1 item) cont)))))) (defun mml-compute-boundary (cont) @@ -513,13 +552,14 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." "") mml-base-boundary)) -(defun mml-insert-mime-headers (cont type charset encoding) +(defun mml-insert-mime-headers (cont type charset encoding flowed) (let (parameters disposition description) (setq parameters (mml-parameter-string cont mml-content-type-parameters)) (when (or charset parameters + flowed (not (equal type mml-generate-default-type))) (when (consp charset) (error @@ -528,6 +568,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (when charset (insert "; " (mail-header-encode-parameter "charset" (symbol-name charset)))) + (when flowed + (insert "; format=flowed")) (when parameters (mml-insert-parameter-string cont mml-content-type-parameters)) @@ -626,6 +668,9 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (message-encode-message-body) (save-restriction (message-narrow-to-headers-or-head) + ;; Skip past any From_ headers. + (while (looking-at "From ") + (forward-line 1)) (let ((mail-parse-charset message-default-charset)) (mail-encode-encoded-word-buffer)))) @@ -928,7 +973,8 @@ If RAW, don't highlight the article." (erase-buffer) (mm-disable-multibyte) (insert s))) - (let ((gnus-newsgroup-charset (car message-posting-charset))) + (let ((gnus-newsgroup-charset (car message-posting-charset)) + gnus-article-prepare-hook gnus-original-article-buffer) (run-hooks 'gnus-article-decode-hook) (let ((gnus-newsgroup-name "dummy")) (gnus-article-prepare-display)))) @@ -962,7 +1008,23 @@ If RAW, don't highlight the article." (setq alist (cdr alist))))))) (if func (funcall func cont) - cont))) + cont) + (let ((alist mml-tweak-sexp-alist)) + (while alist + (if (eval (caar alist)) + (funcall (cdar alist) cont)) + (setq alist (cdr alist))))) + cont) + +(defun mml-tweak-externalize-attachments (cont) + "Tweak attached files as external parts." + (let (filename-cons) + (when (and (eq (car cont) 'part) + (not (cdr (assq 'buffer cont))) + (and (setq filename-cons (assq 'filename cont)) + (not (equal (cdr (assq 'nofile cont)) "yes")))) + (setcar cont 'external) + (setcar filename-cons 'name)))) (provide 'mml) diff --git a/lisp/nnagent.el b/lisp/nnagent.el index 6a3b7be..c77b91f 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -1,6 +1,6 @@ ;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -128,6 +128,46 @@ (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) nil) +(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) + (let ((file (gnus-agent-article-name ".overview" group)) + arts n) + (save-excursion + (gnus-agent-load-alist group) + (setq arts (gnus-set-difference articles + (mapcar 'car gnus-agent-article-alist))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (while (and arts (not (eobp))) + (cond + ((looking-at "[0-9]") + (setq n (read (current-buffer))) + (if (> n (car arts)) + (beginning-of-line)) + (while (and arts (> n (car arts))) + (insert (format + "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" + (car arts) (car arts))) + (pop arts)) + (if (and arts (= n (car arts))) + (pop arts)))) + (forward-line 1)) + (while (and arts) + (insert (format + "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" + (car arts) (car arts))) + (pop arts)) + (if (and fetch-old + (not (numberp fetch-old))) + t ; Don't remove anything. + (nnheader-nov-delete-outside-range + (if fetch-old (max 1 (- (car articles) fetch-old)) + (car articles)) + (car (last articles))) + t) + 'nov))) + (deffoo nnagent-request-group (group &optional server dont-check) (nnoo-parent-function 'nnagent 'nnml-request-group (list group (nnagent-server server) dont-check))) @@ -178,10 +218,6 @@ (nnoo-parent-function 'nnagent 'nnml-request-scan (list group (nnagent-server server)))) -(deffoo nnagent-retrieve-headers (sequence &optional group server fetch-old) - (nnoo-parent-function 'nnagent 'nnml-retrieve-headers - (list sequence group (nnagent-server server) fetch-old))) - (deffoo nnagent-set-status (article name value &optional group server) (nnoo-parent-function 'nnagent 'nnml-set-status (list article name value group (nnagent-server server)))) diff --git a/lisp/nneething.el b/lisp/nneething.el index 0d9d760..9c30970 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -1,6 +1,6 @@ ;;; nneething.el --- arbitrary file access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -126,11 +126,23 @@ included.") (file-exists-p file) ; The file exists. (not (file-directory-p file)) ; It's not a dir. (save-excursion - (nnmail-find-file file) ; Insert the file in the nntp buf. + (let ((nnmail-file-coding-system 'binary)) + (nnmail-find-file file)) ; Insert the file in the nntp buf. (unless (nnheader-article-p) ; Either it's a real article... - (goto-char (point-min)) - (nneething-make-head - file (current-buffer)) ; ... or we fake some headers. + (let ((type + (unless (file-directory-p file) + (or (cdr (assoc (concat "." (file-name-extension file)) + mailcap-mime-extensions)) + "text/plain"))) + (charset + (mm-detect-mime-charset-region (point-min) (point-max))) + (encoding)) + (unless (string-match "\\`text/" type) + (base64-encode-region (point-min) (point-max)) + (setq encoding "base64")) + (goto-char (point-min)) + (nneething-make-head file (current-buffer) + nil type charset encoding)) (insert "\n")) t)))) @@ -272,13 +284,44 @@ included.") (insert-buffer-substring nneething-work-buffer) (goto-char (point-max)))) -(defun nneething-make-head (file &optional buffer extra-msg) +(defun nneething-encode-file-name (file &optional coding-system) + "Encode the name of the FILE in CODING-SYSTEM." + (let ((pos 0) buf) + (setq file (mm-encode-coding-string + file (or coding-system nnmail-pathname-coding-system))) + (while (string-match "[^-a-zA-Z_:/.]" file pos) + (setq buf (cons (format "%%%02x" (aref file (match-beginning 0))) + (cons (substring file pos (match-beginning 0)) buf)) + pos (match-end 0))) + (apply (function concat) + (nreverse (cons (substring file pos) buf))))) + +(defun nneething-decode-file-name (file &optional coding-system) + "Decode the name of the FILE is encoded in CODING-SYSTEM." + (let ((pos 0) buf) + (while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos) + (setq buf (cons (string (string-to-number (match-string 1 file) 16)) + (cons (substring file pos (match-beginning 0)) buf)) + pos (match-end 0))) + (decode-coding-string + (apply (function concat) + (nreverse (cons (substring file pos) buf))) + (or coding-system nnmail-pathname-coding-system)))) + +(defun nneething-get-file-name (id) + "Extract the file name from the message ID string." + (when (string-match "\\`\\'" id) + (nneething-decode-file-name (match-string 1 id)))) + +(defun nneething-make-head (file &optional buffer extra-msg + mime-type mime-charset mime-encoding) "Create a head by looking at the file attributes of FILE." (let ((atts (file-attributes file))) (insert "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n" "Message-ID: \n" (if (equal '(0 0) (nth 5 atts)) "" (concat "Date: " (current-time-string (nth 5 atts)) "\n")) @@ -297,6 +340,19 @@ included.") (concat "Lines: " (int-to-string (count-lines (point-min) (point-max))) "\n")) + "") + (if mime-type + (concat "Content-Type: " mime-type + (if mime-charset + (concat "; charset=" + (if (stringp mime-charset) + mime-charset + (symbol-name mime-charset))) + "") + (if mime-encoding + (concat "\nContent-Transfer-Encoding: " mime-encoding) + "") + "\nMIME-Version: 1.0\n") "")))) (defun nneething-from-line (uid &optional file) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 25613f6..0715110 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1163,13 +1163,14 @@ This command does not work if you use short group names." (nnfolder-open-marks group server) ;; Update info using `nnfolder-marks'. (mapcar (lambda (pred) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (cdr (assq (cdr pred) nnfolder-marks)) - (gnus-info-marks info)) - t)) + (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) + (gnus-info-set-marks + info + (gnus-update-alist-soft + (cdr pred) + (cdr (assq (cdr pred) nnfolder-marks)) + (gnus-info-marks info)) + t))) gnus-article-mark-lists) (let ((seen (cdr (assq 'read nnfolder-marks)))) (gnus-info-set-read info diff --git a/lisp/nnimap.el b/lisp/nnimap.el index a5bd4d4..0d9fd9b 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -194,7 +194,9 @@ RFC2060 section 6.4.4." :group 'nnimap :type 'sexp) -(defcustom nnimap-close-asynchronous nil +;; Performance / bug workaround variables + +(defcustom nnimap-close-asynchronous t "Close mailboxes asynchronously in `nnimap-close-group'. This means that errors cought by nnimap when closing the mailbox will not prevent Gnus from updating the group status, which may be harmful. @@ -202,6 +204,18 @@ However, it increases speed." :type 'boolean :group 'nnimap) +(defcustom nnimap-dont-close t + "Never close mailboxes. +This increases the speed of closing mailboxes (quiting group) but may +decrease the speed of selecting another mailbox later. Re-selecting +the same mailbox will be faster though." + :type 'boolean + :group 'nnimap) + +(defvoo nnimap-need-unselect-to-notice-new-mail nil + "Unselect mailboxes before looking for new mail in them. +Some servers seem to need this under some circumstances.") + ;; Authorization / Privacy variables (defvoo nnimap-auth-method nil @@ -419,16 +433,18 @@ If SERVER is nil, uses the current server." (defun nnimap-before-find-minmax-bugworkaround () "Function called before iterating through mailboxes with `nnimap-find-minmax-uid'." - ;; XXX this is for UoW imapd problem, it doesn't notice new mail in - ;; currently selected mailbox without a re-select/examine. - (or (null (imap-current-mailbox nnimap-server-buffer)) - (imap-mailbox-unselect nnimap-server-buffer))) + (when nnimap-need-unselect-to-notice-new-mail + ;; XXX this is for UoW imapd problem, it doesn't notice new mail in + ;; currently selected mailbox without a re-select/examine. + (or (null (imap-current-mailbox nnimap-server-buffer)) + (imap-mailbox-unselect nnimap-server-buffer)))) (defun nnimap-find-minmax-uid (group &optional examine) "Find lowest and highest active article nummber in GROUP. If EXAMINE is non-nil the group is selected read-only." (with-current-buffer nnimap-server-buffer - (when (imap-mailbox-select group examine) + (when (or (string= group (imap-current-mailbox)) + (imap-mailbox-select group examine)) (let (minuid maxuid) (when (> (imap-mailbox-get 'exists) 0) (imap-fetch "1,*" "UID" nil 'nouidfetch) @@ -843,15 +859,18 @@ function is generally only called when Gnus is shutting down." (when (and (imap-opened) (nnimap-possibly-change-group group server)) (case nnimap-expunge-on-close - (always (imap-mailbox-expunge nnimap-close-asynchronous) - (imap-mailbox-close nnimap-close-asynchronous)) + (always (progn + (imap-mailbox-expunge nnimap-close-asynchronous) + (unless nnimap-dont-close + (imap-mailbox-close nnimap-close-asynchronous)))) (ask (if (and (imap-search "DELETED") - (gnus-y-or-n-p (format - "Expunge articles in group `%s'? " - imap-current-mailbox))) - (progn (imap-mailbox-expunge nnimap-close-asynchronous) - (imap-mailbox-close nnimap-close-asynchronous)) - (imap-mailbox-unselect))) + (gnus-y-or-n-p (format "Expunge articles in group `%s'? " + imap-current-mailbox))) + (progn + (imap-mailbox-expunge nnimap-close-asynchronous) + (unless nnimap-dont-close + (imap-mailbox-close nnimap-close-asynchronous))) + (imap-mailbox-unselect))) (t (imap-mailbox-unselect))) (not imap-current-mailbox)))) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 0da7857..bc33cf9 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -109,7 +109,8 @@ (setq num (string-to-int (match-string 2 xref)) group (match-string 1 xref)) (or (with-current-buffer buffer - (gnus-cache-request-article num group)) + (or (gnus-cache-request-article num group) + (gnus-agent-request-article num group))) (gnus-request-article num group buffer))))) (deffoo nnkiboze-request-scan (&optional group server) @@ -251,11 +252,12 @@ Finds out what articles are to be part of the nnkiboze groups." (when (file-exists-p newsrc-file) (load newsrc-file)) (let ((coding-system-for-write nnkiboze-file-coding-system)) + (gnus-make-directory (file-name-directory nov-file)) (with-temp-file nov-file (when (file-exists-p nov-file) (insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) - ;; Go through the active hashtb and add new all groups that match the + ;; Go through the active hashtb and add new all groups that match the ;; kiboze regexp. (mapatoms (lambda (group) @@ -272,7 +274,7 @@ Finds out what articles are to be part of the nnkiboze groups." nnkiboze-newsrc))) gnus-active-hashtb) ;; `newsrc' is set to the list of groups that possibly are - ;; component groups to this kiboze group. This list has elements + ;; component groups to this kiboze group. This list has elements ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest ;; number that has been kibozed in GROUP in this kiboze group. (setq newsrc nnkiboze-newsrc) @@ -293,13 +295,13 @@ Finds out what articles are to be part of the nnkiboze groups." gnus-newsrc-hashtb))) (unwind-protect (progn - ;; We set all list of article marks to nil. Since we operate - ;; on copies of the real lists, we can destroy anything we + ;; We set all list of article marks to nil. Since we operate + ;; on copies of the real lists, we can destroy anything we ;; want here. (when (nth 3 ginfo) (setcar (nthcdr 3 ginfo) nil)) - ;; We set the list of read articles to be what we expect for - ;; this kiboze group -- either nil or `(1 . LOWEST)'. + ;; We set the list of read articles to be what we expect for + ;; this kiboze group -- either nil or `(1 . LOWEST)'. (when ginfo (setcar (nthcdr 2 ginfo) (and (not (= lowest 1)) (cons 1 lowest)))) @@ -319,7 +321,7 @@ Finds out what articles are to be part of the nnkiboze groups." ;; We go through the list of scored articles. (while gnus-newsgroup-scored (when (> (caar gnus-newsgroup-scored) lowest) - ;; If it has a good score, then we enter this article + ;; If it has a good score, then we enter this article ;; into the kiboze group. (nnkiboze-enter-nov nov-buffer @@ -339,6 +341,7 @@ Finds out what articles are to be part of the nnkiboze groups." (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) (setq newsrc (cdr newsrc))))) ;; We save the kiboze newsrc for this group. + (gnus-make-directory (file-name-directory newsrc-file)) (with-temp-file newsrc-file (insert "(setq nnkiboze-newsrc '") (gnus-prin1 nnkiboze-newsrc) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index d9cee77..334d37f 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -466,7 +466,7 @@ parameter. It should return nil, `warn' or `delete'." (const warn) (const delete))) -(defcustom nnmail-extra-headers nil +(defcustom nnmail-extra-headers '(To Newsgroups) "*Extra headers to parse." :version "21.1" :group 'nnmail @@ -702,7 +702,7 @@ If SOURCE is a directory spec, try to return the group name component." (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -731,7 +731,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-search-unix-mail-delim-backward () "Put point at the beginning of the current Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -1071,13 +1071,11 @@ FUNC will be called with the group name to determine the article number." (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))) + (let ((restore (current-buffer))) (nnheader-set-temp-buffer "*Split Trace*") (gnus-add-buffer) - (while trace - (insert (car trace) "\n") - (setq trace (cdr trace))) + (dolist (trace (nreverse nnmail-split-trace)) + (insert trace "\n")) (goto-char (point-min)) (gnus-configure-windows 'split-trace) (set-buffer restore))) @@ -1266,10 +1264,10 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (push (cdr cached-pair) nnmail-split-trace)) (let ((split-rest (cddr split)) (end (match-end 0)) - ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So, - ;; start-of-value is the the point just before the - ;; beginning of the value, whereas after-header-name is - ;; the point just after the field name. + ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). + ;; So, start-of-value is the point just before the + ;; beginning of the value, whereas after-header-name + ;; is the point just after the field name. (start-of-value (match-end 1)) (after-header-name (match-end 2))) ;; Start the next search just before the beginning of the diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el index 61c7c41..9525854 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -1,5 +1,5 @@ ;;; nnmaildir.el --- maildir backend for Gnus -;; Copyright (c) 2001 Free Software Foundation, Inc. +;; Copyright (c) 2001, 2002 Free Software Foundation, Inc. ;; Copyright (c) 2000, 2001 Paul Jarc ;; Author: Paul Jarc @@ -30,17 +30,15 @@ ;; ;; Some goals of nnmaildir: ;; * Everything Just Works, and correctly. E.g., stale NOV data is -;; ignored when articles have been edited; no need for -;; -generate-nov-databases. +;; ignored; no need for -generate-nov-databases. ;; * Perfect reliability: [C-g] will never corrupt its data in memory, ;; and SIGKILL will never corrupt its data in the filesystem. ;; * We make it easy to manipulate marks, etc., from outside Gnus. ;; * All information about a group is stored in the maildir, for easy -;; backup and restoring. +;; backup, copying, restoring, etc. ;; * We use the filesystem as a database. ;; ;; Todo: -;; * Ignore old NOV data when gnus-extra-headers has changed. ;; * Don't force article renumbering, so nnmaildir can be used with ;; the cache and agent. Alternatively, completely rewrite the Gnus ;; backend interface, which would have other advantages. @@ -136,7 +134,9 @@ by nnmaildir-request-article.") ["subject\tfrom\tdate" "references\tchars\lines" "extra" - article-file-modtime]] + article-file-modtime + ;; The value of nnmail-extra-headers when this NOV data was parsed: + (to in-reply-to)]] (defmacro nnmaildir--srv-new () '(make-vector 11 nil)) (defmacro nnmaildir--srv-get-name (server) `(aref ,server 0)) @@ -213,15 +213,17 @@ by nnmaildir-request-article.") (defmacro nnmaildir--art-set-msgid (article val) `(aset ,article 3 ,val)) (defmacro nnmaildir--art-set-nov (article val) `(aset ,article 4 ,val)) -(defmacro nnmaildir--nov-new () '(make-vector 4 nil)) +(defmacro nnmaildir--nov-new () '(make-vector 5 nil)) (defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0)) (defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1)) (defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2)) (defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3)) +(defmacro nnmaildir--nov-get-neh (nov) `(aref ,nov 4)) (defmacro nnmaildir--nov-set-beg (nov val) `(aset ,nov 0 ,val)) (defmacro nnmaildir--nov-set-mid (nov val) `(aset ,nov 1 ,val)) (defmacro nnmaildir--nov-set-end (nov val) `(aset ,nov 2 ,val)) (defmacro nnmaildir--nov-set-mtime (nov val) `(aset ,nov 3 ,val)) +(defmacro nnmaildir--nov-set-neh (nov val) `(aset ,nov 4 ,val)) (defmacro nnmaildir--srv-grp-dir (srv-dir gname) `(file-name-as-directory (concat ,srv-dir ,gname))) @@ -289,7 +291,8 @@ by nnmaildir-request-article.") (defun nnmaildir--update-nov (srv-dir group article) (let ((nnheader-file-coding-system 'binary) dir gname pgname msgdir prefix suffix file attr mtime novdir novfile - nov msgid nov-beg nov-mid nov-end field pos extra val deactivate-mark) + nov msgid nov-beg nov-mid nov-end field pos extra val old-neh new-neh + deactivate-mark) (catch 'return (setq suffix (nnmaildir--art-get-suffix article)) (if (stringp suffix) nil @@ -315,17 +318,35 @@ by nnmaildir-request-article.") novfile (concat novdir prefix)) (save-excursion (set-buffer (get-buffer-create " *nnmaildir nov*")) - (when (file-exists-p novfile) - (and nov - (equal mtime (nnmaildir--nov-get-mtime nov)) - (throw 'return nov)) - (erase-buffer) - (nnheader-insert-file-contents novfile) - (setq nov (read (current-buffer))) - (nnmaildir--art-set-msgid article (car nov)) - (setq nov (cadr nov)) - (and (equal mtime (nnmaildir--nov-get-mtime nov)) - (throw 'return nov))) + (when (file-exists-p novfile) ;; If not, force reparsing the message. + (if nov nil ;; It's already in memory. + ;; Else read the data from the NOV file. + (erase-buffer) + (nnheader-insert-file-contents novfile) + (setq nov (read (current-buffer))) + (nnmaildir--art-set-msgid article (car nov)) + (setq nov (cadr nov))) + ;; If the NOV's modtime matches the file's current modtime, + ;; and it has the right length (i.e., it wasn't produced by + ;; a too-much older version of nnmaildir), then we may use + ;; this NOV data rather than parsing the message file, + ;; unless nnmail-extra-headers has been augmented since this + ;; data was last parsed. + (when (and (equal mtime (nnmaildir--nov-get-mtime nov)) + (= (length nov) (length (nnmaildir--nov-new)))) + ;; This NOV data is potentially up-to-date. + (setq old-neh (nnmaildir--nov-get-neh nov) + new-neh nnmail-extra-headers) + (if (equal new-neh old-neh) (throw 'return nov)) ;; Common case. + ;; They're not equal, but maybe the new is a subset of the old... + (if (null new-neh) (throw 'return nov)) + (while new-neh + (if (memq (car new-neh) old-neh) + (progn + (setq new-neh (cdr new-neh)) + (if new-neh nil (throw 'return nov))) + (setq new-neh nil))))) + ;; Parse the NOV data out of the message. (erase-buffer) (nnheader-insert-file-contents file) (insert "\n") @@ -399,8 +420,9 @@ by nnmaildir-request-article.") (nnmaildir--nov-set-mid nov nov-mid) (nnmaildir--nov-set-end nov nov-end) (nnmaildir--nov-set-mtime nov mtime) + (nnmaildir--nov-set-neh nov (copy-sequence nnmail-extra-headers)) (prin1 (list msgid nov) (current-buffer)) - (setq file (concat novdir ":")) + (setq file (concat novfile ":")) (nnmaildir--unlink file) (write-region (point-min) (point-max) file nil 'no-message)) (rename-file file novfile 'replace) @@ -1438,7 +1460,8 @@ by nnmaildir-request-article.") (let ((no-force (not force)) (group (nnmaildir--prepare server gname)) pgname time boundary time-iter bound-iter high low target dir nlist - stop num article didnt suffix nnmaildir--file deactivate-mark) + stop number article didnt suffix nnmaildir--file + nnmaildir-article-file-name deactivate-mark) (catch 'return (if group nil (nnmaildir--srv-set-error nnmaildir--cur-server @@ -1460,11 +1483,7 @@ by nnmaildir-request-article.") high (1- high))) (setcar (cdr boundary) low) (setcar boundary high) - (setq target (nnmaildir--param pgname 'expire-group) - target (and (stringp target) - (not (string-equal target pgname)) - target) - dir (nnmaildir--srv-get-dir nnmaildir--cur-server) + (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server) dir (nnmaildir--srv-grp-dir dir gname) dir (nnmaildir--cur dir) nlist (nnmaildir--grp-get-lists group) @@ -1473,17 +1492,17 @@ by nnmaildir-request-article.") (save-excursion (set-buffer (get-buffer-create " *nnmaildir move*")) (while ranges - (setq num (car ranges) ranges (cdr ranges)) - (while (eq num (car ranges)) + (setq number (car ranges) ranges (cdr ranges)) + (while (eq number (car ranges)) (setq ranges (cdr ranges))) - (if (numberp num) (setq stop num) - (setq stop (car num) num (cdr num))) - (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) num) + (if (numberp number) (setq stop number) + (setq stop (car number) number (cdr number))) + (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) number) nlist)) (while (and nlist (setq article (car nlist) - num (nnmaildir--art-get-num article)) - (>= num stop)) + number (nnmaildir--art-get-num article)) + (>= number stop)) (setq nlist (cdr nlist) suffix (nnmaildir--art-get-suffix article)) (catch 'continue @@ -1509,14 +1528,20 @@ by nnmaildir-request-article.") time-iter (cdr time-iter))) (and bound-iter time-iter (car-less-than-car bound-iter time-iter)))) - (setq didnt (cons (nnmaildir--art-get-num article) didnt)) - (when target + (setq didnt (cons number didnt)) + (save-excursion + (setq nnmaildir-article-file-name nnmaildir--file + target (nnmaildir--param pgname 'expire-group))) + (when (and (stringp target) + (not (string-equal target pgname))) ;; Move it. (erase-buffer) (nnheader-insert-file-contents nnmaildir--file) (gnus-request-accept-article target nil nil 'no-encode)) - (nnmaildir--unlink nnmaildir--file) - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil))))) + (if (equal target pgname) + (setq didnt (cons number didnt)) ;; Leave it here. + (nnmaildir--unlink nnmaildir--file) + (nnmaildir--art-set-suffix article 'expire) + (nnmaildir--art-set-nov article nil)))))) (erase-buffer)) didnt))) diff --git a/lisp/nnml.el b/lisp/nnml.el index b7eb5b1..6ebfb6a 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -939,13 +939,14 @@ Use the nov database for the current group if available." (nnml-open-marks group server) ;; Update info using `nnml-marks'. (mapcar (lambda (pred) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (cdr (assq (cdr pred) nnml-marks)) - (gnus-info-marks info)) - t)) + (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) + (gnus-info-set-marks + info + (gnus-update-alist-soft + (cdr pred) + (cdr (assq (cdr pred) nnml-marks)) + (gnus-info-marks info)) + t))) gnus-article-mark-lists) (let ((seen (cdr (assq 'read nnml-marks)))) (gnus-info-set-read info diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index f3a6f6f..21156e9 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -1,5 +1,5 @@ ;;; nnslashdot.el --- interfacing with Slashdot -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -23,9 +23,6 @@ ;;; Commentary: -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - ;;; Code: (eval-when-compile (require 'cl)) @@ -101,9 +98,10 @@ (let ((case-fold-search t)) (erase-buffer) (when (= start 1) - (mm-url-insert (format nnslashdot-article-url - (nnslashdot-sid-strip sid)) t) + (mm-url-insert (format nnslashdot-article-url sid) t) (goto-char (point-min)) + (if (eobp) + (error "Couldn't open connection to slashdot")) (re-search-forward "Posted by[ \t\r\n]+") (when (looking-at "\\(]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") (setq from (mm-url-decode-entities-string (match-string 2)))) @@ -118,15 +116,14 @@ 1 (make-full-mail-header 1 group from date - (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>") + (concat "<" sid "%1@slashdot>") "" 0 lines nil nil)) headers) (setq start (if nnslashdot-threaded 2 (pop articles)))) (while (and start (<= start last)) (setq point (goto-char (point-max))) (mm-url-insert - (format nnslashdot-comments-url - (nnslashdot-sid-strip sid) + (format nnslashdot-comments-url sid nnslashdot-threshold 0 (- start 2)) t) (when (and nnslashdot-threaded first-comments) @@ -183,10 +180,9 @@ article (concat subject " (" score ")") from date - (concat "<" (nnslashdot-sid-strip sid) "%" cid "@slashdot>") + (concat "<" sid "%" cid "@slashdot>") (if parent - (concat "<" (nnslashdot-sid-strip sid) "%" - parent "@slashdot>") + (concat "<" sid "%" parent "@slashdot>") "") 0 lines nil nil)) headers) @@ -303,6 +299,8 @@ (mm-with-unibyte-buffer (mm-url-insert nnslashdot-backslash-url t) (goto-char (point-min)) + (if (eobp) + (error "Couldn't open connection to slashdot")) (while (search-forward "" nil t) (narrow-to-region (point) (search-forward "")) (goto-char (point-min)) @@ -355,7 +353,7 @@ (deffoo nnslashdot-request-post (&optional server) (nnslashdot-possibly-change-server nil server) - (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) + (let ((sid (message-fetch-field "newsgroups")) (subject (message-fetch-field "subject")) (references (car (last (split-string (message-fetch-field "references"))))) @@ -501,8 +499,6 @@ (defun nnslashdot-lose (why) (error "Slashdot HTML has changed; please get a new version of nnslashdot")) -(defalias 'nnslashdot-sid-strip 'identity) - (provide 'nnslashdot) ;;; nnslashdot.el ends here diff --git a/lisp/nnspool.el b/lisp/nnspool.el index a3e0c3b..e20d355 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -1,7 +1,8 @@ ;;; nnspool.el --- spool access for GNU Emacs ;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000 Free Software Foundation, Inc. +;; 2000, 2002 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -330,7 +331,8 @@ there.") () (nnheader-report 'nnspool "") (set-process-sentinel proc 'nnspool-inews-sentinel) - (process-send-region proc (point-min) (point-max)) + (mm-with-unibyte-current-buffer + (process-send-region proc (point-min) (point-max))) ;; We slap a condition-case around this, because the process may ;; have exited already... (ignore-errors diff --git a/lisp/nntp.el b/lisp/nntp.el index ac2362c..3e57e1e 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,7 @@ ;;; nntp.el --- nntp access for Gnus + ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000, 2001 -;; Free Software Foundation, Inc. +;; 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -9,18 +9,18 @@ ;; This file is part of GNU Emacs. ;; GNU Emacs 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. +;; 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. -;; GNU Emacs 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. +;; GNU Emacs 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: @@ -460,8 +460,10 @@ noticing asynchronous data.") (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) (erase-buffer))) (nntp-encode-text) - (process-send-region (nntp-find-connection nntp-server-buffer) - (point-min) (point-max)) + (mm-with-unibyte-current-buffer + ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro. + (process-send-region (nntp-find-connection nntp-server-buffer) + (point-min) (point-max))) (nntp-retrieve-data nil nntp-address nntp-port-number nntp-server-buffer wait-for nnheader-callback-function)) @@ -572,7 +574,8 @@ noticing asynchronous data.") (last-point (point-min)) (nntp-inhibit-erase t) (buf (nntp-find-connection-buffer nntp-server-buffer)) - (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) + (command (if nntp-server-list-active-group + "LIST ACTIVE" "GROUP"))) (while groups ;; Send the command to the server. (nntp-send-command nil command (pop groups)) @@ -734,8 +737,8 @@ noticing asynchronous data.") (save-excursion (set-buffer nntp-server-buffer) (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number)) - (nntp-find-group-and-number)))) + (nntp-find-group-and-number group)) + (nntp-find-group-and-number group)))) (deffoo nntp-request-head (article &optional group server) (nntp-possibly-change-group group server) @@ -743,7 +746,7 @@ noticing asynchronous data.") "\r?\n\\.\r?\n" "HEAD" (if (numberp article) (int-to-string article) article)) (prog1 - (nntp-find-group-and-number) + (nntp-find-group-and-number group) (nntp-decode-text)))) (deffoo nntp-request-body (article &optional group server) @@ -1171,7 +1174,10 @@ password contained in '~/.nntp-authinfo'." (erase-buffer) (nntp-send-command "^[245].*\n" "GROUP" group) (setcar (cddr entry) group) - (erase-buffer)))))) + (erase-buffer) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer))))))) (defun nntp-decode-text (&optional cr-only) "Decode the text in the current buffer." @@ -1367,7 +1373,7 @@ password contained in '~/.nntp-authinfo'." (setq nntp-server-xover nil))) nntp-server-xover)))) -(defun nntp-find-group-and-number () +(defun nntp-find-group-and-number (&optional group) (save-excursion (save-restriction (set-buffer nntp-server-buffer) @@ -1379,29 +1385,48 @@ password contained in '~/.nntp-authinfo'." (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))) - group newsgroups xref) + newsgroups xref) (and number (zerop number) (setq number nil)) - ;; Then we find the group name. - (setq group - (cond - ;; If there is only one group in the Newsgroups header, - ;; then it seems quite likely that this article comes - ;; from that group, I'd say. - ((and (setq newsgroups (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) - newsgroups) - ;; If there is more than one group in the Newsgroups - ;; header, then the Xref header should be filled out. - ;; We hazard a guess that the group that has this - ;; article number in the Xref header is the one we are - ;; looking for. This might very well be wrong if this - ;; article happens to have the same number in several - ;; groups, but that's life. - ((and (setq xref (mail-fetch-field "xref")) - number - (string-match (format "\\([^ :]+\\):%d" number) xref)) - (substring xref (match-beginning 1) (match-end 1))) - (t ""))) + (if number + ;; Then we find the group name. + (setq group + (cond + ;; If there is only one group in the Newsgroups + ;; header, then it seems quite likely that this + ;; article comes from that group, I'd say. + ((and (setq newsgroups + (mail-fetch-field "newsgroups")) + (not (string-match "," newsgroups))) + newsgroups) + ;; If there is more than one group in the + ;; Newsgroups header, then the Xref header should + ;; be filled out. We hazard a guess that the group + ;; that has this article number in the Xref header + ;; is the one we are looking for. This might very + ;; well be wrong if this article happens to have + ;; the same number in several groups, but that's + ;; life. + ((and (setq xref (mail-fetch-field "xref")) + number + (string-match + (format "\\([^ :]+\\):%d" number) xref)) + (match-string 1 xref)) + (t ""))) + (cond + ((and (setq xref (mail-fetch-field "xref")) + (string-match + (if group + (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)") + "\\([^ :]+\\):\\([0-9]+\\)") + xref)) + (setq group (match-string 1 xref) + number (string-to-int (match-string 2 xref)))) + ((and (setq newsgroups + (mail-fetch-field "newsgroups")) + (not (string-match "," newsgroups))) + (setq group newsgroups)) + (group) + (t (setq group "")))) (when (string-match "\r" group) (setq group (substring group 0 (match-beginning 0)))) (cons group number))))) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index bd45c7d..046c470 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -521,14 +521,15 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;;; We map between virtual articles and real articles in a manner -;;; which keeps the size of the virtual active list the same as -;;; the sum of the component active lists. -;;; To achieve fair mixing of the groups, the last article in -;;; each of N component groups will be in the the last N articles -;;; in the virtual group. - -;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7 -;;; resprectively, then the virtual article numbers look like: +;;; which keeps the size of the virtual active list the same as the +;;; sum of the component active lists. + +;;; To achieve fair mixing of the groups, the last article in each of +;;; N component groups will be in the last N articles in the virtual +;;; group. + +;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and +;;; 6-7 resprectively, then the virtual article numbers look like: ;;; ;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7 diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 10eff84..948e168 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,5 +1,5 @@ ;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -535,13 +535,20 @@ The buffer may be narrowed." (defun rfc2047-decode-string (string) "Decode the quoted-printable-encoded STRING and return the results." (let ((m (mm-multibyte-p))) - (with-temp-buffer - (when m - (mm-enable-multibyte)) - (insert string) - (inline - (rfc2047-decode-region (point-min) (point-max))) - (buffer-string)))) + (if (string-match "=\\?" string) + (with-temp-buffer + (when m + (mm-enable-multibyte)) + (insert string) + (inline + (rfc2047-decode-region (point-min) (point-max))) + (buffer-string)) + (if (and m + mail-parse-charset + (not (eq mail-parse-charset 'us-ascii)) + (not (eq mail-parse-charset 'gnus-decoded))) + (mm-decode-coding-string string mail-parse-charset) + string)))) (defun rfc2047-parse-and-decode (word) "Decode WORD and return it if it is an encoded word. diff --git a/lisp/smiley-ems.el b/lisp/smiley-ems.el index f8a91d9..1cb263d 100644 --- a/lisp/smiley-ems.el +++ b/lisp/smiley-ems.el @@ -1,6 +1,6 @@ ;;; smiley-ems.el --- displaying smiley faces -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Dave Love ;; Keywords: news mail multimedia @@ -37,6 +37,7 @@ (eval-when-compile (require 'cl)) (require 'nnheader) +(require 'gnus-art) (defgroup smiley nil "Turn :-)'s into real images." @@ -102,10 +103,6 @@ regexp to replace with IMAGE. IMAGE is the name of a PBM file in (push (list (car elt) (cadr elt) image) smiley-cached-regexp-alist))))))) -(defvar smiley-active nil - "Non-nil means smilies in the buffer will be displayed.") -(make-variable-buffer-local 'smiley-active) - (defvar smiley-mouse-map (let ((map (make-sparse-keymap))) (define-key map [down-mouse-2] 'ignore) ; override widget @@ -126,7 +123,6 @@ A list of images is returned." (overlays-in start end)) (unless smiley-cached-regexp-alist (smiley-update-cache)) - (setq smiley-active t) (save-excursion (let ((beg (or start (point-min))) group overlay image images) @@ -137,6 +133,8 @@ A list of images is returned." (while (re-search-forward (car entry) end t) (when image (push image images) + (gnus-add-wash-type 'smiley) + (gnus-add-image 'smiley image) (add-text-properties (match-beginning group) (match-end group) `(display ,image @@ -147,12 +145,15 @@ A list of images is returned." images)))) (defun smiley-toggle-buffer (&optional arg) - "Toggle displaying smiley faces. + "Toggle displaying smiley faces in article buffer. With arg, turn displaying on if and only if arg is positive." (interactive "P") - (if (numberp arg) - (setq smiley-active (> arg 0)) - (setq smiley-active (not smiley-active)))) + (gnus-with-article-buffer + (if (if (numberp arg) + (> arg 0) + (not (memq 'smiley gnus-article-wash-types))) + (smiley-region (point-min) (point-max)) + (gnus-delete-images 'smiley)))) (defun smiley-mouse-toggle-buffer (event) "Toggle displaying smiley faces. @@ -163,25 +164,6 @@ With arg, turn displaying on if and only if arg is positive." (mouse-set-point event) (smiley-toggle-buffer)))) -(eval-when-compile (defvar gnus-article-buffer)) - -(defun gnus-smiley-display (&optional arg) - "Display textual emoticaons (\"smilies\") as small graphical icons. -With arg, turn displaying on if and only if arg is positive." - (interactive "P") - (gnus-with-article-buffer - (if (memq 'smiley gnus-article-wash-types) - (gnus-delete-images 'smiley) - (article-goto-body) - (let ((images (smiley-region (point) (point-max)))) - (when images - (gnus-add-wash-type 'smiley) - (dolist (image images) - (gnus-add-image 'smiley image)))) - (when (and (numberp arg) - (<= arg 0)) - (smiley-toggle-buffer arg))))) - (provide 'smiley) ;;; smiley-ems.el ends here diff --git a/lisp/smiley.el b/lisp/smiley.el index d82cbb3..afc5b21 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -64,10 +64,10 @@ ;; two alists below. (defcustom smiley-deformed-regexp-alist - '(("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3.xbm") - ("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2.xbm") - ("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1.xbm") - ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm") + '(("\\(\\^_\\^;;;\\)\\W" 1 "WideFaceAse3.xbm") + ("\\(\\^_\\^;;\\)\\W" 1 "WideFaceAse2.xbm") + ("\\(\\^_\\^;\\)\\W" 1 "WideFaceAse1.xbm") + ("\\(\\^_\\^\\)\\W" 1 "WideFaceSmile.xbm") ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm") ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm") ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") diff --git a/texi/.cvsignore b/texi/.cvsignore index f091e83..b323d1e 100644 --- a/texi/.cvsignore +++ b/texi/.cvsignore @@ -32,3 +32,4 @@ xface.tex smiley.tex gnusconfig.tex old +thumb* diff --git a/texi/ChangeLog b/texi/ChangeLog index de3983b..eb55f64 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,6 +1,135 @@ +2002-01-20 Patric Mueller + + * gnus.texi (Group Timestamp): Typo fix. + +2002-01-19 Lars Magne Ingebrigtsen + + * gnus.texi (Selecting a Group): Addition. + +2002-01-19 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Spool): Note that the .marks files can be + removed. + +2002-01-17 Paul Jarc + + * gnus.texi (Choosing a Mail Back End): mention nnmaildir. + (Comparing Mail Backends): briefly describe nnmaildir. + +2002-01-17 ShengHuo ZHU + + * gnus.texi (Agent Commands): Use gnus-agent-batch instead of + gnus-agent-batch-fetch. + +2002-01-15 Tue Jari Aalto + + * gnus.texi (Really Various Summary Commands): Added commands how + to create nnvirtual group and and how to modify the nnvirtual + regexp + +2002-01-12 ShengHuo ZHU + + * gnus.texi (Agent Caveats): Add agent cache. + (Agent Variables): Addition. + +2002-01-12 Simon Josefsson + + * gnus.texi (Conformity): Fix typo. + + * emacs-mime.texi (Flowed text, Standards): Add. + +2002-01-11 ShengHuo ZHU + + * message.texi (Mailing Lists): Addition. + * gnus.texi (Group Parameters): Addition. + From Sriram Karra . + +2002-01-10 Colin Marquardt + + * gnus.texi (Changing Servers): Addition. + +2002-01-06 ShengHuo ZHU + + * gnus.texi (Archived Messages): Rename + gnus-inews-mark-gcc-as-read to gnus-gcc-mark-as-read. + + * Makefile.in (clean): Clean thumb*. + +2002-01-05 Harry Putnam + + * gnus.texi (Score Variables): Clarify. + +2002-01-05 Lars Magne Ingebrigtsen + + * gnus.texi (Agent Expiry): Addition. + (Sorting the Summary Buffer): Addition. + +2002-01-05 Simon Josefsson + + * gnus.texi (Conformity): Add MIME and Disposition Notifications. + + * message.texi (Header Commands): Fix. Add m-goto-from. + (Insertion): Add m-i-disposition-notification-to. + +2002-01-05 ShengHuo ZHU + + * Makefile.in (.latexi.pdf-x): Use thumbpdf. + + * gnus.texi (Advanced Formatting): Double @'s. Use thumbpdf. + colorlinks=true. + +2002-01-05 Norman Walsh + + * gnus-faq.texi: Fix typo. + +2002-01-05 Lars Magne Ingebrigtsen + + * gnus.texi (Sorting the Summary Buffer): Addition. + +2002-01-04 Lars Magne Ingebrigtsen + + * gnus.texi (Virtual Groups): Addition. + +2002-01-03 Lars Magne Ingebrigtsen + + * gnus.texi (Article Keymap): Addition. + (Summary Mail Commands): Fix. + +2002-01-02 Lars Magne Ingebrigtsen + + * gnus.texi (Group Timestamp): Addition. Example from Andras + BALI. + (X-Face): Addition. + (Advanced Formatting): Add example. + +2002-01-01 Simon Josefsson + + * gnus.texi (Conformity): Add and fix. + + * message.texi (Security): Mention gpg-temp-directory. + + * gnus.texi (Article Washing): Link to Security section. + (Security): Fix. + (Signing and Encrypting): Renamed from Using GPG. + (IMAP): Fixes. + +2002-01-01 Simon Josefsson + + * gnus.texi (Customizing Articles): Add crossreference links. Add + gnus-body-boundary-delimiter. + 2002-01-01 Lars Magne Ingebrigtsen * gnus.texi (Choosing Commands): Addition. + (Article Display): Update. + (Article Display): Addition. + (Article Header): New. + (Slow Terminal Connection): Addition. + (Predicate Specifiers): New. + (To From Newsgroups): Addition. + (Topic Commands): Addition. + Update the menus. + Fix some references b0rked up by the menu fixing. 2001-12-31 Rui Zhu diff --git a/texi/Makefile.in b/texi/Makefile.in index dd4d951..934b1fa 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -61,12 +61,12 @@ refcard.pdf: refcard.tex gnuslogo-refcard.eps gnusref.tex TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) refcard.tex clean: - rm -f gnus.*.bak *.ky *.cp *.fn *.cps *.kys *.log *.aux *.dvi *.vr \ - *.pdf *.tp *.toc *.pg gnus.latexi *.aux *.[cgk]idx \ - gnus.ilg gnus.ind gnus.[cgk]ind gnus.idx \ - gnustmp.texi *.tmplatexi gnus.tmplatexi1 texput.log *.orig *.rej \ - gnus.latexi*~* xface.tex picons.tex smiley.tex *.latexi *.dvi-x \ - *.pdf-x gnus.out + rm -f *.[cgk]idx *.aux *.cp *.cps *.dvi *.dvi-x *.fn *.ky \ + *.kys *.latexi *.log *.orig *.pdf *.pdf-x *.pg *.rej \ + *.tmplatexi *.toc *.tp *.vr gnus.*.bak gnus.[cgk]ind gnus.idx \ + gnus.ilg gnus.ind gnus.latexi*~* gnus.out gnus.tmplatexi1 \ + gnustmp.texi picons.tex smiley.tex texput.log thumb*.png \ + thumbdta.tex xface.tex makeinfo: makeinfo -o gnus gnus.texi @@ -114,6 +114,7 @@ gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi: $(src egrep -v "end\{document\}" $< > gnus.tmplatexi cat $(srcdir)/postamble.tex >> gnus.tmplatexi TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) gnus.tmplatexi + thumbpdf gnus.pdf TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) gnus.tmplatexi mv gnus.pdf $@ diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 16ed3f8..12a4862 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -18,7 +18,7 @@ This file documents the Emacs MIME interface functionality. -Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.1 or @@ -1116,6 +1116,7 @@ string containing the @sc{mime} message. * Advanced MML Example:: Another example MML document. * Charset Translation:: How charsets are mapped from @sc{mule} to MIME. * Conversion:: Going from @sc{mime} to MML and vice versa. +* Flowed text:: Soft and hard newlines. @end menu @@ -1428,6 +1429,27 @@ other. The resulting contents of the message should remain equivalent, if not identical. +@node Flowed text +@section Flowed text +@cindex format=flowed + +The Emacs @sc{mime} library will respect the @code{use-hard-newlines} +variable (@pxref{Hard and Soft Newlines, ,Hard and Soft Newlines, +emacs, Emacs Manual}) when encoding a message, and the +``format=flowed'' Content-Type parameter when decoding a message. + +On encoding text, lines terminated by soft newline characters are +filled together and wrapped after the column decided by +@code{fill-flowed-encode-column}. This variable controls how the text +will look in a client that does not support flowed text, the default +is to wrap after 66 characters. If hard newline characters are not +present in the buffer, no flow encoding occurs. + +On decoding flowed text, lines with soft newline characters are filled +together and wrapped after the column decided by +@code{fill-flowed-display-column}. The default is to wrap after +@code{fill-column}. + @node Standards @chapter Standards @@ -1481,6 +1503,9 @@ Administrative Messages Communicating Presentation Information in Internet Messages: The Content-Disposition Header Field +@item RFC2646 +Documentation of the text/plain format parameter for flowed text. + @end table diff --git a/texi/gnus-faq.texi b/texi/gnus-faq.texi index f3830b7..d3da1d5 100644 --- a/texi/gnus-faq.texi +++ b/texi/gnus-faq.texi @@ -1,6 +1,6 @@ @c Insert "\input texinfo" at 1st line before texing this file alone. @c -*-texinfo-*- -@c Copyright (C) 1995, 2001 Free Software Foundation, Inc. +@c Copyright (C) 1995, 2001, 2002 Free Software Foundation, Inc. @setfilename gnus-faq.info @node Frequently Asked Questions @@ -262,7 +262,7 @@ being responded to. These commands are also selectable as @i{Followup and Yank} and @i{Reply and Yank} in the Post menu. @kbd{C-c C-y} grabs the previous message and prefixes each line with -@code{ail-indentation-spaces} spaces or @code{mail-yank-prefix} if that is +@code{message-indentation-spaces} spaces or @code{message-yank-prefix} if that is non-nil, unless you have set your own @code{mail-citation-hook}, which will be called to do the job. diff --git a/texi/gnus.texi b/texi/gnus.texi index 30b8189..c000d91 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -25,14 +25,15 @@ \ifx\pdfoutput\undefined \else -\usepackage[pdftex,bookmarks]{hyperref} +\usepackage[pdftex,bookmarks,colorlinks=true]{hyperref} +\usepackage{thumbpdf} \pdfcompresslevel=9 \fi \makeindex \begin{document} -\newcommand{\gnusversionname}{Oort Gnus v.} +\newcommand{\gnusversionname}{Oort Gnus v0.05} \newcommand{\gnuschaptername}{} \newcommand{\gnussectionname}{} @@ -286,7 +287,7 @@ \thispagestyle{empty} -Copyright \copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001 +Copyright \copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. @@ -315,7 +316,7 @@ license to the document, as described in section 6 of the license. This file documents Gnus, the GNU Emacs newsreader. -Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -345,7 +346,7 @@ license to the document, as described in section 6 of the license. @page @vskip 0pt plus 1filll -Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001 +Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -381,7 +382,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Oort Gnus v. +This manual corresponds to Oort Gnus v0.05 @end ifinfo @@ -477,8 +478,8 @@ Group Buffer Format Group Topics -* Topic Variables:: How to customize the topics the Lisp Way. * Topic Commands:: Interactive E-Z commands. +* Topic Variables:: How to customize the topics the Lisp Way. * Topic Sorting:: Sorting each topic individually. * Topic Topology:: A map of the world. * Topic Parameters:: Parameters that apply to all groups in a topic. @@ -498,7 +499,7 @@ Summary Buffer * Choosing Articles:: Reading articles. * Paging the Article:: Scrolling the current article. * Reply Followup and Post:: Posting articles. -* Delayed Articles:: +* Delayed Articles:: * Marking Articles:: Marking articles as read, expirable, etc. * Limiting:: You can limit the summary buffer. * Threading:: How threads are made. @@ -543,16 +544,16 @@ Reply, Followup and Post * Summary Mail Commands:: Sending mail. * Summary Post Commands:: Sending news. * Summary Message Commands:: Other Message-related commands. -* Canceling and Superseding:: +* Canceling and Superseding:: Marking Articles * Unread Articles:: Marks for unread articles. * Read Articles:: Marks for read articles. * Other Marks:: Marks that do not affect readedness. -* Setting Marks:: -* Generic Marking Commands:: -* Setting Process Marks:: +* Setting Marks:: +* Generic Marking Commands:: +* Setting Process Marks:: Marking Articles @@ -593,8 +594,10 @@ Article Treatment * Article Fontisizing:: Making emphasized text look nice. * Article Hiding:: You also want to make certain info go away. * Article Washing:: Lots of way-neat functions to make life better. +* Article Header:: Doing various header transformations. * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Date:: Grumble, UT! +* Article Display:: Display various stuff---X-Face, Picons, Smileys * Article Signature:: What is a signature? * Article Miscellania:: Various other stuff. @@ -607,7 +610,7 @@ Various Summary Stuff * Summary Group Information:: Information oriented commands. * Searching for Articles:: Multiple article commands. -* Summary Generation Commands:: +* Summary Generation Commands:: * Really Various Summary Commands:: Those pesky non-conformant commands. Article Buffer @@ -627,7 +630,7 @@ Composing Messages * Posting Styles:: An easier way to specify who you are. * Drafts:: Postponing messages and rejected messages. * Rejected Articles:: What happens if the server doesn't like your article? -* Using GPG:: How to use GPG and MML to sign and encrypt messages +* Signing and encrypting:: How to compose secure messages. Select Methods @@ -676,7 +679,6 @@ Getting Mail * Duplicates:: Dealing with duplicated mail. * Not Reading Mail:: Using mail back ends for reading other files. * Choosing a Mail Back End:: Gnus can read a variety of mail formats. -* Archiving Mail:: How to backup your mail. Mail Sources @@ -695,6 +697,7 @@ Choosing a Mail Back End Browsing the Web +* Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. * Slashdot:: Reading the Slashdot comments. * Ultimate:: The Ultimate Bulletin Board systems. @@ -752,9 +755,9 @@ Agent Categories Agent Commands -* Group Agent Commands:: -* Summary Agent Commands:: -* Server Agent Commands:: +* Group Agent Commands:: +* Summary Agent Commands:: +* Server Agent Commands:: Scoring @@ -804,8 +807,9 @@ Various * Daemons:: Gnus can do things behind your back. * NoCeM:: How to avoid spam and other fatty foods. * Undo:: Some actions can be undone. +* Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. -* Image Enhancements:: There are more pictures and stuff under XEmacs. +* Image Enhancements:: Modern versions of Emacs/XEmacs can display images. * Fuzzy Matching:: What's the big fuzz? * Thwarting Email Spam:: A how-to on avoiding unsolicited commercial email. * Various Various:: Things that are really various. @@ -821,10 +825,11 @@ Formatting Variables * Tabulation:: Tabulating your output. * Wide Characters:: Dealing with wide characters. -XEmacs Enhancements +Image Enhancements -* Picons:: How to display pictures of what your reading. +* Picons:: How to display pictures of what you're reading. * Smileys:: Show all those happy faces the way they were meant to be shown. +* X-Face:: Display a funky, teensy black-and-white image. * Toolbar:: Click'n'drool. * XVarious:: Other XEmacsy Gnusey variables. @@ -838,6 +843,7 @@ Picons Appendices +* XEmacs:: Requirements for installing under XEmacs. * History:: How Gnus got where it is today. * On Writing Manuals:: Why this is not a beginner's guide. * Terminology:: We use really difficult, like, words here. @@ -845,6 +851,7 @@ Appendices * Troubleshooting:: What you might try if things do not work. * Gnus Reference Guide:: Rilly, rilly technical stuff. * Emacs for Heathens:: A short introduction to Emacsian terms. +* Frequently Asked Questions:: History @@ -887,8 +894,8 @@ Gnus Reference Guide Back End Interface -* Required Back End Functions:: Functions that must be implemented. -* Optional Back End Functions:: Functions that need not be implemented. +* Required Back End Functions:: Functions that must be implemented. +* Optional Back End Functions:: Functions that need not be implemented. * Error Messaging:: How to get messages and report errors. * Writing New Back Ends:: Extending old back ends. * Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end. @@ -1350,9 +1357,18 @@ and read ranges have become worthless. You can use the @kbd{M-x gnus-group-clear-data-on-native-groups} command to clear out all data that you have on your native groups. Use with caution. +@kindex M-x gnus-group-clear-data +@findex gnus-group-clear-data +Clear the data from the current group only---nix out marks and the +list of read articles (@code{gnus-group-clear-data}). + After changing servers, you @strong{must} move the cache hierarchy away, since the cached articles will have wrong article numbers, which will affect which articles Gnus thinks are read. +@code{gnus-group-clear-data-on-native-groups} will ask you if you want +to have it done automatically; for @code{gnus-group-clear-data}, you +can use @kbd{M-x gnus-cache-move-cache} (but beware, it will move the +cache for all groups). @node Startup Files @@ -2082,6 +2098,11 @@ Place point on the subject line of the first article. @item unseen Place point on the subject line of the first unseen article. +@item unseen-or-unread +Place point on the subject line of the first unseen article, and if +there is no such article, place point on the subject line of the first +unread article. + @item best Place point on the subject line of the highest-scored unread article. @@ -2657,6 +2678,17 @@ entering summary buffer. See also @code{gnus-parameter-to-list-alist}. +@item subscribed +@cindex subscribed +If this parameter is set to @code{t}, Gnus will consider the +to-address and to-list parameters for this group as addresses of +mailing lists you are subscribed to. Giving Gnus this information +will help it to generate correct Mail-Followup-To headers for your +posts to these lists. + +See also @code{gnus-find-subscribed-addresses}, the function that +directly uses this group parameter. + @item visible @cindex visible If the group parameter list has the element @code{(visible . t)}, @@ -3595,6 +3627,16 @@ Delete an empty topic (@code{gnus-topic-delete}). List all groups that Gnus knows about in a topics-ified way (@code{gnus-topic-list-active}). +@item T M-n +@kindex T M-n (Topic) +@findex gnus-topic-goto-next-topic +Go to the next topic (@code{gnus-topic-goto-next-topic}). + +@item T M-p +@kindex T M-p (Topic) +@findex gnus-topic-goto-previous-topic +Go to the next topic (@code{gnus-topic-goto-previous-topic}). + @item G p @kindex G p (Topic) @findex gnus-topic-edit-parameters @@ -4074,6 +4116,20 @@ something like: "%M\%S\%p\%P\%5y: %(%-40,40g%) %6,6~(cut 2)d\n") @end lisp +If you would like greater control of the time format, you can use a +user-defined format spec. Something like the following should do the +trick: + +@lisp +(setq gnus-group-line-format + "%M\%S\%p\%P\%5y: %(%-40,40g%) %ud\n") +(defun gnus-user-format-function-d (headers) + (let ((time (gnus-group-timestamp gnus-tmp-group))) + (if time + (format-time-string "%b %d %H:%M" time) + ""))) +@end lisp + @node File Commands @subsection File Commands @@ -4185,7 +4241,7 @@ You can have as many summary buffers open as you wish. * Choosing Articles:: Reading articles. * Paging the Article:: Scrolling the current article. * Reply Followup and Post:: Posting articles. -* Delayed Articles:: +* Delayed Articles:: * Marking Articles:: Marking articles as read, expirable, etc. * Limiting:: You can limit the summary buffer. * Threading:: How threads are made. @@ -4466,6 +4522,9 @@ In summary, you'd typically put something like the following in "Your Name Here") @end lisp +(The values listed above are the default values in Gnus. Alter them +to fit your needs.) + Now, this is mostly useful for mail groups, where you have control over the @sc{nov} files that are created. However, if you can persuade your nntp admin to add: @@ -4896,7 +4955,7 @@ Select the article buffer (@code{gnus-summary-select-article-buffer}). * Summary Mail Commands:: Sending mail. * Summary Post Commands:: Sending news. * Summary Message Commands:: Other Message-related commands. -* Canceling and Superseding:: +* Canceling and Superseding:: @end menu @@ -4937,8 +4996,8 @@ Mail a wide reply to the author of the current article goes out to all people listed in the @code{To}, @code{From} (or @code{Reply-to}) and @code{Cc} headers. -@item S W -@kindex S W (Summary) +@item S V +@kindex S V (Summary) @findex gnus-summary-wide-reply-with-original Mail a wide reply to the current article and include the original message (@code{gnus-summary-wide-reply-with-original}). This command uses @@ -6526,6 +6585,7 @@ Matching}). @findex gnus-thread-sort-by-author @findex gnus-thread-sort-by-number @vindex gnus-thread-sort-functions +@findex gnus-thread-sort-by-most-recent-thread If you are using a threaded summary display, you can sort the threads by setting @code{gnus-thread-sort-functions}, which can be either a single function, a list of functions, or a list containing functions and @@ -6534,7 +6594,9 @@ function, a list of functions, or a list containing functions and By default, sorting is done on article numbers. Ready-made sorting predicate functions include @code{gnus-thread-sort-by-number}, @code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, -@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and +@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, +@code{gnus-thread-sort-by-most-recent-number}, +@code{gnus-thread-sort-by-most-recent-date} and @code{gnus-thread-sort-by-total-score}. Each function takes two threads and returns non-@code{nil} if the first @@ -6773,6 +6835,10 @@ gnus-cache-generate-nov-databases} will (re)build all the @sc{nov} files, and @kbd{gnus-cache-generate-active} will (re)generate the active file. +@findex gnus-cache-move-cache +@code{gnus-cache-move-cache} will move your whole +@code{gnus-cache-directory} to some other location. You get asked to +where, isn't that cool? @node Persistent Articles @section Persistent Articles @@ -7548,15 +7614,16 @@ writing, so there are tons of functions and variables to make reading these articles easier. @menu -* Article Highlighting:: You want to make the article look like fruit salad. -* Article Fontisizing:: Making emphasized text look nice. -* Article Hiding:: You also want to make certain info go away. -* Article Washing:: Lots of way-neat functions to make life better. -* Article Buttons:: Click on URLs, Message-IDs, addresses and the like. -* Article Date:: Grumble, UT! -* Article Display:: Display various stuff---X-Face, Picons, Smileys -* Article Signature:: What is a signature? -* Article Miscellania:: Various other stuff. +* Article Highlighting:: You want to make the article look like fruit salad. +* Article Fontisizing:: Making emphasized text look nice. +* Article Hiding:: You also want to make certain info go away. +* Article Washing:: Lots of way-neat functions to make life better. +* Article Header:: Doing various header transformations. +* Article Buttons:: Click on URLs, Message-IDs, addresses and the like. +* Article Date:: Grumble, UT! +* Article Display:: Display various stuff---X-Face, Picons, Smileys +* Article Signature:: What is a signature? +* Article Miscellania:: Various other stuff. @end menu @@ -8077,18 +8144,7 @@ message.@footnote{PGP keys for many hierarchies are available at @kindex W s (Summary) @findex gnus-summary-force-verify-and-decrypt Verify a signed (PGP, PGP/MIME or S/MIME) message -(@code{gnus-summary-force-verify-and-decrypt}). - -@item W u -@kindex W u (Summary) -@findex gnus-article-treat-unfold-headers -Unfold folded header lines (@code{gnus-article-treat-unfold-headers}). - -@item W n -@kindex W n (Summary) -@findex gnus-article-treat-fold-newsgroups -Fold the @code{Newsgroups} and @code{Followup-To} headers -(@code{gnus-article-treat-fold-newsgroups}). +(@code{gnus-summary-force-verify-and-decrypt}). @xref{Security}. @item W W H @kindex W W H (Summary) @@ -8144,6 +8200,33 @@ body (@code{gnus-article-strip-trailing-space}). @xref{Customizing Articles}, for how to wash articles automatically. +@node Article Header +@subsection Article Header + +These commands perform various transformations of article header. + +@table @kbd + +@item W G u +@kindex W G u (Summary) +@findex gnus-article-treat-unfold-headers +Unfold folded header lines (@code{gnus-article-treat-unfold-headers}). + +@item W G n +@kindex W G n (Summary) +@findex gnus-article-treat-fold-newsgroups +Fold the @code{Newsgroups} and @code{Followup-To} headers +(@code{gnus-article-treat-fold-newsgroups}). + +@item W G f +@kindex W G f (Summary) +@findex gnus-article-treat-fold-header +Fold all the message headers +(@code{gnus-article-treat-fold-headers}). + +@end table + + @node Article Buttons @subsection Article Buttons @cindex buttons @@ -8348,9 +8431,8 @@ Display an @code{X-Face} in the @code{From} header. @item W D s @kindex W D s (Summary) -@findex gnus-article-toggle-smiley -Toggle whether to display smileys -(@code{gnus-article-toggle-smiley}). +@findex gnus-smiley-smiley +Display smileys (@code{gnus-treat-smiley}). @item W D f @kindex W D f (Summary) @@ -8369,6 +8451,12 @@ Piconify all mail headers (i. e., @code{Cc}, @code{To}) Piconify all news headers (i. e., @code{Newsgroups} and @code{Followup-To}) (@code{gnus-treat-from-picon}). +@item W D D +@kindex W D D (Summary) +@findex gnus-article-remove-images +Remove all images from the article buffer +(@code{gnus-article-remove-images}). + @end table @@ -9309,7 +9397,7 @@ suggestions you find reasonable. (Note that @menu * Summary Group Information:: Information oriented commands. * Searching for Articles:: Multiple article commands. -* Summary Generation Commands:: +* Summary Generation Commands:: * Really Various Summary Commands:: Those pesky non-conformant commands. @end menu @@ -9791,23 +9879,22 @@ to you to figure out, I think. @section Security Gnus is able to verify signed messages or decrypt encrypted messages. -The formats that are supported are PGP (plain text, RFC 1991 format), -PGP/MIME (RFC 2015/3156) and S/MIME, however you need some external -programs to get things to work: +The formats that are supported are PGP, PGP/MIME and S/MIME, however +you need some external programs to get things to work: @enumerate @item -To verify or decrypt PGP messages, you have to install mailcrypt or -gpg.el as well as a OpenPGP implementation (such as GnuPG). @xref{Using GPG}. +To handle PGP messages, you have to install mailcrypt or gpg.el as +well as a OpenPGP implementation (such as GnuPG). @item -To verify or decrypt S/MIME message, you need to install OpenSSL. -OpenSSL 0.9.6 or newer is recommended. +To handle S/MIME message, you need to install OpenSSL. OpenSSL 0.9.6 +or newer is recommended. @end enumerate More information on how to set things up can be found in the message -manual. @xref{Security, ,Security, message, The Message Manual}. +manual (@pxref{Security, ,Security, message, Message Manual}). @table @code @item mm-verify-option @@ -9819,7 +9906,7 @@ protocols. Otherwise, ask user. @item mm-decrypt-option @vindex mm-decrypt-option Option of decrypting encrypted parts. @code{never}, no decryption; -@code{always}, always decrypt @code{known}, only decrypt known +@code{always}, always decrypt; @code{known}, only decrypt known protocols. Otherwise, ask user. @end table @@ -10217,7 +10304,21 @@ possible but those listed are probably sufficient for most people. @table @code @item gnus-treat-buttonize (t, integer) @item gnus-treat-buttonize-head (head) + +@xref{Article Buttons}. + @item gnus-treat-capitalize-sentences (t, integer) +@item gnus-treat-overstrike (t, integer) +@item gnus-treat-strip-cr (t, integer) +@item gnus-treat-strip-headers-in-body (t, integer) +@item gnus-treat-strip-leading-blank-lines (t, integer) +@item gnus-treat-strip-multiple-blank-lines (t, integer) +@item gnus-treat-strip-pem (t, last, integer) +@item gnus-treat-strip-pgp (t, last, integer) +@item gnus-treat-strip-trailing-blank-lines (t, last, integer) + +@xref{Article Washing}. + @item gnus-treat-date-english (head) @item gnus-treat-date-iso8601 (head) @item gnus-treat-date-lapsed (head) @@ -10225,9 +10326,29 @@ possible but those listed are probably sufficient for most people. @item gnus-treat-date-original (head) @item gnus-treat-date-user-defined (head) @item gnus-treat-date-ut (head) -@item gnus-treat-display-picons (head) + +@xref{Article Date}. + +@item gnus-treat-from-picon (head) +@item gnus-treat-mail-picon (head) +@item gnus-treat-newsgroups-picon (head) + +@xref{Picons}. + @item gnus-treat-display-smileys (t, integer) + +@item gnus-treat-body-boundary (head) + +@vindex gnus-body-boundary-delimiter +Adds a delimiter between header and body, the string used as delimiter +is controlled by @code{gnus-body-boundary-delimiter}. + +@xref{Smileys}. + @item gnus-treat-display-xface (head) + +@xref{X-Face}. + @item gnus-treat-emphasize (t, head, integer) @item gnus-treat-fill-article (t, integer) @item gnus-treat-fill-long-lines (t, integer) @@ -10236,26 +10357,25 @@ possible but those listed are probably sufficient for most people. @item gnus-treat-hide-citation-maybe (t, integer) @item gnus-treat-hide-headers (head) @item gnus-treat-hide-signature (t, last) + +@xref{Article Hiding}. + @item gnus-treat-highlight-citation (t, integer) @item gnus-treat-highlight-headers (head) @item gnus-treat-highlight-signature (t, last, integer) -@item gnus-treat-overstrike (t, integer) + +@xref{Article Highlighting}. + @item gnus-treat-play-sounds -@item gnus-treat-strip-cr (t, integer) -@item gnus-treat-strip-headers-in-body (t, integer) -@item gnus-treat-strip-leading-blank-lines (t, integer) -@item gnus-treat-strip-multiple-blank-lines (t, integer) -@item gnus-treat-strip-pem (t, last, integer) -@item gnus-treat-strip-pgp (t, last, integer) -@item gnus-treat-strip-trailing-blank-lines (t, last, integer) @item gnus-treat-translate @item gnus-treat-x-pgp-sig (head) -@item gnus-treat-from-picon (head) -@item gnus-treat-mail-picon (head) -@item gnus-treat-newsgroups-picon (head) + @item gnus-treat-unfold-headers (head) +@item gnus-treat-fold-headers (head) @item gnus-treat-fold-newsgroups (head) -@item gnus-treat-body-boundary (head) + + + @end table @vindex gnus-part-display-hook @@ -10325,6 +10445,23 @@ only makes sense if you have buttonizing turned on. @findex gnus-article-prev-button Go to the previous button, if any (@code{gnus-article-prev-button}). +@item R +@kindex R (Article) +@findex gnus-article-reply-with-original +Send a reply to the current article and yank the current article +(@code{gnus-article-reply-with-original}). If given a prefix, make a +wide reply. If the region is active, only yank the text in the +region. + +@item F +@kindex F (Article) +@findex gnus-article-followup-with-original +Send a followup to the current article and yank the current article +(@code{gnus-article-followup-with-original}). If given a prefix, make +a wide reply. If the region is active, only yank the text in the +region. + + @end table @@ -10429,11 +10566,13 @@ This is the delimiter mentioned above. By default, it is @samp{^L} @cindex followup @cindex post @cindex using gpg +@cindex using s/mime +@cindex using smime @kindex C-c C-c (Post) All commands for posting and mailing will put you in a message buffer where you can edit the article all you like, before you send the -article by pressing @kbd{C-c C-c}. @xref{Top, , Top, message, The +article by pressing @kbd{C-c C-c}. @xref{Top, , Overview, message, Message Manual}. Where the message will be posted/mailed to depends on your setup (@pxref{Posting Server}). @@ -10445,7 +10584,7 @@ on your setup (@pxref{Posting Server}). * Posting Styles:: An easier way to specify who you are. * Drafts:: Postponing messages and rejected messages. * Rejected Articles:: What happens if the server doesn't like your article? -* Using GPG:: How to use GPG and MML to sign and encrypt messages +* Signing and encrypting:: How to compose secure messages. @end menu Also see @pxref{Canceling and Superseding} for information on how to @@ -10701,8 +10840,8 @@ of names). This variable can be used instead of @code{gnus-message-archive-group}, but the latter is the preferred method. -@item gnus-inews-mark-gcc-as-read -@vindex gnus-inews-mark-gcc-as-read +@item gnus-gcc-mark-as-read +@vindex gnus-gcc-mark-as-read If non-@code{nil}, automatically mark @code{Gcc} articles as read. @end table @@ -10906,36 +11045,66 @@ The rejected articles will automatically be put in a special draft group (@pxref{Drafts}). When the server comes back up again, you'd then typically enter that group and send all the articles off. -@node Using GPG -@section Using GPG +@node Signing and encrypting +@section Signing and encrypting @cindex using gpg +@cindex using s/mime +@cindex using smime -Gnus has an ALPHA support to GPG that's provided by @file{gpg.el}. See -@code{mm-verify-option} and @code{mm-decrypt-option} to enable Gnus to -verify or decrypt messages accordingly. +Gnus can digitally sign and encrypt your messages, using vanilla PGP +format or PGP/MIME or S/MIME. For decoding such messages, see the +@code{mm-verify-option} and @code{mm-decrypt-option} options +(@pxref{Security}). -To use this correctly with GPG, you'll need the following lisp code in your -@file{~/.emacs} or @file{~/.gnus}: +For PGP, Gnus supports two external libraries, @sc{gpg.el} and +@sc{Mailcrypt}, you need to install at least one of them. The S/MIME +support in Gnus requires the external program OpenSSL. -@lisp -(require 'gpg) -(setq mml2015-use 'gpg) -(setq mml1991-use 'gpg) -(setq gpg-temp-directory (expand-file-name "~/.gnupg/tmp")) -@end lisp +Instructing MML to perform security operations on a MIME part is done +using the @code{C-c C-m s} key map for signing and the @code{C-c C-m +c} key map for encryption, as follows. + +@table @kbd + +@item C-c C-m s s +@kindex C-c C-m s s +@findex mml-secure-sign-smime + +Digitally sign current MIME part using S/MIME. + +@item C-c C-m s o +@kindex C-c C-m s o +@findex mml-secure-sign-pgp + +Digitally sign current MIME part using PGP. -The @code{gpg-temp-directory} need to point to a directory with permissions set -to 700, for your own safety. +@item C-c C-m s p +@kindex C-c C-m s p +@findex mml-secure-sign-pgp -To sign or encrypt your message you may choose to use the MML Security -menu or @kbd{C-c C-m s p} to sign your message using PGP/MIME, -@kbd{C-c C-m s s} to sign your message using S/MIME. There's also -@kbd{C-c C-m c p} to encrypt your message with PGP/MIME and @kbd{C-c -C-m c s} to encrypt using S/MIME. @xref{Security, ,Security, message, -The Message Manual}. +Digitally sign current MIME part using PGP/MIME. -Gnus will ask for your passphrase and then it will send your message, if -you've typed it correctly. +@item C-c C-m c s +@kindex C-c C-m c s +@findex mml-secure-encrypt-smime + +Digitally encrypt current MIME part using S/MIME. + +@item C-c C-m c o +@kindex C-c C-m c o +@findex mml-secure-encrypt-pgp + +Digitally encrypt current MIME part using PGP. + +@item C-c C-m c p +@kindex C-c C-m c p +@findex mml-secure-encrypt-pgpmime + +Digitally encrypt current MIME part using PGP/MIME. + +@end table + +Also @xref{Security, ,Security, message, Message Manual}. @node Select Methods @chapter Select Methods @@ -11890,7 +12059,6 @@ course. * Duplicates:: Dealing with duplicated mail. * Not Reading Mail:: Using mail back ends for reading other files. * Choosing a Mail Back End:: Gnus can read a variety of mail formats. -* Archiving Mail:: How to backup your mail. @end menu @@ -13409,10 +13577,13 @@ Gnus will read the mail spool when you activate a mail group. The mail file is first copied to your home directory. What happens after that depends on what format you want to store your mail in. -There are five different mail back ends in the standard Gnus, and more +There are six different mail back ends in the standard Gnus, and more back ends are available separately. The mail back end most people use -(because it is the fastest and most flexible) is @code{nnml} -(@pxref{Mail Spool}). +(because it is possibly the fastest) is @code{nnml} (@pxref{Mail +Spool}). You might notice that only five back ends are listed below; +@code{nnmaildir}'s documentation has not yet been completely +incorporated into this manual. Until it is, you can find it at +@uref{http://multivac.cwru.edu./nnmaildir/}. @menu * Unix Mail Box:: Using the (quite) standard Un*x mbox. @@ -13527,6 +13698,10 @@ Individual @code{nnml} groups are also possible to backup, use @kbd{G m} to restore the group (after restoring the backup into the nnml directory). +If for some reason you believe your @file{.marks} files are screwed +up, you can just delete them all. Gnus will then correctly regenerate +them next time it starts. + Virtual server settings: @table @code @@ -13844,6 +14019,62 @@ messages, @code{nnfolder} is not the best choice, but if you receive only a moderate amount of mail, @code{nnfolder} is probably the most friendly mail back end all over. +@item nnmaildir + +@code{nnmaildir} is largely similar to @code{nnml}, with some notable +differences. Each message is stored in a separate file, but the +filename is unrelated to the article number in Gnus. @code{nnmaildir} +also stores the equivalent of @code{nnml}'s overview files in one file +per article, so it uses about twice as many inodes as @code{nnml}. (Use +@code{df -i} to see how plentiful your inode supply is.) If this slows +you down or takes up very much space, consider switching to ReiserFS +(@uref{http://www.namesys.com/}) or another non-block-structured +filesystem. + +Since maildirs don't require locking for delivery, the maildirs you use +as groups can also be the maildirs your mail is directly delivered to. +This means you can skip Gnus's mail splitting if your mail is already +organized into different mailboxes during delivery. A @code{directory} +entry in @code{mail-sources} would have a similar effect, but would +require one set of mailboxes for spooling deliveries (in mbox format, +thus damaging message bodies), and another set to be used as groups (in +whatever format you like). A maildir has a built-in spool, in the +@code{new/} subdirectory. Beware that currently, mail moved from +@code{new/} to @code{cur/} instead of via mail splitting will undergo +treatment such as duplicate checking. + +An article will not necessarily keep the same number across Gnus +sessions; articles are renumbered starting from 1 for each Gnus session +(more precisely, each time you open the @code{nnmaildir} server). This +way, you don't get gaps in your article number ranges, and when entering +large groups, Gnus is likely to give a more accurate article count. The +price is that @code{nnmaildir} doesn't work with the cache or agent. +This will probably be changed in the future. + +@code{nnmaildir} stores article marks for a given group in the +corresponding maildir, in a way designed so that it's easy to manipulate +them from outside Gnus. You can tar up a maildir, unpack it somewhere +else, and still have your marks. @code{nnml} also stores marks, but +it's not as easy to work with them from outside Gnus as with +@code{nnmaildir}. + +For configuring expiry and other things, @code{nnmaildir} uses group +parameters slightly different from those of other mail backends. + +@code{nnmaildir} uses a significant amount of memory to speed things up. +(It keeps in memory some of the things that @code{nnml} stores in files +and that @code{nnmh} repeatedly parses out of message files.) If this +is a problem for you, you can set the @code{nov-cache-size} group +parameter to somthing small (0 would probably not work, but 1 probably +would) to make it use less memory. + +Startup and shutdown are likely to be slower with @code{nnmaildir} than +with other backends. Everything in between is likely to be faster, +depending in part on your filesystem. + +@code{nnmaildir} does not use @code{nnoo}, so you cannot use @code{nnoo} +to write an @code{nnmaildir}-derived backend. + @end table @@ -13875,6 +14106,7 @@ Gnus has been getting a bit of a collection of back ends for providing interfaces to these sources. @menu +* Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. * Slashdot:: Reading the Slashdot comments. * Ultimate:: The Ultimate Bulletin Board systems. @@ -14259,6 +14491,7 @@ Put that in your @file{.emacs} file, and hitting links in w3-rendered @sc{html} in the Gnus article buffers will use @code{browse-url} to follow the link. + @node IMAP @section @sc{imap} @cindex nnimap @@ -14270,23 +14503,24 @@ server is much similar to connecting to a news server, you just specify the network address of the server. @sc{imap} has two properties. First, @sc{imap} can do everything that -POP can, it can hence be viewed as POP++. Secondly, @sc{imap} is a +POP can, it can hence be viewed as a POP++. Secondly, @sc{imap} is a mail storage protocol, similar to @sc{nntp} being a news storage -protocol. (@sc{imap} offers more features than @sc{nntp} because news -is more or less read-only whereas mail is read-write.) +protocol -- however, @sc{imap} offers more features than @sc{nntp} +because news is more or less read-only whereas mail is read-write. -If you want to use @sc{imap} as POP++, use an imap entry in -mail-sources. With this, Gnus will fetch mails from the @sc{imap} -server and store them on the local disk. This is not the usage -described in this section. @xref{Mail Sources}. +If you want to use @sc{imap} as a POP++, use an imap entry in +@code{mail-sources}. With this, Gnus will fetch mails from the +@sc{imap} server and store them on the local disk. This is not the +usage described in this section--@xref{Mail Sources}. If you want to use @sc{imap} as a mail storage protocol, use an nnimap -entry in gnus-secondary-select-methods. With this, Gnus will +entry in @code{gnus-secondary-select-methods}. With this, Gnus will manipulate mails stored on the @sc{imap} server. This is the kind of usage explained in this section. A server configuration in @code{~/.gnus} with a few @sc{imap} servers -might look something like this: +might look something like the following. (Note that for SSL/TLS, you +need external programs and libraries, see below.) @lisp (setq gnus-secondary-select-methods @@ -14312,9 +14546,6 @@ might look something like this: (nnimap-stream ssl)))) @end lisp -(Note that for SSL/TLS to work, you need the external library -@samp{ssl.el}, see below.) - The following variables can be used to create a virtual @code{nnimap} server: @@ -14376,10 +14607,10 @@ Please note that the value of @code{nnimap-stream} is a symbol! @itemize @bullet @item -@dfn{gssapi:} Connect with GSSAPI (usually kerberos 5). Requires the +@dfn{gssapi:} Connect with GSSAPI (usually Kerberos 5). Requires the @samp{imtest} program. @item -@dfn{kerberos4:} Connect with kerberos 4. Requires the @samp{imtest} program. +@dfn{kerberos4:} Connect with Kerberos 4. Requires the @samp{imtest} program. @item @dfn{starttls:} Connect via the STARTTLS extension (similar to SSL). Requires the external library @samp{starttls.el} and program @@ -14437,13 +14668,13 @@ Please note that the value of @code{nnimap-authenticator} is a symbol! @itemize @bullet @item -@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Require +@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Requires external program @code{imtest}. @item -@dfn{kerberos4:} Kerberos authentication. Require external program +@dfn{kerberos4:} Kerberos 4 authentication. Requires external program @code{imtest}. @item -@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Require +@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Requires external library @code{digest-md5.el}. @item @dfn{cram-md5:} Encrypted username/password via CRAM-MD5. @@ -15462,9 +15693,12 @@ regexp to match component groups. All marks in the virtual group will stick to the articles in the component groups. So if you tick an article in a virtual group, the -article will also be ticked in the component group from whence it came. -(And vice versa---marks from the component groups will also be shown in -the virtual group.) +article will also be ticked in the component group from whence it +came. (And vice versa---marks from the component groups will also be +shown in the virtual group.). To create an empty virtual group, run +@kbd{G V} (@code{gnus-group-make-empty-virtual}) in the group buffer +and edit the method regexp with @kbd{M-e} +(@code{gnus-group-edit-group-method}) Here's an example @code{nnvirtual} method that collects all Andrea Dworkin newsgroups into one, big, happy newsgroup: @@ -15522,6 +15756,9 @@ not-news back end. (Just to be on the safe side.) @kbd{C-c C-n} in the message buffer will insert the @code{Newsgroups} line from the article you respond to in these cases. +@code{nnvirtual} groups do not inherit anything but articles and marks +from component groups---group parameters, for instance, are not +inherited. @node Kibozed Groups @@ -16109,17 +16346,17 @@ toggles the plugged/unplugged state of the Gnus Agent. @menu -* Group Agent Commands:: -* Summary Agent Commands:: -* Server Agent Commands:: +* Group Agent Commands:: +* Summary Agent Commands:: +* Server Agent Commands:: @end menu -You can run a complete batch fetch from the command line with the +You can run a complete batch command from the command line with the following incantation: -@cindex gnus-agent-batch-fetch +@cindex gnus-agent-batch @example -$ emacs -batch -l ~/.gnus.el -f gnus-agent-batch-fetch +$ emacs -batch -l ~/.gnus.el -f gnus-agent-batch @end example @@ -16244,6 +16481,20 @@ whenever you feel that you're running out of space. It's not particularly fast or efficient, and it's not a particularly good idea to interrupt it (with @kbd{C-g} or anything else) once you've started it. +@code{gnus-agent-expire-days} can also be a list of regexp/day pairs. +The regexps will be matched against group names to allow differing +expiry in different groups. + +@lisp +(setq gnus-agent-expire-days + '(("alt\\." 7) + (".*binary" 1) + ("." 21))) +@end lisp + +If you use the list form, the last element must always be the default +method---it must always match all groups. + @vindex gnus-agent-expire-all if @code{gnus-agent-expire-all} is non-@code{nil}, this command will expire all articles---unread, read, ticked and dormant. If @code{nil} @@ -16343,6 +16594,24 @@ Hook run when connecting to the network. @vindex gnus-agent-unplugged-hook Hook run when disconnecting from the network. +@item gnus-agent-fetched-hook +@vindex gnus-agent-fetched-hook +Hook run when after finishing fetching articles. + +@item gnus-agent-cache +@vindex gnus-agent-cache +Variable to control whether use the locally stored NOV and articles when +plugged. + +@item gnus-agent-go-online +@vindex gnus-agent-go-online +If @code{gnus-agent-go-online} is @code{nil}, the Agent will never +automatically switch offline servers into online status. If it is +@code{ask}, the default, the Agent will ask if you wish to switch +offline servers into online status when you re-connect. If it has any +other value, all offline servers will be automatically switched into +online status. + @end table @@ -16412,20 +16681,19 @@ newsreaders. Here are some common questions that some imaginary people may ask: @table @dfn -@item If I read an article while plugged, do they get entered into the -Agent? +@item If I read an article while plugged, do they get entered into the Agent? -@strong{No.} +@strong{No}. -@item If I read an article while plugged, and the article already exists -in the Agent, will it get downloaded once more? +@item If I read an article while plugged, and the article already exists in the Agent, will it get downloaded once more? -@strong{Yes.} +@strong{No}, unless @code{gnus-agent-cache} is `nil'. @end table In short, when Gnus is unplugged, it only looks into the locally stored -articles; when it's plugged, it only talks to your ISP. +articles; when it's plugged, it only talks to your ISP and also uses the +locally stored articles. @node Scoring @@ -16883,12 +17151,12 @@ are expired. It's 7 by default. @item gnus-update-score-entry-dates @vindex gnus-update-score-entry-dates -If this variable is non-@code{nil}, matching score entries will have -their dates updated. (This is how Gnus controls expiry---all -non-matching entries will become too old while matching entries will -stay fresh and young.) However, if you set this variable to @code{nil}, -even matching entries will grow old and will have to face that oh-so -grim reaper. +If this variable is non-@code{nil}, temporary score entries that have +been triggered (matched) will have their dates updated. (This is how Gnus +controls expiry---all non-matched-entries will become too old while +matched entries will stay fresh and young.) However, if you set this +variable to @code{nil}, even matched entries will grow old and will +have to face that oh-so grim reaper. @item gnus-score-after-write-file-function @vindex gnus-score-after-write-file-function @@ -18275,24 +18543,25 @@ four days, Gnus will decay the scores four times, for instance. @chapter Various @menu -* Process/Prefix:: A convention used by many treatment commands. -* Interactive:: Making Gnus ask you many questions. -* Symbolic Prefixes:: How to supply some Gnus functions with options. -* Formatting Variables:: You can specify what buffers should look like. -* Window Layout:: Configuring the Gnus buffer windows. -* Faces and Fonts:: How to change how faces look. -* Compilation:: How to speed Gnus up. -* Mode Lines:: Displaying information in the mode lines. -* Highlighting and Menus:: Making buffers look all nice and cozy. -* Buttons:: Get tendinitis in ten easy steps! -* Daemons:: Gnus can do things behind your back. -* NoCeM:: How to avoid spam and other fatty foods. -* Undo:: Some actions can be undone. -* Moderation:: What to do if you're a moderator. -* Image Enhancements:: Modern versions of Emacs/XEmacs can display images. -* Fuzzy Matching:: What's the big fuzz? -* Thwarting Email Spam:: A how-to on avoiding unsolicited commercial email. -* Various Various:: Things that are really various. +* Process/Prefix:: A convention used by many treatment commands. +* Interactive:: Making Gnus ask you many questions. +* Symbolic Prefixes:: How to supply some Gnus functions with options. +* Formatting Variables:: You can specify what buffers should look like. +* Window Layout:: Configuring the Gnus buffer windows. +* Faces and Fonts:: How to change how faces look. +* Compilation:: How to speed Gnus up. +* Mode Lines:: Displaying information in the mode lines. +* Highlighting and Menus:: Making buffers look all nice and cozy. +* Buttons:: Get tendinitis in ten easy steps! +* Daemons:: Gnus can do things behind your back. +* NoCeM:: How to avoid spam and other fatty foods. +* Undo:: Some actions can be undone. +* Predicate Specifiers:: Specifying predicates. +* Moderation:: What to do if you're a moderator. +* Image Enhancements:: Modern versions of Emacs/XEmacs can display images. +* Fuzzy Matching:: What's the big fuzz? +* Thwarting Email Spam:: A how-to on avoiding unsolicited commercial email. +* Various Various:: Things that are really various. @end menu @@ -18484,6 +18753,7 @@ less than 4 characters wide. Also Gnus supports some extended format specifications, such as @samp{%&user-date;}. + @node Mode Line Formatting @subsection Mode Line Formatting @@ -18550,6 +18820,13 @@ Return an empty string if the field is equal to the specified value. @item form Use the specified form as the field value when the @samp{@@} spec is used. + +Here's an example: + +@lisp +"~(form (current-time-string))@@" +@end lisp + @end table Let's take an example. The @samp{%o} spec in the summary mode lines @@ -19467,6 +19744,33 @@ command, which should feel kinda like the normal Emacs @code{undo} command. +@node Predicate Specifiers +@section Predicate Specifiers +@cindex predicate specifiers + +Some Gnus variables are @dfn{predicate specifiers}. This is a special +form that allows flexible specification of predicates without having +to type all that much. + +These specifiers are lists consisting of functions, symbols and lists. + +Here's an example: + +@lisp +(or gnus-article-unseen-p + gnus-article-unread-p) +@end lisp + +The available symbols are @code{or}, @code{and} and @code{not}. The +functions all take one parameter. + +@findex gnus-make-predicate +Internally, Gnus calls @code{gnus-make-predicate} on these specifiers +to create a function that can be called. This input parameter to this +function will be passed along to all the functions in the predicate +specifier. + + @node Moderation @section Moderation @cindex moderation @@ -19519,11 +19823,11 @@ XEmacs, as well as Emacs 21, is able to display pictures and stuff, so Gnus has taken advantage of that. @menu -* Picons:: How to display pictures of what you're reading. -* Smileys:: Show all those happy faces the way they were meant to be shown. -* X-Face:: Display a funky, teensy black-and-white image. -* Toolbar:: Click'n'drool. -* XVarious:: Other XEmacsy Gnusey variables. +* Picons:: How to display pictures of what you're reading. +* Smileys:: Show all those happy faces the way they were meant to be shown. +* X-Face:: Display a funky, teensy black-and-white image. +* Toolbar:: Click'n'drool. +* XVarious:: Other XEmacsy Gnusey variables. @end menu @@ -19871,9 +20175,10 @@ Face used for mouse highlighting over the smiley face. @subsection X-Face @cindex x-face -@code{X-Face} headers describe a 48x48 pixel black-and-white image -that's supposed to represent the author of the message. It seems to -be supported by an ever-growing number of mail and news readers. +@code{X-Face} headers describe a 48x48 pixel black-and-white (1 bit +depth) image that's supposed to represent the author of the message. +It seems to be supported by an ever-growing number of mail and news +readers. @cindex x-face @findex gnus-article-display-x-face @@ -19917,6 +20222,39 @@ like @code{netpbm}, @code{libgr-progs} and @code{compface}.}) (NOTE: @code{x-face} is used in the variable/function names, not @code{xface}). +Gnus provides a few convenience functions and variables to allow +easier insertion of X-Face headers in outgoing messages. + +@findex gnus-random-x-face +@code{gnus-random-x-face} goes through all the @samp{pbm} files +in @code{gnus-x-face-directory} and picks one at random, and then +converts it to the X-Face format by using the +@code{gnus-convert-pbm-to-x-face-command} shell command. The +@samp{pbm} files should be 48x48 pixels big. + +@code{gnus-x-face-from-file} takes a file as the parameter, and then +converts the file to X-Face format by using the +@code{gnus-convert-image-to-x-face-command} shell command. + +Here's how you would typically use the former function. Put something +like the folllowing in your @file{.gnus.el} file: + +@lisp +(setq message-required-news-headers + (nconc message-required-news-headers + (list '(X-Face . gnus-random-x-face)))) +@end lisp + +Using the latter function would be something like this: + +@lisp +(setq message-required-news-headers + (nconc message-required-news-headers + (list '(X-Face . (lambda () + (gnus-x-face-from-file + "~/My-face.gif")))))) +@end lisp + @node Toolbar @subsection Toolbar @@ -20303,10 +20641,13 @@ renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs. @node Gnus Versions @subsection Gnus Versions -@cindex Pterodactyl Gnus @cindex ding Gnus @cindex September Gnus +@cindex Red Gnus @cindex Quassia Gnus +@cindex Pterodactyl Gnus +@cindex Oort Gnus +@cindex No Gnus The first ``proper'' release of Gnus 5 was done in November 1995 when it was included in the Emacs 19.30 distribution (132 (ding) Gnus releases @@ -20460,8 +20801,9 @@ with, of course. @table @strong -@item RFC 822 +@item RFC (2)822 @cindex RFC 822 +@cindex RFC 2822 There are no known breaches of this standard. @item RFC 1036 @@ -20490,6 +20832,38 @@ on Son-of-RFC 1036. They have produced a number of drafts proposing various changes to the format of news articles. The Gnus towers will look into implementing the changes when the draft is accepted as an RFC. +@item MIME - RFC 2045-2049 etc +@cindex MIME +All the various MIME RFCs are supported. + +@item Disposition Notifications - RFC 2298 +Message Mode is able to request notifications from the receiver. + +@item PGP - RFC 1991 and RFC 2440 +@cindex RFC 1991 +@cindex RFC 2440 +RFC 1991 is the original PGP message specification, published as a +Information RFC. RFC 2440 was the follow-up, now called Open PGP, and +put on the Standards Track. Both document a non-MIME aware PGP +format. Gnus supports both encoding (signing and encryption) and +decoding (verification and decryption). + +@item PGP/MIME - RFC 2015/3156 +RFC 2015 (superceded by 3156 which references RFC 2440 instead of RFC +1991) describes the MIME-wrapping around the RF 1991/2440 format. +Gnus supports both encoding and decoding. + +@item S/MIME - RFC 2633 +RFC 2633 describes the S/MIME format. + +@item IMAP - RFC 1730/2060, RFC 2195, RFC 2086, RFC 2359, RFC 2595, RFC 1731 +RFC 1730 is IMAP version 4, updated somewhat by RFC 2060 (IMAP 4 +revision 1). RFC 2195 describes CRAM-MD5 authentication for IMAP. RFC +2086 describes access control lists (ACLs) for IMAP. RFC 2359 +describes a IMAP protocol enhancement. RFC 2595 describes the proper +TLS integration (STARTTLS) with IMAP. RFC 1731 describes the +GSSAPI/Kerberos4 mechanisms for IMAP. + @end table If you ever notice Gnus acting non-compliant with regards to the texts @@ -21962,6 +22336,22 @@ want to read them anyway. If this is non-@code{nil}, all threads in the summary buffer will be hidden initially. +This can also be a predicate specifier (@pxref{Predicate Specifiers}). +Avaliable predicates are @code{gnus-article-unread-p} and +@code{gnus-article-unseen-p}). + +Here's an example: + +@lisp +(setq gnus-thread-hide-subtree + '(or gnus-article-unread-p + gnus-article-unseen-p)) +@end lisp + +(It's a pretty nonsensical example, since all unseen articles are also +unread, but you get my drift.) + + @item gnus-updated-mode-lines If this is @code{nil}, Gnus will not put information in the buffer mode lines, which might save some time. @@ -22320,8 +22710,8 @@ In the examples and definitions I will refer to the imaginary back end @cindex @code{nnchoke} @menu -* Required Back End Functions:: Functions that must be implemented. -* Optional Back End Functions:: Functions that need not be implemented. +* Required Back End Functions:: Functions that must be implemented. +* Optional Back End Functions:: Functions that need not be implemented. * Error Messaging:: How to get messages and report errors. * Writing New Back Ends:: Extending old back ends. * Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end. diff --git a/texi/message.texi b/texi/message.texi index f47b81a..0f31710 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -18,7 +18,7 @@ This file documents Message, the Emacs message composition mode. -Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.1 or @@ -112,6 +112,7 @@ sending it. * Forwarding:: Forwarding a message via news or mail. * Resending:: Resending a mail message. * Bouncing:: Bouncing a mail message. +* Mailing Lists:: Send mail to mailing lists. @end menu @@ -316,6 +317,119 @@ will be removed before popping up the buffer. The default is @samp{^\\(Received\\|Return-Path\\):}. +@node Mailing Lists +@section Mailing Lists + +Sometimes while posting to mailing lists, the poster needs to direct +followups to the post to specific places. The Mail-Followup-To (MFT) +was created to enable just this. Two example scenarios where this is +useful: + +@itemize +@item +A mailing list poster can use MFT to express that responses should be +sent to just the list, and not the poster as well. This will happen +if the poster is already subscribed to the list. + +@item +If a message is posted to several mailing lists, MFT may also be used +to direct the following discussion to one list only, because +discussions that are spread over several lists tend to be fragmented +and very difficult to follow. + +@end itemize + +Gnus honors the MFT header in other's messages (i.e. while following +up to someone else's post) and also provides support for generating +sensible MFT headers for outgoing messages as well. + +@c @menu +@c * Honoring an MFT post:: What to do when one already exists +@c * Composing with a MFT header:: Creating one from scratch. +@c @end menu + +@c @node Composing with a MFT header +@subsection Composing a correct MFT header automagically + +The first step in getting Gnus to automagically generate a MFT header +in posts you make is to give Gnus a list of the mailing lists +addresses you are subscribed to. You can do this in more than one +way. The following variables would come in handy. + +@table @code + +@item message-subscribed-addresses +This should be a list of addresses the user is subscribed to. Its +default value is @code{nil}. Example: +@lisp +(setq message-subscribed-addresses + '("ding@@gnus.org" "bing@@noose.org")) +@end lisp + +@item message-subscribed-regexps +This should be a list of regexps denoting the addresses of mailing +lists subscribed to. Default value is @code{nil}. Example: If you +want to achieve the same result as above: +@lisp +(setq message-subscribed-regexps + '("[bd]ing@@\\(gnus\\|noose\\)\\.org")) +@end lisp + +@item message-subscribed-address-functions +This can be a list of functions to be called (one at a time!!) to +determine the value of MFT headers. It is advisable that these +functions not take any arguments. Default value is @code{nil}. + +@item message-subscribed-address-file +You might be one organised human freak and have a list of addresses of +all subscribed mailing lists in a separate file! Then you can just +set this variable to the name of the file and life would be good. + +@end table + +You can use one or more of the above variables. All their values are +``added'' in some way that works :-) + +Now you are all set. Just start composing a message as you normally +do. And just send it; as always. Just before the message is sent +out, Gnus' MFT generation thingy kicks in and checks if the message +already has a MFT header. If there is one, the header is left alone. +If not then the list of recipient addresses (in the To: and Cc: +headers) is checked to see if one of them is a list address you are +subscribed to. If none of them is a list address, then no MFT is +generated; otherwise, a MFT is added to the other headers and set to +the value of all addresses in To: and Cc: + +Hm. ``So'', you ask, ``what if I send an email to a list I am not +subscribed to?'' Well, the kind folks at Gnus Towers are working on a +database of all known mailing list addresses that can be used for this +purpose. Till then, you could, like, insert a MFT header manually, +with the help of @kbd{C-c C-f m} !! + +@c @node Honoring an MFT post +@subsection Honoring an MFT post + +When you followup to a post on a mailing list, and the post has a MFT +header, Gnus' action will depend on the value of the variable +@code{message-use-mail-followup-to}. This variable can be one of: + +@table @code +@item t + Always honor MFTs. The To: and Cc: headers in your followup will be + derived from the MFT header of the original post. + +@item nil + Always dishonor MFTs (just ignore the darned thing) + +@item ask +Gnus will prompt you for an action. This is the default. + +@end table + +It is considered good nettiquette to honor MFT, as it is assumed the +fellow who posted a message knows where the followups need to go +better than you do. + @node Commands @chapter Commands @@ -359,7 +473,7 @@ inserted. @item C-c ? @kindex C-c ? -@findex message-goto-to +@findex describe-mode Describe the message mode. @item C-c C-f C-t @@ -367,6 +481,12 @@ Describe the message mode. @findex message-goto-to Go to the @code{To} header (@code{message-goto-to}). +@item C-c C-f C-o +@kindex C-c C-f C-o +@findex message-goto-from +Go to the @code{From} header (@code{message-goto-from}). (The ``o'' +in the key binding is for Originator.) + @item C-c C-f C-b @kindex C-c C-f C-b @findex message-goto-bcc @@ -503,6 +623,14 @@ Insert a signature at the end of the buffer @findex message-insert-headers Insert the message headers (@code{message-insert-headers}). +@item C-c M-n +@kindex C-c M-n +@findex message-insert-disposition-notification-to +Insert a request for a disposition +notification. (@code{message-insert-disposition-notification-to}). +This means that if the recipient support RFC 2298 she might send you a +notification that she received the message. + @end table @@ -669,6 +797,10 @@ interface to it, such as Mailcrypt (available from @uref{http://www.nb.net/~lbudney/linux/software/mailcrypt.html}) or Florian Weimer's @code{gpg.el}. +@vindex gpg-temp-directory +Note, if you are using the @code{gpg.el} you must make sure that the +path specified by @code{gpg-temp-directory} have permissions 0700. + Creating your own OpenPGP key is described in detail in the documentation of your OpenPGP implementation, so we refer to it. -- 1.7.10.4