From 2cc5659442ce551b395b9aeebe213947e415ac6d Mon Sep 17 00:00:00 2001 From: yamaoka Date: Thu, 21 Dec 2000 11:17:16 +0000 Subject: [PATCH] t-gnus-6_15-quimby: New branch for developing and synchronizing with Oort Gnus. --- ChangeLog | 1106 +--- ChangeLog.3 | 2916 +++++++++ GNUS-NEWS | 28 + Makefile.in | 132 +- Mule23@1934.en | 135 +- Mule23@1934.ja | 138 +- README | 11 +- README-gnus-bbdb.en | 6 +- README-gnus-bbdb.ja | 40 +- README.T-gnus | 12 +- README.branch | 35 +- README.branch.ja | 35 +- README.semi | 58 +- README.semi.ja | 58 +- acinclude.m4 | 103 - aclocal.m4 | 410 +- configure | 665 ++- configure.in | 35 +- contrib/ChangeLog | 48 + contrib/README | 3 + contrib/base64.el | 278 + contrib/gpg-ring.el | 484 ++ contrib/gpg.el | 1311 +++++ contrib/md5.el | 409 ++ contrib/one-line-cookie.diff | 28 + contrib/timer.el | 308 + contrib/vcard.el | 308 + etc/smilies/frown.pbm | Bin 0 -> 37 bytes etc/smilies/smile.pbm | Bin 0 -> 37 bytes etc/smilies/wry.pbm | Bin 0 -> 37 bytes lisp/ChangeLog | 7019 ++++------------------ lisp/ChangeLog.1 |10100 +++++++++++++++++++++++++++++++ lisp/Makefile.in | 49 +- lisp/base64.el | 306 +- lisp/binhex.el | 65 +- lisp/catchup.pbm | Bin 0 -> 81 bytes lisp/catchup.xpm | 73 + lisp/cu-exit.pbm | Bin 0 -> 81 bytes lisp/cu-exit.xpm | 64 + lisp/describe-group.pbm | Bin 0 -> 81 bytes lisp/describe-group.xpm | 72 + lisp/dgnushack.el | 586 +- lisp/dgnuspath.el.in | 7 +- lisp/dig.el | 169 + lisp/earcon.el | 9 +- lisp/exit-gnus.pbm | Bin 0 -> 81 bytes lisp/exit-gnus.xpm | 76 + lisp/exit-summ.pbm | Bin 0 -> 81 bytes lisp/exit-summ.xpm | 45 + lisp/flow-fill.el | 103 + lisp/followup.pbm | Bin 0 -> 81 bytes lisp/followup.xpm | 54 + lisp/format-spec.el | 2 +- lisp/fuwo.pbm | Bin 0 -> 81 bytes lisp/fuwo.xpm | 53 + lisp/get-news.pbm | Bin 0 -> 81 bytes lisp/get-news.xpm | 68 + lisp/gnntg.pbm | Bin 0 -> 81 bytes lisp/gnntg.xpm | 64 + lisp/gnus-agent.el | 351 +- lisp/gnus-art.el | 1541 +++-- lisp/gnus-async.el | 77 +- lisp/gnus-audio.el | 158 +- lisp/gnus-bbdb.el | 250 +- lisp/gnus-bcklg.el | 61 +- lisp/gnus-cache.el | 49 +- lisp/gnus-cite.el | 217 +- lisp/gnus-clfns.el | 77 + lisp/gnus-cus.el | 115 +- lisp/gnus-demon.el | 15 +- lisp/gnus-draft.el | 39 +- lisp/gnus-dup.el | 11 +- lisp/gnus-eform.el | 3 +- lisp/gnus-ems.el | 255 +- lisp/gnus-gl.el | 34 +- lisp/gnus-group.el | 761 ++- lisp/gnus-int.el | 21 +- lisp/gnus-kill.el | 10 +- lisp/gnus-load.el | 2 +- lisp/gnus-logic.el | 6 +- lisp/gnus-mailcap.el | 609 +- lisp/gnus-mh.el | 14 +- lisp/gnus-ml.el | 205 + lisp/gnus-mlspl.el | 88 +- lisp/gnus-move.el | 4 +- lisp/gnus-msg.el | 424 +- lisp/gnus-nocem.el | 54 +- lisp/gnus-offline.el | 478 +- lisp/gnus-ofsetup.el | 397 +- lisp/gnus-picon.el | 9 +- lisp/gnus-range.el | 27 +- lisp/gnus-salt.el | 118 +- lisp/gnus-score.el | 633 +- lisp/gnus-setup.el | 40 +- lisp/gnus-soup.el | 26 +- lisp/gnus-spec.el | 192 +- lisp/gnus-srvr.el | 192 +- lisp/gnus-start.el | 458 +- lisp/gnus-sum.el | 1338 +++-- lisp/gnus-topic.el | 321 +- lisp/gnus-undo.el | 14 +- lisp/gnus-util.el | 143 +- lisp/gnus-uu.el | 216 +- lisp/gnus-vers.el | 85 + lisp/gnus-vm.el | 5 +- lisp/gnus-win.el | 267 +- lisp/gnus-xmas.el | 207 +- lisp/gnus.el | 396 +- lisp/ietf-drums.el | 14 +- lisp/imap.el | 1263 ++-- lisp/kill-group.pbm | Bin 0 -> 81 bytes lisp/kill-group.xpm | 50 + lisp/lpath.el | 182 +- lisp/mail-parse.el | 11 +- lisp/mail-prsvr.el | 6 +- lisp/mail-reply.pbm | Bin 0 -> 81 bytes lisp/mail-reply.xpm | 51 + lisp/mail-source.el | 539 +- lisp/md5.el | 10 +- lisp/message.el | 1532 +++-- lisp/messagexmas.el | 8 +- lisp/messcompat.el | 6 +- lisp/mm-bodies.el | 222 +- lisp/mm-decode.el | 679 ++- lisp/mm-encode.el | 40 +- lisp/mm-extern.el | 169 + lisp/mm-partial.el | 159 + lisp/mm-util.el | 320 +- lisp/mm-uu.el | 505 +- lisp/mm-view.el | 104 +- lisp/mml-sec.el | 112 + lisp/mml-smime.el | 183 + lisp/mml.el | 706 ++- lisp/mml2015.el | 533 ++ lisp/next-ur.pbm | Bin 0 -> 81 bytes lisp/next-ur.xpm | 66 + lisp/nnagent.el | 75 +- lisp/nnbabyl.el | 31 +- lisp/nndb.el | 7 +- lisp/nndir.el | 4 +- lisp/nndoc.el | 39 +- lisp/nndraft.el | 26 +- lisp/nneething.el | 24 +- lisp/nnfolder.el | 399 +- lisp/nngateway.el | 4 +- lisp/nnheader.el | 228 +- lisp/nnheaderxm.el | 8 +- lisp/nnimap.el | 688 ++- lisp/nnkiboze.el | 290 +- lisp/nnlistserv.el | 30 +- lisp/nnmail.el | 258 +- lisp/nnmbox.el | 228 +- lisp/nnmh.el | 72 +- lisp/nnml.el | 76 +- lisp/nnoo.el | 18 +- lisp/nnshimbun.el | 1382 +++++ lisp/nnslashdot.el | 322 +- lisp/nnsoup.el | 48 +- lisp/nnspool.el | 17 +- lisp/nntp.el | 275 +- lisp/nnultimate.el | 104 +- lisp/nnvirtual.el | 161 +- lisp/nnwarchive.el | 775 ++- lisp/nnweb.el | 156 +- lisp/nnwfm.el | 426 ++ lisp/parse-time.el | 14 +- lisp/pop3.el | 224 +- lisp/post.pbm | Bin 0 -> 81 bytes lisp/post.xpm | 53 + lisp/prev-ur.pbm | Bin 0 -> 81 bytes lisp/prev-ur.xpm | 65 + lisp/ptexinfmt.el | 759 +++ lisp/qp.el | 198 +- lisp/read-passwd.el | 23 +- lisp/reply-wo.pbm | Bin 0 -> 81 bytes lisp/reply-wo.xpm | 65 + lisp/reply.pbm | Bin 0 -> 81 bytes lisp/reply.xpm | 64 + lisp/rfc1843.el | 64 +- lisp/rfc2045.el | 6 +- lisp/rfc2047.el | 392 +- lisp/rfc2104.el | 29 +- lisp/rfc2231.el | 27 +- lisp/rot13.pbm | Bin 0 -> 81 bytes lisp/rot13.xpm | 50 + lisp/save-aif.pbm | Bin 0 -> 81 bytes lisp/save-aif.xpm | 55 + lisp/save-art.pbm | Bin 0 -> 81 bytes lisp/save-art.xpm | 62 + lisp/score-mode.el | 1 - lisp/smiley-ems.el | 158 + lisp/smiley.el | 162 +- lisp/smime.el | 454 ++ lisp/starttls.el | 79 + lisp/subscribe.pbm | Bin 0 -> 81 bytes lisp/subscribe.xpm | 49 + lisp/time-date.el | 21 +- lisp/unsubscribe.pbm | Bin 0 -> 81 bytes lisp/unsubscribe.xpm | 48 + lisp/utf7.el | 41 +- lisp/uu-decode.pbm | Bin 0 -> 81 bytes lisp/uu-decode.xpm | 48 + lisp/uu-post.pbm | Bin 0 -> 81 bytes lisp/uu-post.xpm | 57 + lisp/uudecode.el | 125 +- lisp/webmail.el | 773 ++- make.bat | 33 +- mkinstalldirs | 2 - sample.lpath.el | 52 +- texi/ChangeLog | 435 ++ texi/Makefile.in | 116 +- texi/TRANSLATION.ja | 54 +- texi/doclicense.texi | 368 ++ texi/emacs-mime.texi | 145 +- texi/gnus-faq-ja.texi | 53 +- texi/gnus-ja.texi |13402 +++++++++++++++++++++++------------------- texi/gnus.texi | 2162 +++++-- texi/gnusref.tex | 1722 +++--- texi/message-ja.texi | 316 +- texi/message.texi | 270 +- texi/postamble.tex | 13 +- texi/refcard.tex | 217 +- todo | 1467 +++++ 223 files changed, 54027 insertions(+), 23704 deletions(-) create mode 100644 ChangeLog.3 delete mode 100644 acinclude.m4 create mode 100644 contrib/ChangeLog create mode 100644 contrib/README create mode 100644 contrib/base64.el create mode 100644 contrib/gpg-ring.el create mode 100644 contrib/gpg.el create mode 100644 contrib/md5.el create mode 100644 contrib/one-line-cookie.diff create mode 100644 contrib/timer.el create mode 100644 contrib/vcard.el create mode 100644 etc/smilies/frown.pbm create mode 100644 etc/smilies/smile.pbm create mode 100644 etc/smilies/wry.pbm create mode 100644 lisp/ChangeLog.1 create mode 100644 lisp/catchup.pbm create mode 100644 lisp/catchup.xpm create mode 100644 lisp/cu-exit.pbm create mode 100644 lisp/cu-exit.xpm create mode 100644 lisp/describe-group.pbm create mode 100644 lisp/describe-group.xpm create mode 100644 lisp/dig.el create mode 100644 lisp/exit-gnus.pbm create mode 100644 lisp/exit-gnus.xpm create mode 100644 lisp/exit-summ.pbm create mode 100644 lisp/exit-summ.xpm create mode 100644 lisp/flow-fill.el create mode 100644 lisp/followup.pbm create mode 100644 lisp/followup.xpm create mode 100644 lisp/fuwo.pbm create mode 100644 lisp/fuwo.xpm create mode 100644 lisp/get-news.pbm create mode 100644 lisp/get-news.xpm create mode 100644 lisp/gnntg.pbm create mode 100644 lisp/gnntg.xpm create mode 100644 lisp/gnus-clfns.el create mode 100644 lisp/gnus-ml.el create mode 100644 lisp/gnus-vers.el create mode 100644 lisp/kill-group.pbm create mode 100644 lisp/kill-group.xpm create mode 100644 lisp/mail-reply.pbm create mode 100644 lisp/mail-reply.xpm create mode 100644 lisp/mm-extern.el create mode 100644 lisp/mm-partial.el create mode 100644 lisp/mml-sec.el create mode 100644 lisp/mml-smime.el create mode 100644 lisp/mml2015.el create mode 100644 lisp/next-ur.pbm create mode 100644 lisp/next-ur.xpm create mode 100644 lisp/nnshimbun.el create mode 100644 lisp/nnwfm.el create mode 100644 lisp/post.pbm create mode 100644 lisp/post.xpm create mode 100644 lisp/prev-ur.pbm create mode 100644 lisp/prev-ur.xpm create mode 100644 lisp/ptexinfmt.el create mode 100644 lisp/reply-wo.pbm create mode 100644 lisp/reply-wo.xpm create mode 100644 lisp/reply.pbm create mode 100644 lisp/reply.xpm create mode 100644 lisp/rot13.pbm create mode 100644 lisp/rot13.xpm create mode 100644 lisp/save-aif.pbm create mode 100644 lisp/save-aif.xpm create mode 100644 lisp/save-art.pbm create mode 100644 lisp/save-art.xpm create mode 100644 lisp/smiley-ems.el create mode 100644 lisp/smime.el create mode 100644 lisp/starttls.el create mode 100644 lisp/subscribe.pbm create mode 100644 lisp/subscribe.xpm create mode 100644 lisp/unsubscribe.pbm create mode 100644 lisp/unsubscribe.xpm create mode 100644 lisp/uu-decode.pbm create mode 100644 lisp/uu-decode.xpm create mode 100644 lisp/uu-post.pbm create mode 100644 lisp/uu-post.xpm create mode 100644 texi/doclicense.texi create mode 100644 todo diff --git a/ChangeLog b/ChangeLog index ace1615..0755e3f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,1096 +1,28 @@ -1999-12-03 Hirokazu FUKUI - Katsumi Yamaoka +2000-12-21 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 01. + * lisp/lpath.el: Fbind `compose-mail' for Mule. - * lisp/dgnushack.el (char-before): Use compiler macro instead of - byte-optimizer. - (char-after): Comment out the byte-optimization. + * lisp/dgnushack.el (TopLevel): Byte-optimize + `custom-declare-variable', `custom-declare-group, and + `custom-declare-face' to omit unsupported keywords when Mule is + running. - * imap.el (imap-base64-encode-string, imap-base64-decode-string): - New functions. They are identical to the built-in codec if - possible, otherwise the functions defined in mel are used. - (imap-cram-md5-auth): Use them. +2000-12-20 Katsumi Yamaoka -1999-12-02 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.0 revision 00. - * lisp/imap.el: Remove autoload settings for `base64-decode-string' - and `base64-encode-string'. + * lisp/dgnushack.el (TopLevel): Advise `custom-handle-keyword' not + to signal an error when Mule is running. + (TopLevel): Bind `:ascent', `:foreground', `:help', `:version' and + `:set-after' if colon keyword is not available. + (TopLevel): Require `custom'. -1999-12-02 Katsumi Yamaoka + * lisp/lpath.el (TopLevel): Fbind `shell-command-to-string' for + Mule. + (TopLevel): Don't require `custom' here. - * lisp/gnus.el (gnus-version-number): Update to 6.13.4. - (gnus-revision-number): Clear to 00. +2000-12-20 Jesper Harder - * README.T-gnus: Update. + * make.bat: set max-lisp-eval-depth. - * GNUS-NEWS: Sync up with Pterodactyl Gnus v0.99. - - * lisp/{rfc2047.el,rfc1843.el,nnweb.el,nnvirtual.el,nntp.el, - nnmh.el,nnmail.el,nnimap.el,nnheader.el,nnfolder.el,nndraft.el, - nndoc.el,mml.el,mm-view.el,mm-uu.el,mm-util.el,mm-encode.el, - mm-decode.el,mm-bodies.el,message.el,mail-source.el,lpath.el, - gnus-xmas.el,gnus-uu.el,gnus-util.el,gnus-topic.el,gnus-sum.el, - gnus-start.el,gnus-srvr.el,gnus-spec.el,gnus-score.el,gnus-salt.el, - gnus-picon.el,gnus-msg.el,gnus-mailcap.el,gnus-int.el, - gnus-group.el,gnus-ems.el,gnus-cus.el,gnus-cache.el,gnus-async.el, - gnus-art.el,gnus-agent.el,dgnushack.el,base64.el,Makefile.in, - ChangeLog}: Sync up with Pterodactyl Gnus v0.99. - - * lisp/{webmail.el,nnwarchive.el,nnultimate.el,nnslashdot.el}: New - files. - - * texi/{message.texi,message-ja.texi,gnus.texi,gnus-ja.texi, - emacs-mime.texi,Makefile.in,ChangeLog}: Sync up with Pterodactyl - Gnus v0.99. - -1999-12-02 Katsumi Yamaoka - - * lisp/gnus.el (gnus-select-method): Undo (`if' -> `when'). - * lisp/gnus-picon.el (gnus-picons-file-suffixes): Ditto. - * lisp/gnus-start.el (save-buffers-kill-emacs): Ditto. - (gnus-after-getting-new-news-hook): Ditto. - - * lisp/gnus-group.el (gnus-useful-groups): Undo (`or' -> `unless'). - -1999-12-01 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 10. - - * lisp/gnus-art.el (article-treat-overstrike): Work for multibyte - char with old Emacsen as well. - -1999-12-01 Daiki Ueno - - * lisp/gnus-agent.el (gnus-category-edit-predicate): Expand `setf' - appears in the backquoted form. - (gnus-category-edit-score): Ditto. - - * lisp/gnus-sum.el (gnus-data-set-header): Expand `setf' - appears in the backquoted form. - -1999-11-30 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 09. - - * lisp/gnus-offline.el (gnus-offline-define-menu-and-key): Fix a - bug -- do add-hook. - (gnus-offline-popup): Examine whether `easy-menu-create-menu' is - defined. If not, call `easy-menu-create-keymaps'. - -1999-11-30 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 08. - - * lisp/gnus-offline.el (TopLevel): Use `static-if', requiring - "static" at the compile time. - (gnus-offline-hangup-function): Abolish. - (gnus-offline-auto-ppp): New variable. - (gnus-offline-gnus-get-new-news): Refer to it. - (gnus-offline-set-unplugged-state): Ditto. - (gnus-offline-set-auto-ppp): New function. It replaces the - function `gnus-offline-toggle-auto-hangup'. - (gnus-offline-toggle-auto-hangup): Abolish. - (gnus-offline-define-menu-and-key): Use `static-if' and - `static-cond'. - (gnus-offline-popup-menu): Do not define this function under XEmacs. - (gnus-offline-popup): New function. - - * gnus-ofsetup.el (gnus-ofsetup-update-setting-file): Typo. - (gnus-ofsetup-resource-en): Fix doc strings. - (gnus-ofsetup-resource-ja): Ditto. - -1999-11-30 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 07. - - * lisp/gnus-art.el (gnus-article-wash-status): Sync up with - Pterodactyl Gnus v0.98. - -1999-11-30 Katsumi Yamaoka - - * lisp/nnimap.el (nnimap-request-newgroups): Don't use `member-if'. - - * lisp/gnus.el (gnus-select-method): Use `if' instead of `when'. - - * lisp/gnus-sum.el (gnus-summary-make-marking-command-1): Use - `car' and `cdr' instead of `cadr'. - - * lisp/gnus-picon.el (gnus-picons-file-suffixes): Use `cons' - instead of `push'; use `if' instead of `when'. - - * lisp/gnus-group.el (gnus-group-iterate): Use `car' and `cdr' - instead of `pop'. - (gnus-useful-groups): Use `or' instead of `unless'. - - * lisp/gnus-art.el (gnus-emphasis-alist): Use `car' and `cdr' - instead of `cadr'. - -1999-11-30 Katsumi Yamaoka - - * lisp/gnus-start.el (save-buffers-kill-emacs): Don't use the macro - `when' in the body of `defadvice'. Use `if' instead. - - * lisp/dgnushack.el (last, mapc): New compiler macros for emulating - cl functions. - -1999-11-29 Katsumi Yamaoka - - * lisp/gnus-start.el (gnus-after-getting-new-news-hook): Don't use - the macro `when' in the arg of `defcustom'. Use `if' instead. - -1999-11-27 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 06. - - * lisp/gnus-art.el (gnus-signature-toggle): Specify the 4th arg of - `next-single-property-change' LIMIT as `point-max'. - (gnus-article-prepare-mime-display): Ditto. - (article-hide-signature): Ditto. - -1999-11-26 NAKAJI Hiroyuki - - * lisp/gnus.el (gnus-version): Parentheses of gnus-revision-number - are removed to fill gnus-version within 80 columns. - -1999-11-25 NAKAJI Hiroyuki - - * lisp/gnus.el (gnus-version): Shows also gnus-revision-number. - -1999-11-24 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 05. - - * lisp/gnus-agent.el (gnus-agent-fetch-headers): Use `gnus-union' - instead of `union'. - - * lisp/gnus-util.el (gnus-union): New function. - - * lisp/gnus-sum.el (gnus-summary-exit-no-update): Use - `copy-sequence' instead of `copy-list'. - * lisp/gnus-art.el (gnus-article-setup-highlight-words): Ditto. - - * lisp/dgnushack.el (union, copy-list): Remove compiler macros. - -1999-11-24 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 04. - - * lisp/dgnushack.el (union, copy-list): New compiler macros for - emulating cl functions. - -1999-11-22 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 03. - (gnus-select-method): Use `condition-case' instead of - `ignore-errors'. - - * lisp/gnus-start.el (gnus-site-init-file): Use `condition-case' - instead of `ignore-errors'. - - * lisp/{gnus-ofsetup.el,gnus-offline.el}: Remove RCS magic cookie. - - * lisp/{time-date.el,smiley.el,score-mode.el,pop3.el,nnweb.el, - nnvirtual.el,nntp.el,nnspool.el,nnsoup.el,nnoo.el,nnml.el,nnmh.el, - nnmbox.el,nnmail.el,nnlistserv.el,nnimap.el,nnheader.el, - nneething.el,nndraft.el,nndoc.el,nnbabyl.el,message.el,imap.el, - gnus-win.el,gnus-vm.el,gnus-util.el,gnus-topic.el,gnus-sum.el, - gnus-start.el,gnus-srvr.el,gnus-spec.el,gnus-score.el,gnus-salt.el, - gnus-range.el,gnus-picon.el,gnus-ofsetup.el,gnus-offline.el, - gnus-msg.el,gnus-mlspl.el,gnus-mailcap.el,gnus-logic.el, - gnus-kill.el,gnus-group.el,gnus-cite.el,gnus-async.el,gnus-art.el, - gnus-agent.el,earcon.el}: Require `cl' using `eval-when-compile'. - -1999-11-22 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 02. - - * lisp/{time-date.el,smiley.el,pop3.el,nnweb.el,nnvirtual.el, - nntp.el,nnspool.el,nnsoup.el,nnoo.el,nnml.el,nnmh.el,nnmbox.el, - nnmail.el,nnlistserv.el,nnimap.el,nnheader.el,nneething.el, - nndoc.el,nnbabyl.el,message.el,imap.el,gnus.el,gnus-win.el, - gnus-util.el,gnus-topic.el,gnus-sum.el,gnus-start.el,gnus-srvr.el, - gnus-spec.el,gnus-score.el,gnus-salt.el,gnus-range.el, - gnus-picon.el,gnus-ofsetup.el,gnus-offline.el,gnus-mlspl.el, - gnus-mailcap.el,gnus-logic.el,gnus-kill.el,gnus-group.el, - gnus-cite.el,gnus-async.el,gnus-art.el,gnus-agent.el,earcon.el}: - Require `cl' at the top level. - - * lisp/gnus.el (gnus-select-method): Undo last change. - * lisp/gnus-util.el (copy-list): Undo last change (remove it). - * lisp/gnus-start.el (gnus-site-init-file): Undo last change. - - * lisp/gnus-ems.el (gnus-split-string): Remove. - -1999-11-21 Daiki Ueno - - * lisp/pop3.el: Add description about STLS extension; add autoload - setting for `starttls-open-stream' and `starttls-negotiate'. - (pop3-stls): New function. - (pop3-open-tls-stream): New function. - (pop3-open-server): Use `pop3-open-tls-stream' if - 'pop3-connection-type' is bound to `tls'. - -1999-11-20 Daiki Ueno - - * lisp/imap.el: Add autoload setting for `starttls-open-stream' - and `starttls-negotiate'. - (imap-stream-alist): Add TLS entry. - (imap-tls-p): New function. - (imap-tls-open): New function. - (imap-ssl-open): Enclose `open-ssl-stream' with - `as-binary-process'. - -1999-11-19 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 01. - (gnus-select-method): Use `condition-case' instead of - `ignore-errors'. - - * lisp/pop3.el (pop3-apop): Move the autoload seting to the top - level. - - * lisp/md5.el (md5): Allow the optional 4th and 5th arguments - `coding' and `noerror' for the stopgaps. - - * lisp/lpath.el (md5): Allow the optional 4th and 5th arguments - `coding' and `noerror'. - (function-max-args): Maybe-fbind for FSF Emacsen. - - * lisp/imap.el (imap-cram-md5-auth): Specify the 4th arg to `md5' - as `binary' if possible. - (imap-log): Default to nil (synched with pgnus 0.99). - (base64-decode-string): Autoload "mel" instead of "base64". - (md5): Autoload "md5" without `eval-and-compile'. - - * lisp/gnus-util.el (copy-list): New function defined by - `defun-maybe'. - - * lisp/gnus-sum.el (gnus-update-summary-mark-positions): Specify - the 3rd arg of `make-full-mail-header' to "nobody" instead of "". - - * lisp/gnus-start.el (gnus-site-init-file): Use `condition-case' - instead of `ignore-errors'. - - * lisp/gnus-picon.el: Require `cl'. - - * lisp/{smiley.el,rfc2104.el,nnvirtual.el,mailheader.el, - gnus-offline.el} (cl): Enclose the requiring procedure with - `eval-when-compile'. - - * lisp/{imap.el,gnus-mailcap.el} (cl): Enclose the requiring - procedure with `eval-when-compile' instead of `eval-and-compile'. - -1999-11-09 Yoshiki Hayashi - - * lisp/read-passwd.el (read-pw-set-mail-source-passwd-cache): - Use mail-sources instead of nnmail-spool-file. - From: Toshiaki -PCX- Tanaka. - -1999-11-09 Katsumi Yamaoka - - * lisp/gnus.el (gnus-group-startup-message): Insert space before - "based on". - * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Ditto. - -1999-11-09 Katsumi Yamaoka - - * lisp/gnus.el (gnus-version-number): Update to 6.13.3. - (gnus-revision-number): Clear to 00. - - * README.T-gnus: Update. - - * lisp/{rfc1843.el,qp.el,nntp.el,nnmail.el,nnfolder.el,nnagent.el, - mml.el,mm-view.el,mm-uu.el,mm-util.el,mm-decode.el,mm-bodies.el, - message.el,mail-source.el,lpath.el,gnus-util.el,gnus-topic.el, - gnus-sum.el,gnus-start.el,gnus-srvr.el,gnus-msg.el,gnus-mailcap.el, - gnus-group.el,gnus-art.el,gnus-agent.el,dgnushack.el,binhex.el, - ChangeLog}: Sync up with Pterodactyl Gnus v0.98. - - * lisp/{rfc2104.el,nnimap.el,imap.el}: New files. - - * texi/gnus-ja.texi: Sync up with Pterodactyl Gnus v0.98 without - translation. - - * texi/{gnus.texi,ChangeLog}: Sync up with Pterodactyl Gnus v0.98. - -1999-11-08 Kinji Itoh - - * lisp/gnus-draft.el (gnus-draft-edit-message): Use - `message-save-drafts' instead of `set-buffer-modified-p' and - `save-buffer'. - * lisp/message.el (message-save-drafts): Insert In-Reply-To header - because the reply data is lost in Drafts. - * lisp/gnus-art.el (gnus-signature-face): Don't check - window-system type. - -1999-11-08 Daiki Ueno - - * lisp/pop3.el (pop3-progress-message): New function. - (pop3-movemail): Use it. - -1999-10-28 Katsumi Yamaoka - - * lisp/gnus.el (TopLevel): Autolaod "gnus-msg" for the function - `gnus-following-method'. - - * lisp/gnus-msg.el (gnus-following-method): Move from gnus-msg.el; - wide reply as a mail if the message is not a news; use the macro - `gnus-setup-message'. - - * lisp/gnus-art.el (gnus-following-method): Move to gnus-msg.el. - -1999-10-26 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 14. - (TopLevel): Autoload "gnus-bitmap" instead of "smiley-mule" for the - function `gnus-smiley-display'. - - * lisp/gnus-art.el (gnus-treat-display-smileys): Default to nil if - `window-system' is nil. - (gnus-article-x-face-command): Default to external command if - `window-system' is nil. - -1999-10-26 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 13. - (TopLevel): Rearrange autoload settings. - - * lisp/gnus-art.el (gnus-treatment-function-alist): Don't use - `smiley-buffer'. - - * lisp/gnus-sum.el (gnus-summary-make-menu-bar): Add button - "Toggle smileys" in "Washing" menu. - (gnus-summary-wash-map): Add "s" key for `smiley-toggle-buffer'. - - * lisp/smiley.el (gnus-smiley-display): Use `smiley-toggle-buffer'. - (smiley-toggle-buffer): New function. - (smiley-buffer): Don't quote the function. - (smiley-toggle-extents): Ditto. - -1999-10-24 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 12. - (TopLevel): Add and delete autoloads for functions defined in - "gnus-cus", "gnus-offline", "miee", "pop3-fma" and "mw32misc". - - * lisp/gnus-offline.el (TopLevel): Do not consider the functions - defined in "miee". - - * lisp/gnus-ofsetup.el (TopLEvel): Do not autoload - `gnus-custom-mode' defined in "gnus-cus". - -1999-10-21 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 11. - - * lisp/gnus-offline.el (TopLevel): Call `mime-set-field-decoder' - when "eword-decode" is loaded. It is for X-Gnus-Offline-Backend - header. - -1999-10-19 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 10. - (TopLevel): Autoload "x-face-mule" and "smiley-mule" for the - functions `x-face-mule-gnus-article-display-x-face' and - `smiley-buffer'. - - * lisp/lpath.el (smiley-encode-buffer): Bind it for FSF Emacsen. - - * lisp/gnus-ems.el (gnus-group-startup-message): Don't replace with - `gnus-mule-group-startup-message'. - (gnus-mule-group-startup-message): Remove. - (gnus-mule-bitmap-image-file): Remove. - - * lisp/gnus-msg.el (gnus-copy-article-buffer): Encode smileys to - ordinary text if the feature `smiley-mule' is provided and FSF - Emacs is used. - (TopLevel): Require `static' at the compile time. - - * lisp/gnus-art.el (gnus-article-prepare-display): Bind - `mime-display-text/plain-hook' to nil. - (gnus-article-prepare-mime-display): Use `let' instead of `let*'; - treat the next entity position as a marker. - (gnus-treatment-function-alist): Use `smiley-buffer' instead of - `gnus-smiley-display' under FSF Emacsen. - (gnus-treat-display-smileys): Default to t if the module - `smiley-mule' is installed. - (gnus-treat-display-xface): Default to `head' if the value of - `gnus-article-x-face-command' is - `x-face-mule-gnus-article-display-x-face'. - (gnus-article-x-face-command): Default to - `x-face-mule-gnus-article-display-x-face' if the module - `x-face-mule' is installed. - (TopLevel): Require `static' first; require `path-util'. - -1999-10-18 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 09. - - * lisp/message.el (message-mode): Make - `message-font-lock-last-position' as buffer local. - (message-font-lock-keywords-2): Use - `message-font-lock-cited-text-matcher' instead of regexp. - (message-font-lock-cited-text-matcher): New function. - (font-lock-after-change-function): Advice to the keep last cursor - position in `message-font-lock-last-position' before fontifying. - (message-font-lock-last-position): New variable. - (message-font-lock-citation-name-max-column): New variable. - (message-font-lock-cited-text-regexp): New variable. - (message-font-lock-fence-close-position): New variable. - (message-font-lock-fence-open-position): New variable. - (message-font-lock-fence-close-regexp): New variable. - (message-font-lock-fence-open-regexp): New variables. - -1999-10-04 Masatoshi Tsuchiya - - * lisp/message.el (message-mode): Rearrange `font-lock-defaults' - using `message-font-lock-keywords', `message-font-lock-keywords-1' - and `message-font-lock-keywords-2'. - (message-font-lock-keywords): Restruct. - (message-font-lock-keywords-1): New variable split from - `message-font-lock-keywords'. - (message-font-lock-keywords-2): Ditto. - -1999-10-11 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 08. - - * lisp/gnus-art.el (gnus-treat-article): Buttonize the signature - before highlighting or hiding it. - (gnus-article-buttonize-signature): New function. - (gnus-article-highlight-signature): Don't buttonize. - (gnus-treatment-function-alist): Undo the last change. - (gnus-treat-emphasize): Default to nil. - -1999-10-08 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 07. - (TopLevel): Autoload "gnus-art" for the function - `gnus-article-show-all'. - - * lisp/gnus-sum.el (gnus-summary-select-article): Expose all - hidden text if the command `gnus-summary-toggle-mime' is used. - - * lisp/gnus-art.el (gnus-signature-toggle): Don't hide the - following parts. - (gnus-article-highlight-signature): Work for forwarded messages. - (gnus-article-show-all): New function based on `article-show-all'. - (gnus-article-show-all-headers): Based on - `article-show-all-headers'. - (article-show-all-headers): New function to show all *HEADERS*. - (article-show-all): Show *ALL* literally. - (article-hide-signature): Work for forwarded messages. - (gnus-treatment-function-alist): Put `gnus-treat-hide-signature' - off after `gnus-treat-highlight-signature'. - -1999-10-08 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 06. - - * lisp/gnus-art.el (gnus-article-prepare-mime-display): Protect - against forwarded messages without MIME structure. - (gnus-treatment-function-alist): Move - 'gnus-treat-decode-article-as-default-mime-charset' to the top; - put `gnus-treat-emphasize' off after - `gnus-treat-highlight-headers'. - -1999-10-07 Yoshiki Hayashi - - * lisp/gnus.el (gnus-revision-number): Increment to 05. - -1999-10-07 Katsumi Yamaoka - - * lisp/gnus-art.el (gnus-treat-predicate): Examine whether the - argument is list or not before condition. - -1999-10-07 Yoshiki Hayashi - - * lisp/gnus-art.el (gnus-treat-predicate): Work for - (typep "something"). - -1999-10-07 Yoshiki Hayashi - - * lisp/gnus-art.el (gnus-article-prepare-display): - Pass argument nil as a condition to gnus-treat-article. - * lisp/gnus-art.el (gnus-article-prepare-mime-display): - Ditto. Also, treat last part of multipart article correctly. - -1999-10-06 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 04. - - * lisp/message.el (message-generate-headers): Don't insert - excessive newline. - - * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Don't use - negative number for the 2nd arg of `insert-char'. - -1999-10-06 Tsukamoto Tetsuo - - * lisp/gnus-ofsetup.el (gnus-ofsetup-customize): Info link to - gnus-ja instead of gnus if Japanese environment is on. - -1999-10-06 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 03. - (semi-gnus-developers): Remove. - (gnus-maintainer): Change mail address. - (gnus-group-startup-message): Display version string. - - * lisp/gnus-msg.el (gnus-bug): Delete `Cc'; modify version string. - - * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Display - version string; fix glyph position. - -1999-10-06 Yoshiki Hayashi - - * lisp/gnus-sum.el (gnus-read-move-group-name): Revert - to previous version until problem of respooling from - nnimap to nnml is solved. - (gnus-summary-move-article): Ditto. - -1999-10-05 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 02. - - * lisp/gnus-art.el (gnus-treat-predicate): Check whether arg's - value is t before checking for `condition'. - (gnus-article-prepare-mime-display): Search for the entity children - if the primary type is `multipart'. - -1999-10-01 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 01. - - * lisp/gnus-sum.el (gnus-read-move-group-name): Returns nil - instead of signaling an error if the destination group is not - newly created. - (gnus-summary-move-article): Do nothing if the destination group - is not newly created. - - * lisp/gnus-msg.el (gnus-bug): Use text/plain for the snooped - environment part. - -1999-09-30 Daiki Ueno - - * nnfolder.el (nnfolder-possibly-change-group): Don't create an - active entry for the group even if it doesn't exist. - -1999-09-28 Daiki Ueno - - * gnus-art.el (gnus-article-mime-part-status): Use `mime-entity-children'. - -1999-09-28 Katsumi Yamaoka - - * lisp/gnus.el (gnus-version-number): Update to 6.13.2. - (gnus-revision-number): Clear to 00. - - * README.T-gnus: Update. - - * texi/{message.texi,message-ja.texi,gnus.texi,gnus-ja.texi, - emacs-mime.texi,ChangeLog}: Sync up with Pterodactyl Gnus v0.97. - - * lisp/{qp.el,nntp.el,nnmail.el,mml.el,mm-util.el,mm-encode.el, - mm-decode.el,message.el,mail-source.el,gnus.el,gnus-xmas.el, - gnus-util.el,gnus-sum.el,gnus-srvr.el,gnus-score.el,gnus-nocem.el, - gnus-msg.el,gnus-group.el,gnus-cache.el,gnus-art.el,gnus-agent.el, - ChangeLog}: Sync up with Pterodactyl Gnus v0.97. - -1999-09-24 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 07. - - * lisp/gnus-art.el (gnus-article-prev-page): Rewrite to realize - smooth scrolling under XEmacs. - (gnus-article-next-page):Ditto. - - * Mule23@1934.en, Mule23@1934.ja: Separate from Mule23@1934; add - descriptions about the problem of loaddefs.el and the patch for - CUSTOM 1.9962. - -1999-09-22 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 06. - - * lisp/nnmail.el (TopLevel): Bind keywords `:user', `:path' and - `:predicate' for old Emacsen; require `static'. - - * lisp/dgnushack.el (TopLevel): Don't bind keywords `:user', - `:path' and `:predicate'. - -1999-09-20 Daiki Ueno - - * gnus-agent.el (gnus-agent-toggle-plugged): Mark the current - modeline as modified. - -1999-09-17 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 05. - - * lisp/gnus-art.el (gnus-treat-article): Inherit the text property - `mime-view-entity' in the modified header under FSF Emacsen. - -1999-09-13 Tsukamoto Tetsuo - - * README-offline.en: Rewrite the usage description. - * README-offline.ja: Ditto. - -1999-09-12 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 04. - - * lisp/gnus-ofsetup.el (gnus-offline-lang): Declare before loading - `gnus-offline'. - -1999-09-12 Tsukamoto Tetsuo - - * README-offline.en: Do not refer to `gnus-agent-toggle-plugged'. - * README-offline.ja: Ditto. - -1999-09-11 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 03. - - * lisp/gnus-agent.el (gnus-agent-toggle-plugged): Do not mark - the current buffer as modified. - - * lisp/gnus-offline.el (gnus-offline-menu): New variable. - (gnus-offline-get-menu-items): New function. - (gnus-offline-define-menu-on-miee): Use it. - (gnus-offline-define-menu-on-agent): Ditto. - -1999-09-04 Daiki Ueno - - * lisp/gnus-msg.el (gnus-configure-posting-styles): Quote `:file'. - - * lisp/pop3.el (pop3-save-uidls): Don't use `dotimes' to check - backets of `pop3-uidl-obarray'; don't clear `pop3-uidl-obarray'. - (pop3-quit): Clear `pop3-uidl-obarray'. - -1999-09-03 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 02. - - * lisp/gnus-offline.el (gnus-offline-resource-en, - gnus-offline-resource-ja, - gnus-offline-resource-ja_complete): New variables. - (gnus-offline-get-message): News function. - (gnus-offline-error-check): Use it. - (gnus-offline-connect-server): Ditto. - (gnus-offline-get-new-news-function): Ditto. - (gnus-offline-set-mail-group-level): Ditto. - (gnus-offline-hangup-line): Ditto. - (gnus-offline-after-jobs-done): Ditto. - (gnus-offline-toggle-auto-hangup): Ditto. - (gnus-offline-toggle-on/off-send-mail): Ditto. - (gnus-offline-toggle-articles-to-fetch): Ditto. - (gnus-offline-empting-spool): Ditto. - (gnus-offline-set-interval-time): Ditto. - - * lisp/gnus-ofsetup.el (gnus-offline-lang, - gnus-ofsetup-resource-en, gnus-ofsetup-resource-ja): New - variables. - (gnus-ofsetup-get-message): New function. - (gnus-setup-for-offline): Use it. - (gnus-ofsetup-find-parameters): Ditto. - (gnus-ofsetup-prepapre-for-miee): Ditto. - (gnus-ofsetup-completing-read-symbol): Ditto. - (gnus-ofsetup-customize): Ditto. - (gnus-ofsetup-customize-done): Ditto. - -1999-09-01 Katsumi Yamaoka - - * lisp/gnus-sum.el (gnus-summary-isearch-article): Don't bind - `isearch-lazy-highlight'. - -1999-08-30 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 01. - - * lisp/lpath.el (babel-as-string): Bind it. - - * lisp/gnus-sum.el (gnus-summary-search-article): Keep the - original X-Face field while searching. It is done for only FSF - Emacsen. - (gnus-summary-search-article-highlight-matched-text): Ditto. - (gnus-summary-search-article-matched-data): Bind it explicitly. - -1999-08-29 Katsumi Yamaoka - - * lisp/gnus.el (gnus-version-number): Update to 6.13.1. - (gnus-revision-number): Clear to 00. - - * README.T-gnus: Update. - - * README: Sync up with Pterodactyl Gnus v0.96. - * lisp/{smiley.el,nntp.el,nnmail.el,nnfolder.el,mml.el,mm-view.el, - mm-uu.el,mm-util.el,mm-encode.el,mm-decode.el,mm-bodies.el, - gnus-uu.el,gnus-util.el,gnus-sum.el,gnus-start.el,gnus-score.el, - gnus-mlspl.el,gnus-group.el,gnus-bcklg.el,gnus-art.el, - gnus-agent.el,ChangeLog}: Ditto. - * texi/{gnus.texi,gnus-ja.texi,ChangeLog}: Ditto. - -1999-08-27 Daiki Ueno - - * lisp/pop3.el (pop3-movemail): If the argument `crashbox' is t, - don't retrieve any incoming mails.; Don't filter articles here. - Use `convert-standard-filename' to generate fresh UIDL file names. - (pop3-get-message-numbers): Rewrite. - (pop3-save-uidls): Clear UIDL hash.; Use `with-temp-file' instead - of `with-temp-buffer'. - -1999-08-27 Tsukamoto Tetsuo - - * README-offline.ja : Fix. - - * lisp/gnus-offline.el (gnus-offline-agent-automatic-expire): - Fix typo. - - * lisp/gnus-ofsetup.el : Remove gnus-cus from compile time - requirements; Enclose the autoload for `gnus-custom-mode' with - `eval-and-compile'. - -1999-08-27 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 15. - - * lisp/dgnushack.el (char-before, char-after): Optimize byte code - for them before lpath.el is loaded. Because lpath.el requires - `poe' via `path-util'. [cf. ] - - * lisp/gnus-sum.el (gnus-summary-search-article): Search for - X-Face image if the regexp "^X-Face:" is specified. - (gnus-summary-search-article-highlight-matched-text): Use - `gnus-summary-search-article-highlight-goto-x-face'; maybe display - X-Face image if it is requested. - (gnus-summary-search-article-highlight-goto-x-face): New macro. - -1999-08-26 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 14. - - * lisp/gnus-sum.el (gnus-summary-search-article): Treat and - recenter the article when touchdown; popup the article buffer if - it is disappeared. - (gnus-summary-search-article-highlight-matched-text): Treat the - article before highlighting; use old style backquote syntax. - (gnus-summary-search-article-position-point): Fix the beginning - position; use old style backquote syntax. - (gnus-summary-select-article): Undo the last change. - (gnus-summary-display-article): Bind - `gnus-summary-search-article-matched-data' in the article buffer - locally. It is moved from `gnus-summary-select-article'. - -1999-08-25 NAKAJI Hiroyuki - - * texi/Makefile.in (EMACS): Use @EMACS@, not emacs directly. - (clean): Remove formatted info files. - (distclean): Just remove Makefile. - -1999-08-25 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 13. - - * lisp/gnus-agent.el (gnus-agent-large-newsgroup): New variable. - (gnus-agent-fetch-headers): Limit downloadable articles if the - number of unread articles exceeds `gnus-agent-large-newsgroup'. - (gnus-agent-expire): Do not expire saved or replied articles when - `gnus-agent-expire-all' is nil. - - * lisp/gnus-offline.el (gnus-offline-agent-automatic-expire): New - variable. - (gnus-offline-agent-expire): Check it; Bind - `gnus-agent-expire-all' to nil if `gnus-agent-expire-days' is 0. - (gnus-offline-after-jobs-done): Don't check - `gnus-agent-expire-all'. - - * lisp/gnus-ofsetup.el (gnus-offline-setting-file): Check if - `user-login-name' and `user-real-login-name' returns the same - value or not. - (gnus-ofsetup-prepare-for-miee): Write forms as a variable. - (gnus-ofsetup-update-setting-file): Ditto. - (gnus-ofsetup-prepare): New macro. - (gnus-setup-for-offline): Use it. - (gnus-ofsetup-customize-done): Ditto. - -1999-08-25 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 12. - - * lisp/gnus-sum.el (gnus-summary-search-article): Rearrange. - (gnus-summary-search-article-highlight-matched-text): Rearrange. - (gnus-summary-search-article-position-point): New macro. - (gnus-summary-search-article-matched-data): Rename from - `gnus-summary-search-article-matched-text'. - (gnus-summary-isearch-article): Bind `gnus-inhibit-treatment' to t; - use `gnus-article-show-all-headers' for exposing the visited - article. - (gnus-summary-select-article): Bind - `gnus-summary-search-article-matched-data' in the article buffer - locally. - - * lisp/gnus-art.el (gnus-treat-article): Don't treat the article - if the value of `gnus-inhibit-treatment' is non-nil. - (article-toggle-headers): Don't redisplay X-Face if the value of - `gnus-inhibit-treatment' is non-nil. - (gnus-article-treat-custom): Add new treatment variable `mime'. - -1999-08-25 Daiki Ueno - - * lisp/gnus-group.el (gnus-group-line-format): Fix typo in - documentation. - - * lisp/gnus-sum.el (gnus-summary-mode): Don't set - `gnus-newsgroup-incorporated' explicitly. - -1999-08-24 Katsumi Yamaoka - - * README.semi: Update for the recent a-ftp sites and directories. - * README.semi.ja: Ditto. - * texi/gnus-faq.texi: Ditto. - * texi/gnus-faq-ja.texi: Ditto. - -1999-08-24 Daiki Ueno - - * lisp/gnus.el (gnus-revision-number): Increment to 11. - (gnus-summary-incorporated-face): New face spec. - - * lisp/gnus-group.el (gnus-group-line-format-alist): Add - entry about the format specifier `w'. - (gnus-group-line-format): Fix documentation. - - * lisp/gnus-sum.el (gnus-summary-highlight): Highlight lines on - newly incorporated mails with `gnus-summary-incorporated-face'. - (gnus-newsgroup-incorporated): New variable. - (gnus-summary-local-variables): Add `gnus-newsgroup-incorporated'. - (gnus-summary-mode): Set `gnus-newsgroup-incorporated'. - - * lisp/nnmail.el (nnmail-new-mail-numbers): New function. - - * lisp/gnus-srvr.el (gnus-browse-foreign-server): Don't prepend - `K' if the group has already been subscribed. - -1999-08-24 Katsumi Yamaoka - - * lisp/gnus-sum.el (gnus-summary-isearch-article): Set - `isearch-lazy-highlight' t in the buffer locally; goto the - beginning of the buffer before searching. - - * lisp/gnus-util.el (gnus-eval-in-buffer-window): Select the last - selected frame. - -1999-08-23 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 10. - - * lisp/gnus-sum.el (gnus-summary-search-article): Highlight - matched text after the searching is done; call - `gnus-summary-select-article' with the args nil and t; bind - `gnus-treat-*' to nil. - (gnus-summary-search-article-highlight-matched-text): New macro - for highlighting matched text. It is bound at the compile time - only. - (gnus-summary-isearch-article): Call `gnus-summary-select-article' - with the args nil and t; bind `gnus-treat-*' to nil. - - * lisp/gnus-ems.el (gnus-x-splash): Change the foreground color of - `gnus-splash' to "Brown"; use `with-temp-buffer' instead of - `with-temp-file'; use `insert-file-contents-as-binary' instead of - `insert-file-contents'. - -1999-08-20 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 09. - - * lisp/gnus-offline.el: Fix comments. - (TopLevel): Delete the code for emulating custom. Do not inhibit - byte-compile-warnings, but hide useless ones. - (gnus-offline-dialup-program-arguments): defvar instead of - defcustom. - (gnus-offline-hangup-program-arguments): Ditto. - (gnus-offline-interval-time): Ditto. - (gnus-offline-dialup-program, gnus-offline-hangup-program, - gnus-offline-drafts-queue-type, gnus-offline-MTA-type): defvar. - (gnus-offline-disable-fetch-mail): Remove pop3-fma dependent - codes. - Set `mail-sources' instead of `nnmail-spool-file'. - (gnus-offline-enable-fetch-mail): Ditto. - (gnus-offline-toggle-movemail-program): Abolish. - (gnus-offline-define-menu-and-key): Modify according to it. - (gnus-offline-define-menu-on-miee): Ditto. - (gnus-offline-define-menu-on-agent): Ditto. - (gnus-offline-message-add-header): Bind temporary variables. - (gnus-offline-add-custom-header): Ditto. - (gnus-offline-restore-mail-group-level): Ditto. - - * lisp/gnus-ofsetup.el (TopLevel): Require gnus-cus and - gnus-offline at the compile time. Do not inhibit - byte-compile-warnings. - (gnus-setup-for-offline): Really bind all temporary variables. - (gnus-ofsetup-write-settting-file): Check if interval is a - integer. - Use `mail-sources' instead of `nnmail-spool-file'. - (gnus-ofsetup-update-setting-file): Redefine as a macro. - (gnus-ofsetup-prepare-for-miee): Ditto. - - * README-offline.en : Update. - * README-offline.ja : Ditto. - -1999-08-20 Daiki Ueno - - * lisp/gnus-sum.el (gnus-wheel-summary-scroll): Bind - `inhibit-read-only' to t; bind `buffer-read-only' to nil. - -1999-08-20 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 08. - -1999-08-19 Keiichi Suzuki - - * lisp/nnmail.el (nnmail-split-it): Match whole word for getting - group name with `\N'. - -1999-08-19 Daiki Ueno - - * lisp/gnus.el (gnus-revision-number): Increment to 07. - - * lisp/pop3.el (pop3-except-header-regexp): New variable. - (pop3-movemail): Don't retrieve messages whose headers are - matching `pop3-except-header-regexp'. - (pop3-top): New function. - (pop3-retr): Don't use `save-restriction'. - -1999-08-18 Daiki Ueno - - * lisp/pop3.el (pop3-get-extended-response): Fix regexp. - -1999-08-18 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 06. - - * lisp/gnus-art.el (mime-preview-over-to-next-method-alist): Use - `gnus-article-next-page' when the last page is not displayed. - (mime-preview-over-to-previous-method-alist): Use - `gnus-article-prev-page' when the first page is not displayed. - (gnus-next-page-map): Use `make-sparse-keymap' instead of - `make-keymap'; don't use `suppress-keymap'. - (gnus-insert-next-page-button, gnus-insert-prev-page-button): - Succeed to the value of the text property `mime-view-situation' in - the Next/Prev buttons; make `gnus-{next|prev}-page-map' have the - current local map as a parent under FSF Emacsen. - -1999-08-18 Daiki Ueno - - * lisp/pop3.el (pop3-retr): Undo last change. - -1999-08-17 Daiki Ueno - - * lisp/gnus.el (gnus-revision-number): Increment to 05. - - * lisp/pop3.el (pop3-get-extended-response): Enable timeout of - `accept-process-output'; Move point to the end of the normal - response. - (pop3-movemail): Add suffix to `pop3-uidl-file-name'. - (pop3-get-list): Abolish. - (pop3-retr): Don't use `save-restriction'. - (pop3-uidl): Don't use `condition-case' when checking UIDL support. - (pop3-list): Likewise. - -1999-08-17 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 04. - - * lisp/gnus-sum.el (gnus-wheel-summary-scroll): Use - `event-basic-type' instead of `event-button' under FSF Emacsen. - -1999-08-16 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 03. - -1999-08-16 Daiki Ueno - - * lisp/gnus-sum.el: Add `gnus-wheel-install' to - `gnus-summary-mode-hook'. - (gnus-use-wheel): New variable. - (gnus-wheel-scroll-amount): New variable. - (gnus-wheel-edge-resistance): New variable. - (gnus-wheel-summary-scroll): New function. - (gnus-wheel-install): New function. - -1999-08-16 Katsumi Yamaoka - - * lisp/gnus.el (gnus-revision-number): Increment to 02. - - * lisp/nnheader.el (make-full-mail-header-from-decoded-header): Use - `defun' instead of `defsubst'. - (make-full-mail-header): Ditto. - - * lisp/dgnushack.el (dgnushack-texi-format): Fold up long lines. - (TopLevel): Autoload "texinfmt" for avoiding byte compile warning. - -1999-08-16 Tsukamoto Tetsuo - - * lisp/gnus.el (gnus-revision-number): Increment to 01. - - * lisp/gnus-draft.el (gnus-group-send-drafts): Say which message - is being sent. - - * lisp/gnus-ofsetup.el (gnus-ofsetup-completing-read-symbol): New - function from Nana-gnus. - (gnus-setup-for-offline): Rewrite. Bind all temporary variables. - (gnus-ofsetup-update-setting-file): Rename from - `gnus-ofsetup-write-setting-file'. - (gnus-ofsetup-find-parameters): Rename from - `gnus-ofsetup-parameters'. - (gnus-ofsetup-customize-done): Rewrite. - -1999-08-15 Daiki Ueno - - * pop3.el: Sync up with pop3.el version 2.04. - (pop3-leave-mail-on-server): New variable. - (pop3-maximum-message-size): New variable. - (pop3-uidl-file-name): New variable. - (pop3-uidl-support): New variable. - (pop3-uidl-obarray): New variable. - (pop3-movemail): Check message size on every retrieval. - (pop3-open-ssl-stream-1): Use new style macro. - (pop3-get-message-numbers): New function. - (pop3-get-list): New function. - (pop3-get-uidl): New function. - (pop3-get-unread-message-numbers): New function. - (pop3-save-uidls): New function. - (pop3-retr): Use `pop3-get-extended-response'. - (pop3-list): New implementation. - (pop3-uidl): New function. - (pop3-get-extended-response): New function. - -1999-08-04 Katsumi Yamaoka - - * lisp/gnus.el: T-gnus 6.13.0 is released. - -1999-08-04 Katsumi Yamaoka - - * ChangeLog.2: New file, rename from ChangeLog. - - * lisp/dgnushack.el (TopLevel): Rearrange. - - * README.branch.ja: Update for t-gnus-6_12 and t-gnus-6_13 branch. - * README.branch: Ditto. - - * texi/gnus-faq.texi: Replace ftp.jaist.ac.jp with ftp.etl.go.jp. - - * texi/gnus-faq-ja.texi: Modify for T-gnus 6.13. - * texi/message-ja.texi: Ditto. - * texi/message.texi: Ditto. - * texi/gnus-ja.texi: Ditto. - * texi/gnus.texi: Ditto. - * README-offline.ja: Ditto. - * README-offline.en: Ditto. - * README.semi.ja: Ditto. - * README.semi: Ditto. - * README.T-gnus: Ditto. - - * t-gnus-6_13: NEW PUBLIC BRANCH. - -See ChangeLog.2 for earlier changes. +See ChangeLog.3 for earlier changes. diff --git a/ChangeLog.3 b/ChangeLog.3 new file mode 100644 index 0000000..6859e0f --- /dev/null +++ b/ChangeLog.3 @@ -0,0 +1,2916 @@ +2000-12-06 Katsumi Yamaoka + + * lisp/nnshimbun.el (TopLevel): Defalias `coding-system-category' + to `get-code-mnemonic' for Mule. + (TopLevel): Make codesys `euc-japan' and `shift_jis' for Mule. + (nnshimbun-type-definition): Use `static-if' to determine codesys. + (TopLevel): Require `static'. + +2000-12-06 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-retrieve-url): coding detection is + improved. + (nnshimbun-meta-content-type-charset-regexp): New constant. + (nnshimbun-meta-charset-content-type-regexp): Ditto. + +2000-12-03 Tetsuo Tsukamoto + + * texi/gnus-ja.texi: Fixes for the last modification. + +2000-12-02 Tetsuo Tsukamoto + + * texi/gnus-ja.texi: Translate description about + `nnmail-split-fancy-with-parent'. + + * texi/message-ja.texi: Use two lines for direntry. + +2000-12-01 Katsumi Yamaoka + + * lisp/dgnushack.el: Attempt to add another FLIM path to `load-path' + if the module `mel' does not found. This procedure may be needed + when recent FLIM 1.14 is used under old Emacsen. + +2000-11-27 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 08. + + * lisp/message.el (message-send-mail-with-smtp): Leave the error + handling in `smtp-send-buffer's own care. + +2000-11-22 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 07. + + * lisp/gnus.el: Add autoloads for x-face-e21. + + * lisp/gnus-sum.el (gnus-summary-search-article-position-point): + Search for `x-face-image' as well as `x-face-mule-bitmap-image'. + + * lisp/gnus-art.el (gnus-article-x-face-command): Default to + `x-face-decode-message-header' when Emacs 21 is running and + x-face-e21 is installed. + +2000-11-21 Katsumi Yamaoka + + * lisp/message.el (message-send-mail-with-smtp): Use + `smtp-send-buffer' if it exists instead of `smtp-via-smtp'. + + * lisp/dgnushack.el (describe-key-briefly): New compiler macro for + old Emacsen. + +2000-11-17 Akihiro Arisawa + + * lisp/nnheader.el (nnheader-header-value): Save point. + +2000-11-16 Katsuhiro Hermit Endo + + * texi/gnus-ja.texi (Drafts): Fix typo. + +2000-11-14 Katsumi Yamaoka + + * lisp/gnus-art.el (article-verify-x-pgp-sig): Autoload "mm-uu". + (gnus-treat-x-pgp-sig): Default to nil. + +2000-11-10 Katsumi Yamaoka + + * Mule23@1934.en, Mule23@1934.ja, sample.lpath.el: Upgrade. + + * configure: Regenerate. + * aclocal.m4 (AC_PATH_PACKAGEDIR): No need to quote a string for + `AC_MSG_RESULT'. + (AC_CHECK_W3): Ignore cache; no need to quote a string for + `AC_MSG_RESULT'. + (AC_CHECK_EMACS_FLAVOR): Ignore cache. + (AC_CHECK_EMACS): Ignore cache. + (AC_DEFINE_GNUS_PRODUCT_NAME): Cache. + +2000-11-09 Katsumi Yamaoka + + * configure: Regenerate. + + * aclocal.m4 (AC_CHECK_W3): Substitute `W3' with empty string + instead of "no" if it is not acceptable. + + * lisp/dgnushack.el: Load dgnuspath.el and ~/.lpath.el just before + path-util is loaded. + (dgnushack-compile): Show `load-path'. + (dgnushack-w3-dir): Ignore the env var W3DIR if it is empty. + + * lisp/lpath.el: Move out `load-path' modification for APEL, FLIM + and SEMI to dgnushack.el. + * lisp/dgnushack.el: Move here. + + * lisp/lpath.el (md5): Don't bind. + (url-insert-file-contents): Fbind for FSF Emacsen. + +2000-11-08 Katsumi Yamaoka + + * texi/Makefile.in (install-ja-info): Specify `EMACS' and + `infodir'. + (install-info): Ditto. + (install-ja): Ditto. + + * lisp/lpath.el (md5): Fbind using `maybe-fbind'. + + * lisp/dgnushack.el (dgnushack-compose-package): Remove function. + (dgnushack-install-package-info-ja): Remove function. + (dgnushack-install-package-info): Remove function. + (dgnushack-install-package-lick): Remove function. + (dgnushack-install-package-pkginfo): Remove function. + (dgnushack-install-package-info-files): Remove function. + (dgnushack-install-package-manifest): New function. + (dgnushack-remove-extra-files-in-package): New function. + (dgnushack-gnus-product-name): Remove function. + (dgnushack-examine-package-dir): Remove function. + (dgnushack-exporting-files): Rename from `dgnushack-exported-files'. + (dgnushack-unexporting-files): Rename from + `dgnushack-unexported-files'; attempt to fix `load-path' for W3 and + retry to load `w3-forms' if it is failed. + (dgnushack-w3-dir): New variable. + + * lisp/Makefile.in (remove-extra-files-in-package): New target. + (install-package-manifest): New target. + (install-package-info-ja): Remove target. + (install-package-info): Remove target. + (install-package-lick): Remove target. + (install-lisp): New target detached from `install'. + (install): Call `clever' and `install-lisp'. + (EXPORTING_FILES, GNUS_PRODUCT_NAME): New variables. + + * configure: Regenerate. + + * aclocal.m4 (AC_PATH_PACKAGEDIR): Examine `PACKAGEDIR' if it is + not specified under XEmacs. + (AC_EXAMINE_PACKAGEDIR): New function. + (AC_PATH_LISPDIR): Don't say annotations about install-package if + FSFmacs is used. + (AC_DEFINE_GNUS_PRODUCT_NAME): Add substitution for + `GNUS_PRODUCT_NAME'. + + * Makefile.in (remove-extra-files-in-package): New target. + (install-package-manifest): New target. + (install-package-info-ja): Examine `PACKAGEDIR' if it is not + specified; call install-ja-info in texi/Makefile. + (install-package-info): Examine `PACKAGEDIR' if it is not + specified; call install-info in texi/Makefile. + (install-package-lisp): Rename from `install-package-lick'; examine + `PACKAGEDIR' if it is not specified; call `install-lisp' in + lisp/Makefile. + (install-package-ja): Call `xlick', `compose-package', + `remove-extra-files-in-package', `install-package-lisp', + `install-package-info', `install-package-info-ja' and + `install-package-manifest'. + (install-package): Call `xlick', `compose-package', + `remove-extra-files-in-package', `install-package-lisp', + `install-package-info' and `install-package-manifest'. + (install-info-ja, install-info): Specify `infodir'. + (EXAMINE_PACKAGEDIR, GNUS_PRODUCT_NAME, infodir): New variables. + +2000-11-07 Tetsuo Tsukamoto + + * texi/gnus-ja.texi: Do not use characters other than ascii ones + for direntries. + * texi/message-ja.texi: Ditto. + +2000-11-06 Katsumi Yamaoka + + * lisp/Makefile.in (install): Don't check for the file names. + +2000-11-04 Katsuhiro Hermit Endo + + * lisp/gnus-topic.el (gnus-group-topic-map): Define "T" prefix + command in `gnus-topic-mode-map' instead of `gnus-group-mode-map'. + +2000-10-25 Katsuhiro Hermit Endo + + * lisp/gnus-topic.el (gnus-topic-rename): Use current topic as + initial value for read-string. + +2000-11-06 Katsumi Yamaoka + + * lisp/Makefile.in (install): Use the lisp function + `dgnushack-exported-files'. + + * lisp/nnmail.el (nnmail-pathname-coding-system): Default to + `binary'. + * lisp/nnheader.el (nnheader-pathname-coding-system): Ditto. + + * lisp/message.el (message-get-reply-headers): Remove useless + `concat'. + + * lisp/md5.el: Restore the file. + + * lisp/dgnushack.el (dgnushack-compile): Refer to the constant + `dgnushack-exported-files'. + (dgnushack-exported-files): New function. + (dgnushack-exported-files): New constant. + (dgnushack-unexported-files): Add some files. + (dgnushack-tool-files): Remove, merge it into + `dgnushack-unexported-files'. + + * lisp/base64.el: New file -- base64 encoding functions using MEL. + +2000-11-05 Tetsuo Tsukamoto + + * lisp/smiley.el (smiley-deformed-regexp-alist): Modify regexp for + the winking face. + +2000-11-02 Katsumi Yamaoka + + * lisp/dgnushack.el (dgnushack-make-manifest): Fix info directory. + +2000-11-02 Katsumi Yamaoka + + * Makefile.in (install-package-ja): Compile and install lisp files + first. + (install-package): Ditto. + (compose-package, install-package-info-ja, install-package-info, + install-package-lick): New sub targets. + + * lisp/Makefile.in (install-package-info-ja, install-package-info, + install-package-lick): New targets. + (compose-package): Rename from `package'. + (install-package): Remove. + + * lisp/dgnushack.el (dgnushack-install-package-info-ja, + dgnushack-install-package-info, dgnushack-install-package-lick, + dgnushack-install-package-pkginfo, + dgnushack-install-package-info-files, dgnushack-make-manifest, + dgnushack-gnus-product-name, dgnushack-examine-package-dir, + dgnushack-make-autoloads): New functions. + (dgnushack-install-package): Remove. + (dgnushack-compose-package): Rename from `dgnushack-make-package'. + (dgnushack-info-file-regexp-ja, dgnushack-info-file-regexp-en): + Split from `dgnushack-info-file-regexp'. + (dgnushack-texi-file-regexp): Remove. + +2000-11-01 Katsumi Yamaoka + + * lisp/dgnushack.el (dgnushack-texi-format): Remove @ignore'd areas + before processing. + +2000-11-01 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 06. + + * lisp/gnus.el (gnus-product-variable-file-list): Check for + `emacs-version' in the file "cache" as well. + * lisp/gnus-start.el (gnus-product-read-variable-file-1): Make it + talkative. + +2000-10-31 Katsumi Yamaoka + + * lisp/dgnushack.el: Bind `:key-type' and `:value-type' for old + Emacsen. + +2000-10-31 TAKAHASHI Kaoru + + * lisp/ptexinfmt.el (texinfo-format-direntry): Fixed broken + direntry generate probrem. + (Advised by Tetsuo Tsukamoto ) + +2000-10-31 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-summary-insert-line): Work with quoted + double-quote characters. + (gnus-summary-prepare-threads): Ditto. + +2000-10-30 TAKAHASHI Kaoru + + * lisp/ptexinfmt.el (ptexinfmt-disable-broken-notice-flag): Renamed + from `ptexinfmt-disable-broken-notice'. + +2000-10-27 TAKAHASHI Kaoru + + * lisp/ptexinfmt.el (texinfo-format-printindex): Mule for Windows + detection fixed. + +2000-10-26 Katsumi Yamaoka + + * lisp/gnus.el (gnus-group-startup-message): Rewrite for Emacs 21. + * lisp/lpath.el: Fbind `propertize'. + +2000-10-22 Katsuhiro Hermit Endo + + * texi/gnus-ja.texi (Changing Servers): Fix typo. + +2000-10-19 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-netbsd-get-headers): Fix regular + expression to extract xover urls. + +2000-10-12 Jesper Harder + + * make.bat: Makes it possible to generate the Info files on + windows again. + +2000-10-11 Katsumi Yamaoka + + * Makefile.in (info-ja, xinfo-ja): No need to use `MAKEINFO=no'. + (install-info-ja, install-info, install-lisp, install-ja): New + targets (possibly for FSF Emacsen). + + * texi/Makefile.in (install-ja-info, install-info, install-ja, + %-ja.info, %-ja): New targets. + + * texi/message-ja.texi (direntry): Replace "message" with + "message-ja". + +2000-10-08 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-type-definition): Fix regular + expression to extract article body from `ZDNet'. + +2000-10-06 Katsumi Yamaoka + + * lisp/imap.el: Require `base64' instead of to autoload it. + +2000-10-05 Katsumi Yamaoka + + * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Don't use + `gnus-point-at-eol'. + * lisp/gnus.el (gnus-group-startup-message): Ditto. + + * lisp/gnus-ems.el (gnus-ems-redefine): Revive annulling of + `gnus-summary-set-display-table'. + +2000-10-04 Akihiro Arisawa + + * lisp/gnus-sum.el (gnus-build-sparse-threads): Use + `make-full-mail-header-from-decoded-header' instead of + `make-full-mail-header'. + +2000-10-03 Katsumi Yamaoka + + * lisp/gnus-group.el (gnus-group-get-new-news): Update modeline + using `gnus-agent-toggle-plugged' if agent is activated. + * lisp/gnus-agent.el (gnus-group-get-new-news): Don't advise it, + merge it into gnus-group.el instead. + + * lisp/gnus-offline.el (gnus-offline-after-jobs-done): Use `ding' + with `play-sound-file' for XEmacs statically. + + * lisp/gnus-art.el (gnus-article-add-button): Quote + `:button-keymap' for Mule 2.3 but it won't work. + +2000-09-29 Katsumi Yamaoka + + * lisp/message.el (message-ignored-supersedes-headers): Synch with + Gnus. + +2000-09-27 TAKAHASHI Kaoru + + * list/ptexinfmt.el (texinfo-multitable-widths): Fix + broken-facility probrem when use multitable unsupported + texinfmt.el. + +2000-09-26 TAKAHASHI Kaoru + + * lisp/ptexinfmt.el (texinfo-format-printindex): Use (featurep + 'meadow) instead of `texinfmt-version'. + +2000-09-25 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 05. + + * texi/gnus-faq-ja.texi, lisp/gnus.el, README.semi.ja, README.semi, + README: Replace "" with + "". + +2000-09-22 TAKAHASHI Kaoru + + * lisp/ptexinfmt.el (texinfo-format-printindex): Add + broken-facility check, for Mule for Windows. + (texinfo-format-printindex): New function. + +2000-09-19 Katsumi Yamaoka + + * lisp/gnus-msg.el (gnus-copy-article-buffer): Encode bitmap + smileys to ordinary text before removing any text properties. It + is synchronized with the latest smiley-mule.el. + +2000-09-19 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-type-definition): Follow URL change + of `ZDNet'. + +2000-09-15 Daiki Ueno + + * lisp/gnus-art.el: Always require `wid-edit'. + +2000-09-14 Katsumi Yamaoka + + * lisp/dgnushack.el (dgnushack-compile): Don't compile gnus-ml.el + when FSFmacs is running. + + * lisp/gnus-ml.el: Bind some undeclared variables. + + * lisp/gnus-art.el (gnus-article-add-button): Add widget button. + (gnus-article-display-mime-message): Don't set + `mime-button-mother-dispatcher'. + + * lisp/message.el: Require `reporter' for the function + `define-mail-user-agent' when Mule 2.3 is running. + +2000-09-07 Tadashi Watanabe + + * lisp/smiley.el (smiley-buffer, smiley-create-glyph): Work with + GTK XEmacs as well. + +2000-09-06 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-header-xref): New function. + (nnshimbun-insert-header): Use `nnshimbun-header-xref', instead of + `mail-header-xref'. + (nnshimbun-make-mhonarc-contents): Took a measure against + unexpected TAB characters. + +2000-09-05 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el: Add `netbsd' support. + (nnshimbun-nov-fix-header): Change a form storing Message-Id. + (nnshimbun-search-id): Ditto. + (nnshimbun-make-mhonarc-contents): Use optional header + information. + +2000-09-05 Daiki Ueno + + * lisp/pop3.el (pop3-quit): Don't clear `pop3-uidl-obarray'. + (pop3-save-uidls): Clear `pop3-uidl-obarray' here. + +2000-09-04 Daiki Ueno + + * lisp/mail-source.el (pop3-leave-mail-on-server): Declare. + (mail-source-keyword-map): New keyword `:leave' for pop. + (mail-source-fetch-pop): Refer it. + + * lisp/pop3.el (pop3-ssl-program-name): New variable. + +2000-08-31 TAKAHASHI Kaoru + + * lisp/ptexinfmt.el (texinfo-multitable-widths, + texinfo-multitable-item): Apply char-width probrem fix patch + (by KOIE Hidetaka ). + Newsgroups: fj.editor.emacs + Message-ID: <5dzom3nxq7.fsf@skipjack.koie.org> + + * lisp/ptexinfmt.el (ptexinfmt-disable-broken-notice): New + variable. + +2000-08-29 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-zdnet-get-headers): Follow changes + of ZDNet. + +2000-08-25 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. + +2000-08-25 Yagi Tatsuya + Katsumi Yamaoka + + * lisp/nntp.el (nntp-list-options, nntp-options-subscribe, + nntp-options-not-subscribe): New server variables. + (nntp-request-list): Use them. + * texi/gnus.texi, texi/gnus-ja.texi: Update for them. + +2000-08-23 Katsumi Yamaoka + + * lisp/gnus.el (gnus-group-startup-message): Use `image-size' to + simplify the program. + + * lisp/gnus-group.el (gnus-group-rename-group): Inhibit renaming of + zombie or killed groups. + +2000-08-21 Katsumi Yamaoka + + * lisp/nnheader.el (nnheader-replace-chars-in-string): Use + `static-if'. + * lisp/message.el (message-replace-chars-in-string): Ditto. + +2000-08-19 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-type-definition): Follow changes of + ZDNet. + (nnshimbun-make-text-or-html-contents): Ditto. + (nnshimbun-make-html-contents): Ditto. + +2000-08-18 TSUCHIYA Masatoshi + Akihiro Arisawa + + * lisp/nnshimbun.el: Add `mew' and `xemacs' support. + +2000-08-17 Katsumi Yamaoka + + * lisp/dgnushack.el (dgnushack-texi-format): Require `ptexinfmt' + instead of `texinfmt'. + (dgnushack-install-package): Don't install ptexinfmt.el. + (dgnushack-make-package): Don't include ptexinfmt.el in MANIFEST. + (dgnushack-compile): Don't compile dgnushack.el nor ptexinfmt.el. + (dgnushack-unexported-files, dgnushack-tool-files): New constants. + + * lisp/Makefile.in (install-package): No need to remove + dgnushack.elc. + (install): Don't install ptexinfmt.el; no need to remove + dgnushack.elc. + + * lisp/ptexinfmt.el: New file imported from Wanderlust. + +2000-08-09 Katsumi Yamaoka + + * lisp/nntp.el (nntp-open-telnet): Wait for the telnet prompt + before sending a command; allow the rtelnet prompt as well. + + * lisp/message.el (message-make-forward-subject): Remove garbage + line. + +2000-08-01 Katsumi Yamaoka + + * configure: Regenerate. + * aclocal.m4 (AC_CHECK_EMACS): Unset `EMACS' environment variable + if it is `t'. + +2000-07-24 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. + + * configure: Regenerate with autoconf v2.14.1. + + * configure.in: Rewrite for using new macros in aclocal.m4. + + * aclocal.m4: (AC_ADD_LOAD_PATH, AC_PATH_PACKAGEDIR, + AC_CHECK_EMACS, AC_DEFINE_GNUS_PRODUCT_NAME): New macros. + (AC_PATH_LISPDIR): Set `lispdir' to ".../site-lisp/t-gnus" by + default. + (AC_CHECK_EMACS_FLAVOR): Rename from `AC_XEMACS_P'; check for + `MULE' as well. + (AM_PATH_LISPDIR): Remove. + + * acinclude.m4: Remove. + + * lisp/dgnushack.el: Don't add "/usr/share/emacs/site-lisp" to + `load-path'. + + * lisp/gnus-ems.el (gnus-ems-redefine): Defalias + `gnus-summary-set-display-table' to `(lambda ())' instead of + `ignore' (don't synch. with Gnus). + +2000-07-21 Daiki Ueno + + * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Use + mime-entity-fetch-field instead of mail-header-from. + +2000-07-18 Daiki Ueno + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. + + * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Don't refer + gnus-original-article-buffer. + (gnus-bbdb-insinuate): Set gnus-article-display-hook instead of + gnus-article-prepare-hook. + (gnus-bbdb/extract-field-value): Use mime-entity-fetch-field + instead of mail-fetch-field. + (gnus-bbdb/extract-field-value-init): Just return extractor. + +2000-07-15 Daiki Ueno + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. + + * README-gnus-bbdb.{ja|en}: Add example setting about + gnus-bbdb-insinuate-message. + (bbdb-auto-notes-hook): Don't use pop. + + * lisp/gnus-bbdb.el: Check defvaralias when compiling. + + * lisp/gnus-art.el (gnus-article-setup-buffer): Set + gnus-original-article-buffer as unibyte. + (gnus-request-article-this-buffer): Ditto. + + * lisp/nnimap.el (nnimap-callback): Don't use nnimap-demule. + (nnimap-request-article-part): Ditto. + + * lisp/imap.el (imap-open): Set process buffer as unibyte. + +2000-07-13 10:09:52 Katsumi Yamaoka + + * acinclude.m4 (AC_CHECK_W3): Fix typo. + +2000-07-13 Katsumi Yamaoka + + * configure: Regenerate with autoconf v2.14.1. + * aclocal.m4: Regenerate with aclocal v1.4. + + * configure.in: Don't call `AC_CHECK_PROG' for `EMACS'. + + * acinclude.m4: Merge ShengHuo's changes. + (AC_CHECK_W3): Use `quote' instead of '. + (AC_XEMACS_P): Don't modify the value of `XEMACS'. + (AC_EMACS_LISP): Safely quote the elisp form. + +2000-07-12 15:47:06 ShengHuo ZHU + + * aclocal.m4: Stolen macros from w3. + * configure.in: Use them. + * configure: Generate it. + +2000-07-03 Katsumi Yamaoka + + * lisp/gnus-vers.el (T-gnus): Update to 6.14.5. + (gnus-revision-number): Clear to 00. + + * README.T-gnus: Update. + + * lisp/{webmail.el,rfc2047.el,qp.el,pop3.el,nnwarchive.el, + nnsoup.el,nnslashdot.el,nnml.el,nnmh.el,nnmbox.el,nnmail.el, + nnimap.el,nnheader.el,nnfolder.el,nndraft.el,nndoc.el,mml.el, + mm-view.el,mm-uu.el,mm-util.el,mm-decode.el,mm-bodies.el, + message.el,mail-source.el,lpath.el,imap.el,gnus.el,gnus-uu.el, + gnus-util.el,gnus-topic.el,gnus-sum.el,gnus-start.el,gnus-srvr.el, + gnus-soup.el,gnus-score.el,gnus-msg.el,gnus-mailcap.el, + gnus-group.el,gnus-ems.el,gnus-demon.el,gnus-cus.el,gnus-art.el, + gnus-agent.el,ChangeLog}: Sync up with Gnus v5.8.7. + + * texi/{message.texi,gnus.texi,gnus-ja.texi,ChangeLog}: Sync up + with Gnus v5.8.7. + + * contrib/rfc2015.el: New file. + +2000-06-27 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. + + * lisp/gnus-sum.el (gnus-mime-extract-message/rfc822): Use + `mime-insert-entity-content' instead of obsolete functions. + +2000-06-13 Hirokazu FUKUI + + * lisp/gnus-bbdb.el(gnus-bbdb/update-record): Fix to fetch last + mail field. + +2000-06-09 Katsumi Yamaoka + + * lisp/gnus.el (gnus-news-group-p): Sync with Gnus. + (gnus-select-method): Remove "*" from doc string. + (gnus-group-startup-message): Use `dino' colors. + +2000-06-08 Katsumi Yamaoka + + * lisp/message.el (message-fix-before-sending): Expose all + invisible text with the property `message-invisible'; don't expose + invisible X-Face fields; widen at first. + (message-invisible-region): New function, substitute for + `invisible-region'. + (message-send): Call `message-fix-before-sending' after evaluating + `message-send-hook'. + (message-check-ignore-invisible-x-face-field): Remove. You can use + (add-hook 'message-send-hook 'x-face-xmas-remove-x-face-glyph) + instead. + +2000-06-06 Katsumi Yamaoka + + * lisp/message.el (message-save-drafts): Rewrite. + + * lisp/nnheader.el (nnheader-text-coding-system-for-write, + nnheader-text-coding-system): New variables, substitutes for + `mm-text-coding-system-for-write' or `mm-text-coding-system'. + + * lisp/nnmbox.el (nnmbox-active-file-coding-system, + nnmbox-file-coding-system): Use `nnheader-text-coding-system'. + * lisp/nnmail.el (nnmail-incoming-coding-system): Ditto. + * lisp/nnfolder.el (nnfolder-file-coding-system): Ditto. + (nnfolder-active-file-coding-system): Ditto. + + * lisp/mail-source.el (mail-source-text-coding-system): Remove. + (TopLevel): require `nnheader'. + + * lisp/nndraft.el (nndraft-request-article): Bind coding system to + `nnheader-text-coding-system'. + (nndraft-request-replace-article): Ditto. + * lisp/mail-source.el (mail-source-fetch-maildir): Ditto. + * lisp/gnus-uu.el (gnus-uu-save-article): Ditto. + * lisp/gnus-util.el (gnus-output-to-mail, gnus-output-to-rmail): + Ditto. + * lisp/gnus-soup.el (gnus-soup-write-prefixes): Ditto. + + * lisp/gnus-util.el (gnus-write-buffer): Bind + `file-name-coding-system' to `nnmail-pathname-coding-system'. + * lisp/gnus-start.el (gnus-slave-save-newsrc): Bind coding system + to `gnus-startup-file-coding-system'. + +2000-06-06 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. + + * lisp/message.el (message-fix-before-sending): Don't check for + invisible X-Face fields if + `message-check-ignore-invisible-x-face-field' is non-nil. + (message-send): Call `message-fix-before-sending' before encoding. + (message-check-ignore-invisible-x-face-field): New user option. + +2000-06-01 KANEMATSU Daiji + + * texi/gnus-ja.texi (gnus-summary-hide-all-threads): Fix typo. + +2000-05-28 TSUCHIYA Masatoshi + + * nnshimbun.el (nnshimbun-request-article-1): Fix to insert x-face + unless SERVER. + (nnshimbun-asahi-get-headers): Fix for subjects which contain ^M. + +2000-05-26 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-write-nov): New function. + (nnshimbun-close-group): Call nnshimbun-write-nov. + (nnshimbun-generate-nov-database): Ditto. + (nnshimbun-generate-nov-for-each-group): Fix bug which occur new + entries add NOV database. + (nnshimbun-generate-nov-for-all-groups): Ditto. + (nnshimbun-search-id): Add argument to return header, and modify + for search of original message id. + (nnshimbun-nov-fix-header): New function. + (nnshimbun-make-date-string): Fix for a two-digit year. + +2000-05-26 Katsumi Yamaoka + + * lisp/nnshimbun.el (nnshimbun-make-html-contents): Show X-Face. + (nnshimbun-make-text-or-html-contents): Ditto. + (nnshimbun-request-article-1): Ditto. + (nnshimbun-x-face-alist): New variable. + +2000-05-25 Tanaka Akira + + * README.semi, README.semi.ja: Update for CVS via SSH. + +2000-05-25 Katsumi Yamaoka + + * texi/gnus-ja.texi: Change coding-system to `iso-2022-7bit-ss2'. + * texi/TRANSLATION.ja: Replace CRLF with LF. + +2000-05-25 Keiichi Suzuki + + * lisp/nnshimbun.el (nnshimbun-fill-line): Use + `nnshimbun-fill-column' instead of `fill-column'. + +2000-05-25 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el: Clean up codes. + + * lisp/gnus-group.el (gnus-group-make-shimbun-group): Follow + changes in nnshimbun.el. + * texi/gnus-ja.texi (nnshimbun): Ditto. + +2000-05-24 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el: Add `ZDNet Japan', `Yomiuri', and `Wired + News' support. + (nnshimbun-regexp-opt): New function. + (nnshimbun-wired-get-all-headers): Replace regexp-opt with + nnshimbun-regexp-opt. + +2000-05-24 Katsumi Yamaoka + + * lisp/gnus-group.el (gnus-group-make-shimbun-group): Complete + completions. + +2000-05-24 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el: Add `CNET Japan' support. + (nnshimbun-make-date-string): New function. + (nnshimbun-asahi-get-headers): Use nnshimbun-make-date-string. + (nnshimbun-sponichi-get-headers): Ditto. + +2000-05-24 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-retrieve-url): Add argument to + ignore w3's cache. + +2000-05-24 Katsumi Yamaoka + + * lisp/gnus-group.el (gnus-group-make-shimbun-group): Add + completion to the shimbun address; delete empty strings from + `gnus-group-shimbun-type-history' and + `gnus-group-shimbun-address-history'. + + * lisp/nnshimbun.el (nnshimbun-asahi-get-headers): Don't use + `timezone'. + (nnshimbun-type-definition): Add address. + +2000-05-23 Tatsuya Ichikawa + + * lisp/nnshimbun.el: Add `sponichi' support. + +2000-05-23 KOSEKI Yoshinori + + * lisp/nnshimbun.el (nnshimbun-mime-encode-string): Fix wrong + close brackets. + +2000-05-23 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el: Change coding-system. + +2000-05-21 TSUCHIYA Masatoshi + + * texi/gnus-ja.texi (nnshimbun): Add description. + +2000-05-21 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. + + * lisp/dgnushack.el (dgnushack-texi-format): Fix last change. + +2000-05-21 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el: New backend. + + * lisp/gnus-group.el (gnus-group-make-shimbun-group): New command. + +2000-05-17 Kenichi OKADA + + * lisp/imap.el (imap-digest-md5-auth): Rewrite for the use of + `sasl-digest-md5-digest-response' instead of + `digest-md5-digest-response'. + (TopLevel): Require `sasl' when compiling instead of `digest-md5'; + don't autoload "digest-md5". + +2000-05-17 Katsumi Yamaoka + + * lisp/nndraft.el (nndraft-request-replace-article): Replace + `mm-text-coding-system' with `mail-source-text-coding-system'; + Replace `mm-auto-save-coding-system' with + `message-draft-coding-system'. + + * lisp/mail-source.el (mail-source-fetch-maildir): Replace + `mm-text-coding-system' with `mail-source-text-coding-system'. + (mail-source-text-coding-system): New variable. + + * lisp/dgnushack.el (dgnushack-texi-format): Use + `output-coding-system' instead of `coding-system-for-write' when + old Mule is used. + +2000-05-16 Katsumi Yamaoka + + * lisp/message.el (message-forward) Replace the use of `eolp' with + `bolp' for detecting the start of the line. + (message-indent-citation): Ditto. + +2000-05-10 Daiki Ueno + + * lisp/gnus-bbdb.el (gnus-bbdb/pop-up-bbdb-buffer): Don't bind + `bbdb-use-pop-up' while executing `bbdb-pop-up-bbdb-buffer'. + +2000-05-10 Katsumi Yamaoka + + * lisp/gnus-msg.el (gnus-debug): Break MIME tags from the snoopies. + (gnus-bug): Insert text/plain tag at the end of the buffer. + +2000-05-10 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. + +2000-05-10 Keiichi Suzuki + + * lisp/message.el (message-list-references): Do not insert + duplicate Message-Id, when specified + `message-list-references-add-position'. + + * lisp/gnus-bbdb.el (gnus-bbdb/split-mail): Support group address. + (gnus-bbdb/insert-address-regexp): New function. + +2000-05-09 Katsumi Yamaoka + + * lisp/gnus-msg.el (gnus-debug): Add "nntp.el" and `defvoo'. + +2000-05-08 Katsumi Yamaoka + + * lisp/gnus-vers.el (T-gnus): Update to 6.14.4. + + * README.T-gnus: Update. + + * lisp/{webmail.el,rfc2047.el,nnmbox.el,nndoc.el,mml.el,mm-view.el, + mm-partial.el,mm-decode.el,mm-bodies.el,message.el,lpath.el, + gnus.el,gnus-vers.el,gnus-util.el,gnus-start.el,gnus-score.el, + gnus-msg.el,gnus-mailcap.el,gnus-ems.el,gnus-draft.el,gnus-art.el, + ChangeLog}: Sync up with Gnus v5.8.6. + * texi/{postamble.tex,message.texi,message-ja.texi,gnusref.tex, + gnus.texi,gnus-ja.texi,emacs-mime.texi,Makefile.in,ChangeLog}: Sync + up with Gnus v5.8.6. + +2000-04-28 Katsumi Yamaoka + + * texi/gnus.texi, texi/gnus-ja.texi, texi/gnus-faq-ja.texi, README: + You might be able to use T-gnus with the versions of XEmacs prior + to 21.1.1. + + * contrib/timer.el: New file. Imported from fsf-compat-1.07-pkg. + +2000-04-27 Katsumi Yamaoka + + * lisp/mm-view.el (gnus-article-mime-handles): Don't bind it. + + * lisp/gnus-sum.el (gnus-article-mime-handles): Restore from Gnus. + (gnus-article-decoded-p): Ditto. + + * lisp/gnus-art.el (gnus-article-mime-handles): Don't bind it. + (gnus-article-decoded-p): Ditto. + +2000-04-25 NAKAJI Hiroyuki + + * lisp/dgnushack.el: Add code to avoid mule-2.3@19.34 failing to + make info from texi. Thanks to Hayashi-san. + +2000-04-25 Katsumi Yamaoka + + * lisp/dgnushack.el (union, member-if, mapcon, last): Remove + compiler macros. + +2000-04-24 Katsumi Yamaoka + + * lisp/gnus-vers.el (T-gnus): Update to 6.14.3. + + * README.T-gnus: Update. + + * GNUS-NEWS: Sync up with Gnus v5.8.5. + * lisp/{webmail.el,utf7.el,time-date.el,smiley.el,rfc2047.el, + rfc1843.el,qp.el,pop3.el,parse-time.el,nnweb.el,nnwarchive.el, + nnvirtual.el,nnultimate.el,nntp.el,nnspool.el,nnslashdot.el, + nnml.el,nnmail.el,nnimap.el,nnheader.el,nnfolder.el,nndraft.el, + nndoc.el,nnagent.el,mml.el,mm-view.el,mm-uu.el,mm-util.el, + mm-encode.el,mm-decode.el,mm-bodies.el,message.el,mail-source.el, + mail-prsvr.el,mail-parse.el,lpath.el,imap.el,ietf-drums.el,gnus.el, + gnus-xmas.el,gnus-win.el,gnus-uu.el,gnus-util.el,gnus-topic.el, + gnus-sum.el,gnus-start.el,gnus-srvr.el,gnus-spec.el,gnus-score.el, + gnus-msg.el,gnus-move.el,gnus-mlspl.el,gnus-mh.el,gnus-mailcap.el, + gnus-logic.el,gnus-kill.el,gnus-int.el,gnus-group.el,gnus-ems.el, + gnus-eform.el,gnus-dup.el,gnus-draft.el,gnus-cite.el,gnus-cache.el, + gnus-bcklg.el,gnus-async.el,gnus-art.el,gnus-agent.el, + format-spec.el,flow-fill.el,fill-flowed.el,dgnushack.el,ChangeLog}: + Sync up with Gnus v5.8.5. + * texi/{refcard.tex,gnusref.tex,gnus.texi,gnus-ja.texi, + gnus-faq-ja.texi,Makefile.in,ChangeLog}: Sync up with Gnus v5.8.5. + + * README: Requires XEmacs 21.1.1 and later. + * texi/{gnus.texi, gnus-faq-ja.texi}: Ditto. + +2000-04-20 Katsumi Yamaoka + + * lisp/gnus-vers.el (T-gnus): Update to 6.14.2. + (gnus-revision-number): Clear to 00. + + * README.T-gnus: Update. + + * lisp/{webmail.el,utf7.el,time-date.el,rfc2047.el,qp.el,pop3.el, + parse-time.el,nnweb.el,nnwarchive.el,nnultimate.el,nntp.el, + nnslashdot.el,nnml.el,nnmail.el,nnimap.el,nnheader.el,nnfolder.el, + mm-view.el,mm-util.el,mm-decode.el,mm-bodies.el,message.el, + mail-source.el,mail-parse.el,lpath.el,imap.el,ietf-drums.el, + gnus.el,gnus-win.el,gnus-vers.el,gnus-uu.el,gnus-topic.el, + gnus-sum.el,gnus-start.el,gnus-srvr.el,gnus-mailcap.el, + gnus-group.el,gnus-cus.el,gnus-art.el,gnus-agent.el,base64.el, + ChangeLog}: Sync up with Gnus v5.8.4. + + * lisp/fill-flowed.el: New file. + + * texi/{gnus.texi,gnus-ja.texi,ChangeLog}: Sync up with Gnus v5.8.4. + + * contrib/{vcard.el,one-line-cookie.diff,README}: New files. + +2000-04-14 Katsumi Yamaoka + + * lisp/gnus-msg.el (gnus-summary-yank-message): Rewrite for the use + of the separated message frames; use `gnus-copy-article-buffer'. + +2000-04-13 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 18. + (gnus-extended-version): Use `gnus-product-name' and + `gnus-version-number' instead of the use of `product-string'. + (gnus-version-number): Exclude `gnus-revision-number'. + (Defining product): Include `gnus-revision-number'. + (TopLevel): Require `poe' for the function `butlast'. + +2000-04-13 Keiichi Suzuki + + * lisp/gnus-spec.el (gnus-update-format): Fix a bug in last + modification. + (gnus-search-or-regist-spec): Change interface. + +2000-04-12 Katsumi Yamaoka + + * lisp/gnus-art.el (gnus-article-prev-page): Bind + `window-pixel-scroll-increment' to nil while scrolling for + canceling a backlash and a modeline erosion. It may work under + XEmacs 21.2.20 and later. + (gnus-article-next-page): Ditto. + +2000-04-12 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 17. + + * lisp/gnus-spec.el (gnus-format-specs-compiled): Fix doc string. + +2000-04-11 Keiichi Suzuki + + * lisp/gnus-start.el (gnus-product-variable-touch): Support multiple + arguments. + + * lisp/gnus-spec.el (gnus-search-or-regist-spec): New utility macro. + (gnus-update-format-specifications): Support new data structure of + `gnus-format-specs-compiled'. + (gnus-update-format-specification-1): Likewise. + (gnus-update-format): Support new data structure of + `gnus-format-specs'. + (gnus-format-specs): Modify data structure. + +2000-04-10 Daiki Ueno + + * lisp/imap.el (imap-body-lines): Check Content-Type: of the + article case insensitively. + +2000-04-07 Katsumi Yamaoka + + * lisp/message.el (message-cite-original): Use "unknown sender" if + from field does not exist in the yanked article. + +2000-04-06 Katsumi Yamaoka + + * lisp/message.el (message-cite-original): Extract from field for + the simple citation line. + +2000-03-21 Katsumi Yamaoka + + * lisp/nnimap.el (nnimap-request-article-part): Returns nil if the + article does not exist. + +2000-03-17 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 16. + + * lisp/nnweb.el (nnweb-fetch-url): Bind `input-coding-system' and + `output-coding-system' for Mule 2.3. + * lisp/mail-source.el (mail-source-fetch-imap): Ditto. + * lisp/imap.el (imap-ssl-open): Ditto. + * lisp/gnus-start.el (gnus-product-read-variable-file-1): Ditto. + +2000-03-17 Katsumi Yamaoka + + * lisp/gnus-start.el (gnus-re-read-newsrc-el-file): New function. + (gnus-read-newsrc-el-file): If it fails, attempt to re-read the + file using `gnus-re-read-newsrc-el-file'. In that case, the + compiled format specs in the file which may be created by the other + Gnusae should be ignored. + +2000-03-16 Katsumi Yamaoka + + * lisp/gnus.el (gnus-product-variable-file-list): Use `*ctext*' + when Mule 2.3 is running. + +2000-03-16 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 15. + + * lisp/gnus.el (gnus-continuum-version): Remove. + (gnus-product-variable-file-list): Use `product-version' instead of + the constant values. + (TopLevel): Don't autoload "gnus-msg" for the function + `gnus-extended-version'. + (gnus-version): Move to gnus-vers.el. + (gnus-version): Ditto. + (gnus-version-number): Ditto. + (gnus-product-name): Ditto. + (gnus-original-product-name): Ditto. + (running-pterodactyl-gnus-0_73-or-later): Ditto. + (gnus-original-version-number): Ditto. + (gnus-revision-number): Ditto. + + * lisp/gnus-vers.el (gnus-extended-version): Move from gnus-msg.el. + (gnus-version): Move from gnus.el. + (gnus-version): Ditto. + (gnus-version-number): Ditto. + (gnus-product-name): Ditto. + (gnus-original-product-name): Ditto. + (running-pterodactyl-gnus-0_73-or-later): Ditto. + (gnus-original-version-number): Ditto. + (gnus-revision-number): Ditto. + + * lisp/gnus-start.el (gnus-product-quick-file-format): Use + `gnus-vers' instead of `gnus' for the product. + (gnus-product-save-variable-file-1): Message an absolute file name; + use `save-buffer-as-coding-system'; use `gnus-vers' instead of + `gnus' for the product. + (gnus-convert-old-ticks): Remove. + (gnus-convert-old-newsrc): Remove. + (gnus-read-newsrc-file): Don't call `gnus-read-newsrc-file'. + + * lisp/gnus-spec.el (gnus-compile): Modify for the new form of + `gnus-format-specs-compiled'. + (gnus-update-format-specifications): Specify the arg `format' for + `gnus-update-format-specification-1'. + (gnus-update-format-specification-1): Modify for the new form of + `gnus-format-specs-compiled'; add a new arg `format'. + (gnus-format-specs-compiled): Allow the plural compiled functions + for each element. + + * lisp/gnus-msg.el (gnus-extended-version): Move to gnus-vers.el. + +2000-03-14 Keiichi Suzuki + + NOTE: It requires `product' in APEL 10.0 or later. + Will be created ``~/News/.T-gnus/'' directory automatically by + default. You can customize location by `gnus-product-directory'. + ``cache'' and ``strict-cache'' files will be created under the + directory. + + * lisp/gnus.el (TopLevel): Require `gnus-vers'. + (gnus-product-name): Abolished. + (gnus-version-number): Ditto. + (gnus-version): Use `product-string'. (Format changed) + (gnus-variable-list): Delete `gnus-format-specs'. + (gnus-product-variable-file-list): New variable. + (TopLevel): Use `product-provide'. + + * lisp/gnus-vers.el: New file. + + * lisp/gnus-start.el (gnus-product-directory): New user option. + (gnus-clear-quick-file-variables): New function. + (gnus-clear-system): Use `gnus-clear-quick-file-variables'. + (gnus-read-newsrc-file): Likewise. + (gnus-read-newsrc-el-file): Read product's variable files. + (gnus-product-read-variable-file-1): New function. + (gnus-save-newsrc-file): Save product's variable files. + (gnus-product-variable-touch): New function. + (gnus-product-variables-dirty-p): Ditto. + (gnus-product-save-variable-file): Ditto. + (gnus-product-save-variable-file-1): Ditto. + (gnus-product-quick-file-format): Ditto. + + * lisp/gnus-spec.el (gnus-update-format): Use + `gnus-product-variable-touch'. + (gnus-update-format-specification-1): Likewise. + (gnus-update-format-specifications): Do not check `emacs-version' + and `gnus-newsrc-file-version'. Use + `gnus-product-variable-touch'. + + * lisp/gnus-msg.el (gnus-inews-add-send-actions): Use + `product-string'. + +2000-03-09 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 14. + (gnus-compile-user-specs): New user option. + + * texi/gnus.texi: Update. + * texi/gnus-ja.texi: Update. + + * lisp/gnus-start.el (gnus-setup-news): Revert. + (gnus-setup-news-hook): Revert. + + * lisp/gnus-spec.el (gnus-compile): Modify the actual format specs + as well; don't bind `gnus-tmp-func'. + (gnus-update-format-specifications): Revert; use + `gnus-update-format-specification-1'. + (gnus-update-format-specification-1): New function. + (gnus-format-specs-compiled): Modify the form. + (TopLevel): Require `alist'. + +2000-03-09 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 13. + + * texi/gnus.texi: Update. + * texi/gnus-ja.texi: Update. + + * lisp/gnus-start.el (gnus-setup-news): Update all format specs + just before `gnus-setup-news-hook' is evaluated. + (gnus-setup-news-hook): Default to `gnus-compile'. + + * lisp/gnus-spec.el (gnus-compile): Don't modify the value of + `gnus-format-specs', generate compiled specs in + `gnus-format-specs-compiled' instead; don't touch the dribble + buffer. + (gnus-update-format-specifications): Bind `gnus-format-specs' to + `gnus-format-specs-compiled' if the latter is non-nil; use + `gnus-update-format-specifications-1'. + (gnus-update-format-specifications-1): Rename from + `gnus-update-format-specifications'; update the value of + `gnus-newsrc-file-version' if the updating is forced. + (gnus-format-specs-compiled): New internal variable. + +2000-03-05 Keiichi Suzuki + + * lisp/gnus-spec.el (gnus-update-format-specifications): Force + update format specifications, when differ `gnus-version' and + `gnus-newsrc-file-version' instead of `gnus-version' and + `gnus-version' in `gnus-format-specs'. + Do not add `gnus-version' into `gnus-format-specs'. + +2000-03-04 Daiki Ueno + + * lisp/gnus-spec.el (gnus-compile): Remove gnus-version entry + from gnus-format-specs. + +2000-02-21 Yoshiki Hayashi + + * nnvirtual.el (nnvirtual-request-article): + Bind gnus-override-method to nil. + (nnvirtual-request-update-mark): Don't update mark when + article is not there. + +2000-03-03 Daiki Ueno + + * lisp/gnus.el (gnus-revision-number): Increment to 12. + + * lisp/gnus-sum.el: Add autoload setting for `pgg-decrypt-region' + and `pgg-verify-region'. + (gnus-summary-decrypt-article): New command. + (gnus-summary-verify-article): New command. + (gnus-summary-article-map): Bind them. + (gnus-wheel-summary-scroll): Fix paren style. + +2000-03-02 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 11. + +2000-03-01 MORIOKA Tomohiko + + * lisp/nnheader.el (nnheader-insert-nov): Use + `mime-entity-fetch-field' instead of `mime-fetch-field'. + + * lisp/gnus-sum.el (gnus-summary-line-format-alist): Use + `mime-entity-read-field' instead of `mime-read-field'. + (gnus-article-sort-by-author): Likewise. + +2000-03-02 Daiki Ueno + + * lisp/nnimap.el (nnimap-request-article-part): Don't use + `imap-capability' to detect BODYDETAIL response. + +2000-03-01 Daiki Ueno + + * lisp/gnus.el (gnus-revision-number): Increment to 10. + + * lisp/nnimap.el + (nnimap-request-article-part): Handle `BODY' fetch response when + the server implements IMAP4 rev1 capabilities. + (nnimap-request-article): Use BODY.PEEK rather than RFC822.PEEK. + this attribute was obsoleted in RFC2060. + (nnimap-request-body): Ditto. + +2000-02-29 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 09. + + * lisp/gnus-ems.el (gnus-tilde-cut-form, gnus-tilde-max-form): Copy + from gnus-xmas.el; share them with XEmacs-MULE. + + * lisp/gnus-xmas.el (gnus-tilde-cut-form, gnus-tilde-max-form): + Move to gnus-ems.el. + +2000-02-20 Daiki Ueno + + * lisp/gnus.el (gnus-revision-number): Increment to 08. + + * lisp/gnus-bbdb.el: Sync up with Nana-gnus 7 for supporting + `gnus-bbdb/split-mail'. + * README-gnus-bbdb.ja: Ditto. + +2000-02-08 Yoshiki Hayashi + + * gnus-art.el (article-display-face): Show folded X-Face. + +2000-02-08 Keiichi Suzuki + + * lisp/gnus.el (gnus-revision-number): Increment to 07. + + * lisp/nnmail.el (nnmail-get-new-mail): Do not check + `nnmail-spool-file'. + +2000-02-06 Daiki Ueno + + * lisp/gnus.el (gnus-revision-number): Increment to 06. + + * lisp/gnus-ofsetup.el: Provide `gnus-ofsetup'. + (gnus-setup-for-offline): Add `starttls' to IMAP streams; add + `digest-md5' to IMAP authenticators. + + * lisp/gnus-offline.el (gnus-group-get-new-news, + gnus-agent-toggle-plugged,gnus-agent-expire, + gnus-agent-mode): Check whether `gnus-ofsetup' is provided before + redefining. + + * lisp/imap.el (imap-stream-alist): Remove redundant entry for TLS. + + * lisp/nnimap.el (nnimap-retrieve-headers-progress): Remove + confusing tabs from original header. + +2000-02-02 Katsumi Yamaoka + + * lisp/pop3.el (pop3-md5): Fset to `md5' if the module `md5' is + installed. + (pop3-apop): Use built-in `md5' if it exists. + +2000-01-27 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 05. + + * lisp/gnus-art.el (gnus-treat-display-smileys): Check for the + module `gnus-bitmap' instead of `smiley-mule'. + + * lisp/gnus-sum.el (gnus-summary-exit): Recenter the group buffer + without redisplaying if the point is out of view. + +2000-01-25 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 04. + +2000-01-24 SANETO Takanori + + * lisp/gnus-spec.el: Call `gnus-ems-redefine'. + + * lisp/pop3.el (pop3-movemail): Don't use `format' for `message'. + * lisp/gnus-offline.el (gnus-offline-toggle-articles-to-fetch): + Ditto. + + * lisp/read-passwd.el (read-pw-read-noecho): Use "%s" for the 1st + arg of `message'. + * lisp/gnus.el (gnus-version): Ditto. + * lisp/gnus-sum.el (gnus-summary-simplify-subject-query): Ditto. + * lisp/gnus-offline.el (gnus-offline-set-interval-time, + gnus-offline-empting-spool, gnus-offline-toggle-on/off-send-mail, + gnus-offline-set-auto-ppp, gnus-offline-after-jobs-done, + gnus-offline-hangup-line, gnus-offline-get-new-news-function, + gnus-offline-connect-server): Ditto. + * lisp/dgnushack.el (dgnushack-make-package): Ditto. + +2000-01-18 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 03. + + * lisp/gnus-sum.el (gnus-summary-exit): Don't recenter the group + buffer if it is called non-interactively. + +2000-01-18 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 02. + + * lisp/gnus-sum.el (gnus-summary-exit): Recenter the group buffer + if the point is out of view. + +2000-01-15 Tsukamoto Tetsuo + + * lisp/gnus-art.el (gnus-article-next-page): Scroll up LINES if + `pos-visible-in-window-p' returns nil. + +2000-01-15 Tsukamoto Tetsuo + + * lisp/gnus-offline.el (gnus-agent-mode): New advice. + +2000-01-12 Hirokazu FUKUI + + * lisp/base64.el: Unbound base64-*-string and base64-*-region + when defined by autoload. + +2000-01-11 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-summary-reselect-current-group): Restore + the original code; hide group contents while rescanning. + +2000-01-07 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-summary-reselect-current-group): Truncate + lines in the imitation buffer; turn off h-scrollbar for XEmacs. + +2000-01-07 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 01. + + * lisp/{rfc2231.el,nnweb.el,nnultimate.el,nntp.el,nnspool.el, + nnslashdot.el,nnml.el,nnmh.el,nnkiboze.el,nnimap.el,gnus-topic.el, + gnus-ofsetup.el,gnus-offline.el,gnus-mlspl.el,gnus-cache.el, + gnus-agent.el}: Require `gnus-clfns' when compiling. + + * lisp/rfc2231.el: Require `cl' when compiling. + + * lisp/gnus-clfns.el: New file. + + * lisp/dgnushack.el: Move compiler macros to gnus-clfns.el; load + gnus-clfns.el. + + * lisp/gnus-sum.el (gnus-summary-reselect-current-group): Don't + rescan the current newsgroup before exiting; wear an imitation + summary buffer while rescanning. + +2000-01-06 Hirokazu FUKUI + + * lisp/dgnushack.el (char-before): Use the byte-optimaization. + +2000-01-05 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.14.1. + (gnus-revision-number): Clear to 00. + + * README.T-gnus: Update. + + * lisp/{webmail.el,uudecode.el,utf7.el,time-date.el,smiley.el, + score-mode.el,rfc2047.el,rfc1843.el,qp.el,pop3.el,parse-time.el, + nnweb.el,nnwarchive.el,nnvirtual.el,nnultimate.el,nntp.el, + nnspool.el,nnsoup.el,nnslashdot.el,nnml.el,nnmh.el,nnmbox.el, + nnmail.el,nnlistserv.el,nnkiboze.el,nnimap.el,nnheader.el, + nnfolder.el,nneething.el,nndraft.el,nndoc.el,nndb.el,nnbabyl.el, + nnagent.el,mml.el,mm-view.el,mm-uu.el,mm-util.el,mm-encode.el, + mm-decode.el,mm-bodies.el,messcompat.el,message.el,md5.el, + mail-source.el,mail-prsvr.el,lpath.el,imap.el,ietf-drums.el, + gnus-xmas.el,gnus-win.el,gnus-vm.el,gnus-uu.el,gnus-util.el, + gnus-undo.el,gnus-topic.el,gnus-sum.el,gnus-start.el,gnus-srvr.el, + gnus-spec.el,gnus-soup.el,gnus-setup.el,gnus-score.el,gnus-salt.el, + gnus-range.el,gnus-picon.el,gnus-nocem.el,gnus-msg.el, + gnus-mlspl.el,gnus-mh.el,gnus-mailcap.el,gnus-logic.el, + gnus-load.el,gnus-kill.el,gnus-group.el,gnus-gl.el,gnus-ems.el, + gnus-draft.el,gnus-demon.el,gnus-cus.el,gnus-cite.el,gnus-cache.el, + gnus-bcklg.el,gnus-audio.el,gnus-async.el,gnus-art.el, + gnus-agent.el,binhex.el,base64.el,ChangeLog}: Sync up with Gnus + v5.8.3. + + * texi/{postamble.tex,message.texi,gnus.texi,gnus-ja.texi, + emacs-mime.texi,ChangeLog}: Sync up with Gnus v5.8.3. + +2000-01-05 Katsumi Yamaoka + + * README.semi, README.semi.ja, texi/gnus-faq-ja.texi: Update for + the new CVS server. + + * lisp/gnus-sum.el (gnus-articles-to-read): Bind + `cursor-in-echo-area' to nil while `read-from-minibuffer'. + +1999-12-30 Tsukamoto Tetsuo + + * lisp/gnus-offline.el (TopLevel): Call + `define-process-argument-editiong' only under Meadow -- i.e. don't + call this function under NTEmacs. + +1999-12-28 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 15. + + * lisp/gnus-offline.el (gnus-offline-auto-expire): Rename from + `gnus-offline-agent-automatic-expire'. + (gnus-agent-expire): Fix the advice. + (gnus-offline-after-jobs-done): Refer to + `gnus-offline-auto-expire'. + + * lisp/gnus-ofsetup.el (gnus-offline-resource-en): Reorder the + messages. + (gnus-offline-resource-ja): Ditto. + + * lisp/imap.el (imap-ssl-open-2): If `system-type' is windows-nt, + bind `coding-system-for-read' to raw-text-dos, else bind it to + binary. + +1999-12-28 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 14. + + * lisp/dgnushack.el (mapcon): Bind the 1st arg `fn' as a temp var. + +1999-12-27 Tsukamoto Tetsuo + + * lisp/pop3.el (pop3-ssl-program-arguments): Add "s_client". + (pop3-open-ssl-stream-1): Bind `ssl-program-name' because its + value depends on the version of ssl.el. + (pop3-open-ssl-stream): If `system-type' is windows-nt, bind + `coding-system-for-read' to raw-text-dos, else bind it to binary. + +1999-12-23 Keiichi Suzuki + + * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Fix timing of + `save-restriction'. + +1999-12-21 Daiki Ueno + + * lisp/imap.el (imap-streams,imap-stream-alist, + imap-authenticators,imap-authenticator-alist, + imap-digest-md5-p): Sync with latest Gnus. + (imap-starttls-p): Rename from `imap-tls-p'. + (imap-starttls-open): Rename from `imap-tls-open'. + +1999-12-21 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 13. + + * lisp/dgnuspath.el.in: Add the path of APEL to `load-path' as well + as its parent directory. + + * lisp/imap.el (base64-encode-string, base64-decode-string): + Autoload "base64" instead of the tricky definitions. + + * lisp/base64.el: Restore the original code and invalidate it; use + mel for the base64 codec. + +1999-12-20 Katsumi Yamaoka + + * lisp/imap.el (mel-find-function): Always require `mel' instead of + the use of autoloading. Because the function `mel-find-function' + is defined by `defsubst'. + +1999-12-18 Tsukamoto Tetsuo + + * lisp/gnus-offline.el (gnus-offline-after-get-new-news): Refer to + `gnus-offline-connected', not `gnus-plugged'. + + * lisp/gnus-ofsetup.el (gnus-setup-for-offline): No need to use + `unless'. Use `when'. + + * lisp/imap.el (base64-encode-string): Fix. May work. + +1999-12-16 Katsumi Yamaoka + + * lisp/message.el (message-goto-mail-copies-to): If the field is + newly created, a string "never" is inserted in default. + (message-goto-mail-followup-to): If the field is newly created and + To field contains only one address, the address is inserted in + default. + (message-mode-map): New key stroke `C-c C-f c' for the command + `message-goto-mail-copies-to'. + +1999-12-15 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 12. + + * lisp/nnimap.el (nnimap-request-newgroups): Use `member-if'. + + * lisp/lpath.el (toolbar-gnus, get-charset-property, + font-lock-set-defaults, find-coding-system, coding-system-get): + Bind them for FSF Emacsen. + (read-color, x-defined-colors, compute-motion): Don't bind. + + * lisp/imap.el (imap-digest-md5-auth, imap-cram-md5-auth): Use + `base64-encode-string' and `base64-decode-string' instead of + `imap-base64-encode-string' or `imap-base64-decode-string'. + (base64-encode-string): New function. It won't be defined if it + is already bound and the optional second arg is allowed. + (base64-decode-string): New function defined by `defun-maybe'. + (imap-base64-encode-string, imap-base64-decode-string): Remove. + (mel-find-function): Autoload "mel". + + * lisp/dgnushack.el (read-color, x-defined-colors, event-object, + get-popup-menu-response, toolbar-gnus, get-charset-property, + find-coding-system, coding-system-get, font-lock-set-defaults): + Don't bind. + (union, member-if, mapcon, mapc, last): Don't define as compiler + macros under XEmacs. It is based on Hrvoje's advice. + (member-if): New compiler macro for emulating cl function. + +1999-12-14 Katsumi Yamaoka + + * lisp/imap.el (imap-base64-encode-string): Use `static-if' instead + of `static-condition-case'. + +1999-12-14 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 11. + + * lisp/imap.el (imap-base64-encode-string): Allow the optional 2nd + arg `no-line-break'. + +1999-12-14 Daiki Ueno + + * lisp/imap.el: Require `digest-md5' when compiling; add autoload + settings for `digest-md5-parse-digest-challenge' and + `digest-md5-digest-response'. + (imap-authenticators): Add `digest-md5'. + (imap-authenticator-alist): Setup for `digest-md5'. + (imap-digest-md5-p): New function. + (imap-digest-md5-auth): New function. + +1999-12-12 Tsukamoto Tetsuo + + * lisp/mail-source.el (mail-source-fetch-imap): Each temporary + buffer name must be specific to its mail source. + +1999-12-11 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 10. + + * lisp/gnus-offline.el (gnus-offline-define-menu-and-key): Don't + call too many `static-if's. + + * lisp/gnus-uu.el (gnus-uu-grab-move): Simply copy FILE if + `make-symbolic-link' is not availabe. + + * lisp/lpath.el (TopLevel): Don't warn about `make-symbolic-link'. + +1999-12-11 Tsukamoto Tetsuo + + * lisp/gnus-offline.el (gnus-offline-set-unplugged-state): Call + the original `gnus-agent-toggle-plugged'. + + * lisp/mail-source.el (mail-source-fetch-imap): Don't create + multiple temporary buffers, and don't kill one. + +1999-12-10 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 09. + + * lisp/gnus-ofsetup.el (gnus-setup-for-offline): Accept an + optional argument `force'. Use `read-file-name' instead of + `read-directory-name'. + +1999-12-10 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-numbser): Increment to 08. + + * lisp/gnus-agent.el (gnus): Give up to advise here. + (gnus-group-get-new-news): New advice instead. + + * lisp/gnus-offline.el (gnus-offline-setup): Call + `gnus-offline-processed-by-timer' and `gnus-offline-error-check' + here. + (gnus-offline-define-menu-and-key): Simplify. + (gnus-offline-processed-by-timer): Call `gnus-group-get-new-news' + interactively. + + * lisp/gnus-ofsetup.el (TopLevel): Require `read-passwd' here, not in + `gnus-offline-setting-file'. + (gnus-nntp-service): Set this variable here, not in + `gnus-offline-setting-file' + (gnus-nntp-server): Ditto. + (gnus-after-getting-new-news-hook): Ditto. + (message-send-hook): Ditto. + (mail-source-read-passwd): Ditto. + (gnus-setup-news-hook): Ditto. + (gnus-setup-for-offline): Now one can get mails from `imap', + `file', `directory' or `maildir'. + + * lisp/read-passwd.el (read-pw-set-mail-source-passwd-cache): + Ignore non-POP mail sources. + +1999-12-10 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 07. + + * lisp/gnus-util.el (gnus-union): Remove. + (gnus-ems-redefine): Don't call it; don't require `gnus-ems'. + + * lisp/gnus-agent.el (gnus-agent-fetch-headers): Use `union' + instead of `gnus-union'. + +1999-12-10 A.Hitachi + Katsumi Yamaoka + + * lisp/dgnushack.el (union): New compiler macro for emulating cl + function. + +1999-12-10 Katsumi Yamaoka + + * lisp/gnus-util.el: Require `gnus-ems'. + (gnus-ems-redefine): Call it to redefine the functions + `gnus-truncate-string', etc. + (gnus-union): Fix doc string. + + * lisp/dgnushack.el (mapcon, mapc): Eliminate the redundant code. + +1999-12-09 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 06. + +1999-12-09 Tsukamoto Tetsuo + + * lisp/dgnushack.el (dgnushack-install-package): Preserve any file + in $(PACKAGEDIR)/lisp/t-gnus if it is without .el or .elc suffix. + +1999-12-09 Katsumi Yamaoka + + * lisp/dgnushack.el (mapcon): New compiler macro for emulating cl + function. + (mapc): Bug fix - treat the last arg as a list. + +1999-12-08 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 05. + + * lisp/gnus-agent.el (gnus): New advice. Always synchronize the + modeline "Plugged" status display with the value of + `gnus-plugged'. + + * lisp/gnus-offline.el (TopLevel): Require `gnus-group' at the + compile time. + (gnus-offline-set-online-sendmail-function): defsubst. + (gnus-offline-set-offline-sendmail-function): Ditto. + (gnus-offline-set-offline-post-news-function): Ditto. + (gnus-offline-set-online-post-news-function): Ditto. + (gnus-offline-disable-fetch-mail): Ditto. + (gnus-offline-enable-fetch-mail): Ditto. + (gnus-offline-setup): Fix typo. + (gnus-offline-gnus-get-new-news): Abolish. + (gnus-offline-toggle-plugged): Ditto. + (gnus-offline-agent-expire): Ditto. + (gnus-group-get-new-news): New advice which does things + `gnus-offline-gnus-get-new-news' was doing. + (gnus-agent-toggle-plugged): New advice which does thing + `gnus-offline-toggle-plugged' was doing. + (gnus-agent-expire): New advice which does things + `gnus-offline-agent-expire' was doing. + (gnus-offline-define-menu-and-key): No longer substitute key + definitions on `gnus-group-mode-map'. No longer swap commands for + a toolbar button. + (gnus-offline-after-get-new-news): Do jobs only when + `gnus-plugged' is t. + + * lisp/gnus-ofsetup.el (gnus-ofsetup-customize): Compile lambda + expressions. + +1999-12-08 Katsumi Yamaoka + + * lisp/message.el (message-yank-add-new-references): Fix doc string. + + * texi/{message-ja.texi, message.texi} + (message-list-references-add-position, + message-yank-add-new-references): Add documentations. + +1999-12-07 Tsukamoto Tetsuo + + * lisp/gnus-offline.el (gnus-offline-gettext): Rename from + `gnus-offline-get-message'. + + * lisp/gnus-ofsetup.el (gnus-ofsetup-gettext): Rename from + `gnus-ofsetup-get-message'. + +1999-12-07 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 04. + (smiley-toggle-buffer): Autoload "smiley" or "gnus-bitmap". + + * lisp/gnus-art.el (gnus-article-prepare-mime-display): Don't use + `get-text-property' in the outside of the boundary. + (gnus-article-smiley-display): New function. + (gnus-treatment-function-alist): Use it. + + * lisp/dgnushack.el (byte-optimize-form-code-walker): Replace with + the bug fixed version rigidly instead of the use of `defadvice'. + + * lisp/message.el (font-lock-after-change-function): Don't use + `compile' for the arg of `defadvice'. + +1999-12-06 Keiichi Suzuki + + * lisp/message.el (message-yank-add-new-references): New option + value `message-id-only'. + (message-yank-original): Likewise. + (message-list-references-add-position): New user option. + (message-list-references): When + `message-list-references-add-position' is integer value, the order + of designate number message-ids is kept. + +1999-12-06 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 03. + + * lisp/gnus-offline.el (gnus): Don't advise here. + (TopLevel): Call `gnus-offline-define-menu-and-key'. + (gnus-offline-setup): Don't call + `gnus-offline-define-menu-and-key' here. + + * lisp/gnus-ofsetup.el (gnus-offline-update-setting-file): Don't + rely on `gnus-load-hook'. + (gnus): New advice. Call `gnus-offline-setup' when everything is + done. + + * lisp/gnus-start.el (save-buffers-kill-emacs): Compile the advice + at the compile time. Use `gnus-alive-p'. + +1999-12-06 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 02. + + * lisp/dgnushack.el (char-after): Uncomment the byte-optimization; + don't use `byte-defop-compiler'. + (byte-optimize-form-code-walker): Advise it for fixing the bug in + and/or forms. The original idea is devised by FUKUI-san, modified + by KOBAYASHI-san. + (max-specpdl-size): Set 3000. + +1999-12-05 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 01. + + * lisp/gnus-offline.el (gnus): New advice. synchronize + `gnus-offline-connected' with `gnus-plugged'. + +1999-12-04 Daiki Ueno + + * lisp/gnus.el (gnus-version-number): Update to 6.14.0. + (gnus-revision-number): Clear to 00. + + * README.branch.ja: Update for t-gnus-6_14 branch. + * README.branch: Ditto. + * README.T-gnus: Ditto. + * README.semi.ja: Ditto. + * README.semi: Ditto. + + * lisp/{rfc2047.el,nnweb.el,nnultimate.el,nntp.el,nnslashdot.el, + nnmh.el,nnfolder.el,nndoc.el,mml.el,mm-view.el,mm-util.el, + mm-bodies.el,message.el,mail-source.el,gnus.el,gnus-uu.el, + gnus-sum.el,gnus-start.el,gnus-msg.el,gnus-int.el,gnus-cache.el, + gnus-art.el,dgnushack.el,ChangeLog}: Sync up with Gnus v5.8.2. + + * texi/{message.texi,message-ja.texi,gnus.texi,gnus-ja.texi, + gnus-faq-ja.texi,ChangeLog}: Modify for T-gnus 6.14; sync up with + Gnus v5.8.2. + + * t-gnus-6_14: NEW PUBLIC BRANCH. + +1999-12-03 Hirokazu FUKUI + Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 01. + + * lisp/dgnushack.el (char-before): Use compiler macro instead of + byte-optimizer. + (char-after): Comment out the byte-optimization. + + * imap.el (imap-base64-encode-string, imap-base64-decode-string): + New functions. They are identical to the built-in codec if + possible, otherwise the functions defined in mel are used. + (imap-cram-md5-auth): Use them. + +1999-12-02 Katsumi Yamaoka + + * lisp/imap.el: Remove autoload settings for `base64-decode-string' + and `base64-encode-string'. + +1999-12-02 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.13.4. + (gnus-revision-number): Clear to 00. + + * README.T-gnus: Update. + + * GNUS-NEWS: Sync up with Pterodactyl Gnus v0.99. + + * lisp/{rfc2047.el,rfc1843.el,nnweb.el,nnvirtual.el,nntp.el, + nnmh.el,nnmail.el,nnimap.el,nnheader.el,nnfolder.el,nndraft.el, + nndoc.el,mml.el,mm-view.el,mm-uu.el,mm-util.el,mm-encode.el, + mm-decode.el,mm-bodies.el,message.el,mail-source.el,lpath.el, + gnus-xmas.el,gnus-uu.el,gnus-util.el,gnus-topic.el,gnus-sum.el, + gnus-start.el,gnus-srvr.el,gnus-spec.el,gnus-score.el,gnus-salt.el, + gnus-picon.el,gnus-msg.el,gnus-mailcap.el,gnus-int.el, + gnus-group.el,gnus-ems.el,gnus-cus.el,gnus-cache.el,gnus-async.el, + gnus-art.el,gnus-agent.el,dgnushack.el,base64.el,Makefile.in, + ChangeLog}: Sync up with Pterodactyl Gnus v0.99. + + * lisp/{webmail.el,nnwarchive.el,nnultimate.el,nnslashdot.el}: New + files. + + * texi/{message.texi,message-ja.texi,gnus.texi,gnus-ja.texi, + emacs-mime.texi,Makefile.in,ChangeLog}: Sync up with Pterodactyl + Gnus v0.99. + +1999-12-02 Katsumi Yamaoka + + * lisp/gnus.el (gnus-select-method): Undo (`if' -> `when'). + * lisp/gnus-picon.el (gnus-picons-file-suffixes): Ditto. + * lisp/gnus-start.el (save-buffers-kill-emacs): Ditto. + (gnus-after-getting-new-news-hook): Ditto. + + * lisp/gnus-group.el (gnus-useful-groups): Undo (`or' -> `unless'). + +1999-12-01 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 10. + + * lisp/gnus-art.el (article-treat-overstrike): Work for multibyte + char with old Emacsen as well. + +1999-12-01 Daiki Ueno + + * lisp/gnus-agent.el (gnus-category-edit-predicate): Expand `setf' + appears in the backquoted form. + (gnus-category-edit-score): Ditto. + + * lisp/gnus-sum.el (gnus-data-set-header): Expand `setf' + appears in the backquoted form. + +1999-11-30 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 09. + + * lisp/gnus-offline.el (gnus-offline-define-menu-and-key): Fix a + bug -- do add-hook. + (gnus-offline-popup): Examine whether `easy-menu-create-menu' is + defined. If not, call `easy-menu-create-keymaps'. + +1999-11-30 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 08. + + * lisp/gnus-offline.el (TopLevel): Use `static-if', requiring + "static" at the compile time. + (gnus-offline-hangup-function): Abolish. + (gnus-offline-auto-ppp): New variable. + (gnus-offline-gnus-get-new-news): Refer to it. + (gnus-offline-set-unplugged-state): Ditto. + (gnus-offline-set-auto-ppp): New function. It replaces the + function `gnus-offline-toggle-auto-hangup'. + (gnus-offline-toggle-auto-hangup): Abolish. + (gnus-offline-define-menu-and-key): Use `static-if' and + `static-cond'. + (gnus-offline-popup-menu): Do not define this function under XEmacs. + (gnus-offline-popup): New function. + + * gnus-ofsetup.el (gnus-ofsetup-update-setting-file): Typo. + (gnus-ofsetup-resource-en): Fix doc strings. + (gnus-ofsetup-resource-ja): Ditto. + +1999-11-30 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 07. + + * lisp/gnus-art.el (gnus-article-wash-status): Sync up with + Pterodactyl Gnus v0.98. + +1999-11-30 Katsumi Yamaoka + + * lisp/nnimap.el (nnimap-request-newgroups): Don't use `member-if'. + + * lisp/gnus.el (gnus-select-method): Use `if' instead of `when'. + + * lisp/gnus-sum.el (gnus-summary-make-marking-command-1): Use + `car' and `cdr' instead of `cadr'. + + * lisp/gnus-picon.el (gnus-picons-file-suffixes): Use `cons' + instead of `push'; use `if' instead of `when'. + + * lisp/gnus-group.el (gnus-group-iterate): Use `car' and `cdr' + instead of `pop'. + (gnus-useful-groups): Use `or' instead of `unless'. + + * lisp/gnus-art.el (gnus-emphasis-alist): Use `car' and `cdr' + instead of `cadr'. + +1999-11-30 Katsumi Yamaoka + + * lisp/gnus-start.el (save-buffers-kill-emacs): Don't use the macro + `when' in the body of `defadvice'. Use `if' instead. + + * lisp/dgnushack.el (last, mapc): New compiler macros for emulating + cl functions. + +1999-11-29 Katsumi Yamaoka + + * lisp/gnus-start.el (gnus-after-getting-new-news-hook): Don't use + the macro `when' in the arg of `defcustom'. Use `if' instead. + +1999-11-27 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 06. + + * lisp/gnus-art.el (gnus-signature-toggle): Specify the 4th arg of + `next-single-property-change' LIMIT as `point-max'. + (gnus-article-prepare-mime-display): Ditto. + (article-hide-signature): Ditto. + +1999-11-26 NAKAJI Hiroyuki + + * lisp/gnus.el (gnus-version): Parentheses of gnus-revision-number + are removed to fill gnus-version within 80 columns. + +1999-11-25 NAKAJI Hiroyuki + + * lisp/gnus.el (gnus-version): Shows also gnus-revision-number. + +1999-11-24 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 05. + + * lisp/gnus-agent.el (gnus-agent-fetch-headers): Use `gnus-union' + instead of `union'. + + * lisp/gnus-util.el (gnus-union): New function. + + * lisp/gnus-sum.el (gnus-summary-exit-no-update): Use + `copy-sequence' instead of `copy-list'. + * lisp/gnus-art.el (gnus-article-setup-highlight-words): Ditto. + + * lisp/dgnushack.el (union, copy-list): Remove compiler macros. + +1999-11-24 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 04. + + * lisp/dgnushack.el (union, copy-list): New compiler macros for + emulating cl functions. + +1999-11-22 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 03. + (gnus-select-method): Use `condition-case' instead of + `ignore-errors'. + + * lisp/gnus-start.el (gnus-site-init-file): Use `condition-case' + instead of `ignore-errors'. + + * lisp/{gnus-ofsetup.el,gnus-offline.el}: Remove RCS magic cookie. + + * lisp/{time-date.el,smiley.el,score-mode.el,pop3.el,nnweb.el, + nnvirtual.el,nntp.el,nnspool.el,nnsoup.el,nnoo.el,nnml.el,nnmh.el, + nnmbox.el,nnmail.el,nnlistserv.el,nnimap.el,nnheader.el, + nneething.el,nndraft.el,nndoc.el,nnbabyl.el,message.el,imap.el, + gnus-win.el,gnus-vm.el,gnus-util.el,gnus-topic.el,gnus-sum.el, + gnus-start.el,gnus-srvr.el,gnus-spec.el,gnus-score.el,gnus-salt.el, + gnus-range.el,gnus-picon.el,gnus-ofsetup.el,gnus-offline.el, + gnus-msg.el,gnus-mlspl.el,gnus-mailcap.el,gnus-logic.el, + gnus-kill.el,gnus-group.el,gnus-cite.el,gnus-async.el,gnus-art.el, + gnus-agent.el,earcon.el}: Require `cl' using `eval-when-compile'. + +1999-11-22 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 02. + + * lisp/{time-date.el,smiley.el,pop3.el,nnweb.el,nnvirtual.el, + nntp.el,nnspool.el,nnsoup.el,nnoo.el,nnml.el,nnmh.el,nnmbox.el, + nnmail.el,nnlistserv.el,nnimap.el,nnheader.el,nneething.el, + nndoc.el,nnbabyl.el,message.el,imap.el,gnus.el,gnus-win.el, + gnus-util.el,gnus-topic.el,gnus-sum.el,gnus-start.el,gnus-srvr.el, + gnus-spec.el,gnus-score.el,gnus-salt.el,gnus-range.el, + gnus-picon.el,gnus-ofsetup.el,gnus-offline.el,gnus-mlspl.el, + gnus-mailcap.el,gnus-logic.el,gnus-kill.el,gnus-group.el, + gnus-cite.el,gnus-async.el,gnus-art.el,gnus-agent.el,earcon.el}: + Require `cl' at the top level. + + * lisp/gnus.el (gnus-select-method): Undo last change. + * lisp/gnus-util.el (copy-list): Undo last change (remove it). + * lisp/gnus-start.el (gnus-site-init-file): Undo last change. + + * lisp/gnus-ems.el (gnus-split-string): Remove. + +1999-11-21 Daiki Ueno + + * lisp/pop3.el: Add description about STLS extension; add autoload + setting for `starttls-open-stream' and `starttls-negotiate'. + (pop3-stls): New function. + (pop3-open-tls-stream): New function. + (pop3-open-server): Use `pop3-open-tls-stream' if + 'pop3-connection-type' is bound to `tls'. + +1999-11-20 Daiki Ueno + + * lisp/imap.el: Add autoload setting for `starttls-open-stream' + and `starttls-negotiate'. + (imap-stream-alist): Add TLS entry. + (imap-tls-p): New function. + (imap-tls-open): New function. + (imap-ssl-open): Enclose `open-ssl-stream' with + `as-binary-process'. + +1999-11-19 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 01. + (gnus-select-method): Use `condition-case' instead of + `ignore-errors'. + + * lisp/pop3.el (pop3-apop): Move the autoload seting to the top + level. + + * lisp/md5.el (md5): Allow the optional 4th and 5th arguments + `coding' and `noerror' for the stopgaps. + + * lisp/lpath.el (md5): Allow the optional 4th and 5th arguments + `coding' and `noerror'. + (function-max-args): Maybe-fbind for FSF Emacsen. + + * lisp/imap.el (imap-cram-md5-auth): Specify the 4th arg to `md5' + as `binary' if possible. + (imap-log): Default to nil (synched with pgnus 0.99). + (base64-decode-string): Autoload "mel" instead of "base64". + (md5): Autoload "md5" without `eval-and-compile'. + + * lisp/gnus-util.el (copy-list): New function defined by + `defun-maybe'. + + * lisp/gnus-sum.el (gnus-update-summary-mark-positions): Specify + the 3rd arg of `make-full-mail-header' to "nobody" instead of "". + + * lisp/gnus-start.el (gnus-site-init-file): Use `condition-case' + instead of `ignore-errors'. + + * lisp/gnus-picon.el: Require `cl'. + + * lisp/{smiley.el,rfc2104.el,nnvirtual.el,mailheader.el, + gnus-offline.el} (cl): Enclose the requiring procedure with + `eval-when-compile'. + + * lisp/{imap.el,gnus-mailcap.el} (cl): Enclose the requiring + procedure with `eval-when-compile' instead of `eval-and-compile'. + +1999-11-09 Yoshiki Hayashi + + * lisp/read-passwd.el (read-pw-set-mail-source-passwd-cache): + Use mail-sources instead of nnmail-spool-file. + From: Toshiaki -PCX- Tanaka. + +1999-11-09 Katsumi Yamaoka + + * lisp/gnus.el (gnus-group-startup-message): Insert space before + "based on". + * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Ditto. + +1999-11-09 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.13.3. + (gnus-revision-number): Clear to 00. + + * README.T-gnus: Update. + + * lisp/{rfc1843.el,qp.el,nntp.el,nnmail.el,nnfolder.el,nnagent.el, + mml.el,mm-view.el,mm-uu.el,mm-util.el,mm-decode.el,mm-bodies.el, + message.el,mail-source.el,lpath.el,gnus-util.el,gnus-topic.el, + gnus-sum.el,gnus-start.el,gnus-srvr.el,gnus-msg.el,gnus-mailcap.el, + gnus-group.el,gnus-art.el,gnus-agent.el,dgnushack.el,binhex.el, + ChangeLog}: Sync up with Pterodactyl Gnus v0.98. + + * lisp/{rfc2104.el,nnimap.el,imap.el}: New files. + + * texi/gnus-ja.texi: Sync up with Pterodactyl Gnus v0.98 without + translation. + + * texi/{gnus.texi,ChangeLog}: Sync up with Pterodactyl Gnus v0.98. + +1999-11-08 Kinji Itoh + + * lisp/gnus-draft.el (gnus-draft-edit-message): Use + `message-save-drafts' instead of `set-buffer-modified-p' and + `save-buffer'. + * lisp/message.el (message-save-drafts): Insert In-Reply-To header + because the reply data is lost in Drafts. + * lisp/gnus-art.el (gnus-signature-face): Don't check + window-system type. + +1999-11-08 Daiki Ueno + + * lisp/pop3.el (pop3-progress-message): New function. + (pop3-movemail): Use it. + +1999-10-28 Katsumi Yamaoka + + * lisp/gnus.el (TopLevel): Autolaod "gnus-msg" for the function + `gnus-following-method'. + + * lisp/gnus-msg.el (gnus-following-method): Move from gnus-msg.el; + wide reply as a mail if the message is not a news; use the macro + `gnus-setup-message'. + + * lisp/gnus-art.el (gnus-following-method): Move to gnus-msg.el. + +1999-10-26 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 14. + (TopLevel): Autoload "gnus-bitmap" instead of "smiley-mule" for the + function `gnus-smiley-display'. + + * lisp/gnus-art.el (gnus-treat-display-smileys): Default to nil if + `window-system' is nil. + (gnus-article-x-face-command): Default to external command if + `window-system' is nil. + +1999-10-26 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 13. + (TopLevel): Rearrange autoload settings. + + * lisp/gnus-art.el (gnus-treatment-function-alist): Don't use + `smiley-buffer'. + + * lisp/gnus-sum.el (gnus-summary-make-menu-bar): Add button + "Toggle smileys" in "Washing" menu. + (gnus-summary-wash-map): Add "s" key for `smiley-toggle-buffer'. + + * lisp/smiley.el (gnus-smiley-display): Use `smiley-toggle-buffer'. + (smiley-toggle-buffer): New function. + (smiley-buffer): Don't quote the function. + (smiley-toggle-extents): Ditto. + +1999-10-24 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 12. + (TopLevel): Add and delete autoloads for functions defined in + "gnus-cus", "gnus-offline", "miee", "pop3-fma" and "mw32misc". + + * lisp/gnus-offline.el (TopLevel): Do not consider the functions + defined in "miee". + + * lisp/gnus-ofsetup.el (TopLEvel): Do not autoload + `gnus-custom-mode' defined in "gnus-cus". + +1999-10-21 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 11. + + * lisp/gnus-offline.el (TopLevel): Call `mime-set-field-decoder' + when "eword-decode" is loaded. It is for X-Gnus-Offline-Backend + header. + +1999-10-19 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 10. + (TopLevel): Autoload "x-face-mule" and "smiley-mule" for the + functions `x-face-mule-gnus-article-display-x-face' and + `smiley-buffer'. + + * lisp/lpath.el (smiley-encode-buffer): Bind it for FSF Emacsen. + + * lisp/gnus-ems.el (gnus-group-startup-message): Don't replace with + `gnus-mule-group-startup-message'. + (gnus-mule-group-startup-message): Remove. + (gnus-mule-bitmap-image-file): Remove. + + * lisp/gnus-msg.el (gnus-copy-article-buffer): Encode smileys to + ordinary text if the feature `smiley-mule' is provided and FSF + Emacs is used. + (TopLevel): Require `static' at the compile time. + + * lisp/gnus-art.el (gnus-article-prepare-display): Bind + `mime-display-text/plain-hook' to nil. + (gnus-article-prepare-mime-display): Use `let' instead of `let*'; + treat the next entity position as a marker. + (gnus-treatment-function-alist): Use `smiley-buffer' instead of + `gnus-smiley-display' under FSF Emacsen. + (gnus-treat-display-smileys): Default to t if the module + `smiley-mule' is installed. + (gnus-treat-display-xface): Default to `head' if the value of + `gnus-article-x-face-command' is + `x-face-mule-gnus-article-display-x-face'. + (gnus-article-x-face-command): Default to + `x-face-mule-gnus-article-display-x-face' if the module + `x-face-mule' is installed. + (TopLevel): Require `static' first; require `path-util'. + +1999-10-18 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 09. + + * lisp/message.el (message-mode): Make + `message-font-lock-last-position' as buffer local. + (message-font-lock-keywords-2): Use + `message-font-lock-cited-text-matcher' instead of regexp. + (message-font-lock-cited-text-matcher): New function. + (font-lock-after-change-function): Advice to the keep last cursor + position in `message-font-lock-last-position' before fontifying. + (message-font-lock-last-position): New variable. + (message-font-lock-citation-name-max-column): New variable. + (message-font-lock-cited-text-regexp): New variable. + (message-font-lock-fence-close-position): New variable. + (message-font-lock-fence-open-position): New variable. + (message-font-lock-fence-close-regexp): New variable. + (message-font-lock-fence-open-regexp): New variables. + +1999-10-04 Masatoshi Tsuchiya + + * lisp/message.el (message-mode): Rearrange `font-lock-defaults' + using `message-font-lock-keywords', `message-font-lock-keywords-1' + and `message-font-lock-keywords-2'. + (message-font-lock-keywords): Restruct. + (message-font-lock-keywords-1): New variable split from + `message-font-lock-keywords'. + (message-font-lock-keywords-2): Ditto. + +1999-10-11 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 08. + + * lisp/gnus-art.el (gnus-treat-article): Buttonize the signature + before highlighting or hiding it. + (gnus-article-buttonize-signature): New function. + (gnus-article-highlight-signature): Don't buttonize. + (gnus-treatment-function-alist): Undo the last change. + (gnus-treat-emphasize): Default to nil. + +1999-10-08 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 07. + (TopLevel): Autoload "gnus-art" for the function + `gnus-article-show-all'. + + * lisp/gnus-sum.el (gnus-summary-select-article): Expose all + hidden text if the command `gnus-summary-toggle-mime' is used. + + * lisp/gnus-art.el (gnus-signature-toggle): Don't hide the + following parts. + (gnus-article-highlight-signature): Work for forwarded messages. + (gnus-article-show-all): New function based on `article-show-all'. + (gnus-article-show-all-headers): Based on + `article-show-all-headers'. + (article-show-all-headers): New function to show all *HEADERS*. + (article-show-all): Show *ALL* literally. + (article-hide-signature): Work for forwarded messages. + (gnus-treatment-function-alist): Put `gnus-treat-hide-signature' + off after `gnus-treat-highlight-signature'. + +1999-10-08 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 06. + + * lisp/gnus-art.el (gnus-article-prepare-mime-display): Protect + against forwarded messages without MIME structure. + (gnus-treatment-function-alist): Move + 'gnus-treat-decode-article-as-default-mime-charset' to the top; + put `gnus-treat-emphasize' off after + `gnus-treat-highlight-headers'. + +1999-10-07 Yoshiki Hayashi + + * lisp/gnus.el (gnus-revision-number): Increment to 05. + +1999-10-07 Katsumi Yamaoka + + * lisp/gnus-art.el (gnus-treat-predicate): Examine whether the + argument is list or not before condition. + +1999-10-07 Yoshiki Hayashi + + * lisp/gnus-art.el (gnus-treat-predicate): Work for + (typep "something"). + +1999-10-07 Yoshiki Hayashi + + * lisp/gnus-art.el (gnus-article-prepare-display): + Pass argument nil as a condition to gnus-treat-article. + * lisp/gnus-art.el (gnus-article-prepare-mime-display): + Ditto. Also, treat last part of multipart article correctly. + +1999-10-06 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 04. + + * lisp/message.el (message-generate-headers): Don't insert + excessive newline. + + * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Don't use + negative number for the 2nd arg of `insert-char'. + +1999-10-06 Tsukamoto Tetsuo + + * lisp/gnus-ofsetup.el (gnus-ofsetup-customize): Info link to + gnus-ja instead of gnus if Japanese environment is on. + +1999-10-06 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 03. + (semi-gnus-developers): Remove. + (gnus-maintainer): Change mail address. + (gnus-group-startup-message): Display version string. + + * lisp/gnus-msg.el (gnus-bug): Delete `Cc'; modify version string. + + * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Display + version string; fix glyph position. + +1999-10-06 Yoshiki Hayashi + + * lisp/gnus-sum.el (gnus-read-move-group-name): Revert + to previous version until problem of respooling from + nnimap to nnml is solved. + (gnus-summary-move-article): Ditto. + +1999-10-05 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 02. + + * lisp/gnus-art.el (gnus-treat-predicate): Check whether arg's + value is t before checking for `condition'. + (gnus-article-prepare-mime-display): Search for the entity children + if the primary type is `multipart'. + +1999-10-01 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 01. + + * lisp/gnus-sum.el (gnus-read-move-group-name): Returns nil + instead of signaling an error if the destination group is not + newly created. + (gnus-summary-move-article): Do nothing if the destination group + is not newly created. + + * lisp/gnus-msg.el (gnus-bug): Use text/plain for the snooped + environment part. + +1999-09-30 Daiki Ueno + + * nnfolder.el (nnfolder-possibly-change-group): Don't create an + active entry for the group even if it doesn't exist. + +1999-09-28 Daiki Ueno + + * gnus-art.el (gnus-article-mime-part-status): Use `mime-entity-children'. + +1999-09-28 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.13.2. + (gnus-revision-number): Clear to 00. + + * README.T-gnus: Update. + + * texi/{message.texi,message-ja.texi,gnus.texi,gnus-ja.texi, + emacs-mime.texi,ChangeLog}: Sync up with Pterodactyl Gnus v0.97. + + * lisp/{qp.el,nntp.el,nnmail.el,mml.el,mm-util.el,mm-encode.el, + mm-decode.el,message.el,mail-source.el,gnus.el,gnus-xmas.el, + gnus-util.el,gnus-sum.el,gnus-srvr.el,gnus-score.el,gnus-nocem.el, + gnus-msg.el,gnus-group.el,gnus-cache.el,gnus-art.el,gnus-agent.el, + ChangeLog}: Sync up with Pterodactyl Gnus v0.97. + +1999-09-24 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 07. + + * lisp/gnus-art.el (gnus-article-prev-page): Rewrite to realize + smooth scrolling under XEmacs. + (gnus-article-next-page):Ditto. + + * Mule23@1934.en, Mule23@1934.ja: Separate from Mule23@1934; add + descriptions about the problem of loaddefs.el and the patch for + CUSTOM 1.9962. + +1999-09-22 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 06. + + * lisp/nnmail.el (TopLevel): Bind keywords `:user', `:path' and + `:predicate' for old Emacsen; require `static'. + + * lisp/dgnushack.el (TopLevel): Don't bind keywords `:user', + `:path' and `:predicate'. + +1999-09-20 Daiki Ueno + + * gnus-agent.el (gnus-agent-toggle-plugged): Mark the current + modeline as modified. + +1999-09-17 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 05. + + * lisp/gnus-art.el (gnus-treat-article): Inherit the text property + `mime-view-entity' in the modified header under FSF Emacsen. + +1999-09-13 Tsukamoto Tetsuo + + * README-offline.en: Rewrite the usage description. + * README-offline.ja: Ditto. + +1999-09-12 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 04. + + * lisp/gnus-ofsetup.el (gnus-offline-lang): Declare before loading + `gnus-offline'. + +1999-09-12 Tsukamoto Tetsuo + + * README-offline.en: Do not refer to `gnus-agent-toggle-plugged'. + * README-offline.ja: Ditto. + +1999-09-11 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 03. + + * lisp/gnus-agent.el (gnus-agent-toggle-plugged): Do not mark + the current buffer as modified. + + * lisp/gnus-offline.el (gnus-offline-menu): New variable. + (gnus-offline-get-menu-items): New function. + (gnus-offline-define-menu-on-miee): Use it. + (gnus-offline-define-menu-on-agent): Ditto. + +1999-09-04 Daiki Ueno + + * lisp/gnus-msg.el (gnus-configure-posting-styles): Quote `:file'. + + * lisp/pop3.el (pop3-save-uidls): Don't use `dotimes' to check + backets of `pop3-uidl-obarray'; don't clear `pop3-uidl-obarray'. + (pop3-quit): Clear `pop3-uidl-obarray'. + +1999-09-03 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 02. + + * lisp/gnus-offline.el (gnus-offline-resource-en, + gnus-offline-resource-ja, + gnus-offline-resource-ja_complete): New variables. + (gnus-offline-get-message): News function. + (gnus-offline-error-check): Use it. + (gnus-offline-connect-server): Ditto. + (gnus-offline-get-new-news-function): Ditto. + (gnus-offline-set-mail-group-level): Ditto. + (gnus-offline-hangup-line): Ditto. + (gnus-offline-after-jobs-done): Ditto. + (gnus-offline-toggle-auto-hangup): Ditto. + (gnus-offline-toggle-on/off-send-mail): Ditto. + (gnus-offline-toggle-articles-to-fetch): Ditto. + (gnus-offline-empting-spool): Ditto. + (gnus-offline-set-interval-time): Ditto. + + * lisp/gnus-ofsetup.el (gnus-offline-lang, + gnus-ofsetup-resource-en, gnus-ofsetup-resource-ja): New + variables. + (gnus-ofsetup-get-message): New function. + (gnus-setup-for-offline): Use it. + (gnus-ofsetup-find-parameters): Ditto. + (gnus-ofsetup-prepapre-for-miee): Ditto. + (gnus-ofsetup-completing-read-symbol): Ditto. + (gnus-ofsetup-customize): Ditto. + (gnus-ofsetup-customize-done): Ditto. + +1999-09-01 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-summary-isearch-article): Don't bind + `isearch-lazy-highlight'. + +1999-08-30 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 01. + + * lisp/lpath.el (babel-as-string): Bind it. + + * lisp/gnus-sum.el (gnus-summary-search-article): Keep the + original X-Face field while searching. It is done for only FSF + Emacsen. + (gnus-summary-search-article-highlight-matched-text): Ditto. + (gnus-summary-search-article-matched-data): Bind it explicitly. + +1999-08-29 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.13.1. + (gnus-revision-number): Clear to 00. + + * README.T-gnus: Update. + + * README: Sync up with Pterodactyl Gnus v0.96. + * lisp/{smiley.el,nntp.el,nnmail.el,nnfolder.el,mml.el,mm-view.el, + mm-uu.el,mm-util.el,mm-encode.el,mm-decode.el,mm-bodies.el, + gnus-uu.el,gnus-util.el,gnus-sum.el,gnus-start.el,gnus-score.el, + gnus-mlspl.el,gnus-group.el,gnus-bcklg.el,gnus-art.el, + gnus-agent.el,ChangeLog}: Ditto. + * texi/{gnus.texi,gnus-ja.texi,ChangeLog}: Ditto. + +1999-08-27 Daiki Ueno + + * lisp/pop3.el (pop3-movemail): If the argument `crashbox' is t, + don't retrieve any incoming mails.; Don't filter articles here. + Use `convert-standard-filename' to generate fresh UIDL file names. + (pop3-get-message-numbers): Rewrite. + (pop3-save-uidls): Clear UIDL hash.; Use `with-temp-file' instead + of `with-temp-buffer'. + +1999-08-27 Tsukamoto Tetsuo + + * README-offline.ja : Fix. + + * lisp/gnus-offline.el (gnus-offline-agent-automatic-expire): + Fix typo. + + * lisp/gnus-ofsetup.el : Remove gnus-cus from compile time + requirements; Enclose the autoload for `gnus-custom-mode' with + `eval-and-compile'. + +1999-08-27 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 15. + + * lisp/dgnushack.el (char-before, char-after): Optimize byte code + for them before lpath.el is loaded. Because lpath.el requires + `poe' via `path-util'. [cf. ] + + * lisp/gnus-sum.el (gnus-summary-search-article): Search for + X-Face image if the regexp "^X-Face:" is specified. + (gnus-summary-search-article-highlight-matched-text): Use + `gnus-summary-search-article-highlight-goto-x-face'; maybe display + X-Face image if it is requested. + (gnus-summary-search-article-highlight-goto-x-face): New macro. + +1999-08-26 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 14. + + * lisp/gnus-sum.el (gnus-summary-search-article): Treat and + recenter the article when touchdown; popup the article buffer if + it is disappeared. + (gnus-summary-search-article-highlight-matched-text): Treat the + article before highlighting; use old style backquote syntax. + (gnus-summary-search-article-position-point): Fix the beginning + position; use old style backquote syntax. + (gnus-summary-select-article): Undo the last change. + (gnus-summary-display-article): Bind + `gnus-summary-search-article-matched-data' in the article buffer + locally. It is moved from `gnus-summary-select-article'. + +1999-08-25 NAKAJI Hiroyuki + + * texi/Makefile.in (EMACS): Use @EMACS@, not emacs directly. + (clean): Remove formatted info files. + (distclean): Just remove Makefile. + +1999-08-25 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 13. + + * lisp/gnus-agent.el (gnus-agent-large-newsgroup): New variable. + (gnus-agent-fetch-headers): Limit downloadable articles if the + number of unread articles exceeds `gnus-agent-large-newsgroup'. + (gnus-agent-expire): Do not expire saved or replied articles when + `gnus-agent-expire-all' is nil. + + * lisp/gnus-offline.el (gnus-offline-agent-automatic-expire): New + variable. + (gnus-offline-agent-expire): Check it; Bind + `gnus-agent-expire-all' to nil if `gnus-agent-expire-days' is 0. + (gnus-offline-after-jobs-done): Don't check + `gnus-agent-expire-all'. + + * lisp/gnus-ofsetup.el (gnus-offline-setting-file): Check if + `user-login-name' and `user-real-login-name' returns the same + value or not. + (gnus-ofsetup-prepare-for-miee): Write forms as a variable. + (gnus-ofsetup-update-setting-file): Ditto. + (gnus-ofsetup-prepare): New macro. + (gnus-setup-for-offline): Use it. + (gnus-ofsetup-customize-done): Ditto. + +1999-08-25 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 12. + + * lisp/gnus-sum.el (gnus-summary-search-article): Rearrange. + (gnus-summary-search-article-highlight-matched-text): Rearrange. + (gnus-summary-search-article-position-point): New macro. + (gnus-summary-search-article-matched-data): Rename from + `gnus-summary-search-article-matched-text'. + (gnus-summary-isearch-article): Bind `gnus-inhibit-treatment' to t; + use `gnus-article-show-all-headers' for exposing the visited + article. + (gnus-summary-select-article): Bind + `gnus-summary-search-article-matched-data' in the article buffer + locally. + + * lisp/gnus-art.el (gnus-treat-article): Don't treat the article + if the value of `gnus-inhibit-treatment' is non-nil. + (article-toggle-headers): Don't redisplay X-Face if the value of + `gnus-inhibit-treatment' is non-nil. + (gnus-article-treat-custom): Add new treatment variable `mime'. + +1999-08-25 Daiki Ueno + + * lisp/gnus-group.el (gnus-group-line-format): Fix typo in + documentation. + + * lisp/gnus-sum.el (gnus-summary-mode): Don't set + `gnus-newsgroup-incorporated' explicitly. + +1999-08-24 Katsumi Yamaoka + + * README.semi: Update for the recent a-ftp sites and directories. + * README.semi.ja: Ditto. + * texi/gnus-faq.texi: Ditto. + * texi/gnus-faq-ja.texi: Ditto. + +1999-08-24 Daiki Ueno + + * lisp/gnus.el (gnus-revision-number): Increment to 11. + (gnus-summary-incorporated-face): New face spec. + + * lisp/gnus-group.el (gnus-group-line-format-alist): Add + entry about the format specifier `w'. + (gnus-group-line-format): Fix documentation. + + * lisp/gnus-sum.el (gnus-summary-highlight): Highlight lines on + newly incorporated mails with `gnus-summary-incorporated-face'. + (gnus-newsgroup-incorporated): New variable. + (gnus-summary-local-variables): Add `gnus-newsgroup-incorporated'. + (gnus-summary-mode): Set `gnus-newsgroup-incorporated'. + + * lisp/nnmail.el (nnmail-new-mail-numbers): New function. + + * lisp/gnus-srvr.el (gnus-browse-foreign-server): Don't prepend + `K' if the group has already been subscribed. + +1999-08-24 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-summary-isearch-article): Set + `isearch-lazy-highlight' t in the buffer locally; goto the + beginning of the buffer before searching. + + * lisp/gnus-util.el (gnus-eval-in-buffer-window): Select the last + selected frame. + +1999-08-23 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 10. + + * lisp/gnus-sum.el (gnus-summary-search-article): Highlight + matched text after the searching is done; call + `gnus-summary-select-article' with the args nil and t; bind + `gnus-treat-*' to nil. + (gnus-summary-search-article-highlight-matched-text): New macro + for highlighting matched text. It is bound at the compile time + only. + (gnus-summary-isearch-article): Call `gnus-summary-select-article' + with the args nil and t; bind `gnus-treat-*' to nil. + + * lisp/gnus-ems.el (gnus-x-splash): Change the foreground color of + `gnus-splash' to "Brown"; use `with-temp-buffer' instead of + `with-temp-file'; use `insert-file-contents-as-binary' instead of + `insert-file-contents'. + +1999-08-20 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 09. + + * lisp/gnus-offline.el: Fix comments. + (TopLevel): Delete the code for emulating custom. Do not inhibit + byte-compile-warnings, but hide useless ones. + (gnus-offline-dialup-program-arguments): defvar instead of + defcustom. + (gnus-offline-hangup-program-arguments): Ditto. + (gnus-offline-interval-time): Ditto. + (gnus-offline-dialup-program, gnus-offline-hangup-program, + gnus-offline-drafts-queue-type, gnus-offline-MTA-type): defvar. + (gnus-offline-disable-fetch-mail): Remove pop3-fma dependent + codes. + Set `mail-sources' instead of `nnmail-spool-file'. + (gnus-offline-enable-fetch-mail): Ditto. + (gnus-offline-toggle-movemail-program): Abolish. + (gnus-offline-define-menu-and-key): Modify according to it. + (gnus-offline-define-menu-on-miee): Ditto. + (gnus-offline-define-menu-on-agent): Ditto. + (gnus-offline-message-add-header): Bind temporary variables. + (gnus-offline-add-custom-header): Ditto. + (gnus-offline-restore-mail-group-level): Ditto. + + * lisp/gnus-ofsetup.el (TopLevel): Require gnus-cus and + gnus-offline at the compile time. Do not inhibit + byte-compile-warnings. + (gnus-setup-for-offline): Really bind all temporary variables. + (gnus-ofsetup-write-settting-file): Check if interval is a + integer. + Use `mail-sources' instead of `nnmail-spool-file'. + (gnus-ofsetup-update-setting-file): Redefine as a macro. + (gnus-ofsetup-prepare-for-miee): Ditto. + + * README-offline.en : Update. + * README-offline.ja : Ditto. + +1999-08-20 Daiki Ueno + + * lisp/gnus-sum.el (gnus-wheel-summary-scroll): Bind + `inhibit-read-only' to t; bind `buffer-read-only' to nil. + +1999-08-20 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 08. + +1999-08-19 Keiichi Suzuki + + * lisp/nnmail.el (nnmail-split-it): Match whole word for getting + group name with `\N'. + +1999-08-19 Daiki Ueno + + * lisp/gnus.el (gnus-revision-number): Increment to 07. + + * lisp/pop3.el (pop3-except-header-regexp): New variable. + (pop3-movemail): Don't retrieve messages whose headers are + matching `pop3-except-header-regexp'. + (pop3-top): New function. + (pop3-retr): Don't use `save-restriction'. + +1999-08-18 Daiki Ueno + + * lisp/pop3.el (pop3-get-extended-response): Fix regexp. + +1999-08-18 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 06. + + * lisp/gnus-art.el (mime-preview-over-to-next-method-alist): Use + `gnus-article-next-page' when the last page is not displayed. + (mime-preview-over-to-previous-method-alist): Use + `gnus-article-prev-page' when the first page is not displayed. + (gnus-next-page-map): Use `make-sparse-keymap' instead of + `make-keymap'; don't use `suppress-keymap'. + (gnus-insert-next-page-button, gnus-insert-prev-page-button): + Succeed to the value of the text property `mime-view-situation' in + the Next/Prev buttons; make `gnus-{next|prev}-page-map' have the + current local map as a parent under FSF Emacsen. + +1999-08-18 Daiki Ueno + + * lisp/pop3.el (pop3-retr): Undo last change. + +1999-08-17 Daiki Ueno + + * lisp/gnus.el (gnus-revision-number): Increment to 05. + + * lisp/pop3.el (pop3-get-extended-response): Enable timeout of + `accept-process-output'; Move point to the end of the normal + response. + (pop3-movemail): Add suffix to `pop3-uidl-file-name'. + (pop3-get-list): Abolish. + (pop3-retr): Don't use `save-restriction'. + (pop3-uidl): Don't use `condition-case' when checking UIDL support. + (pop3-list): Likewise. + +1999-08-17 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 04. + + * lisp/gnus-sum.el (gnus-wheel-summary-scroll): Use + `event-basic-type' instead of `event-button' under FSF Emacsen. + +1999-08-16 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 03. + +1999-08-16 Daiki Ueno + + * lisp/gnus-sum.el: Add `gnus-wheel-install' to + `gnus-summary-mode-hook'. + (gnus-use-wheel): New variable. + (gnus-wheel-scroll-amount): New variable. + (gnus-wheel-edge-resistance): New variable. + (gnus-wheel-summary-scroll): New function. + (gnus-wheel-install): New function. + +1999-08-16 Katsumi Yamaoka + + * lisp/gnus.el (gnus-revision-number): Increment to 02. + + * lisp/nnheader.el (make-full-mail-header-from-decoded-header): Use + `defun' instead of `defsubst'. + (make-full-mail-header): Ditto. + + * lisp/dgnushack.el (dgnushack-texi-format): Fold up long lines. + (TopLevel): Autoload "texinfmt" for avoiding byte compile warning. + +1999-08-16 Tsukamoto Tetsuo + + * lisp/gnus.el (gnus-revision-number): Increment to 01. + + * lisp/gnus-draft.el (gnus-group-send-drafts): Say which message + is being sent. + + * lisp/gnus-ofsetup.el (gnus-ofsetup-completing-read-symbol): New + function from Nana-gnus. + (gnus-setup-for-offline): Rewrite. Bind all temporary variables. + (gnus-ofsetup-update-setting-file): Rename from + `gnus-ofsetup-write-setting-file'. + (gnus-ofsetup-find-parameters): Rename from + `gnus-ofsetup-parameters'. + (gnus-ofsetup-customize-done): Rewrite. + +1999-08-15 Daiki Ueno + + * pop3.el: Sync up with pop3.el version 2.04. + (pop3-leave-mail-on-server): New variable. + (pop3-maximum-message-size): New variable. + (pop3-uidl-file-name): New variable. + (pop3-uidl-support): New variable. + (pop3-uidl-obarray): New variable. + (pop3-movemail): Check message size on every retrieval. + (pop3-open-ssl-stream-1): Use new style macro. + (pop3-get-message-numbers): New function. + (pop3-get-list): New function. + (pop3-get-uidl): New function. + (pop3-get-unread-message-numbers): New function. + (pop3-save-uidls): New function. + (pop3-retr): Use `pop3-get-extended-response'. + (pop3-list): New implementation. + (pop3-uidl): New function. + (pop3-get-extended-response): New function. + +1999-08-04 Katsumi Yamaoka + + * lisp/gnus.el: T-gnus 6.13.0 is released. + +1999-08-04 Katsumi Yamaoka + + * ChangeLog.2: New file, rename from ChangeLog. + + * lisp/dgnushack.el (TopLevel): Rearrange. + + * README.branch.ja: Update for t-gnus-6_12 and t-gnus-6_13 branch. + * README.branch: Ditto. + + * texi/gnus-faq.texi: Replace ftp.jaist.ac.jp with ftp.etl.go.jp. + + * texi/gnus-faq-ja.texi: Modify for T-gnus 6.13. + * texi/message-ja.texi: Ditto. + * texi/message.texi: Ditto. + * texi/gnus-ja.texi: Ditto. + * texi/gnus.texi: Ditto. + * README-offline.ja: Ditto. + * README-offline.en: Ditto. + * README.semi.ja: Ditto. + * README.semi: Ditto. + * README.T-gnus: Ditto. + + * t-gnus-6_13: NEW PUBLIC BRANCH. + +See ChangeLog.2 for earlier changes. diff --git a/GNUS-NEWS b/GNUS-NEWS index ae36555..720c857 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -1,3 +1,10 @@ +** Gnus changes since 5.8. + +*** MML (Mime compose) prefix changed from `M-m' to `C-c C-m'. + +This change was made to avoid conflict with the standard binding of +`back-to-indentation', which is also useful in message mode. + ** Gnus changes. The Gnus NEWS entries are short, but they reflect sweeping changes in @@ -7,6 +14,22 @@ internationalization and mail-fetching. *** The mail-fetching functions have changed. See the manual for the many details. In particular, all procmail fetching variables are gone. +If you used procmail like in + +(setq nnmail-use-procmail t) +(setq nnmail-spool-file 'procmail) +(setq nnmail-procmail-directory "~/mail/incoming/") +(setq nnmail-procmail-suffix "\\.in") + +this now has changed to + +(setq mail-sources + '((directory :path "~/mail/incoming/" + :suffix ".in"))) + +More information is available in the info doc at Select Methods -> +Getting Mail -> Mail Sources + *** Gnus is now a MIME-capable reader. This affects many parts of Gnus, and adds a slew of new commands. See the manual for details. @@ -31,3 +54,8 @@ ever-changing layouts. *** Gnus can now read IMAP mail via nnimap. + +Local variables: +mode: outline +paragraph-separate: "[ ]*$" +end: diff --git a/Makefile.in b/Makefile.in index 0dbddc4..7bbcdfd 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1,5 +1,6 @@ prefix = @prefix@ datadir = @datadir@ +infodir = @infodir@ lispdir = @lispdir@ srcdir = @srcdir@ @@ -7,6 +8,24 @@ srcdir = @srcdir@ EMACS = @EMACS@ XEMACS = @XEMACS@ PACKAGEDIR = @PACKAGEDIR@ +GNUS_PRODUCT_NAME = @GNUS_PRODUCT_NAME@ + +# It will be used to look for the XEmacs package path if this file is +# mis-configured (e.g. configured for FSFmacs). +EXAMINE_PACKAGEDIR = $(XEMACS) -batch -q -no-site-file -eval \ + "(let (package-dir) \ + (if (boundp (quote early-packages)) \ + (let ((dirs (delq nil (append (if early-package-load-path \ + early-packages) \ + (if late-package-load-path \ + late-packages) \ + (if last-package-load-path \ + last-packages))))) \ + (while (and dirs (not package-dir)) \ + (if (file-directory-p (car dirs)) \ + (setq package-dir (car dirs) \ + dirs (cdr dirs)))))) \ + (princ (or package-dir \"\")))" 2>/dev/null all: lick info @@ -15,24 +34,94 @@ all-ja: lick info info-ja lick: cd lisp && $(MAKE) EMACS="$(EMACS)" lispdir="$(lispdir)" all -install: - cd lisp && $(MAKE) EMACS="$(EMACS)" lispdir="$(lispdir)" install - cd texi && $(MAKE) EMACS="$(EMACS)" install - -# Rule for XEmacs package. -package: xlick xinfo - cd lisp && $(MAKE) EMACS="$(XEMACS)" package +install: install-lisp install-info -install-package: xinfo - cd lisp && $(MAKE) EMACS="$(XEMACS)" PACKAGEDIR="$(PACKAGEDIR)" \ - install-package +install-ja: install install-info-ja -package-ja: xlick xinfo xinfo-ja - cd lisp && $(MAKE) EMACS="$(XEMACS)" package +install-lisp: + cd lisp && $(MAKE) EMACS="$(EMACS)" lispdir="$(lispdir)" install -install-package-ja: xinfo xinfo-ja - cd lisp && $(MAKE) EMACS="$(XEMACS)" PACKAGEDIR="$(PACKAGEDIR)" \ - install-package +install-info: + cd texi && $(MAKE) EMACS="$(EMACS)" infodir="$(infodir)" install + +install-info-ja: + cd texi && $(MAKE) EMACS="$(EMACS)" infodir="$(infodir)" install-ja + +## Rule for XEmacs package. +install-package: xlick compose-package remove-extra-files-in-package \ + install-package-lisp \ + install-package-info install-package-manifest + +install-package-ja: xlick compose-package remove-extra-files-in-package \ + install-package-lisp \ + install-package-info install-package-info-ja \ + install-package-manifest + +package: xlick xinfo compose-package + +package-ja: xlick xinfo xinfo-ja compose-package + +# Sub-rule for XEmacs package. +install-package-lisp: + @if test x$(PACKAGEDIR) = x; then \ + package_dir=`$(EXAMINE_PACKAGEDIR)`; \ + else \ + package_dir="$(PACKAGEDIR)"; \ + fi; \ + echo "cd lisp && $(MAKE)" \ + "lispdir=$$package_dir""/lisp/$(GNUS_PRODUCT_NAME)" \ + "install-lisp"; \ + cd lisp && $(MAKE) \ + lispdir="$$package_dir""/lisp/$(GNUS_PRODUCT_NAME)" \ + install-lisp + +install-package-info: + @if test x$(PACKAGEDIR) = x; then \ + package_dir=`$(EXAMINE_PACKAGEDIR)`; \ + else \ + package_dir="$(PACKAGEDIR)"; \ + fi; \ + echo "cd texi && $(MAKE) EMACS=$(XEMACS)" \ + "infodir=$$package_dir""/info install-info"; \ + cd texi && $(MAKE) EMACS="$(XEMACS)" \ + infodir="$$package_dir""/info" install-info + +install-package-info-ja: + @if test x$(PACKAGEDIR) = x; then \ + package_dir=`$(EXAMINE_PACKAGEDIR)`; \ + else \ + package_dir="$(PACKAGEDIR)"; \ + fi; \ + echo "cd texi && $(MAKE) EMACS=$(XEMACS)" \ + "infodir=$$package_dir""/info install-ja-info"; \ + cd texi && $(MAKE) EMACS="$(XEMACS)" \ + infodir="$$package_dir""/info" install-ja-info + +install-package-manifest: + @if test x$(PACKAGEDIR) = x; then \ + package_dir=`$(EXAMINE_PACKAGEDIR)`; \ + else \ + package_dir="$(PACKAGEDIR)"; \ + fi; \ + echo "cd lisp && $(MAKE) EMACS=$(XEMACS) PACKAGEDIR=$$package_dir" \ + "install-package-manifest"; \ + cd lisp && $(MAKE) EMACS="$(XEMACS)" PACKAGEDIR=$$package_dir \ + install-package-manifest + +remove-extra-files-in-package: + @if test x$(PACKAGEDIR) = x; then \ + package_dir=`$(EXAMINE_PACKAGEDIR)`; \ + else \ + package_dir="$(PACKAGEDIR)"; \ + fi; \ + echo "cd lisp && $(MAKE) EMACS=$(XEMACS) PACKAGEDIR=$$package_dir" \ + "remove-extra-files-in-package"; \ + cd lisp && $(MAKE) EMACS="$(XEMACS)" PACKAGEDIR=$$package_dir \ + remove-extra-files-in-package + +compose-package: + cd lisp && $(MAKE) EMACS="$(XEMACS)" compose-package +## xlick: cd lisp && $(MAKE) EMACS="$(XEMACS)" lispdir="$(lispdir)" all @@ -41,7 +130,7 @@ xinfo: cd texi && $(MAKE) EMACS="$(XEMACS)" all-info xinfo-ja: - cd texi && $(MAKE) EMACS="$(XEMACS)" MAKEINFO=no ja-info + cd texi && $(MAKE) EMACS="$(XEMACS)" ja-info # Rule for Lars and nobody else. some: @@ -53,30 +142,27 @@ info: cd texi && $(MAKE) EMACS="$(EMACS)" all info-ja: - cd texi && $(MAKE) EMACS=$(EMACS) MAKEINFO=no ja + cd texi && $(MAKE) EMACS=$(EMACS) ja clean: rm -f */*.orig */*.rej *.orig *.rej rm -f MANIFEST.* for i in lisp texi; do (cd $$i; $(MAKE) clean); done -xsome: - cd lisp && $(MAKE) EMACS="$(XEMACS)" some - elclean: cd lisp && rm -f *.elc auto-autoloads.el custom-load.el x: $(MAKE) EMACS="$(XEMACS)" +xsome: + $(MAKE) EMACS="$(XEMACS)" some + distclean: clean rm -rf *~ for i in lisp texi; do (cd $$i; $(MAKE) distclean); done rm -f config.log config.status config.cache Makefile -osome: - $(MAKE) EMACS="$(XEMACS)" some - config.status: $(srcdir)/configure $(SHELL) ./config.status --recheck $(srcdir)/configure: $(srcdir)/configure.in diff --git a/Mule23@1934.en b/Mule23@1934.en index 3f764d3..7a45479 100644 --- a/Mule23@1934.en +++ b/Mule23@1934.en @@ -1,30 +1,38 @@ How to build T-gnus with Mule 2.3 based on Emacs 19.34. -FIX loaddefs.el -=============== +FIXING loaddefs.el +================== Unfortunately, some variables for `message' are predefined in lisp/ loaddefs.el which is dumped in Mule executable file. It is uninvited, moreover, it has a bad influence. So you should remove these definitions from lisp/loaddefs.el and rebuild Mule. However, if you -don't want to rebuild Mule, put the following lines in the beginning -of .emacs file instead. - -(mapcar - (lambda (symbol) - (makunbound (intern (format "message-%s" symbol)))) - '(citation-line-function - cite-function courtesy-message default-headers default-mail-headers - default-news-headers deletable-headers fcc-handler-function - followup-to-function from-style generate-headers-first generate-new-buffers - ignored-bounced-headers ignored-cited-headers ignored-mail-headers - ignored-news-headers ignored-resent-headers ignored-supersedes-headers - included-forward-headers indent-citation-function interactive - kill-buffer-on-exit post-method reply-to-function required-mail-headers - required-news-headers send-mail-function send-news-function - signature signature-before-forwarded-message signature-file - signature-separator syntax-checks use-followup-to user-organization-file - wide-reply-to-function yank-prefix)) +don't want to rebuild Mule, you may put the following lines in the +beginning of .emacs file instead of rebuilding Mule. + +(let ((symbols '(citation-line-function + cite-function courtesy-message default-headers + default-mail-headers default-news-headers + deletable-headers fcc-handler-function + followup-to-function from-style + generate-headers-first generate-new-buffers + ignored-bounced-headers ignored-cited-headers + ignored-mail-headers ignored-news-headers + ignored-resent-headers ignored-supersedes-headers + included-forward-headers indent-citation-function + interactive kill-buffer-on-exit post-method + reply-to-function required-mail-headers + required-news-headers send-mail-function + send-news-function signature + signature-before-forwarded-message signature-file + signature-separator syntax-checks use-followup-to + user-organization-file wide-reply-to-function + yank-prefix)) + symbol) + (while symbols + (setq symbol (car symbols) + symbols (cdr symbol)) + (makunbound (intern (format "message-%s" symbol))))) INSTALL CUSTOM, APEL, FLIM, SEMI/WEMI @@ -57,20 +65,83 @@ ftp://ftp.dina.kvl.dk/pub/Staff/Per.Abrahamsen/custom/custom-1.9962.tar.gz INSTALL T-gnus ============== -There are two ways of making T-gnus with Mule 2.3 based on Emacs 19.34. +There are three ways of making T-gnus with Mule 2.3 based on Emacs 19.34. - 1. Use the configure option `--with-addpath=' to specify the colon - separated directory names where EMU, APEL or CUSTOM packages have - already installed. For example: +1. If you have installed EMU, APEL, FLIM and SEMI or WEMI packages + under the standard load-path, for instance: - % configure --with-emacs=mule\ - --with-addpath=~/elisp/emu:~/elisp/apel:~elisp/custom - % make install + EMU: /usr/local/share/mule/19.34/site-lisp/ + APEL: /usr/local/share/mule/site-lisp/apel/ + FLIM: /usr/local/share/mule/site-lisp/flim/ + SEMI: /usr/local/share/mule/site-lisp/semi/ - 2. Copy `sample.lpath.el' to `~/.lpath.el' and modify it suitably for - your environment. Then type as following: + What is more, if you have been replaced old CUSTOM with new CUSTOM + or if you have installed new CUSTOM directly under the standard + load-path as such as /usr/local/share/mule/19.34/site-lisp/, you + may have nothing to be done; type the following commands right now. - % configure - % make EMACS=mule + % ./configure --with-emacs=mule + % make install - In this case, you shuold install manually. + However, if you have installed new CUSTOM in the subdirectory under + the standard load-path, use the configure option `--with-addpath=' + as follows: + + % ./configure --with-emacs=mule\ + --with-addpath=/usr/local/share/mule/site-lisp/custom/ + % make install + + or you can use the file subdirs.el under the parent directory of + the subdirectory of CUSTOM to add it into load-path which contain + the following contents: + + (normal-top-level-add-to-load-path + '("custom/" "and the other subdirectories.../")) + + and then just type: + + % ./configure --with-emacs=mule + % make install + +2. If you have installed EMU, APEL, FLIM and SEMI or WEMI packages in + the non-standard load-path, use the configure option + `--with-addpath=' with the colon separated directory names where + EMU, APEL or CUSTOM packages are installed. For example: + + % ./configure --with-emacs=mule\ + --with-addpath=~/elisp/emu/:~/elisp/apel/:~/elisp/custom/ + % make install + + In this case, you have no need to add paths of FLIM, SEMI or WEMI + if they are installed under the directory which is same as the + parent directory of APEL. + +3. This is another way to install T-gnus when you have installed EMU, + APEL, FLIM and SEMI or WEMI packages in the non-standard load-path. + Copy the file `sample.lpath.el' which is included in the + distribution to `~/.lpath.el' and modify it suitably for your + environment. And then type the following command. + + % ./configure --with-emacs=mule + % make install + + +USING Emacs W3 +============== + +;; By the way, it is the point, does anyone know where do we find +;; Emacs W3 package fitting with Mule 2.3 based on Emacs 19.34? :-p + +Some modules of T-gnus (e.g. nnshimbun) requires Emacs W3. You can +build T-gnus to be abel to use them, if you already have Emacs W3 +installed. For that, you should specify the path where Emacs W3 is +installed using the configure option `--with-w3=' or editing the file +`~/.lpath.el'. Here is an example for using the configure option: + + % ./configure --with-emacs=mule\ + --with-w3=/usr/local/share/mule/site-lisp/w3/ + % make install + +Don't mind if configure says "W3... not found". It is currently +malfunction when the configure option `--with-w3=' is not used even if +the path of Emacs W3 is specified in the file `~/.lpath.el'. diff --git a/Mule23@1934.ja b/Mule23@1934.ja index d759e64..5f79393 100644 --- a/Mule23@1934.ja +++ b/Mule23@1934.ja @@ -1,30 +1,39 @@ Emacs 19.34 $B$r%Y!<%9$K$7$?(B Mule 2.3 $B$G(B T-gnus $B$r:n$kJ}K!!#(B -FIX loaddefs.el -=============== +FIXING loaddefs.el +================== $B;DG0$J$3$H$K$$$/$D$+$N(B `message' $B$G;H$&JQ?t$,(B lisp/loaddefs.el $B$GDj5A(B $B$5$l$F$$$F(B Mule $B$N7W(B $B$J$*@$OC$@$7!"$7$+$b0-1F6A$,$"$j$^$9!#$=$3$G$"$J$?$O$=$l$i$NDj5A$r(B lisp/loaddefs.el $B$+$i:o=|$7$F!"(BMule $B$r:n$jD>$5$J$1$l$P$J$j$^$;$s!#(B $B$7$+$7!"$b$7$"$J$?$,(B Mule $B$r:n$jD>$9$3$H$rK>$^$J$$$J$i$P!"(B.emacs $B%U%!(B -$B%$%k$N@hF,$K0J2<$N3F9T$r=q$-9~$`$3$H$GBeMQ$9$k$3$H$,$G$-$^$9!#(B - -(mapcar - (lambda (symbol) - (makunbound (intern (format "message-%s" symbol)))) - '(citation-line-function - cite-function courtesy-message default-headers default-mail-headers - default-news-headers deletable-headers fcc-handler-function - followup-to-function from-style generate-headers-first generate-new-buffers - ignored-bounced-headers ignored-cited-headers ignored-mail-headers - ignored-news-headers ignored-resent-headers ignored-supersedes-headers - included-forward-headers indent-citation-function interactive - kill-buffer-on-exit post-method reply-to-function required-mail-headers - required-news-headers send-mail-function send-news-function - signature signature-before-forwarded-message signature-file - signature-separator syntax-checks use-followup-to user-organization-file - wide-reply-to-function yank-prefix)) +$B%$%k$N@hF,$K0J2<$N3F9T$r=q$-9~$`$3$H$G!"(BMule $B$r:n$jD>$9Be$o$j$K$9$k$3(B +$B$H$,$G$-$^$9!#(B + +(let ((symbols '(citation-line-function + cite-function courtesy-message default-headers + default-mail-headers default-news-headers + deletable-headers fcc-handler-function + followup-to-function from-style + generate-headers-first generate-new-buffers + ignored-bounced-headers ignored-cited-headers + ignored-mail-headers ignored-news-headers + ignored-resent-headers ignored-supersedes-headers + included-forward-headers indent-citation-function + interactive kill-buffer-on-exit post-method + reply-to-function required-mail-headers + required-news-headers send-mail-function + send-news-function signature + signature-before-forwarded-message signature-file + signature-separator syntax-checks use-followup-to + user-organization-file wide-reply-to-function + yank-prefix)) + symbol) + (while symbols + (setq symbol (car symbols) + symbols (cdr symbol)) + (makunbound (intern (format "message-%s" symbol))))) INSTALL CUSTOM, APEL, FLIM, SEMI @@ -57,20 +66,87 @@ ftp://ftp.dina.kvl.dk/pub/Staff/Per.Abrahamsen/custom/custom-1.9962.tar.gz INSTALL T-gnus ============== -Mule 2.3 based on Emacs 19.34 $B$G(B gnus $B$r:n$k$K$OFs$D$NJ}K!$,$"$j$^$9!#(B +Emacs 19.34 $B$r%Y!<%9$K$7$?(B Mule 2.3 $B$G(B gnus $B$r:n$k$K$O;0$D$NJ}K!$,$"$j(B +$B$^$9!#(B - 1. configure $B%*%W%7%g%s$N(B `--with-addpath=' $B$r;H$C$F(B EMU, APEL $B$*$h$S(B - CUSTOM $B$N3F%Q%C%1!<%8$,%$%s%9%H!<%k$5$l$F$$$k>l=j$r;XDj$7$F2<$5$$!#(B - $BNc$($P(B +1. $B$b$7$"$J$?$,(B EMU, APEL, FLIM $B$*$h$S(B SEMI $B$^$?$O(B WEMI $B$N3F%Q%C%1!<(B + $B%8$rI8=`$N(B load-path $B$N2<$K%$%s%9%H!<%k$7$F$$$k$H$7$^$9!#Nc$($P$3$&!#(B - % configure --with-emacs=mule\ - --with-addpath=~/elisp/emu:~/elisp/apel:~elisp/custom - % make + EMU: /usr/local/share/mule/19.34/site-lisp/ + APEL: /usr/local/share/mule/site-lisp/apel/ + FLIM: /usr/local/share/mule/site-lisp/flim/ + SEMI: /usr/local/share/mule/site-lisp/semi/ - 2. `sample.lpath.el' $B$r(B `~/.lpath.el' $B$K%3%T!<$7$F!"$"$J$?$N4D6-$K(B - $B9g$&$h$&$K=q$-49$($F2<$5$$!#$=$7$F2<$K%$%s%9%H!<%k$7$F$$$k$J$i$P!"$"$J$?$O2?$b$9(B + $B$kI,MW$,$"$j$^$;$s!#:#$9$0$K0J2<$N%3%^%s%I$r%?%$%W$7$F2<$5$$!#(B - % configure - % make EMACS=mule + % ./configure --with-emacs=mule + % make install - $B$3$N>l9g(B install $B$O$H(B configure $B%*%W%7%g%s$N(B `--with-addpath=' $B$r;H$C$F2<$5$$!#(B + $BNc$($P(B + + % ./configure --with-emacs=mule\ + --with-addpath=~/elisp/emu/:~/elisp/apel/:~/elisp/custom/ + % make + + $B$3$N>l9g!"$b$7(B FLIM, SEMI $B$^$?$O(B WEMI $B$,(B APEL $B$N?F%G%#%l%/%H%j$HF1(B + $B$8%G%#%l%/%H%j$N2<$K%$%s%9%H!<%k$5$l$F$$$k$J$i$P!"$=$l$i$N(B path $B$r(B + $BDI2C$9$kI,MW$O$"$j$^$;$s!#(B + +3. $B$3$l$O!"(BEMU, APEL, FLIM $B$*$h$S(B SEMI $B$^$?$O(B WEMI $B$N3F%Q%C%1!<%8$rI8(B + $B=`$G$O$J$$(B load-path $B$K%$%s%9%H!<%k$7$F$$$k>l9g$N!"JL$NJ}K!$G$9!#(B + $BG[I[$K4^$^$l$F$$$k%U%!%$%k(B `sample.lpath.el' $B$r(B `~/.lpath.el' $B$K%3(B + $B%T!<$7$F!"$"$J$?$N4D6-$K9g$&$h$&$K=q$-49$($F2<$5$$!#$=$7$Fo$KF/$-(B +$B$^$;$s$N$G!#(B diff --git a/README b/README index e487c43..b5cefcd 100644 --- a/README +++ b/README @@ -30,7 +30,14 @@ in your Emacs, you should probably exit that Emacs and start a new one to fire up Gnus. Gnus does absolutely not work with anything older than Emacs 20.3 or -XEmacs 20.0. So you definitely need a new Emacs. +XEmacs 21.1.1. So you definitely need a new Emacs. However, T-gnus +does support `Mule 2.3 based on Emacs 19.34' (it is commonly called +"Mule 2.3@19.34"). See the file `Mule23@1934.{en,ja}' for details. +Furthermore, you might be able to use the versions of XEmacs prior to +21.1.1, e.g. 20.4, with a little work. For that, copy the file +`timer.el' in the `contrib' directory to the `site-lisp' directory and +do a `M-x byte-compile-file'. This file is imported from one of the +XEmacs package `fsf-compat-1.07-pkg.tar.gz'. Then you do a `M-x gnus', and everything should... uhm... it should work, but it might not. Set `debug-on-error' to t, and mail me the @@ -49,4 +56,4 @@ There are four main things I want your help and input on: bit, and features you would like to see. Send any comments and all your bug fixes/complaints to -`bugs@gnus.org'. +`semi-gnus-ja@meadowy.org' (or `bugs@gnus.org'). diff --git a/README-gnus-bbdb.en b/README-gnus-bbdb.en index b99d805..287636e 100644 --- a/README-gnus-bbdb.en +++ b/README-gnus-bbdb.en @@ -28,6 +28,7 @@ of this file should be applied. If not, it might not. (require 'gnus-bbdb) (bbdb-initialize 'sc) ;; 'Gnus or 'gnus should be deleted. (add-hook 'gnus-startup-hook 'gnus-bbdb-insinuate) +(add-hook 'message-setup-hook 'gnus-bbdb-insinuate-message) If you would like to decode the quoted encoded words forcibly, even though FLIM does not decode them, put the following lines in your @@ -44,7 +45,7 @@ though FLIM does not decode them, put the following lines in your ------ cut here ------ cut here ------ cut here ------ cut here ------ --- bbdb-hooks.el~ Tue Oct 13 03:13:50 1998 +++ bbdb-hooks.el Fri Oct 30 17:05:53 1998 -@@ -352,12 +352,22 @@ +@@ -352,12 +352,23 @@ (marker (bbdb-header-start)) field pairs fieldval ; do all bindings here for speed regexp string notes-field-name notes @@ -60,8 +61,9 @@ though FLIM does not decode them, put the following lines in your + function) + (or (progn + (while (and (not extract-field-value-funtion) -+ (setq function (pop function-list))) ++ (setq function (car function-list))) + (setq extract-field-value-funtion (funcall function))) ++ function-list (cdr function-list))) + extract-field-value-funtion) + (progn + (widen) diff --git a/README-gnus-bbdb.ja b/README-gnus-bbdb.ja index 18f3e9b..f9f99bf 100644 --- a/README-gnus-bbdb.ja +++ b/README-gnus-bbdb.ja @@ -29,6 +29,7 @@ bbdb-auto-notes-hook $B$r;HMQ$7$F$$$J$$J}$K$OITMW$G$9$,!";HMQ$7$F$$$kJ}(B (require 'gnus-bbdb) (bbdb-initialize 'sc) ;; 'gnus / 'Gnus $B$O$O$:$7$F$/$@$5$$!#(B (add-hook 'gnus-startup-hook 'gnus-bbdb-insinuate) +(add-hook 'message-setup-hook 'gnus-bbdb-insinuate-message) FLIM $B$G$O(B quote $B$5$l$?(B eword encoded word $B$O(B decode $B$5$l$^$;$s$,!"$=$l(B $B$r6/@)E*$K(B decode $B$7$?$$>l9g$K$O!"l9g!"(B + `foo-group' $B$K?6$jJ,$1$^$9!#(B + +*2 : `company' $B%U%#!<%k%I$,(B `bar' $B$G;O$^$C$F$$$k>l9g!"(B`company' $B%U%#!<(B + $B%k%I$NFbMF$r$=$N$^$^%0%k!<%WL>$H$7$F;HMQ$7!"?6$jJ,$1$^$9!#(B + +*3 : `group' $B%U%#!<%k%I$,$"$k>l9g!"(B`group' $B%U%#!<%k%I$NFbMF$r$=$N$^$^(B + $B%0%k!<%WL>$H$7$F;HMQ$7!"?6$jJ,$1$^$9!#(B + +*4 : `note' $B%U%#!<%k%I$K(B `my friend' $B$,4^$^$l$k>l9g!"$=$N8e$m$K;XDj$5(B + $B$l$?5,B'$G?6$jJ,$1$^$9!#$3$N5,B'$N5-=RJ}K!$O!"DL>o$N(B + `nnmail-split-fancy' $B$G$N5-=RJ}K!$HF1$8$b$N$G$9!#(B diff --git a/README.T-gnus b/README.T-gnus index b549f6d..cbc2215 100644 --- a/README.T-gnus +++ b/README.T-gnus @@ -1,7 +1,7 @@ ======================================================================== Codename: T-gnus -Branch Tag: t-gnus-6_13 -Branch Status: Public, Stable +Branch Tag: t-gnus-6_15-quimby +Branch Status: Develop, Synchronize with Oort Gnus Branch Goal: Implement latest features of gnus and offline features Use Gnus in Offline status. Branch Policy: (not defined yet) @@ -31,8 +31,8 @@ NEWS: See TODO.ja -* T-gnus 6.13 - this is based on Pterodactyl Gnus. +* T-gnus 6.15 - this is based on Oort Gnus. - The latest T-gnus is T-gnus 6.13.4 (Based on pgnus-0.99). It requires - SEMI/WEMI (1.13.5 or later), FLIM (1.13.1 or later), and APEL (9.20 or - later). + The latest T-gnus is T-gnus 6.15.0 (based on Oort Gnus 0.01). It + requires SEMI/WEMI (1.13.5 or later), FLIM (1.13.1 or later), and + APEL (10.0 or later). diff --git a/README.branch b/README.branch index 1f72794..4b7700d 100644 --- a/README.branch +++ b/README.branch @@ -1,7 +1,7 @@ README.branch --- description of branches and tags. (DRAFT) ======================================================================== -Semi-gnus revision tree (1999-08-04) +Semi-gnus revision tree (2000-12-21) vendor personal main trunk public branch branches branches @@ -22,12 +22,31 @@ qGnus 0.?? ------> Semi-gnus 6.0.0 : : : : : V : : 6.10.072 -----> t-gnus-6_12 - : akr <-- 6.2.3 : \ (for FLIM 1.12, - : shuhei-k <-- 6.3.1 \ stable) -Gnus 5.6.11 ------> 6.3.3 \ - : 6.4.0 (for SEMI 1.5) --> t-gnus-6_13 - : (6.4.?)------> for SEMI 1.5 (for FLIM 1.13, - : | \ develop) + : : : \ (for FLIM 1.12, + : : : \ stable) + : : : \ + : : : --> t-gnus-6_13 + : : : (for FLIM 1.13, + : : : develop) + : : : : + : : t-gnus-6_10-last- t-gnus-6_13-last- + : : | feedback | + : : +<--------------+ + : : | | + : ------------<---------------+ t-gnus-6_14 + : Oort Gnus / : | (for FLIM 1.13, + : | | : : develop) + : V V : | + : t-gnus-6_15-quimby<---<-----(t-gnus-6_14-quimby)<-----+ + : | : | + : : : : + : : + : akr <-- 6.2.3 + : shuhei-k <-- 6.3.1 +Gnus 5.6.11 ------> 6.3.3 + : 6.4.0 (for SEMI 1.5) + : (6.4.?)------> for SEMI 1.5 + : | \ : | \ (Synch with original Gnus | ---> for SEMI 1.6 was done many times, but (6.4.?)------> 6.5 (for SEMI 1.7) @@ -113,6 +132,8 @@ Public Branches pgnus-ichikawa (Main trunk of T-gnus) t-gnus-6_12 T-gnus for SEMI 1.12/1.13, FLIM 1.12 API (stable) t-gnus-6_13 T-gnus for SEMI 1.13, FLIM 1.13 API (develop) + t-gnus-6_14 T-gnus for SEMI 1.13, FLIM 1.13 API (develop) + t-gnus-6_15-quimby T-gnus for SEMI 1.13, FLIM 1.13 API (develop) Personal Branches diff --git a/README.branch.ja b/README.branch.ja index 079e5af..3b69df8 100644 --- a/README.branch.ja +++ b/README.branch.ja @@ -1,7 +1,7 @@ README.branch.ja --- branch $B$H(B tag $B$N@bL@(B ($BAp9F(B) ======================================================================== -Semi-gnus revision tree (1999-08-04) +Semi-gnus revision tree (2000-12-21) vendor personal main trunk public branch branches branches @@ -21,12 +21,31 @@ qGnus 0.?? ------> Semi-gnus 6.0.0 : +-------->---------------+ : : : : : V - : : 6.10.072 ----> t-gnus-6_12 - : akr <-- 6.2.3 : \ (for FLIM 1.12) - : shuhei-k <-- 6.3.1 \ -Gnus 5.6.11 ------> 6.3.3 --> t-gnus-6_13 - : 6.4.0 (for SEMI 1.5) (for FLIM 1.13) - : (6.4.?)------> for SEMI 1.5 + : : 6.10.072 -----> t-gnus-6_12 + : : : \ (for FLIM 1.12, + : : : \ stable) + : : : \ + : : : --> t-gnus-6_13 + : : : (for FLIM 1.13, + : : : develop) + : : : : + : : t-gnus-6_10-last- t-gnus-6_13-last- + : : | feedback | + : : +<--------------+ + : : | | + : ------------<---------------+ t-gnus-6_14 + : Oort Gnus / : | (for FLIM 1.13, + : | | : : develop) + : V V : | + : t-gnus-6_15-quimby<---<-----(t-gnus-6_14-quimby)<-----+ + : | : | + : : : : + : : + : akr <-- 6.2.3 + : shuhei-k <-- 6.3.1 +Gnus 5.6.11 ------> 6.3.3 + : 6.4.0 (for SEMI 1.5) + : (6.4.?)------> for SEMI 1.5 : | \ : | \ ($B85$N(B Gnus $B$H$N(B Sync $B$O2?EY(B | ---> for SEMI 1.6 @@ -113,6 +132,8 @@ Public Branches pgnus-ichikawa (Main trunk of T-gnus) t-gnus-6_12 T-gnus for SEMI 1.12/1.13, FLIM 1.12 API (stable) t-gnus-6_13 T-gnus for SEMI 1.13, FLIM 1.13 API (develop) + t-gnus-6_14 T-gnus for SEMI 1.13, FLIM 1.13 API (develop) + t-gnus-6_15-quimby T-gnus for SEMI 1.13, FLIM 1.13 API (develop) Personal Branches diff --git a/README.semi b/README.semi index a9910ff..400ef23 100644 --- a/README.semi +++ b/README.semi @@ -1,4 +1,4 @@ -This package contains T-gnus 6.13. +This package contains T-gnus 6.15. What is T-gnus? =============== @@ -8,7 +8,7 @@ features of Gnus and gnus-mime, so there are no need to install Gnus to use it, and you must not use gnus-mime for SEMI. It requires APEL, FLIM and SEMI packages, so please get and install -them before to install it. T-gnus 6.13 requires APEL 9.20 or later, +them before to install it. T-gnus 6.15 requires APEL 10.0 or later, FLIM (1.13.1 or later) and SEMI/WEMI (1.13.5 or later). You can get these packages from: @@ -24,15 +24,14 @@ How to get? (via CVS) (0) cvs login (first time only) - % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - login + % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login CVS password: [CR] # NULL string (1) checkout - % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - checkout -r t-gnus-6_13 gnus + % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \ + checkout -r t-gnus-6_15-quimby gnus (2) compile @@ -42,14 +41,12 @@ How to get? (via CVS) (3) update - % cvs update -r t-gnus-6_13 gnus + % cvs update -r t-gnus-6_15-quimby gnus Major tags are following: - t-gnus-6_12 Assigned to the latest stable version of T-gnus. - - t-gnus-6_13 Assigned to the latest development version of - T-gnus. + t-gnus-6_15-quimby Assigned to the latest version of T-gnus for + developing and synchronizing with Oort Gnus. pgnus-ichikawa The main trunk of T-gnus. @@ -81,19 +78,9 @@ For more detailed information, please read README.branch. How to get? (via ftp) ===================== - The stable version of T-gnus is available from - - ftp://ftp.jpl.org/pub/elisp/t-gnus-6.12/ - - and the experimental version of T-gnus is available from + T-gnus 6.15 is available from - ftp://ftp.jpl.org/pub/elisp/t-gnus-6.13/ - - In addition, semi-daily snapshots are also available from - - ftp://ftp.jpl.org/pub/elisp/t-gnus-6.12/snapshots/ - or - ftp://ftp.jpl.org/pub/elisp/t-gnus-6.13/snapshots/ + ftp://ftp.jpl.org/pub/elisp/t-gnus-6.15/snapshots/ NOTE: These snapshots are manually created when the urge takes the administrator of the a-ftp site, and will usually not be tested. @@ -109,8 +96,8 @@ send a bug report to the Gnus maintainers. is a Gnus proper, please send a bug report to the Semi-gnus mailing list: - semi-gnus-en@meadow.scphys.kyoto-u.ac.jp (English) - semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (Japanese) + semi-gnus-en@meadowy.org (English) + semi-gnus-ja@meadowy.org (Japanese) Suggestions for T-gnus improvements are also welcome. @@ -118,14 +105,17 @@ Suggestions for T-gnus improvements are also welcome. latest release of T-gnus, and discuss future enhancements to T-gnus. To join the Semi-gnus ML, send an empty e-mail to - semi-gnus-en-help@meadow.scphys.kyoto-u.ac.jp (English) - semi-gnus-ja-help@meadow.scphys.kyoto-u.ac.jp (Japanese) + semi-gnus-en-help@meadowy.org (English) + semi-gnus-ja-help@meadowy.org (Japanese) In addition, we need developers. If you would like to develop it, -please send mail to cvs@chamonix.jaist.ac.jp with your account name -and UNIX /etc/passwd style crypted password. You can get the notice -of modifications in chamonix open CVS server via the mail which also -contains informations on the other modules. To subscribe it, send an -empty e-mail to - - cvs-info-help@chamonix.jaist.ac.jp +please send mail to cvs@cvs.m17n.org with your account name and your +public key for ssh. cvsroot is :ext:cvs@cvs.m17n.org:/cvs/root. +If you cannot use ssh, please send UNIX /etc/passwd style crypted +password instead. cvsroot is +:pserver:@cvs.m17n.org:/cvs/root in this case. You can +get the notice of modifications in m17n open CVS server via the mail +which also contains informations on the other modules. To subscribe +it, send an empty e-mail to + + cvs-info-help@cvs.m17n.org diff --git a/README.semi.ja b/README.semi.ja index 222f17a..aafaaf7 100644 --- a/README.semi.ja +++ b/README.semi.ja @@ -1,4 +1,4 @@ -$B$3$N%Q%C%1!<%8$K$O(B T-gnus 6.13 $B$,F~$C$F$$$^$9!#(B +$B$3$N%Q%C%1!<%8$K$O(B T-gnus 6.15 $B$,F~$C$F$$$^$9!#(B T-gnus $B$H$O!)(B ============= @@ -9,7 +9,7 @@ T-gnus $B$H$O!)(B $B$7$F$O$$$1$^$;$s!#(B APEL, FLIM $B$*$h$S(B SEMI $B%Q%C%1!<%8$,I,MW$G$9$N$G!"%$%s%9%H!<%k$9$kA0(B -$B$K$=$l$i$r%$%s%9%H!<%k$7$F$/$@$5$$!#(BT-gnus 6.13 $B$O(B APEL 9.20 $B0J>e!"(B +$B$K$=$l$i$r%$%s%9%H!<%k$7$F$/$@$5$$!#(BT-gnus 6.15 $B$O(B APEL 10.0 $B0J>e!"(B FLIM (1.13.1 $B0J>e(B) $B$*$h$S(B SEMI/WEMI (1.13.5 $B0J>e(B) $B$rI,MW$H$7$^$9!#$=$l(B $B$i$N%Q%C%1!<%8$O(B @@ -26,15 +26,14 @@ ftp://ftp.m17n.org/pub/mule/semi/semi-1.13-for-flim-1.13/ (0) cvs login ($B=i2s$N$_(B) - % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - login + % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login CVS password: [CR] # $B6uJ8;zNs(B (1) checkout - % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - checkout -r t-gnus-6_13 gnus + % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \ + checkout -r t-gnus-6_15-quimby gnus (2) compile @@ -44,13 +43,12 @@ ftp://ftp.m17n.org/pub/mule/semi/semi-1.13-for-flim-1.13/ (3) update - % cvs update -r t-gnus-6_13 gnus + % cvs update -r t-gnus-6_15-quimby gnus $Bl=j$+$i$l-Mh$N3HD%$r5DO@$7$?$j$9$k$3$H$,$G$-$^(B $B$9!#(BSemi-gnus ML $B$K;22C$9$k$?$a$K$O(B - semi-gnus-en-help@meadow.scphys.kyoto-u.ac.jp ($B1Q8l(B) - semi-gnus-ja-help@meadow.scphys.kyoto-u.ac.jp ($BF|K\8l(B) + semi-gnus-en-help@meadowy.org ($B1Q8l(B) + semi-gnus-ja-help@meadowy.org ($BF|K\8l(B) $B$K6u$N%a!<%k$rAw$C$F$/$@$5$$!#(B $B2C$($F!"3+H/l9g$O!"(B - cvs@chamonix.jaist.ac.jp $B$K%"%+%&%s%HL>$H(B UNIX $B$N(B /etc/passwd $B$NMM<0(B - $B$G0E9f2=$5$l$?%Q%9%o!<%I$r%a!<%k$rAw$C$F$/$@$5$$!#(B - chamonix open CVS server $B$G9T$J$o$l$?JQ99$r%a!<%k$GDLCN$7$F$b$i$&$3(B - $B$H$b2DG=$G$9!#$3$l$K$O(B gnus $B0J30$N(B module $B$K4X$9$k>pJs$b4^$^$l$^$9!#(B - $BI,MW$JJ}$O(B - - cvs-info-help@chamonix.jaist.ac.jp + cvs@cvs.m17n.org $B$K%"%+%&%s%HL>$H(B ssh $B$N8x3+80$rAw$C$F$/$@$5$$!#(Bssh + $B7PM3$G$N(B cvsroot $B$O(B :ext:cvs@cvs.m17n.org:/cvs/root $B$H$J$j$^$9!#$I$&(B + $B$7$F$b(B ssh $B$,;H$($J$$>l9g!"(BUNIX $B$N(B /etc/passwd $B$NMM<0$G0E9f2=$5$l$?(B + $B%Q%9%o!<%I$r%a!<%k$rAw$C$F$/$@$5$$!#$3$N>l9g(B cvsroot $B$O(B + :pserver:<$B%"%+%&%s%HL>(B>@cvs.m17n.org:/cvs/root $B$H$J$j$^$9!#(Bm17n open + CVS server $B$G9T$J$o$l$?JQ99$r%a!<%k$GDLCN$7$F$b$i$&$3$H$b2DG=$G$9!#(B + $B$3$l$K$O(B gnus $B0J30$N(B module $B$K4X$9$k>pJs$b4^$^$l$^$9!#I,MW$JJ}$O(B + + cvs-info-help@cvs.m17n.org $B$K6u$N%a!<%k$rAw$C$F0FFb$K=>$C$F2<$5$$!#(B diff --git a/acinclude.m4 b/acinclude.m4 deleted file mode 100644 index 79ff3ac..0000000 --- a/acinclude.m4 +++ /dev/null @@ -1,103 +0,0 @@ -dnl Copyright (C) 1999 NISHIDA Keisuke -dnl -dnl This program is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as published by -dnl the Free Software Foundation; either version 2, or (at your option) -dnl any later version. -dnl -dnl This program is distributed in the hope that it will be useful, -dnl but WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -dnl GNU General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public License -dnl along with this program; if not, write to the Free Software -dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -dnl 02111-1307, USA. - -AC_DEFUN(AM_PATH_LISPDIR, - [dnl # - dnl # Check Emacs - dnl # - AC_ARG_WITH(emacs, - [ --with-emacs=EMACS compile with EMACS [EMACS=emacs, xemacs...]], - [case "${withval}" in - yes) EMACS= ;; - no) AC_MSG_ERROR([emacs is not available]) ;; - *) EMACS=${withval} ;; - esac], EMACS=) - if test "x$EMACS" = "xt" -o "x$EMACS" = x; then - AC_PATH_PROGS(EMACS, emacs xemacs mule, no) - if test $EMACS = no; then - AC_MSG_ERROR(you should install Emacs first) - fi - fi - dnl # - dnl # Check Emacs directories - dnl # - AC_MSG_CHECKING([where emacs files are in]) - EMACS_BASENAME="`echo x$EMACS | sed -e 's/x//' -e 's/^.*\///'`" - if test "x$emacsdir" = x; then - if test "x$prefix" = "xNONE"; then - prefix=$ac_default_prefix - fi - emacsdir="\$(datadir)/emacs" - case "$EMACS_BASENAME" in - emacs|emacs-*) - if test -d $prefix/lib/emacs; then - emacsdir="$prefix/lib/emacs" - fi - if test -d $prefix/share/emacs; then - emacsdir="$prefix/share/emacs" - fi - ;; - xemacs|xemacs-*) - if test -d $prefix/lib/xemacs; then - emacsdir="$prefix/lib/xemacs" - fi - if test -d $prefix/share/xemacs; then - emacsdir="$prefix/share/xemacs" - fi - ;; - mule|mule-*) - if test -d $prefix/lib/emacs; then - emacsdir="$prefix/lib/emacs" - fi - if test -d $prefix/share/emacs; then - emacsdir="$prefix/share/emacs" - fi - if test -d $prefix/lib/mule; then - emacsdir="$prefix/lib/mule" - fi - if test -d $prefix/share/mule; then - emacsdir="$prefix/share/mule" - fi - ;; - esac - fi - AC_MSG_RESULT($emacsdir) - AC_SUBST(emacsdir) - dnl # - dnl # Check Emacs site-lisp directories - dnl # - AC_ARG_WITH(lispdir, - [ --with-lispdir=DIR emacs lisp files go to DIR [guessed]], - [case "${withval}" in - yes) lispdir= ;; - no) AC_MSG_ERROR(lispdir is not available) ;; - *) lispdir=${withval} ;; - esac], lispdir=) - AC_MSG_CHECKING([where .elc files should go]) - if test "x$lispdir" = x; then - lispdir="$emacsdir/site-lisp" - if test -d $emacsdir/lisp; then - lispdir="$emacsdir/lisp" - fi - case "$EMACS_BASENAME" in - xemacs|xemacs-*) - lispdir="$lispdir/lookup" - ;; - esac - fi - AC_MSG_RESULT($lispdir) - AC_SUBST(lispdir)]) diff --git a/aclocal.m4 b/aclocal.m4 index fa32a2a..aee05d3 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1,217 +1,225 @@ -dnl aclocal.m4 generated automatically by aclocal 1.3 +AC_DEFUN(AC_DEFINE_GNUS_PRODUCT_NAME, + [echo $ac_n "defining gnus product name... $ac_c" + AC_CACHE_VAL(EMACS_cv_GNUS_PRODUCT_NAME,[EMACS_cv_GNUS_PRODUCT_NAME=$1]) + GNUS_PRODUCT_NAME=${EMACS_cv_GNUS_PRODUCT_NAME} + AC_MSG_RESULT(${GNUS_PRODUCT_NAME}) + AC_SUBST(GNUS_PRODUCT_NAME)]) -dnl Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -dnl This Makefile.in is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. +AC_DEFUN(AC_CHECK_EMACS, + [dnl Check for Emacsen. -dnl This program is distributed in the hope that it will be useful, -dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without -dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A -dnl PARTICULAR PURPOSE. + dnl Apparently, if you run a shell window in Emacs, it sets the EMACS + dnl environment variable to 't'. Lets undo the damage. + test x$EMACS = xt && EMACS= + + dnl Ignore cache. + unset ac_cv_prog_EMACS; unset ac_cv_prog_XEMACS; -dnl Copyright (C) 1999 NISHIDA Keisuke -dnl -dnl This program is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as published by -dnl the Free Software Foundation; either version 2, or (at your option) -dnl any later version. -dnl -dnl This program is distributed in the hope that it will be useful, -dnl but WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -dnl GNU General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public License -dnl along with this program; if not, write to the Free Software -dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -dnl 02111-1307, USA. - -AC_DEFUN(AM_PATH_LISPDIR, - [dnl # - dnl # Check Emacs - dnl # AC_ARG_WITH(emacs, - [ --with-emacs=EMACS compile with EMACS [EMACS=emacs, xemacs...]], - [case "${withval}" in - yes) EMACS= ;; - no) AC_MSG_ERROR([emacs is not available]) ;; - *) EMACS=${withval} ;; - esac], EMACS=) - if test "x$EMACS" = "xt" -o "x$EMACS" = x; then - AC_PATH_PROGS(EMACS, emacs xemacs mule, no) - if test $EMACS = no; then - AC_MSG_ERROR(you should install Emacs first) + [ --with-emacs=EMACS compile with EMACS [EMACS=emacs, mule...]], + [if test x$withval = xyes -o x$withval = x; then + AC_CHECK_PROGS(EMACS, emacs xemacs mule, emacs) + else + AC_CHECK_PROG(EMACS, $withval, $withval, emacs) + fi]) + AC_ARG_WITH(xemacs, + [ --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]], + [if test x$withval = xyes -o x$withval = x; then + AC_CHECK_PROG(XEMACS, xemacs, xemacs, xemacs) + else + AC_CHECK_PROG(XEMACS, $withval, $withval, xemacs) fi + EMACS=$XEMACS], + [XEMACS=xemacs + test x$EMACS = x &&\ + AC_CHECK_PROGS(EMACS, emacs xemacs mule, emacs)]) + AC_SUBST(EMACS) + AC_SUBST(XEMACS)]) + +AC_DEFUN(AC_EMACS_LISP, [ +elisp="$2" +if test -z "$3"; then + AC_MSG_CHECKING(for $1) +fi +AC_CACHE_VAL(EMACS_cv_SYS_$1,[ + OUTPUT=./conftest-$$ + echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& AC_FD_CC 2>&1 + eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& AC_FD_CC 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& AC_FD_CC 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_$1=$retval +]) +$1=${EMACS_cv_SYS_$1} +if test -z "$3"; then + AC_MSG_RESULT($$1) +fi +]) + +AC_DEFUN(AC_CHECK_EMACS_FLAVOR, + [AC_MSG_CHECKING([what a flavor does $EMACS have]) + + dnl Ignore cache. + unset EMACS_cv_SYS_flavor; + + AC_EMACS_LISP(flavor, + (cond ((featurep (quote xemacs)) \"XEmacs\")\ + ((boundp (quote MULE)) \"MULE\")\ + (t \"FSF Emacs\")), + "noecho") + case $EMACS_cv_SYS_flavor in + XEmacs) + EMACS_FLAVOR=xemacs;; + MULE) + EMACS_FLAVOR=mule;; + *) + EMACS_FLAVOR=emacs;; + esac + AC_MSG_RESULT($EMACS_cv_SYS_flavor)]) + +AC_DEFUN(AC_PATH_LISPDIR, [ + AC_CHECK_EMACS_FLAVOR + if test "$prefix" = "NONE"; then + AC_MSG_CHECKING([prefix for your Emacs]) + AC_EMACS_LISP(prefix,(expand-file-name \"..\" invocation-directory),"noecho") + prefix=${EMACS_cv_SYS_prefix} + AC_MSG_RESULT($prefix) fi - dnl # - dnl # Check Emacs directories - dnl # - AC_MSG_CHECKING([where emacs files are in]) - EMACS_BASENAME="`echo x$EMACS | sed -e 's/x//' -e 's/^.*\///'`" - if test "x$emacsdir" = x; then - if test "x$prefix" = "xNONE"; then - prefix=$ac_default_prefix - fi - emacsdir="\$(datadir)/emacs" - case "$EMACS_BASENAME" in - emacs|emacs-*) - if test -d $prefix/lib/emacs; then - emacsdir="$prefix/lib/emacs" - fi - if test -d $prefix/share/emacs; then - emacsdir="$prefix/share/emacs" - fi - ;; - xemacs|xemacs-*) - if test -d $prefix/lib/xemacs; then - emacsdir="$prefix/lib/xemacs" - fi - if test -d $prefix/share/xemacs; then - emacsdir="$prefix/share/xemacs" - fi - ;; - mule|mule-*) - if test -d $prefix/lib/emacs; then - emacsdir="$prefix/lib/emacs" - fi - if test -d $prefix/share/emacs; then - emacsdir="$prefix/share/emacs" - fi - if test -d $prefix/lib/mule; then - emacsdir="$prefix/lib/mule" - fi - if test -d $prefix/share/mule; then - emacsdir="$prefix/share/mule" - fi - ;; - esac - fi - AC_MSG_RESULT($emacsdir) - AC_SUBST(emacsdir) - dnl # - dnl # Check Emacs site-lisp directories - dnl # AC_ARG_WITH(lispdir, - [ --with-lispdir=DIR emacs lisp files go to DIR [guessed]], - [case "${withval}" in - yes) lispdir= ;; - no) AC_MSG_ERROR(lispdir is not available) ;; - *) lispdir=${withval} ;; - esac], lispdir=) - AC_MSG_CHECKING([where .elc files should go]) - if test "x$lispdir" = x; then - lispdir="$emacsdir/site-lisp" - if test -d $emacsdir/lisp; then - lispdir="$emacsdir/lisp" + [ --with-lispdir=DIR Where to install lisp files + (for XEmacs package, use --with-packagedir instead)], + lispdir=${withval}) + AC_MSG_CHECKING([where lisp files should go]) + if test -z "$lispdir"; then + dnl Set default value + theprefix=$prefix + if test "x$theprefix" = "xNONE"; then + theprefix=$ac_default_prefix fi - case "$EMACS_BASENAME" in - xemacs|xemacs-*) - lispdir="$lispdir/tgnus" - ;; - esac + lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}" + for thedir in share lib; do + potential= + if test -d ${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp; then + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}" + break + fi + done fi - AC_MSG_RESULT($lispdir) - AC_SUBST(lispdir)]) - -# Do all the work for Automake. This macro actually does too much -- -# some checks are only needed if your package does certain things. -# But this isn't really a big deal. - -# serial 1 - -dnl Usage: -dnl AM_INIT_AUTOMAKE(package,version, [no-define]) - -AC_DEFUN(AM_INIT_AUTOMAKE, -[AC_REQUIRE([AM_PROG_INSTALL]) -PACKAGE=[$1] -AC_SUBST(PACKAGE) -VERSION=[$2] -AC_SUBST(VERSION) -dnl test to see if srcdir already configured -if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then - AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) -fi -ifelse([$3],, -AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE") -AC_DEFINE_UNQUOTED(VERSION, "$VERSION")) -AC_REQUIRE([AM_SANITY_CHECK]) -AC_REQUIRE([AC_ARG_PROGRAM]) -dnl FIXME This is truly gross. -missing_dir=`cd $ac_aux_dir && pwd` -AM_MISSING_PROG(ACLOCAL, aclocal, $missing_dir) -AM_MISSING_PROG(AUTOCONF, autoconf, $missing_dir) -AM_MISSING_PROG(AUTOMAKE, automake, $missing_dir) -AM_MISSING_PROG(AUTOHEADER, autoheader, $missing_dir) -AM_MISSING_PROG(MAKEINFO, makeinfo, $missing_dir) -AC_REQUIRE([AC_PROG_MAKE_SET])]) - - -# serial 1 - -AC_DEFUN(AM_PROG_INSTALL, -[AC_REQUIRE([AC_PROG_INSTALL]) -test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' -AC_SUBST(INSTALL_SCRIPT)dnl + if test ${EMACS_FLAVOR} = xemacs; then + AC_MSG_RESULT([$lispdir + (it will be ignored when \"make install-package[[-ja]]\" is done)]) + else + AC_MSG_RESULT([$lispdir]) + fi + AC_SUBST(lispdir) ]) -# -# Check to make sure that the build environment is sane. -# - -AC_DEFUN(AM_SANITY_CHECK, -[AC_MSG_CHECKING([whether build environment is sane]) -# Just in case -sleep 1 -echo timestamp > conftestfile -# Do `set' in a subshell so we don't clobber the current shell's -# arguments. Must try -L first in case configure is actually a -# symlink; some systems play weird games with the mod time of symlinks -# (eg FreeBSD returns the mod time of the symlink's containing -# directory). -if ( - set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null` - if test "[$]*" = "X"; then - # -L didn't work. - set X `ls -t $srcdir/configure conftestfile` - fi - if test "[$]*" != "X $srcdir/configure conftestfile" \ - && test "[$]*" != "X conftestfile $srcdir/configure"; then - - # If neither matched, then we have a broken ls. This can happen - # if, for instance, CONFIG_SHELL is bash and it inherits a - # broken ls alias from the environment. This has actually - # happened. Such a system could not be considered "sane". - AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken -alias in your environment]) - fi +dnl +dnl Check whether a function exists in a library +dnl All '_' characters in the first argument are converted to '-' +dnl +AC_DEFUN(AC_EMACS_CHECK_LIB, [ +if test -z "$3"; then + AC_MSG_CHECKING(for $2 in $1) +fi +library=`echo $1 | tr _ -` +AC_EMACS_LISP($1,(progn (fmakunbound (quote $2)) (condition-case nil (progn (require (quote $library)) (fboundp (quote $2))) (error (prog1 nil (message \"$library not found\"))))),"noecho") +if test "${EMACS_cv_SYS_$1}" = "nil"; then + EMACS_cv_SYS_$1=no +fi +if test "${EMACS_cv_SYS_$1}" = "t"; then + EMACS_cv_SYS_$1=yes +fi +HAVE_$1=${EMACS_cv_SYS_$1} +AC_SUBST(HAVE_$1) +if test -z "$3"; then + AC_MSG_RESULT($HAVE_$1) +fi +]) - test "[$]2" = conftestfile - ) -then - # Ok. - : +dnl +dnl Perform sanity checking and try to locate the W3 package +dnl +AC_DEFUN(AC_CHECK_W3, [ +AC_MSG_CHECKING(for acceptable W3 version) + +dnl Ignore cache. +unset EMACS_cv_ACCEPTABLE_W3; +unset EMACS_cv_SYS_w3_dir; +unset EMACS_cv_SYS_w3_forms; + +AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_W3,[ +AC_EMACS_CHECK_LIB(w3_forms, w3-form-encode-xwfu,"noecho") +if test "${HAVE_w3_forms}" = "yes"; then + EMACS_cv_ACCEPTABLE_W3=yes else - AC_MSG_ERROR([newly created file is older than distributed files! -Check your system clock]) + EMACS_cv_ACCEPTABLE_W3= fi -rm -f conftest* -AC_MSG_RESULT(yes)]) - -dnl AM_MISSING_PROG(NAME, PROGRAM, DIRECTORY) -dnl The program must properly implement --version. -AC_DEFUN(AM_MISSING_PROG, -[AC_MSG_CHECKING(for working $2) -# Run test in a subshell; some versions of sh will print an error if -# an executable is not found, even if stderr is redirected. -# Redirect stdin to placate older versions of autoconf. Sigh. -if ($2 --version) < /dev/null > /dev/null 2>&1; then - $1=$2 - AC_MSG_RESULT(found) -else - $1="$3/missing $2" - AC_MSG_RESULT(missing) + +if test "x${EMACS_cv_ACCEPTABLE_W3}" = "xyes"; then + AC_EMACS_LISP(w3_dir,(file-name-directory (locate-library \"w3-forms\")),"noecho") + EMACS_cv_ACCEPTABLE_W3=$EMACS_cv_SYS_w3_dir fi -AC_SUBST($1)]) +]) + AC_ARG_WITH(w3,[ --with-w3=DIR Specify where to find the w3 package], [ EMACS_cv_ACCEPTABLE_W3=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ]) + W3=${EMACS_cv_ACCEPTABLE_W3} + AC_SUBST(W3) + if test "x${EMACS_cv_ACCEPTABLE_W3}" = "x"; then + AC_MSG_RESULT(not found) + else + AC_MSG_RESULT(${W3}) + fi +]) +AC_DEFUN(AC_EXAMINE_PACKAGEDIR, + [dnl Examine PACKAGEDIR. + AC_EMACS_LISP(PACKAGEDIR, + (let (package-dir)\ + (if (boundp (quote early-packages))\ + (let ((dirs (delq nil (append (if early-package-load-path\ + early-packages)\ + (if late-package-load-path\ + late-packages)\ + (if last-package-load-path\ + last-packages)))))\ + (while (and dirs (not package-dir))\ + (if (file-directory-p (car dirs))\ + (setq package-dir (car dirs)\ + dirs (cdr dirs))))))\ + (or package-dir \"\")), + "noecho")]) + +AC_DEFUN(AC_PATH_PACKAGEDIR, + [dnl Check for PACKAGEDIR. + if test ${EMACS_FLAVOR} = xemacs; then + AC_MSG_CHECKING([where the XEmacs package is]) + AC_ARG_WITH(packagedir, + [ --with-packagedir=DIR package DIR for XEmacs], + [if test x$withval != xyes -a x$withval != x; then + PACKAGEDIR=$withval + else + AC_EXAMINE_PACKAGEDIR + fi], + AC_EXAMINE_PACKAGEDIR) + if test x$PACKAGEDIR = x; then + AC_MSG_RESULT(not found) + else + AC_MSG_RESULT($PACKAGEDIR) + fi + else + PACKAGEDIR= + fi + AC_SUBST(PACKAGEDIR)]) + +AC_DEFUN(AC_ADD_LOAD_PATH, + [dnl Check for additional load path. + AC_ARG_WITH(addpath, + [ --with-addpath=PATH search Emacs-Lisp libraries with PATH + use colons to separate directory names], + [if test x$withval != xyes -a x$withval != x; then + AC_MSG_CHECKING([where to find the additional elisp libraries]) + ADDITIONAL_LOAD_PATH=$withval + AC_MSG_RESULT($ADDITIONAL_LOAD_PATH) + fi], + ADDITIONAL_LOAD_PATH=) + AC_SUBST(ADDITIONAL_LOAD_PATH)]) diff --git a/configure b/configure index f96ef07..6cc8412 100755 --- a/configure +++ b/configure @@ -1,7 +1,7 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf version 2.13 +# Generated automatically using autoconf version 2.14.1 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation @@ -12,16 +12,19 @@ ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: ac_help="$ac_help - --with-emacs=EMACS compile with EMACS [EMACS=emacs, xemacs...]" + --with-emacs=EMACS compile with EMACS [EMACS=emacs, mule...]" ac_help="$ac_help - --with-lispdir=DIR emacs lisp files go to DIR [guessed]" + --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]" ac_help="$ac_help - --with-addpath=PATH search Emacs-Lisp libraries with PATH - use colons to separate directory names" + --with-lispdir=DIR Where to install lisp files + (for XEmacs package, use --with-packagedir instead)" ac_help="$ac_help - --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]" + --with-w3=DIR Specify where to find the w3 package" ac_help="$ac_help - --with-packagedir=DIR package DIR for XEmacs [guessed]" + --with-packagedir=DIR package DIR for XEmacs" +ac_help="$ac_help + --with-addpath=PATH search Emacs-Lisp libraries with PATH + use colons to separate directory names" # Initialize some variables set by options. # The variables have the same names as the options, with @@ -344,7 +347,7 @@ EOF verbose=yes ;; -version | --version | --versio | --versi | --vers) - echo "configure generated by autoconf version 2.13" + echo "configure generated by autoconf version 2.14.1" exit 0 ;; -with-* | --with-*) @@ -504,7 +507,7 @@ done if test -r "$cache_file"; then echo "loading cache $cache_file" - . $cache_file + test -f "$cache_file" && . $cache_file else echo "creating cache $cache_file" > $cache_file @@ -532,10 +535,20 @@ else fi +echo $ac_n "defining gnus product name... $ac_c" + if eval "test \"\${EMACS_cv_GNUS_PRODUCT_NAME+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + EMACS_cv_GNUS_PRODUCT_NAME=t-gnus +fi + + GNUS_PRODUCT_NAME=${EMACS_cv_GNUS_PRODUCT_NAME} + echo "$ac_t""${GNUS_PRODUCT_NAME}" 1>&6 + echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:537: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:550: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then +if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftestmake <<\EOF @@ -574,9 +587,9 @@ done if test -z "$ac_aux_dir"; then { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } fi -ac_config_guess=$ac_aux_dir/config.guess -ac_config_sub=$ac_aux_dir/config.sub -ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" +ac_config_sub="$SHELL $ac_aux_dir/config.sub" +ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. # Find a good install program. We prefer a C program (faster), # so one script is as good as another. But avoid the broken or @@ -590,9 +603,9 @@ ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:594: checking for a BSD compatible install" >&5 +echo "configure:607: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then -if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then +if eval "test \"\${ac_cv_path_install+set}\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" @@ -610,6 +623,10 @@ else grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. : + elif test $ac_prog = install && + grep pwplus $ac_dir/$ac_prog >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : else ac_cv_path_install="$ac_dir/$ac_prog -c" break 2 @@ -638,54 +655,74 @@ echo "$ac_t""$INSTALL" 1>&6 # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' -test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' - # Check whether --with-emacs or --without-emacs was given. -if test "${with_emacs+set}" = set; then - withval="$with_emacs" - case "${withval}" in - yes) EMACS= ;; - no) { echo "configure: error: emacs is not available" 1>&2; exit 1; } ;; - *) EMACS=${withval} ;; - esac +# Extract the first word of "makeinfo", so it can be a program name with args. +set dummy makeinfo; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:666: checking for $ac_word" >&5 +if eval "test \"\${ac_cv_prog_MAKEINFO+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$MAKEINFO"; then + ac_cv_prog_MAKEINFO="$MAKEINFO" # Let the user override the test. else - EMACS= + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_MAKEINFO="makeinfo" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_MAKEINFO" && ac_cv_prog_MAKEINFO="no" fi +fi +MAKEINFO="$ac_cv_prog_MAKEINFO" +if test -n "$MAKEINFO"; then + echo "$ac_t""$MAKEINFO" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + + test x$EMACS = xt && EMACS= - if test "x$EMACS" = "xt" -o "x$EMACS" = x; then - for ac_prog in emacs xemacs mule + unset ac_cv_prog_EMACS; unset ac_cv_prog_XEMACS; + + # Check whether --with-emacs or --without-emacs was given. +if test "${with_emacs+set}" = set; then + withval="$with_emacs" + if test x$withval = xyes -o x$withval = x; then + for ac_prog in emacs xemacs mule do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:664: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_path_EMACS'+set}'`\" = set"; then +echo "configure:707: checking for $ac_word" >&5 +if eval "test \"\${ac_cv_prog_EMACS+set}\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else - case "$EMACS" in - /*) - ac_cv_path_EMACS="$EMACS" # Let the user override the test with a path. - ;; - ?:/*) - ac_cv_path_EMACS="$EMACS" # Let the user override the test with a dos path. - ;; - *) + if test -n "$EMACS"; then + ac_cv_prog_EMACS="$EMACS" # Let the user override the test. +else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" - for ac_dir in $ac_dummy; do + for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then - ac_cv_path_EMACS="$ac_dir/$ac_word" + ac_cv_prog_EMACS="$ac_prog" break fi done IFS="$ac_save_ifs" - ;; -esac fi -EMACS="$ac_cv_path_EMACS" +fi +EMACS="$ac_cv_prog_EMACS" if test -n "$EMACS"; then echo "$ac_t""$EMACS" 1>&6 else @@ -694,146 +731,470 @@ fi test -n "$EMACS" && break done -test -n "$EMACS" || EMACS="no" +test -n "$EMACS" || EMACS="emacs" - if test $EMACS = no; then - { echo "configure: error: you should install Emacs first" 1>&2; exit 1; } + else + # Extract the first word of "$withval", so it can be a program name with args. +set dummy $withval; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:741: checking for $ac_word" >&5 +if eval "test \"\${ac_cv_prog_EMACS+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$EMACS"; then + ac_cv_prog_EMACS="$EMACS" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_EMACS="$withval" + break fi - fi - echo $ac_n "checking where emacs files are in""... $ac_c" 1>&6 -echo "configure:705: checking where emacs files are in" >&5 - EMACS_BASENAME="`echo x$EMACS | sed -e 's/x//' -e 's/^.*\///'`" - if test "x$emacsdir" = x; then - if test "x$prefix" = "xNONE"; then - prefix=$ac_default_prefix + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_EMACS" && ac_cv_prog_EMACS="emacs" +fi +fi +EMACS="$ac_cv_prog_EMACS" +if test -n "$EMACS"; then + echo "$ac_t""$EMACS" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + fi - emacsdir="\$(datadir)/emacs" - case "$EMACS_BASENAME" in - emacs|emacs-*) - if test -d $prefix/lib/emacs; then - emacsdir="$prefix/lib/emacs" - fi - if test -d $prefix/share/emacs; then - emacsdir="$prefix/share/emacs" - fi - ;; - xemacs|xemacs-*) - if test -d $prefix/lib/xemacs; then - emacsdir="$prefix/lib/xemacs" - fi - if test -d $prefix/share/xemacs; then - emacsdir="$prefix/share/xemacs" - fi - ;; - mule|mule-*) - if test -d $prefix/lib/emacs; then - emacsdir="$prefix/lib/emacs" - fi - if test -d $prefix/share/emacs; then - emacsdir="$prefix/share/emacs" - fi - if test -d $prefix/lib/mule; then - emacsdir="$prefix/lib/mule" - fi - if test -d $prefix/share/mule; then - emacsdir="$prefix/share/mule" - fi - ;; - esac - fi - echo "$ac_t""$emacsdir" 1>&6 - - # Check whether --with-lispdir or --without-lispdir was given. -if test "${with_lispdir+set}" = set; then - withval="$with_lispdir" - case "${withval}" in - yes) lispdir= ;; - no) { echo "configure: error: lispdir is not available" 1>&2; exit 1; } ;; - *) lispdir=${withval} ;; - esac +fi + + # Check whether --with-xemacs or --without-xemacs was given. +if test "${with_xemacs+set}" = set; then + withval="$with_xemacs" + if test x$withval = xyes -o x$withval = x; then + # Extract the first word of "xemacs", so it can be a program name with args. +set dummy xemacs; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:778: checking for $ac_word" >&5 +if eval "test \"\${ac_cv_prog_XEMACS+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$XEMACS"; then + ac_cv_prog_XEMACS="$XEMACS" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_XEMACS="xemacs" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_XEMACS" && ac_cv_prog_XEMACS="xemacs" +fi +fi +XEMACS="$ac_cv_prog_XEMACS" +if test -n "$XEMACS"; then + echo "$ac_t""$XEMACS" 1>&6 else - lispdir= + echo "$ac_t""no" 1>&6 fi - echo $ac_n "checking where .elc files should go""... $ac_c" 1>&6 -echo "configure:760: checking where .elc files should go" >&5 - if test "x$lispdir" = x; then - lispdir="$emacsdir/site-lisp" - if test -d $emacsdir/lisp; then - lispdir="$emacsdir/lisp" + else + # Extract the first word of "$withval", so it can be a program name with args. +set dummy $withval; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:809: checking for $ac_word" >&5 +if eval "test \"\${ac_cv_prog_XEMACS+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$XEMACS"; then + ac_cv_prog_XEMACS="$XEMACS" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_XEMACS="$withval" + break fi - case "$EMACS_BASENAME" in - xemacs|xemacs-*) - lispdir="$lispdir/tgnus" - ;; - esac - fi - echo "$ac_t""$lispdir" 1>&6 - -# Extract the first word of "makeinfo", so it can be a program name with args. -set dummy makeinfo; ac_word=$2 + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_XEMACS" && ac_cv_prog_XEMACS="xemacs" +fi +fi +XEMACS="$ac_cv_prog_XEMACS" +if test -n "$XEMACS"; then + echo "$ac_t""$XEMACS" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + fi + EMACS=$XEMACS +else + XEMACS=xemacs + test x$EMACS = x &&\ + for ac_prog in emacs xemacs mule +do +# Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:777: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_path_MAKEINFO'+set}'`\" = set"; then +echo "configure:846: checking for $ac_word" >&5 +if eval "test \"\${ac_cv_prog_EMACS+set}\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else - case "$MAKEINFO" in - /*) - ac_cv_path_MAKEINFO="$MAKEINFO" # Let the user override the test with a path. - ;; - ?:/*) - ac_cv_path_MAKEINFO="$MAKEINFO" # Let the user override the test with a dos path. - ;; - *) + if test -n "$EMACS"; then + ac_cv_prog_EMACS="$EMACS" # Let the user override the test. +else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_dummy="$PATH" - for ac_dir in $ac_dummy; do + for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then - ac_cv_path_MAKEINFO="$ac_dir/$ac_word" + ac_cv_prog_EMACS="$ac_prog" break fi done IFS="$ac_save_ifs" - test -z "$ac_cv_path_MAKEINFO" && ac_cv_path_MAKEINFO="no" - ;; -esac fi -MAKEINFO="$ac_cv_path_MAKEINFO" -if test -n "$MAKEINFO"; then - echo "$ac_t""$MAKEINFO" 1>&6 +fi +EMACS="$ac_cv_prog_EMACS" +if test -n "$EMACS"; then + echo "$ac_t""$EMACS" 1>&6 else echo "$ac_t""no" 1>&6 fi +test -n "$EMACS" && break +done +test -n "$EMACS" || EMACS="emacs" -ADDITIONAL_LOAD_PATH= -# Check whether --with-addpath or --without-addpath was given. -if test "${with_addpath+set}" = set; then - withval="$with_addpath" - ADDITIONAL_LOAD_PATH=$with_addpath fi + + + echo $ac_n "checking what a flavor does $EMACS have""... $ac_c" 1>&6 +echo "configure:882: checking what a flavor does $EMACS have" >&5 -XEMACS="xemacs" -# Check whether --with-xemacs or --without-xemacs was given. -if test "${with_xemacs+set}" = set; then - withval="$with_xemacs" - XEMACS=$with_xemacs + unset EMACS_cv_SYS_flavor; + + +elisp="(cond ((featurep (quote xemacs)) \"XEmacs\")\ + ((boundp (quote MULE)) \"MULE\")\ + (t \"FSF Emacs\"))" +if test -z ""noecho""; then + echo $ac_n "checking for flavor""... $ac_c" 1>&6 +echo "configure:892: checking for flavor" >&5 +fi +if eval "test \"\${EMACS_cv_SYS_flavor+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + OUTPUT=./conftest-$$ + echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& 5 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_flavor=$retval + +fi + +flavor=${EMACS_cv_SYS_flavor} +if test -z ""noecho""; then + echo "$ac_t""$flavor" 1>&6 +fi + + case $EMACS_cv_SYS_flavor in + XEmacs) + EMACS_FLAVOR=xemacs;; + MULE) + EMACS_FLAVOR=mule;; + *) + EMACS_FLAVOR=emacs;; + esac + echo "$ac_t""$EMACS_cv_SYS_flavor" 1>&6 + if test "$prefix" = "NONE"; then + echo $ac_n "checking prefix for your Emacs""... $ac_c" 1>&6 +echo "configure:924: checking prefix for your Emacs" >&5 + +elisp="(expand-file-name \"..\" invocation-directory)" +if test -z ""noecho""; then + echo $ac_n "checking for prefix""... $ac_c" 1>&6 +echo "configure:929: checking for prefix" >&5 +fi +if eval "test \"\${EMACS_cv_SYS_prefix+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + OUTPUT=./conftest-$$ + echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& 5 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_prefix=$retval + +fi + +prefix=${EMACS_cv_SYS_prefix} +if test -z ""noecho""; then + echo "$ac_t""$prefix" 1>&6 +fi + + prefix=${EMACS_cv_SYS_prefix} + echo "$ac_t""$prefix" 1>&6 + fi + # Check whether --with-lispdir or --without-lispdir was given. +if test "${with_lispdir+set}" = set; then + withval="$with_lispdir" + lispdir=${withval} +fi + + echo $ac_n "checking where lisp files should go""... $ac_c" 1>&6 +echo "configure:960: checking where lisp files should go" >&5 + if test -z "$lispdir"; then + theprefix=$prefix + if test "x$theprefix" = "xNONE"; then + theprefix=$ac_default_prefix + fi + lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}" + for thedir in share lib; do + potential= + if test -d ${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp; then + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}" + break + fi + done + fi + if test ${EMACS_FLAVOR} = xemacs; then + echo "$ac_t""$lispdir + (it will be ignored when \"make install-package[-ja]\" is done)" 1>&6 + else + echo "$ac_t""$lispdir" 1>&6 + fi + + + +echo $ac_n "checking for acceptable W3 version""... $ac_c" 1>&6 +echo "configure:985: checking for acceptable W3 version" >&5 + +unset EMACS_cv_ACCEPTABLE_W3; +unset EMACS_cv_SYS_w3_dir; +unset EMACS_cv_SYS_w3_forms; + +if eval "test \"\${EMACS_cv_ACCEPTABLE_W3+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + +if test -z ""noecho""; then + echo $ac_n "checking for w3-form-encode-xwfu in w3_forms""... $ac_c" 1>&6 +echo "configure:998: checking for w3-form-encode-xwfu in w3_forms" >&5 +fi +library=`echo w3_forms | tr _ -` + +elisp="(progn (fmakunbound (quote w3-form-encode-xwfu)) (condition-case nil (progn (require (quote $library)) (fboundp (quote w3-form-encode-xwfu))) (error (prog1 nil (message \"$library not found\")))))" +if test -z ""noecho""; then + echo $ac_n "checking for w3_forms""... $ac_c" 1>&6 +echo "configure:1005: checking for w3_forms" >&5 +fi +if eval "test \"\${EMACS_cv_SYS_w3_forms+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + OUTPUT=./conftest-$$ + echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& 5 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_w3_forms=$retval + +fi + +w3_forms=${EMACS_cv_SYS_w3_forms} +if test -z ""noecho""; then + echo "$ac_t""$w3_forms" 1>&6 +fi + +if test "${EMACS_cv_SYS_w3_forms}" = "nil"; then + EMACS_cv_SYS_w3_forms=no +fi +if test "${EMACS_cv_SYS_w3_forms}" = "t"; then + EMACS_cv_SYS_w3_forms=yes fi +HAVE_w3_forms=${EMACS_cv_SYS_w3_forms} +if test -z ""noecho""; then + echo "$ac_t""$HAVE_w3_forms" 1>&6 +fi + +if test "${HAVE_w3_forms}" = "yes"; then + EMACS_cv_ACCEPTABLE_W3=yes +else + EMACS_cv_ACCEPTABLE_W3= +fi +if test "x${EMACS_cv_ACCEPTABLE_W3}" = "xyes"; then + +elisp="(file-name-directory (locate-library \"w3-forms\"))" +if test -z ""noecho""; then + echo $ac_n "checking for w3_dir""... $ac_c" 1>&6 +echo "configure:1049: checking for w3_dir" >&5 +fi +if eval "test \"\${EMACS_cv_SYS_w3_dir+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + OUTPUT=./conftest-$$ + echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& 5 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_w3_dir=$retval -PACKAGEDIR= -# Check whether --with-packagedir or --without-packagedir was given. +fi + +w3_dir=${EMACS_cv_SYS_w3_dir} +if test -z ""noecho""; then + echo "$ac_t""$w3_dir" 1>&6 +fi + + EMACS_cv_ACCEPTABLE_W3=$EMACS_cv_SYS_w3_dir +fi + +fi + + # Check whether --with-w3 or --without-w3 was given. +if test "${with_w3+set}" = set; then + withval="$with_w3" + EMACS_cv_ACCEPTABLE_W3=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` +fi + + W3=${EMACS_cv_ACCEPTABLE_W3} + + if test "x${EMACS_cv_ACCEPTABLE_W3}" = "x"; then + echo "$ac_t""not found" 1>&6 + else + echo "$ac_t""${W3}" 1>&6 + fi + + if test ${EMACS_FLAVOR} = xemacs; then + echo $ac_n "checking where the XEmacs package is""... $ac_c" 1>&6 +echo "configure:1091: checking where the XEmacs package is" >&5 + # Check whether --with-packagedir or --without-packagedir was given. if test "${with_packagedir+set}" = set; then withval="$with_packagedir" - PACKAGEDIR=$with_packagedir + if test x$withval != xyes -a x$withval != x; then + PACKAGEDIR=$withval + else + +elisp="(let (package-dir)\ + (if (boundp (quote early-packages))\ + (let ((dirs (delq nil (append (if early-package-load-path\ + early-packages)\ + (if late-package-load-path\ + late-packages)\ + (if last-package-load-path\ + last-packages)))))\ + (while (and dirs (not package-dir))\ + (if (file-directory-p (car dirs))\ + (setq package-dir (car dirs)\ + dirs (cdr dirs))))))\ + (or package-dir \"\"))" +if test -z ""noecho""; then + echo $ac_n "checking for PACKAGEDIR""... $ac_c" 1>&6 +echo "configure:1114: checking for PACKAGEDIR" >&5 +fi +if eval "test \"\${EMACS_cv_SYS_PACKAGEDIR+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + OUTPUT=./conftest-$$ + echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& 5 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_PACKAGEDIR=$retval + fi +PACKAGEDIR=${EMACS_cv_SYS_PACKAGEDIR} +if test -z ""noecho""; then + echo "$ac_t""$PACKAGEDIR" 1>&6 +fi + + fi +else + +elisp="(let (package-dir)\ + (if (boundp (quote early-packages))\ + (let ((dirs (delq nil (append (if early-package-load-path\ + early-packages)\ + (if late-package-load-path\ + late-packages)\ + (if last-package-load-path\ + last-packages)))))\ + (while (and dirs (not package-dir))\ + (if (file-directory-p (car dirs))\ + (setq package-dir (car dirs)\ + dirs (cdr dirs))))))\ + (or package-dir \"\"))" +if test -z ""noecho""; then + echo $ac_n "checking for PACKAGEDIR""... $ac_c" 1>&6 +echo "configure:1153: checking for PACKAGEDIR" >&5 +fi +if eval "test \"\${EMACS_cv_SYS_PACKAGEDIR+set}\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + OUTPUT=./conftest-$$ + echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& 5 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& 5 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_PACKAGEDIR=$retval +fi + +PACKAGEDIR=${EMACS_cv_SYS_PACKAGEDIR} +if test -z ""noecho""; then + echo "$ac_t""$PACKAGEDIR" 1>&6 +fi + +fi + if test x$PACKAGEDIR = x; then + echo "$ac_t""not found" 1>&6 + else + echo "$ac_t""$PACKAGEDIR" 1>&6 + fi + else + PACKAGEDIR= + fi + + # Check whether --with-addpath or --without-addpath was given. +if test "${with_addpath+set}" = set; then + withval="$with_addpath" + if test x$withval != xyes -a x$withval != x; then + echo $ac_n "checking where to find the additional elisp libraries""... $ac_c" 1>&6 +echo "configure:1190: checking where to find the additional elisp libraries" >&5 + ADDITIONAL_LOAD_PATH=$withval + echo "$ac_t""$ADDITIONAL_LOAD_PATH" 1>&6 + fi +else + ADDITIONAL_LOAD_PATH= +fi + + trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure @@ -901,7 +1262,7 @@ trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. cat > conftest.defs <<\EOF -s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g +s%#define \([^ ][^ ]*\) *\(.*\)%-D\1=\2%g s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g s%\[%\\&%g s%\]%\\&%g @@ -936,7 +1297,7 @@ do echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) - echo "$CONFIG_STATUS generated by autoconf version 2.13" + echo "$CONFIG_STATUS generated by autoconf version 2.14.1" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; @@ -979,17 +1340,19 @@ s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g +s%@GNUS_PRODUCT_NAME@%$GNUS_PRODUCT_NAME%g s%@SET_MAKE@%$SET_MAKE%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g s%@INSTALL_DATA@%$INSTALL_DATA%g -s%@EMACS@%$EMACS%g -s%@emacsdir@%$emacsdir%g -s%@lispdir@%$lispdir%g s%@MAKEINFO@%$MAKEINFO%g -s%@ADDITIONAL_LOAD_PATH@%$ADDITIONAL_LOAD_PATH%g +s%@EMACS@%$EMACS%g s%@XEMACS@%$XEMACS%g +s%@lispdir@%$lispdir%g +s%@HAVE_w3_forms@%$HAVE_w3_forms%g +s%@W3@%$W3%g s%@PACKAGEDIR@%$PACKAGEDIR%g +s%@ADDITIONAL_LOAD_PATH@%$ADDITIONAL_LOAD_PATH%g CEOF EOF diff --git a/configure.in b/configure.in index dc7bafa..e648a4e 100644 --- a/configure.in +++ b/configure.in @@ -1,32 +1,11 @@ AC_INIT(lisp/gnus.el) +AC_DEFINE_GNUS_PRODUCT_NAME(t-gnus) AC_SET_MAKE AC_PROG_INSTALL -AM_PATH_LISPDIR -AC_PATH_PROG(MAKEINFO, makeinfo, no) - -ADDITIONAL_LOAD_PATH= -AC_ARG_WITH( - addpath, - [ --with-addpath=PATH search Emacs-Lisp libraries with PATH - use colons to separate directory names], - ADDITIONAL_LOAD_PATH=$with_addpath, -) -AC_SUBST(ADDITIONAL_LOAD_PATH) - -XEMACS="xemacs" -AC_ARG_WITH( - xemacs, - [ --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]], - XEMACS=$with_xemacs, -) -AC_SUBST(XEMACS) - -PACKAGEDIR= -AC_ARG_WITH( - packagedir, - [ --with-packagedir=DIR package DIR for XEmacs [guessed]], - PACKAGEDIR=$with_packagedir, -) -AC_SUBST(PACKAGEDIR) - +AC_CHECK_PROG(MAKEINFO, makeinfo, makeinfo, no) +AC_CHECK_EMACS +AC_PATH_LISPDIR +AC_CHECK_W3 +AC_PATH_PACKAGEDIR +AC_ADD_LOAD_PATH AC_OUTPUT(Makefile lisp/Makefile lisp/dgnuspath.el texi/Makefile) diff --git a/contrib/ChangeLog b/contrib/ChangeLog new file mode 100644 index 0000000..647125a --- /dev/null +++ b/contrib/ChangeLog @@ -0,0 +1,48 @@ +2000-12-19 22:00:00 ShengHuo ZHU + + * gpg.el (defalias): Use eval-and-compile. + (gpg-command-all-arglist): Suggest by Jeff Senn . + +2000-12-15 00:00:00 ShengHuo ZHU + + * gpg.el (gpg-command-alist): Alist may not be defined. + +2000-12-14 23:00:00 ShengHuo ZHU + + * gpg.el (gpg-make-temp-file): Don't check file-modes of M$Windows. + +2000-12-14 10:00:00 ShengHuo ZHU + + * gpg.el (gpg-passphrase-store): Don't activate timer if it is live. + +2000-11-30 22:00:00 ShengHuo ZHU + + * gpg.el: (gpg-make-temp-file): Use expand-file-name. + (gpg-point-at-eol): New function. + (gpg-call-process): Use it. + (gpg-key-list-keys-parse-line): Ditto. + (gpg-with-passphrase-env): edebug-form-spec. + (gpg-with-temp-files): Ditto. + (gpg-show-result): Ditto. + +2000-11-08 Bj,Av(Brn Torkelsson + + * gpg.el: In Xemacs it is called point-at-eol, not + line-end-position + + * gpg.el (gpg-key-lessp): use string-lessp instead of + compare-strings (not available on XEmacs) + +2000-11-16 Simon Josefsson + + * gpg.el (gpg-command-verify-cleartext): New variable. + (gpg-verify-cleartext): New function. + +2000-10-31 17:32:02 ShengHuo ZHU + + * gpg.el (gpg-verify): The last argument of apply is a list. + (gpg-encrypt): Add passphrase as a parameter. + +;; Local Variables: +;; coding: iso-2022-7bit +;; End: diff --git a/contrib/README b/contrib/README new file mode 100644 index 0000000..76d0e5c --- /dev/null +++ b/contrib/README @@ -0,0 +1,3 @@ +The files in this directory are not (yet) part of the +Gnus distribution proper. They may later become part +of the distribution, or they may disappear altogether. diff --git a/contrib/base64.el b/contrib/base64.el new file mode 100644 index 0000000..572a5d3 --- /dev/null +++ b/contrib/base64.el @@ -0,0 +1,278 @@ +;;; base64.el,v --- Base64 encoding functions +;; Author: Kyle E. Jones +;; Created: 1997/03/12 14:37:09 +;; Version: 1.6 +;; Keywords: extensions + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (C) 1997 Kyle E. Jones +;;; +;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; +;;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(eval-when-compile (require 'cl)) + +;; For non-MULE +(if (not (fboundp 'char-int)) + (defalias 'char-int 'identity)) + +(defvar base64-alphabet + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + +(defvar base64-decoder-program nil + "*Non-nil value should be a string that names a MIME base64 decoder. +The program should expect to read base64 data on its standard +input and write the converted data to its standard output.") + +(defvar base64-decoder-switches nil + "*List of command line flags passed to the command named by +base64-decoder-program.") + +(defvar base64-encoder-program nil + "*Non-nil value should be a string that names a MIME base64 encoder. +The program should expect arbitrary data on its standard +input and write base64 data to its standard output.") + +(defvar base64-encoder-switches nil + "*List of command line flags passed to the command named by +base64-encoder-program.") + +(defconst base64-alphabet-decoding-alist + '( + ( ?A . 00) ( ?B . 01) ( ?C . 02) ( ?D . 03) ( ?E . 04) ( ?F . 05) + ( ?G . 06) ( ?H . 07) ( ?I . 08) ( ?J . 09) ( ?K . 10) ( ?L . 11) + ( ?M . 12) ( ?N . 13) ( ?O . 14) ( ?P . 15) ( ?Q . 16) ( ?R . 17) + ( ?S . 18) ( ?T . 19) ( ?U . 20) ( ?V . 21) ( ?W . 22) ( ?X . 23) + ( ?Y . 24) ( ?Z . 25) ( ?a . 26) ( ?b . 27) ( ?c . 28) ( ?d . 29) + ( ?e . 30) ( ?f . 31) ( ?g . 32) ( ?h . 33) ( ?i . 34) ( ?j . 35) + ( ?k . 36) ( ?l . 37) ( ?m . 38) ( ?n . 39) ( ?o . 40) ( ?p . 41) + ( ?q . 42) ( ?r . 43) ( ?s . 44) ( ?t . 45) ( ?u . 46) ( ?v . 47) + ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53) + ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59) + ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63) + )) + +(defvar base64-alphabet-decoding-vector + (let ((v (make-vector 123 nil)) + (p base64-alphabet-decoding-alist)) + (while p + (aset v (car (car p)) (cdr (car p))) + (setq p (cdr p))) + v)) + +(defvar base64-binary-coding-system 'binary) + +(defun base64-run-command-on-region (start end output-buffer command + &rest arg-list) + (let ((tempfile nil) status errstring default-process-coding-system + (coding-system-for-write base64-binary-coding-system) + (coding-system-for-read base64-binary-coding-system)) + (unwind-protect + (progn + (setq tempfile (make-temp-name "base64")) + (setq status + (apply 'call-process-region + start end command nil + (list output-buffer tempfile) + nil arg-list)) + (cond ((equal status 0) t) + ((zerop (save-excursion + (set-buffer (find-file-noselect tempfile)) + (buffer-size))) + t) + (t (save-excursion + (set-buffer (find-file-noselect tempfile)) + (setq errstring (buffer-string)) + (kill-buffer nil) + (cons status errstring))))) + (ignore-errors + (delete-file tempfile))))) + +(if (featurep 'xemacs) + (defalias 'base64-insert-char 'insert-char) + (defun base64-insert-char (char &optional count ignored buffer) + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (with-current-buffer buffer + (insert-char char count)))) + (setq base64-binary-coding-system 'no-conversion)) + +(defun base64-decode-region (start end) + (interactive "r") + ;;(message "Decoding base64...") + (let ((work-buffer nil) + (done nil) + (counter 0) + (bits 0) + (lim 0) inputpos + (non-data-chars (concat "^=" base64-alphabet))) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *base64-work*")) + (buffer-disable-undo work-buffer) + (if base64-decoder-program + (let* ((binary-process-output t) ; any text already has CRLFs + (status (apply 'base64-run-command-on-region + start end work-buffer + base64-decoder-program + base64-decoder-switches))) + (if (not (eq status t)) + (error "%s" (cdr status)))) + (goto-char start) + (skip-chars-forward non-data-chars end) + (while (not done) + (setq inputpos (point)) + (cond + ((> (skip-chars-forward base64-alphabet end) 0) + (setq lim (point)) + (while (< inputpos lim) + (setq bits (+ bits + (aref base64-alphabet-decoding-vector + (char-int (char-after inputpos))))) + (setq counter (1+ counter) + inputpos (1+ inputpos)) + (cond ((= counter 4) + (base64-insert-char (lsh bits -16) 1 nil work-buffer) + (base64-insert-char (logand (lsh bits -8) 255) 1 nil + work-buffer) + (base64-insert-char (logand bits 255) 1 nil + work-buffer) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))))) + (cond + ((or (= (point) end) + (eq (char-after (point)) ?=)) + (if (and (= (point) end) (> counter 1)) + (message + "at least %d bits missing at end of base64 encoding" + (* (- 4 counter) 6))) + (setq done t) + (cond ((= counter 1) + (error "at least 2 bits missing at end of base64 encoding")) + ((= counter 2) + (base64-insert-char (lsh bits -10) 1 nil work-buffer)) + ((= counter 3) + (base64-insert-char (lsh bits -16) 1 nil work-buffer) + (base64-insert-char (logand (lsh bits -8) 255) + 1 nil work-buffer)) + ((= counter 0) t))) + (t (skip-chars-forward non-data-chars end))))) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + ;;(message "Decoding base64... done") + ) + +(defun base64-encode-region (start end &optional no-line-break) + (interactive "r") + (message "Encoding base64...") + (let ((work-buffer nil) + (counter 0) + (cols 0) + (bits 0) + (alphabet base64-alphabet) + inputpos) + (unwind-protect + (save-excursion + (setq work-buffer (generate-new-buffer " *base64-work*")) + (buffer-disable-undo work-buffer) + (if base64-encoder-program + (let ((status (apply 'base64-run-command-on-region + start end work-buffer + base64-encoder-program + base64-encoder-switches))) + (if (not (eq status t)) + (error "%s" (cdr status)))) + (setq inputpos start) + (while (< inputpos end) + (setq bits (+ bits (char-int (char-after inputpos)))) + (setq counter (1+ counter)) + (cond ((= counter 3) + (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (base64-insert-char + (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (base64-insert-char + (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (base64-insert-char + (aref alphabet (logand bits 63)) + 1 nil work-buffer) + (setq cols (+ cols 4)) + (cond ((and (= cols 72) + (not no-line-break)) + (base64-insert-char ?\n 1 nil work-buffer) + (setq cols 0))) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 8)))) + (setq inputpos (1+ inputpos))) + ;; write out any remaining bits with appropriate padding + (if (= counter 0) + nil + (setq bits (lsh bits (- 16 (* 8 counter)))) + (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (base64-insert-char (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (if (= counter 1) + (base64-insert-char ?= 2 nil work-buffer) + (base64-insert-char (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (base64-insert-char ?= 1 nil work-buffer))) + (if (and (> cols 0) + (not no-line-break)) + (base64-insert-char ?\n 1 nil work-buffer))) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (message "Encoding base64... done")) + +(defun base64-encode (string &optional no-line-break) + (save-excursion + (set-buffer (get-buffer-create " *base64-encode*")) + (erase-buffer) + (insert string) + (base64-encode-region (point-min) (point-max) no-line-break) + (skip-chars-backward " \t\r\n") + (delete-region (point-max) (point)) + (prog1 + (buffer-string) + (kill-buffer (current-buffer))))) + +(defun base64-decode (string) + (save-excursion + (set-buffer (get-buffer-create " *base64-decode*")) + (erase-buffer) + (insert string) + (base64-decode-region (point-min) (point-max)) + (goto-char (point-max)) + (skip-chars-backward " \t\r\n") + (delete-region (point-max) (point)) + (prog1 + (buffer-string) + (kill-buffer (current-buffer))))) + +(defalias 'base64-decode-string 'base64-decode) +(defalias 'base64-encode-string 'base64-encode) + +(provide 'base64) diff --git a/contrib/gpg-ring.el b/contrib/gpg-ring.el new file mode 100644 index 0000000..eafa4dc --- /dev/null +++ b/contrib/gpg-ring.el @@ -0,0 +1,484 @@ +;;; gpg-ring.el --- Major mode for editing GnuPG key rings. + +;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart + +;; Author: Florian Weimer +;; Maintainer: Florian Weimer +;; Keywords: crypto +;; Created: 2000-04-28 + +;; $Id: gpg-ring.el,v 1.1.4.1 2000-12-21 11:16:03 yamaoka Exp $ + +;; This file is NOT (yet?) 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. + + + +;;;; Code: + +(require 'gpg) +(eval-when-compile + (require 'cl)) + +;;;; Customization: + +;;; Customization: Groups: + +(defgroup gpg-ring nil + "GNU Privacy Guard user interface." + :tag "GnuPG user interface" + :group 'gpg) + +;;; Customization: Variables: + +(defface gpg-ring-key-invalid-face + '((((class color)) + (:foreground "yellow" :background "red")) + (t (:bold t :italic t :underline t))) + "Face for strings indicating key invalidity." + :group 'gpg-ring) + +(defface gpg-ring-uncertain-validity-face + '((((class color)) (:foreground "red")) + (t (:bold t))) + "Face for strings indicating uncertain validity." + :group 'gpg-ring) + +(defface gpg-ring-full-validity-face + '((((class color)) (:foreground "ForestGreen" :bold t)) + (t (:bold t))) + "Face for strings indicating key invalidity." + :group 'gpg-ring) + +(defvar gpg-ring-mode-hook nil + "Normal hook run when entering GnuPG ring mode.") + +;;; Constants + +(defconst gpg-ring-algo-alist + '((rsa . "RSA") + (rsa-encrypt-only . "RSA-E") + (rsa-sign-only . "RSA-S") + (elgamal-encrypt-only . "ELG-E") + (dsa . "DSA") + (elgamal . "ELG-E")) + "Alist mapping algorithm IDs to algorithm abbreviations.") + +(defconst gpg-ring-trust-alist + '((not-known "???" gpg-ring-uncertain-validity-face) + (disabled "DIS" gpg-ring-key-invalid-face) + (revoked "REV" gpg-ring-key-invalid-face) + (expired "EXP" gpg-ring-key-invalid-face) + (trust-undefined "QES" gpg-ring-uncertain-validity-face) + (trust-none "NON" gpg-ring-uncertain-validity-face) + (trust-marginal "MAR") + (trust-full "FUL" gpg-ring-full-validity-face) + (trust-ultimate "ULT" gpg-ring-full-validity-face)) + "Alist mapping trust IDs to trust abbrevs and faces.") + +(defvar gpg-ring-mode-map + (let ((map (make-keymap))) + (suppress-keymap map t) + map) + "Keymap for `gpg-ring-mode'.") + +(define-key gpg-ring-mode-map "0" 'delete-window) +(define-key gpg-ring-mode-map "1" 'delete-other-windows) +(define-key gpg-ring-mode-map "M" 'gpg-ring-mark-process-all) +(define-key gpg-ring-mode-map "U" 'gpg-ring-unmark-all) +(define-key gpg-ring-mode-map "a" 'gpg-ring-toggle-show-unusable) +(define-key gpg-ring-mode-map "d" 'gpg-ring-mark-delete) +(define-key gpg-ring-mode-map "f" 'gpg-ring-update-key) +(define-key gpg-ring-mode-map "g" 'gpg-ring-update) +(define-key gpg-ring-mode-map "i" 'gpg-ring-show-key) +(define-key gpg-ring-mode-map "l" 'gpg-ring-toggle-show-all-ids) +(define-key gpg-ring-mode-map "m" 'gpg-ring-mark-process) +(define-key gpg-ring-mode-map "n" 'gpg-ring-next-record) +(define-key gpg-ring-mode-map "p" 'gpg-ring-previous-record) +(define-key gpg-ring-mode-map "q" 'gpg-ring-quit) +(define-key gpg-ring-mode-map "u" 'gpg-ring-unmark) +(define-key gpg-ring-mode-map "x" 'gpg-ring-extract-keys) +(define-key gpg-ring-mode-map "X" 'gpg-ring-extract-keys-to-kill) + +(define-key gpg-ring-mode-map "\C-c\C-c" 'gpg-ring-action) + +;;; Internal functions: + +(defvar gpg-ring-key-list + nil + "List of keys in the key list buffer.") +(make-variable-buffer-local 'gpg-ring-key-list) + +(defvar gpg-ring-update-funcs + nil + "List of functions called to obtain the key list.") +(make-variable-buffer-local 'gpg-ring-update-funcs) + +(defvar gpg-ring-show-unusable + nil + "If t, show expired, revoked and disabled keys, too.") +(make-variable-buffer-local 'gpg-ring-show-unusable) + +(defvar gpg-ring-show-all-ids + nil + "If t, show all user IDs. If nil, show only the primary user ID.") +(make-variable-buffer-local 'gpg-ring-show-all-ids) + +(defvar gpg-ring-marks-alist + nil + "Alist of (UNIQUE-ID MARK KEY). +UNIQUE-ID is a unique key ID from GnuPG. MARK is either `?D' +(marked for deletion), or `?*' (marked for processing).") +(make-variable-buffer-local 'gpg-ring-marks-alist) + +(defvar gpg-ring-action + nil + "Function to call when `gpg-ring-action' is invoked. +A list of the keys which are marked for processing is passed as argument.") +(make-variable-buffer-local 'gpg-ring-action) + +(defun gpg-ring-mode () + "Mode for editing GnuPG key rings. +\\{gpg-ring-mode-map} +Turning on gpg-ring-mode runs `gpg-ring-mode-hook'." + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (setq truncate-lines t) + (setq buffer-read-only t) + (use-local-map gpg-ring-mode-map) + (setq mode-name "Key Ring") + (setq major-mode 'gpg-ring-mode) + (run-hooks 'gpg-ring-mode-hook)) + + +(defmacro gpg-ring-record-start (&optional pos) + "Return buffer position of start of record containing POS." + `(get-text-property (or ,pos (point)) 'gpg-record-start)) + +(defun gpg-ring-current-key (&optional pos) + "Return GnuPG key at POS, or at point if ommitted." + (or (get-text-property (or pos (point)) 'gpg-key) + (error "No record on current line"))) + +(defun gpg-ring-goto-record (pos) + "Go to record starting at POS. +Position point after the marks at the beginning of a record." + (goto-char pos) + (forward-char 2)) + +(defun gpg-ring-next-record () + "Advances point to the start of the next record." + (interactive) + (let ((start (next-single-property-change + (point) 'gpg-record-start nil (point-max)))) + ;; Don't advance to the last line of the buffer. + (when (/= start (point-max)) + (gpg-ring-goto-record start)))) + +(defun gpg-ring-previous-record () + "Advances point to the start of the previous record." + (interactive) + ;; The last line of the buffer doesn't contain a record. + (let ((start (gpg-ring-record-start))) + (if start + (gpg-ring-goto-record (previous-single-property-change + start 'gpg-record-start nil (point-min))) + (gpg-ring-goto-record + (gpg-ring-record-start (1- (point-max))))))) + +(defun gpg-ring-set-mark (&optional pos mark) + "Set MARK on record at POS, or at point if POS is omitted. +If MARK is omitted, clear it." + (save-excursion + (let* ((start (gpg-ring-record-start pos)) + (key (gpg-ring-current-key start)) + (id (gpg-key-unique-id key)) + (entry (assoc id gpg-ring-marks-alist)) + buffer-read-only) + (goto-char start) + ;; Replace the mark character. + (subst-char-in-region (point) (1+ (point)) (char-after) + (or mark ? )) + ;; Store the mark in alist. + (if entry + (setcdr entry (if mark (list mark key))) + (when mark + (push (list id mark key) gpg-ring-marks-alist)))))) + +(defun gpg-ring-marked-keys (&optional only-marked mark) + "Return list of key specs which have MARK. +If no marks are present and ONLY-MARKED is not nil, return singleton +list with key of the current record. If MARK is omitted, `?*' is +used." + (let ((the-marker (or mark ?*)) + (marks gpg-ring-marks-alist) + key-list) + (while marks + (let ((mark (pop marks))) + ;; If this entry has got the right mark ... + (when (equal (nth 1 mark) the-marker) + ;; ... rember the key spec. + (push (nth 2 mark) key-list)))) + (or key-list (if (not only-marked) (list (gpg-ring-current-key)))))) + +(defun gpg-ring-mark-process () + "Mark record at point for processing." + (interactive) + (gpg-ring-set-mark nil ?*) + (gpg-ring-next-record)) + +(defun gpg-ring-mark-delete () + "Mark record at point for processing." + (interactive) + (gpg-ring-set-mark nil ?D) + (gpg-ring-next-record)) + +(defun gpg-ring-unmark () + "Mark record at point for processing." + (interactive) + (gpg-ring-set-mark) + (gpg-ring-next-record)) + +(defun gpg-ring-mark-process-all () + "Put process mark on all records." + (interactive) + (setq gpg-ring-marks-alist + (mapcar (lambda (key) + (list (gpg-key-unique-id key) ?* key)) + gpg-ring-key-list)) + (gpg-ring-regenerate)) + +(defun gpg-ring-unmark-all () + "Remove all record marks." + (interactive) + (setq gpg-ring-marks-alist nil) + (gpg-ring-regenerate)) + +(defun gpg-ring-toggle-show-unusable () + "Toggle value if `gpg-ring-show-unusable'." + (interactive) + (setq gpg-ring-show-unusable (not gpg-ring-show-unusable)) + (gpg-ring-regenerate)) + +(defun gpg-ring-toggle-show-all-ids () + "Toggle value of `gpg-ring-show-all-ids'." + (interactive) + (setq gpg-ring-show-all-ids (not gpg-ring-show-all-ids)) + (gpg-ring-regenerate)) + +(defvar gpg-ring-output-buffer-name "*GnuPG Output*" + "Name buffer to which output from GnuPG is sent.") + +(defmacro gpg-ring-with-output-buffer (&rest body) + "Erase GnuPG output buffer, evaluate BODY in it, and display it." + `(with-current-buffer (get-buffer-create gpg-ring-output-buffer-name) + (erase-buffer) + (setq truncate-lines t) + ,@body + (goto-char (point-min)) + (display-buffer gpg-ring-output-buffer-name))) + +(defun gpg-ring-quit () + "Bury key list buffer and kill GnuPG output buffer." + (interactive) + (let ((output (get-buffer gpg-ring-output-buffer-name))) + (when output + (kill-buffer output))) + (when (eq 'gpg-ring-mode major-mode) + (bury-buffer))) + +(defun gpg-ring-show-key () + "Show information for current key." + (interactive) + (let ((keys (gpg-ring-marked-keys))) + (gpg-ring-with-output-buffer + (gpg-key-insert-information (gpg-key-unique-id-list keys))))) + +(defun gpg-ring-extract-keys () + "Export currently selected public keys in ASCII armor." + (interactive) + (let ((keys (gpg-ring-marked-keys))) + (gpg-ring-with-output-buffer + (gpg-key-insert-public-key (gpg-key-unique-id-list keys))))) + +(defun gpg-ring-extract-keys-to-kill () + "Export currently selected public keys in ASCII armor to kill ring." + (interactive) + (let ((keys (gpg-ring-marked-keys))) + (with-temp-buffer + (gpg-key-insert-public-key (gpg-key-unique-id-list keys)) + (copy-region-as-kill (point-min) (point-max))))) + +(defun gpg-ring-update-key () + "Fetch key information from key server." + (interactive) + (let ((keys (gpg-ring-marked-keys))) + (gpg-ring-with-output-buffer + (gpg-key-retrieve (gpg-key-unique-id-list keys))))) + +(defun gpg-ring-insert-key-stat (key) + (let* ((validity (gpg-key-validity key)) + (validity-entry (assq validity gpg-ring-trust-alist)) + (trust (gpg-key-trust key)) + (trust-entry (assq trust gpg-ring-trust-alist))) + ;; Insert abbrev for key status. + (let ((start (point))) + (insert (nth 1 validity-entry)) + ;; Change face if necessary. + (when (nth 2 validity-entry) + (add-text-properties start (point) + (list 'face (nth 2 validity-entry))))) + ;; Trust, key ID, length, algorithm, creation date. + (insert (format "/%s %-8s/%4d/%-5s created %s" + (nth 1 trust-entry) + (gpg-short-key-id key) + (gpg-key-length key) + (cdr (assq (gpg-key-algorithm key) gpg-ring-algo-alist)) + (gpg-key-creation-date key))) + ;; Expire date. + (when (gpg-key-expire-date key) + (insert ", ") + (let ((start (point)) + (expired (eq 'expired validity)) + (notice (concat ))) + (insert (if expired "EXPIRED" "expires") + " " (gpg-key-expire-date key)) + (when expired + (add-text-properties start (point) + '(face gpg-ring-key-invalid-face))))))) + +(defun gpg-ring-insert-key (key &optional mark) + "Inserts description for KEY into current buffer before point." + (let ((start (point))) + (insert (if mark mark " ") + " " (gpg-key-primary-user-id key) "\n" + " ") + (gpg-ring-insert-key-stat key) + (insert "\n") + (when gpg-ring-show-all-ids + (let ((uids (gpg-key-user-ids key))) + (while uids + (insert " ID " (pop uids) "\n")))) + (add-text-properties start (point) + (list 'gpg-record-start start + 'gpg-key key)))) + +(defun gpg-ring-regenerate () + "Regenerate the key list buffer from stored data." + (interactive) + (let* ((key-list gpg-ring-key-list) + ;; Record position of point. + (old-record (if (eobp) ; No record on last line. + nil + (gpg-key-unique-id (gpg-ring-current-key)))) + (old-pos (if old-record (- (point) (gpg-ring-record-start)))) + found new-pos new-pos-offset buffer-read-only new-marks) + ;; Replace buffer contents with new data. + (erase-buffer) + (while key-list + (let* ((key (pop key-list)) + (id (gpg-key-unique-id key)) + (mark (assoc id gpg-ring-marks-alist))) + (when (or gpg-ring-show-unusable + (not (memq (gpg-key-validity key) + '(disabled revoked expired)))) + ;; Check if point was in this record. + (when (and old-record + (string-equal old-record id)) + (setq new-pos (point)) + (setq new-pos-offset (+ new-pos old-pos))) + ;; Check if this record was marked. + (if (nth 1 mark) + (progn + (push mark new-marks) + (gpg-ring-insert-key key (nth 1 mark))) + (gpg-ring-insert-key key))))) + ;; Replace mark alist with the new one (which does not contain + ;; marks for records which vanished during this update). + (setq gpg-ring-marks-alist new-marks) + ;; Restore point. + (if (not old-record) + ;; We were at the end of the buffer before. + (goto-char (point-max)) + (if new-pos + (if (and (< new-pos-offset (point-max)) + (equal old-record (gpg-key-unique-id + (gpg-ring-current-key new-pos-offset)))) + ;; Record is there, with offset. + (goto-char new-pos-offset) + ;; Record is there, but not offset. + (goto-char new-pos)) + ;; Record is not there. + (goto-char (point-min)))))) + +(defun gpg-ring-update () + "Update the key list buffer with new data." + (interactive) + (let ((funcs gpg-ring-update-funcs) + old) + ;; Merge the sorted lists obtained by calling elements of + ;; `gpg-ring-update-funcs'. + (while funcs + (let ((additional (funcall (pop funcs))) + new) + (while (and additional old) + (if (gpg-key-lessp (car additional) (car old)) + (push (pop additional) new) + (if (gpg-key-lessp (car old) (car additional)) + (push (pop old) new) + ;; Keys are perhaps equal. Always Add old key. + (push (pop old) new) + ;; If new key is equal, drop it, otherwise add it as well. + (if (string-equal (gpg-key-unique-id (car old)) + (gpg-key-unique-id (car additional))) + (pop additional) + (push (pop additional) new))))) + ;; Store new list as old one for next round. + (setq old (nconc (nreverse new) old additional)))) + ;; Store the list in the buffer. + (setq gpg-ring-key-list old)) + (gpg-ring-regenerate)) + +(defun gpg-ring-action () + "Perform the action associated with this buffer." + (interactive) + (if gpg-ring-action + (funcall gpg-ring-action (gpg-ring-marked-keys)) + (error "No action for this buffer specified"))) + +;;;###autoload +(defun gpg-ring-keys (&optional key-list-funcs action) + (interactive) + (let ((buffer (get-buffer-create "*GnuPG Key List*"))) + (with-current-buffer buffer + (gpg-ring-mode) + (setq gpg-ring-action action) + (setq gpg-ring-update-funcs key-list-funcs key-list-funcs) + (gpg-ring-update) + (goto-char (point-min))) + (switch-to-buffer buffer))) + +;;;###autoload +(defun gpg-ring-public (key-spec) + "List public keys matching keys KEY-SPEC." + (interactive "sList public keys containing: ") + (gpg-ring-keys `((lambda () (gpg-key-list-keys ,key-spec))))) + +(provide 'gpg-ring) + +;;; gpg-ring.el ends here \ No newline at end of file diff --git a/contrib/gpg.el b/contrib/gpg.el new file mode 100644 index 0000000..6e5bf89 --- /dev/null +++ b/contrib/gpg.el @@ -0,0 +1,1311 @@ +;;; gpg.el --- Interface to GNU Privacy Guard + +;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart + +;; Author: Florian Weimer +;; Maintainer: Florian Weimer +;; Keywords: crypto +;; Created: 2000-04-15 + +;; This file is NOT (yet?) 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: + +;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA +;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA +;; +;; This code is not well-tested. BE CAREFUL! +;; +;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA +;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA + +;; Implemented features which can be tested: +;; +;; * Customization for all flavors of PGP is possible. +;; * The main operations (verify, decrypt, sign, encrypt, sign & +;; encrypt) are implemented. +;; * Gero Treuner's gpg-2comp script is supported, and data which is is +;; compatible with PGP 2.6.3 is generated. + +;; Customizing external programs +;; ============================= + +;; The customization are very similar to those of others programs, +;; only the C-ish "%" constructs have been replaced by more Lisp-like +;; syntax. +;; +;; First, you have to adjust the default executable paths +;; (`gpg-command-default-alist', customization group `gpg-options', +;; "Controlling GnuPG invocation."). After that, you should +;; change the configuration options which control how specific +;; command line flags are built (`gpg-command-flag-sign-with-key', +;; (`gpg-command-flag-recipient'). The elements of these lists are +;; concatenated without spaces, and a new argument is only started +;; where indicated. The `gpg-command-flag-recipient' list is special: +;; it consists of two parts, the first one remains at the beginning +;; of the argument, the second one is repeated for each recipient. +;; Finally, `gpg-command-passphrase-env' has to be changed if there's +;; no command line flag to force the external program to read the data +;; from standard input before the message. +;; +;; In customization group `gpg-commands', "Controlling GnuPG +;; invocation.", you have to supply the actual syntax for external +;; program calls. Each variable consists of a pair of a program +;; specification (if a Lisp symbol is given here, it is translated +;; via `gpg-command-default-alist') and a list of program arguments +;; with placeholders. Please read the documentation of each variable +;; before making your adjustments and try to match the given +;; requirements as closely as possible! +;; +;; The `gpg-commands-key' group, "GnuPG Key Management Commands.", +;; specifies key management commands. The syntax of these variables +;; is like those in the `gpg-commands' group. Note that the output +;; format of some of these external programs has to match very close +;; that of GnuPG. Additional tools (Thomas Roessler's "pgpring.c") +;; are available if your favorite implementation of OpenPGP cannot +;; output the this format. + +;; Security considerations +;; ======================= + +;; On a typical multiuser UNIX system, the memory image of the +;; Emacs process is not locked, therefore it can be swapped to disk +;; at any time. As a result, the passphrase might show up in the +;; swap space (even if you don't use the passphrase cache, i.e. if +;; `gpg-passphrase-timeout' is 0). If someone is able to run `gdb' or +;; another debugger on your Emacs process, he might be able to recover +;; the passphrase as well. Unfortunately, nothing can be done in +;; order to prevent this at the moment. +;; +;; BE CAREFUL: If you use the passphrase cache feature, the passphrase +;; is stored in the variable `gpg-passphrase' -- and it is NOT +;; encrypted in any way. (This is a conceptual problem because the +;; nature of the passphrase cache requires that Emacs is able to +;; decrypt automatically, so only a very weak protection could be +;; applied anyway.) +;; +;; In addition, if you use an unpatched Emacs 20 (and earlier +;; versions), passwords show up in the output of the `view-lossage' +;; function (bound to `C-h l' by default). + + +;;;; Code: + +(require 'timer) +(eval-when-compile + (require 'cl)) + +(eval-and-compile + (defalias 'gpg-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position))) + +;;;; Customization: + +;;; Customization: Groups: + +(defgroup gpg nil + "GNU Privacy Guard interface." + :tag "GnuPG" + :group 'processes) + +(defgroup gpg-options nil + "Controlling GnuPG invocation." + :tag "GnuPG Options" + :group 'gpg) + +(defgroup gpg-commands nil + "Primary GnuPG Operations." + :tag "GnuPG Commands" + :group 'gpg) + +(defgroup gpg-commands-key nil + "Commands for GnuPG key management." + :tag "GnuPG Key Commands" + :group 'gpg-commands) + +;;; Customization: Widgets: + +(if (get 'alist 'widget-type) + (define-widget 'gpg-command-alist 'alist + "An association list for GnuPG command names." + :key-type '(symbol :tag "Abbreviation") + :value-type '(string :tag "Program name") + :convert-widget 'widget-alist-convert-widget + :tag "Alist") + (define-widget 'gpg-command-alist 'repeat + "An association list for GnuPG command names." + :args '((cons :format "%v" + (symbol :tag "Abbreviation") + (string :tag "Program name"))) + :tag "Alist")) + +(define-widget 'gpg-command-program 'choice + "Widget for entering the name of a program (mostly the GnuPG binary)." + :tag "Program" + :args '((const :tag "Default GnuPG program." + :value gpg) + (const :tag "GnuPG compatibility wrapper." + :value gpg-2comp) + (const :tag "Disabled" + :value nil) + (string :tag "Custom program" :format "%v"))) + +(define-widget 'gpg-command-sign-options 'cons + "Widget for entering signing options." + :args '(gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert armor option here if necessary." + :value armor) + (const :tag "Insert text mode option here if necessary." + :value textmode) + (const :tag "Insert the sign with key option here if necessary." + :value sign-with-key) + (string :format "%v"))))) + +(define-widget 'gpg-command-key-options 'cons + "Widget for entering key command options." + :args '(gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert key ID here." + :value key-id) + (string :format "%v"))))) + +;;; Customization: Variables: + +;;; Customization: Variables: Paths and Flags: + +(defcustom gpg-passphrase-timeout + 0 + "Timeout (in seconds) for the passphrase cache. +The passphrase cache is cleared after is hasn't been used for this +many seconds. The values 0 means that the passphrase is not cached at +all." + :tag "Passphrase Timeout" + :type 'number + :group 'gpg-options) + +(defcustom gpg-default-key-id + nil + "Default key/user ID used for signatures." + :tag "Default Key ID" + :type '(choice + (const :tag "Use GnuPG default." :value nil) + (string)) + :group 'gpg-options) + +(defcustom gpg-temp-directory + (expand-file-name "~/tmp") + "Directory for temporary files. +If you are running Emacs 20, this directory must have mode 0700." + :tag "Temp directory" + :type 'string + :group 'gpg-options) + +(defcustom gpg-command-default-alist + '((gpg . "gpg") + (gpg-2comp . "gpg-2comp")) + "Default paths for some GnuPG-related programs. +Modify this variable if you have to change the paths to the +executables required by the GnuPG interface. You can enter \"gpg\" +for `gpg-2comp' if you don't have this script, but you'll lose PGP +2.6.x compatibility." + :tag "GnuPG programs" + :type 'gpg-command-alist + :group 'gpg-options) + +(defcustom gpg-command-all-arglist + nil + "List of arguments to add to all GPG commands." + :tag "All command args" + :group 'gpg-options) + +(defcustom gpg-command-flag-textmode "--textmode" + "The flag to indicate canonical text mode to GnuPG." + :tag "Text mode flag" + :type 'string + :group 'gpg-options) + +(defcustom gpg-command-flag-armor "--armor" + "The flag to request ASCII-armoring output from GnuPG." + :tag "Armor flag" + :type 'string + :group 'gpg-options) + +(defcustom gpg-command-flag-sign-with-key '("--local-user=" sign-with-key) + "String to include to specify the signing key ID. +The elements are concatenated (without spaces) to form a command line +option." + :tag "Sign with key flag" + :type '(repeat :tag "Argument parts" + (choice :format "%[Type%] %v" + (const :tag "Start next argument." :value next-argument) + (const :tag "Insert signing key ID here." :value sign-with-key) + (string))) + :group 'gpg-options) + +(defcustom gpg-command-flag-recipient + '(nil . ("-r" next-argument recipient next-argument)) + "Format of a recipient specification. +The elements are concatenated (without spaces) to form a command line +option. The second part is repeated for each recipient." + :tag "Recipients Flag" + :type '(cons + (repeat :tag "Common prefix" + (choice :format "%[Type%] %v" + (const :tag "Start next argument." :value next-argument) + (string))) + (repeat :tag "For each recipient" + (choice :format "%[Type%] %v" + (const :tag "Start next argument." :value next-argument) + (const :tag "Insert recipient key ID here." :value recipient) + (string)))) + :group 'gpg-options) + +(defcustom gpg-command-passphrase-env + nil + "Environment variable to set when a passphrase is required, or nil. +If an operation is invoked which requires a passphrase, this +environment variable is set before calling the external program to +indicate that it should read the passphrase from standard input." + :tag "Passphrase environment" + :type '(choice + (const :tag "Disabled" :value nil) + (cons + (string :tag "Variable") + (string :tag "Value"))) + :group 'gpg-options) + +;;; Customization: Variables: GnuPG Commands: + +(defcustom gpg-command-verify + '(gpg . ("--batch" "--verbose" "--verify" signature-file message-file)) + "Command to verify a detached signature. +The invoked program has to read the signed message and the signature +from the given files. It should write human-readable information to +standard output and/or standard error. The program shall not convert +charsets or line endings; the input data shall be treated as binary." + :tag "Verify Command" + :type '(cons + gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert name of file containing the message here." + :value message-file) + (const :tag "Insert name of file containing the signature here." + :value signature-file) + (string :format "%v")))) + :group 'gpg-commands) + +(defcustom gpg-command-verify-cleartext + '(gpg . ("--batch" "--verbose" "--verify" message-file)) + "Command to verify a message. +The invoked program has to read the signed message from the given +file. It should write human-readable information to standard output +and/or standard error. The program shall not convert charsets or line +endings; the input data shall be treated as binary." + :tag "Cleartext Verify Command" + :type '(cons + gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert name of file containing the message here." + :value message-file) + (string :format "%v")))) + :group 'gpg-commands) + +(defcustom gpg-command-decrypt + '(gpg . ("--decrypt" "--batch" "--passphrase-fd=0")) + "Command to decrypt a message. +The invoked program has to read the passphrase from standard +input, followed by the encrypted message. It writes the decrypted +message to standard output, and human-readable diagnostic messages to +standard error." + :tag "Decrypt Command" + :type '(cons + gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert name of file containing the message here." + :value message-file) + (string :format "%v")))) + :group 'gpg-commands) + +(defcustom gpg-command-sign-cleartext + '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" + armor textmode "--clearsign" + sign-with-key)) + "Command to create a create a \"clearsign\" text file. +The invoked program has to read the passphrase from standard input, +followed by the message to sign. It should write the ASCII-amored +signed text message to standard output, and diagnostic messages to +standard error." + :tag "Clearsign Command" + :type 'gpg-command-sign-options + :group 'gpg-commands) + +(defcustom gpg-command-sign-detached + '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" + armor textmode "--detach-sign" + sign-with-key)) + "Command to create a create a detached signature. +The invoked program has to read the passphrase from standard input, +followed by the message to sign. It should write the ASCII-amored +detached signature to standard output, and diagnostic messages to +standard error. The program shall not convert charsets or line +endings; the input data shall be treated as binary." + :tag "Sign Detached Command" + :type 'gpg-command-sign-options + :group 'gpg-commands) + +(defcustom gpg-command-sign-encrypt + '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" + armor textmode "--always-trust" sign-with-key recipients + "--sign" "--encrypt" plaintext-file)) + "Command to sign and encrypt a file. +The invoked program has to read the passphrase from standard input, +followed by the message to sign and encrypt if there is no +`plaintext-file' placeholder. It should write the ASCII-amored +encrypted message to standard output, and diagnostic messages to +standard error." + :tag "Sign And Encrypt Command" + :type '(cons + gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert the `sign with key' option here if necessary." + :value sign-with-key) + (const :tag "Insert list of recipients here." + :value recipients) + (const :tag "Insert here name of file with plaintext." + :value plaintext-file) + (string :format "%v")))) + :group 'gpg-commands) + +(defcustom gpg-command-encrypt + '(gpg-2comp . ("--batch" "--output=-" armor textmode "--always-trust" + "--encrypt" recipients plaintext-file)) + "Command to encrypt a file. +The invoked program has to read the message to encrypt from standard +input or from the plaintext file (if the `plaintext-file' placeholder +is present). It should write the ASCII-amored encrypted message to +standard output, and diagnostic messages to standard error." + :type '(cons + gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert list of recipients here." + :value recipients) + (const :tag "Insert here name of file with plaintext." + :value plaintext-file) + (string :format "%v")))) + :group 'gpg-commands) + +;;; Customization: Variables: Key Management Commands: + +(defcustom gpg-command-key-import + '(gpg . ("--import" "--verbose" message-file)) + "Command to import a public key from a file." + :tag "Import Command" + :type '(cons + gpg-command-program + (repeat + :tag "Arguments" + (choice + :format "%[Type%] %v" + (const :tag "Insert name of file containing the key here." + :value message-file) + (string :format "%v")))) + :group 'gpg-commands-key) + +(defcustom gpg-command-key-export + '(gpg . ("--no-verbose" "--armor" "--export" key-id)) + "Command to export a public key from the key ring. +The key should be written to standard output using ASCII armor." + :tag "Export Command" + :type 'gpg-command-key-options + :group 'gpg-commands-key) + +(defcustom gpg-command-key-verify + '(gpg . ("--no-verbose" "--batch" "--fingerprint" "--check-sigs" key-id)) + "Command to verify a public key." + :tag "Verification Command" + :type 'gpg-command-key-options + :group 'gpg-commands-key) + +(defcustom gpg-command-key-public-ring + '(gpg . ("--no-verbose" "--batch" "--with-colons" "--list-keys" key-id)) + "Command to list the contents of the public key ring." + :tag "List Public Key Ring Command" + :type 'gpg-command-key-options + :group 'gpg-commands-key) + +(defcustom gpg-command-key-secret-ring + '(gpg . ("--no-verbose" "--batch" "--with-colons" + "--list-secret-keys" key-id)) + "Command to list the contents of the secret key ring." + :tag "List Secret Key Ring Command" + :type 'gpg-command-key-options + :group 'gpg-commands-key) + +(defcustom gpg-command-key-retrieve + '(gpg . ("--batch" "--recv-keys" key-id)) + "Command to retrieve public keys." + :tag "Retrieve Keys Command" + :type 'gpg-command-key-options + :group 'gpg-commands-key) + + +;;;; Helper functions for GnuPG invocation: + +;;; Build the GnuPG command line: + +(defun gpg-build-argument (template substitutions &optional pass-start) + "Build command line argument(s) by substituting placeholders. +TEMPLATE is a list of strings and symbols. The placeholder symbols in +it are replaced by SUBSTITUTIONS, the elements between +`next-argument' symbols are concatenated without spaces and are +returned in a list. + +SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either +a string (which is inserted literally), a list of strings (which are +inserted as well), or nil, which means to insert nothing. + +If PASS-START is t, `next-argument' is also inserted into the result, +and symbols without a proper substitution are retained in the output, +otherwise, an untranslated symbol results in an error. + +This function does not handle empty arguments reliably." + (let ((current-arg "") + (arglist nil)) + (while template + (let* ((templ (pop template)) + (repl (assoc templ substitutions)) + (new (if repl (cdr repl) templ))) + (cond + ((eq templ 'next-argument) + ;; If the current argument is not empty, start a new one. + (unless (equal current-arg "") + (setq arglist (nconc arglist + (if pass-start + (list current-arg 'next-argument) + (list current-arg)))) + (setq current-arg ""))) + ((null new) nil) ; Drop it. + ((and (not (stringp templ)) (null repl)) + ;; Retain an untranslated symbol in the output if + ;; `pass-start' is true. + (unless pass-start + (error "No replacement for `%s'" templ)) + (setq arglist (nconc arglist (list current-arg templ))) + (setq current-arg "")) + (t + (unless (listp new) + (setq new (list new))) + (setq current-arg (concat current-arg + (apply 'concat new))))))) + (unless (equal current-arg "") + (setq arglist (nconc arglist (list current-arg)))) + arglist)) + +(defun gpg-build-arg-list (template substitutions) + "Build command line by substituting placeholders. +TEMPLATE is a list of strings and symbols. The placeholder symbols in +it are replaced by SUBSTITUTIONS. + +SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either a +string (which is inserted literally), a list of strings (which are +inserted as well), or nil, which means to insert nothing." + (let ((arglist (copy-list gpg-command-all-arglist))) + (while template + (let* ((templ (pop template)) + (repl (assoc templ substitutions)) + (new (if repl (cdr repl) templ))) + (cond + ((and (symbolp templ) (null repl)) + (error "No replacement for `%s'" templ)) + ((null new) nil) ; Drop it. + (t + (unless (listp new) + (setq new (list new))) + (setq arglist (nconc arglist new)))))) + arglist)) + +(defun gpg-build-flag-recipients-one (recipient) + "Build argument for one RECIPIENT." + (gpg-build-argument (cdr gpg-command-flag-recipient) + `((recipient . ,recipient)) t)) + +(defun gpg-build-flag-recipients (recipients) + "Build list of RECIPIENTS using `gpg-command-flag-recipient'." + (gpg-build-argument + (apply 'append (car gpg-command-flag-recipient) + (mapcar 'gpg-build-flag-recipients-one + recipients)) + nil)) + +(defun gpg-read-recipients () + "Query the user for several recipients." + (let ((go t) + recipients r) + (while go + (setq r (read-string "Enter recipient ID [RET when no more]: ")) + (if (equal r "") + (setq go nil) + (setq recipients (nconc recipients (list r))))) + recipients)) + +(defun gpg-build-flag-sign-with-key (key) + "Build sign with key flag using `gpg-command-flag-sign-with-key'." + (let ((k (if key key + (if gpg-default-key-id gpg-default-key-id + nil)))) + (if k + (gpg-build-argument gpg-command-flag-sign-with-key + (list (cons 'sign-with-key k))) + nil))) + +(defmacro gpg-with-passphrase-env (&rest body) + "Adjust the process environment and evaluate BODY. +During the evaluation of the body forms, the process environment is +adjust according to `gpg-command-passphrase-env'." + (let ((env-value (make-symbol "env-value"))) + `(let ((,env-value)) + (unwind-protect + (progn + (when gpg-command-passphrase-env + (setq ,env-value (getenv (car gpg-command-passphrase-env))) + (setenv (car gpg-command-passphrase-env) + (cdr gpg-command-passphrase-env))) + ,@body) + (when gpg-command-passphrase-env + ;; This will clear the variable if it wasn't set before. + (setenv (car gpg-command-passphrase-env) ,env-value)))))) +(put 'gpg-with-passphrase-env 'lisp-indent-function 0) +(put 'gpg-with-passphrase-env 'edebug-form-spec '(body)) + +;;; Temporary files: + +(defun gpg-make-temp-file () + "Create a temporary file in a safe way" + (let ((name ;; User may use "~/" + (expand-file-name "gnupg" gpg-temp-directory))) + (if (fboundp 'make-temp-file) + ;; If we've got make-temp-file, we are on the save side. + (make-temp-file name) + ;; make-temp-name doesn't create the file, and an ordinary + ;; write-file operation is prone to nasty symlink attacks if the + ;; temporary file resides in a world-writable directory. + (unless (or (memq system-type '(windows-nt cygwin32 win32 w32 mswindows)) + (eq (file-modes gpg-temp-directory) 448)) ; mode 0700 + (error "Directory for temporary files must have mode 0700.")) + (setq name (make-temp-name name)) + (let ((mode (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes 384) ; mode 0600 + (with-temp-file name)) + (set-default-file-modes mode))) + name))) + +(defvar gpg-temp-files nil + "List of temporary files used by the GnuPG interface. +Do not set this variable. Call `gpg-with-temp-files' if you need +temporary files.") + +(defun gpg-with-temp-files-create (count) + "Do not call this function. Used internally by `gpg-with-temp-files'." + (while (> count 0) + (setq gpg-temp-files (cons (gpg-make-temp-file) gpg-temp-files)) + (setq count (1- count)))) + +(defun gpg-with-temp-files-delete () + "Do not call this function. Used internally by `gpg-with-temp-files'." + (while gpg-temp-files + (let ((file (pop gpg-temp-files))) + (condition-case nil + (delete-file file) + (error nil))))) + +(defmacro gpg-with-temp-files (count &rest body) + "Create COUNT temporary files, USE them, and delete them. +The function USE is called with the names of all temporary files as +arguments." + `(let ((gpg-temp-files)) + (unwind-protect + (progn + ;; Create the temporary files. + (gpg-with-temp-files-create ,count) + ,@body) + (gpg-with-temp-files-delete)))) +(put 'gpg-with-temp-files 'lisp-indent-function 1) +(put 'gpg-with-temp-files 'edebug-form-spec '(body)) + +;;; Making subprocesses: + +(defun gpg-exec-path (option) + "Return the program name for OPTION. +OPTION is of the form (PROGRAM . ARGLIST). This functions returns +PROGRAM, but takes default values into account." + (let* ((prg (car option)) + (path (assq prg gpg-command-default-alist))) + (cond + (path (if (null (cdr path)) + (error "Command `%s' is not available" prg) + (cdr path))) + ((null prg) (error "Command is disabled")) + (t prg)))) + +(defun gpg-call-process (cmd args stdin stdout stderr &optional passphrase) + "Invoke external program CMD with ARGS on buffer STDIN. +Standard output is insert before point in STDOUT, standard error in +STDERR. If PASSPHRASE is given, send it before STDIN. PASSPHRASE +should not end with a line feed (\"\\n\"). + +If `stdin-file' is present in ARGS, it is replaced by the name of a +temporary file. Before invoking CMD, the contents of STDIN is written +to this file." + (gpg-with-temp-files 2 + (let* ((coding-system-for-read 'no-conversion) + (coding-system-for-write 'no-conversion) + (have-stdin-file (memq 'stdin-file args)) + (stdin-file (nth 0 gpg-temp-files)) + (stderr-file (nth 1 gpg-temp-files)) + (cpr-args `(,cmd + nil ; don't delete + (,stdout ,stderr-file) + nil ; don't display + ;; Replace `stdin-file'. + ,@(gpg-build-arg-list + args (list (cons 'stdin-file stdin-file))))) + res) + (when have-stdin-file + (with-temp-file stdin-file + (buffer-disable-undo) + (insert-buffer-substring stdin))) + (setq res + (if passphrase + (with-temp-buffer + (buffer-disable-undo) + (insert passphrase "\n") + (unless have-stdin-file + (apply 'insert-buffer-substring + (if (listp stdin) stdin (list stdin)))) + (apply 'call-process-region (point-min) (point-max) cpr-args) + ;; Wipe out passphrase. + (goto-char (point-min)) + (translate-region (point) (gpg-point-at-eol) + (make-string 256 ? ))) + (if (listp stdin) + (with-current-buffer (car stdin) + (apply 'call-process-region + (cadr stdin) + (if have-stdin-file (cadr stdin) (caddr stdin)) + cpr-args)) + (with-current-buffer stdin + (apply 'call-process-region + (point-min) + (if have-stdin-file (point-min) (point-max)) + cpr-args))))) + (with-current-buffer stderr + (insert-file-contents-literally stderr-file)) + (if (or (stringp res) (> res 0)) + ;; Signal or abnormal exit. + (with-current-buffer stderr + (goto-char (point-max)) + (insert (format "\nCommand exit status: %s\n" res)) + nil) + t)))) + +(defvar gpg-result-buffer nil + "The result of a GnuPG operation is stored in this buffer. +Never set this variable directly, use `gpg-show-result' instead.") + +(defun gpg-show-result-buffer (always-show result) + "Called by `gpg-show-results' to actually show the buffer." + (with-current-buffer gpg-result-buffer + ;; Only proceed if the buffer is non-empty. + (when (and (/= (point-min) (point-max)) + (or always-show (not result))) + (save-window-excursion + (display-buffer (current-buffer)) + (unless (y-or-n-p "Continue? ") + (error "GnuPG operation aborted.")))))) + +(defmacro gpg-show-result (always-show &rest body) + "Show GnuPG result to user for confirmation. +This macro binds `gpg-result-buffer' to a temporary buffer and +evaluates BODY, like `progn'. If BODY evaluates to `nil' (or +`always-show' is not nil), the user is asked for confirmation." + `(let ((gpg-result-buffer (get-buffer-create + (generate-new-buffer-name "*GnuPG Output*")))) + (unwind-protect + (gpg-show-result-buffer ,always-show (progn ,@body)) + (kill-buffer gpg-result-buffer)))) +(put 'gpg-show-result 'lisp-indent-function 1) +(put 'gpg-show-result 'edebug-form-spec '(body)) + +;;; Passphrase handling: + +(defvar gpg-passphrase-timer + (timer-create) + "This timer will clear the passphrase cache periodically.") + +(defvar gpg-passphrase + nil + "The (unencrypted) passphrase cache.") + +(defun gpg-passphrase-clear-string (str) + "Erases STR by overwriting all characters." + (let ((pos 0) + (len (length str))) + (while (< pos len) + (aset str pos ? ) + (incf pos)))) + +;;;###autoload +(defun gpg-passphrase-forget () + "Forget stored passphrase." + (interactive) + (cancel-timer gpg-passphrase-timer) + (gpg-passphrase-clear-string gpg-passphrase) + (setq gpg-passphrase nil)) + +(defun gpg-passphrase-store (passphrase) + "Store PASSPHRASE in cache. +Updates the timeout for clearing the cache to `gpg-passphrase-timeout'." + (unless (equal gpg-passphrase-timeout 0) + (timer-set-time gpg-passphrase-timer + (timer-relative-time (current-time) + gpg-passphrase-timeout)) + (timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget) + (unless (and (fboundp 'itimer-live-p) + (itimer-live-p gpg-passphrase-timer)) + (timer-activate gpg-passphrase-timer)) + (setq gpg-passphrase passphrase)) + passphrase) + +(defun gpg-passphrase-read () + "Read a passphrase and remember it for some time." + (interactive) + (if gpg-passphrase + ;; This reinitializes the timer. + (gpg-passphrase-store gpg-passphrase) + (let ((pp (read-passwd "Enter passphrase: "))) + (gpg-passphrase-store pp)))) + + +;;;; Main operations: + +;;;###autoload +(defun gpg-verify (message signature result) + "Verify buffer MESSAGE against detached SIGNATURE buffer. +Returns t if everything worked out well, nil otherwise. Consult +buffer RESULT for details." + (interactive "bBuffer containing message: \nbBuffer containing signature: \nbBuffor for result: ") + (gpg-with-temp-files 2 + (let* ((sig-file (nth 0 gpg-temp-files)) + (msg-file (nth 1 gpg-temp-files)) + (cmd (gpg-exec-path gpg-command-verify)) + (args (gpg-build-arg-list (cdr gpg-command-verify) + `((signature-file . ,sig-file) + (message-file . ,msg-file)))) + res) + (with-temp-file sig-file + (buffer-disable-undo) + (apply 'insert-buffer-substring (if (listp signature) + signature + (list signature)))) + (with-temp-file msg-file + (buffer-disable-undo) + (apply 'insert-buffer-substring (if (listp message) + message + (list message)))) + (setq res (apply 'call-process-region + (point-min) (point-min) ; no data + cmd + nil ; don't delete + result + nil ; don't display + args)) + (if (or (stringp res) (> res 0)) + ;; Signal or abnormal exit. + (with-current-buffer result + (insert (format "\nCommand exit status: %s\n" res)) + nil) + t)))) + +;;;###autoload +(defun gpg-verify-cleartext (message result) + "Verify message in buffer MESSAGE. +Returns t if everything worked out well, nil otherwise. Consult +buffer RESULT for details. + +NOTE: Use of this function is deprecated." + (interactive "bBuffer containing message: \nbBuffor for result: ") + (gpg-with-temp-files 1 + (let* ((msg-file (nth 0 gpg-temp-files)) + (cmd (gpg-exec-path gpg-command-verify-cleartext)) + (args (gpg-build-arg-list (cdr gpg-command-verify-cleartext) + `((message-file . ,msg-file)))) + res) + (with-temp-file msg-file + (buffer-disable-undo) + (apply 'insert-buffer-substring (if (listp message) + message + (list message)))) + (setq res (apply 'call-process-region + (point-min) (point-min) ; no data + cmd + nil ; don't delete + result + nil ; don't display + args)) + (if (or (stringp res) (> res 0)) + ;; Signal or abnormal exit. + (with-current-buffer result + (insert (format "\nCommand exit status: %s\n" res)) + nil) + t)))) + +;;;###autoload +(defun gpg-decrypt (ciphertext plaintext result &optional passphrase) + "Decrypt buffer CIPHERTEXT to buffer PLAINTEXT. +Returns t if everything worked out well, nil otherwise. Consult +buffer RESULT for details. Reads a missing PASSPHRASE using +`gpg-passphrase-read'." + (interactive "bBuffer containing ciphertext: \nbBuffer for plaintext: \nbBuffor for decryption status: ") + (gpg-call-process (gpg-exec-path gpg-command-decrypt) + (gpg-build-arg-list (cdr gpg-command-decrypt) nil) + ciphertext plaintext result + (if passphrase passphrase (gpg-passphrase-read))) + (when passphrase + (gpg-passphrase-clear-string passphrase))) + +;;;###autoload +(defun gpg-sign-cleartext + (plaintext signed-text result &optional passphrase sign-with-key) + "Sign buffer PLAINTEXT, and store PLAINTEXT with signature in +SIGNED-TEXT. +Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID +SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if +everything worked out well, nil otherwise. Consult buffer RESULT for +details. + +NOTE: Use of this function is deprecated." + (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ") + (let ((subst (list (cons 'sign-with-key + (gpg-build-flag-sign-with-key sign-with-key)) + (cons 'armor gpg-command-flag-armor) + (cons 'textmode gpg-command-flag-textmode)))) + (gpg-call-process (gpg-exec-path gpg-command-sign-cleartext) + (gpg-build-arg-list (cdr gpg-command-sign-cleartext) + subst) + plaintext signed-text result + (if passphrase passphrase (gpg-passphrase-read)))) + (when passphrase + (gpg-passphrase-clear-string passphrase))) + +;;;###autoload +(defun gpg-sign-detached + (plaintext signature result &optional passphrase sign-with-key + armor textmode) + "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer. +Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID +SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if +everything worked out well, nil otherwise. Consult buffer RESULT for +details. ARMOR the result and activate canonical TEXTMODE if +requested." + (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ") + (let ((subst (list (cons 'sign-with-key + (gpg-build-flag-sign-with-key sign-with-key)) + (cons 'armor (if armor gpg-command-flag-armor)) + (cons 'textmode (if armor gpg-command-flag-textmode))))) + (gpg-call-process (gpg-exec-path gpg-command-sign-detached) + (gpg-build-arg-list (cdr gpg-command-sign-detached) + subst) + plaintext signature result + (if passphrase passphrase (gpg-passphrase-read)))) + (when passphrase + (gpg-passphrase-clear-string passphrase))) + + +;;;###autoload +(defun gpg-sign-encrypt + (plaintext ciphertext result recipients &optional passphrase sign-with-key + armor textmode) + "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer. +RECIPIENTS is a list of key IDs used for encryption. This function +reads a missing PASSPHRASE using `gpg-passphrase-read', and uses key +ID SIGN-WITH-KEY for the signature if given, otherwise the default key +ID. Returns t if everything worked out well, nil otherwise. Consult +buffer RESULT for details. ARMOR the result and activate canonical +TEXTMODE if requested." + (interactive (list + (read-buffer "Buffer containing plaintext: " nil t) + (read-buffer "Buffer for ciphertext: " nil t) + (read-buffer "Buffer for status informationt: " nil t) + (gpg-read-recipients))) + (let ((subst `((sign-with-key . ,(gpg-build-flag-sign-with-key + sign-with-key)) + (plaintext-file . stdin-file) + (recipients . ,(gpg-build-flag-recipients recipients)) + (armor ,(if armor gpg-command-flag-armor)) + (textmode ,(if armor gpg-command-flag-textmode))))) + (gpg-call-process (gpg-exec-path gpg-command-sign-encrypt) + (gpg-build-arg-list (cdr gpg-command-sign-encrypt) + subst) + plaintext ciphertext result + (if passphrase passphrase (gpg-passphrase-read)))) + (when passphrase + (gpg-passphrase-clear-string passphrase))) + + +;;;###autoload +(defun gpg-encrypt + (plaintext ciphertext result recipients &optional passphrase armor textmode) + "Encrypt buffer PLAINTEXT, and store CIPHERTEXT in that buffer. +RECIPIENTS is a list of key IDs used for encryption. Returns t if +everything worked out well, nil otherwise. Consult buffer RESULT for +details. ARMOR the result and activate canonical +TEXTMODE if requested." + (interactive (list + (read-buffer "Buffer containing plaintext: " nil t) + (read-buffer "Buffer for ciphertext: " nil t) + (read-buffer "Buffer for status informationt: " nil t) + (gpg-read-recipients))) + (let ((subst `((plaintext-file . stdin-file) + (recipients . ,(gpg-build-flag-recipients recipients)) + (armor ,(if armor gpg-command-flag-armor)) + (textmode ,(if armor gpg-command-flag-textmode))))) + (gpg-call-process (gpg-exec-path gpg-command-encrypt) + (gpg-build-arg-list (cdr gpg-command-encrypt) subst) + plaintext ciphertext result nil)) + (when passphrase + (gpg-passphrase-clear-string passphrase))) + + +;;;; Key management + +;;; ADT: OpenPGP Key + +(defun gpg-key-make (user-id key-id unique-id length algorithm + creation-date expire-date validity trust) + "Create a new key object (for internal use only)." + (vector + ;; 0 1 2 3 4 + user-id key-id unique-id length algorithm + ;; 5 6 7 8 + creation-date expire-date validity trust)) + + +(defun gpg-key-p (key) + "Return t if KEY is a key specification." + (and (arrayp key) (equal (length key) 9) key)) + +(defmacro gpg-key-primary-user-id (key) + "The primary user ID for KEY (human-readable). +DO NOT USE this ID for selecting recipients. It is probably not +unique." + (list 'car (list 'aref key 0))) + +(defmacro gpg-key-user-ids (key) + "A list of additional user IDs for KEY (human-readable). +DO NOT USE these IDs for selecting recipients. They are probably not +unique." + (list 'cdr (list 'aref key 0))) + +(defmacro gpg-key-id (key) + "The key ID of KEY. +DO NOT USE this ID for selecting recipients. It is not guaranteed to +be unique." + (list 'aref key 1)) + +(defun gpg-short-key-id (key) + "The short key ID of KEY." + (let* ((id (gpg-key-id key)) + (len (length id))) + (if (> len 8) + (substring id (- len 8)) + id))) + +(defmacro gpg-key-unique-id (key) + "A non-standard ID of KEY which is only valid locally. +This ID can be used to specify recipients in a safe manner. Note, +even this ID might not be unique unless GnuPG is used." + (list 'aref key 2)) + +(defmacro gpg-key-unique-id-list (key-list) + "Like `gpg-key-unique-id', but operate on a list." + `(mapcar (lambda (key) (gpg-key-unique-id key)) + ,key-list)) + +(defmacro gpg-key-length (key) + "Returns the key length." + (list 'aref key 3)) + +(defmacro gpg-key-algorithm (key) + "The encryption algorithm used by KEY. +One of the symbols `rsa', `rsa-encrypt', `rsa-sign', `elgamal', +`elgamal-encrypt', `dsa'." + (list 'aref key 4)) + +(defmacro gpg-key-creation-date (key) + "A string with the creation date of KEY in ISO format." + (list 'aref key 5)) + +(defmacro gpg-key-expire-date (key) + "A string with the expiration date of KEY in ISO format." + (list 'aref key 6)) + +(defmacro gpg-key-validity (key) + "The calculated validity of KEY. +One of the symbols `not-known', `disabled', `revoked', `expired', +`undefined', `trust-none', `trust-marginal', `trust-full', +`trust-ultimate' (see the GnuPG documentation for details)." + (list 'aref key 7)) + +(defmacro gpg-key-trust (key) + "The assigned trust for KEY. +One of the symbols `not-known', `undefined', `trust-none', +`trust-marginal', `trust-full' (see the GnuPG +documentation for details)." + (list 'aref key 8)) + +(defun gpg-key-lessp (a b) + "Returns t if primary user ID of A is less than B." + (string-lessp (gpg-key-primary-user-id a) (gpg-key-primary-user-id b) )) + +;;; Accessing the key database: + +;; Internal functions: + +(defmacro gpg-key-list-keys-skip-field () + '(search-forward ":" eol 'move)) + +(defmacro gpg-key-list-keys-get-field () + '(buffer-substring (point) (if (gpg-key-list-keys-skip-field) + (1- (point)) + eol))) +(defmacro gpg-key-list-keys-string-field () + '(gpg-key-list-keys-get-field)) + +(defmacro gpg-key-list-keys-read-field () + (let ((field (make-symbol "field"))) + `(let ((,field (gpg-key-list-keys-get-field))) + (if (equal (length ,field) 0) + nil + (read ,field))))) + +(defun gpg-key-list-keys-parse-line () + "Parse the line in the current buffer and return a vector of fields." + (let* ((eol (gpg-point-at-eol)) + (v (if (eolp) + nil + (vector + (gpg-key-list-keys-read-field) ; type + (gpg-key-list-keys-get-field) ; trust + (gpg-key-list-keys-read-field) ; key length + (gpg-key-list-keys-read-field) ; algorithm + (gpg-key-list-keys-get-field) ; key ID + (gpg-key-list-keys-get-field) ; creation data + (gpg-key-list-keys-get-field) ; expire + (gpg-key-list-keys-get-field) ; unique (local) ID + (gpg-key-list-keys-get-field) ; ownertrust + (gpg-key-list-keys-string-field) ; user ID + )))) + (if (eolp) + (when v + (forward-char 1)) + (error "Too many fields in GnuPG key database")) + v)) + +(defconst gpg-pubkey-algo-alist + '((1 . rsa) + (2 . rsa-encrypt-only) + (3 . rsa-sign-only) + (16 . elgamal-encrypt-only) + (17 . dsa) + (20 . elgamal)) + "Alist mapping OpenPGP public key algorithm numbers to symbols.") + +(defconst gpg-trust-alist + '((?- . not-known) + (?o . not-known) + (?d . disabled) + (?r . revoked) + (?e . expired) + (?q . trust-undefined) + (?n . trust-none) + (?m . trust-marginal) + (?f . trust-full) + (?u . trust-ultimate)) + "Alist mapping GnuPG trust value short forms to long symbols.") + +(defmacro gpg-key-list-keys-in-buffer-store () + '(when primary-user-id + (sort user-id 'string-lessp) + (push (gpg-key-make (cons primary-user-id user-id) + key-id unique-id key-length + algorithm creation-date + expire-date validity trust) + key-list))) + +(defun gpg-key-list-keys-in-buffer (&optional buffer) + "Return a list of keys for BUFFER. +If BUFFER is omitted, use current buffer." + (with-current-buffer (if buffer buffer (current-buffer)) + (goto-char (point-min)) + ;; Skip key ring filename written by GnuPG. + (search-forward "\n---------------------------\n" nil t) + ;; Loop over all lines in buffer and analyze them. + (let (primary-user-id user-id key-id unique-id ; current key components + key-length algorithm creation-date expire-date validity trust + line ; fields in current line + key-list) ; keys gather so far + + (while (setq line (gpg-key-list-keys-parse-line)) + (cond + ;; Public or secret key. + ((memq (aref line 0) '(pub sec)) + ;; Store previous key, if any. + (gpg-key-list-keys-in-buffer-store) + ;; Record field values. + (setq primary-user-id (aref line 9)) + (setq user-id nil) + (setq key-id (aref line 4)) + ;; We use the key ID if no unique ID is available. + (setq unique-id (if (> (length (aref line 7)) 0) + (concat "#" (aref line 7)) + (concat "0x" key-id))) + (setq key-length (aref line 2)) + (setq algorithm (assq (aref line 3) gpg-pubkey-algo-alist)) + (if algorithm + (setq algorithm (cdr algorithm)) + (error "Unknown algorithm %s" (aref line 3))) + (setq creation-date (if (> (length (aref line 5)) 0) + (aref line 5))) + (setq expire-date (if (> (length (aref line 6)) 0) + (aref line 6))) + (setq validity (assq (aref (aref line 1) 0) gpg-trust-alist)) + (if validity + (setq validity (cdr validity)) + (error "Unknown validity specification %S" (aref line 1))) + (setq trust (assq (aref (aref line 8) 0) gpg-trust-alist)) + (if trust + (setq trust (cdr trust)) + (error "Unknown trust specification %S" (aref line 8)))) + + ;; Additional user ID + ((eq 'uid (aref line 0)) + (setq user-id (cons (aref line 9) user-id))) + + ;; Subkeys are ignored for now. + ((memq (aref line 0) '(sub ssb)) + t) + (t (error "Unknown record type %S" (aref line 0))))) + + ;; Store the key retrieved last. + (gpg-key-list-keys-in-buffer-store) + ;; Sort the keys according to the primary user ID. + (sort key-list 'gpg-key-lessp)))) + +(defun gpg-key-list-keyspec (command &optional keyspec stderr ignore-error) + "Insert the output of COMMAND before point in current buffer." + (let* ((cmd (gpg-exec-path command)) + (key (if (equal keyspec "") nil keyspec)) + (args (gpg-build-arg-list (cdr command) `((key-id . ,key)))) + exit-status) + (setq exit-status + (apply 'call-process-region + (point-min) (point-min) ; no data + cmd + nil ; don't delete + (if stderr t '(t nil)) + nil ; don't display + args)) + (unless (or ignore-error (equal exit-status 0)) + (error "GnuPG command exited unsuccessfully")))) + + +(defun gpg-key-list-keyspec-parse (command &optional keyspec) + "Return a list of keys matching KEYSPEC. +COMMAND is used to obtain the key list. The usual substring search +for keys is performed." + (with-temp-buffer + (buffer-disable-undo) + (gpg-key-list-keyspec command keyspec) + (gpg-key-list-keys-in-buffer))) + +;;;###autoload +(defun gpg-key-list-keys (&optional keyspec) + "A list of public keys matching KEYSPEC. +The usual substring search for keys is performed." + (gpg-key-list-keyspec-parse gpg-command-key-public-ring keyspec)) + +;;;###autoload +(defun gpg-key-list-secret-keys (&optional keyspec) + "A list of secret keys matching KEYSPEC. +The usual substring search for keys is performed." + (gpg-key-list-keyspec-parse gpg-command-key-secret-ring keyspec)) + +;;;###autoload +(defun gpg-key-insert-public-key (key) + "Inserts the public key(s) matching KEYSPEC. +The ASCII-armored key is inserted before point into current buffer." + (gpg-key-list-keyspec gpg-command-key-export key)) + +;;;###autoload +(defun gpg-key-insert-information (key) + "Insert human-readable information (including fingerprint) on KEY. +Insertion takes place in current buffer before point." + (gpg-key-list-keyspec gpg-command-key-verify key)) + +;;;###autoload +(defun gpg-key-retrieve (key) + "Fetch KEY from default key server. +KEY is a key ID or a list of key IDs. Status information about this +operation is inserted into the current buffer before point." + (gpg-key-list-keyspec gpg-command-key-retrieve key t t)) + +;;;###autoload +(defun gpg-key-add-to-ring (key result) + "Adds key in buffer KEY to the GnuPG key ring. +Human-readable information on the RESULT is stored in buffer RESULT +before point.") + +(provide 'gpg) + +;;; gpg.el ends here diff --git a/contrib/md5.el b/contrib/md5.el new file mode 100644 index 0000000..94d65de --- /dev/null +++ b/contrib/md5.el @@ -0,0 +1,409 @@ +;;; md5.el -- MD5 Message Digest Algorithm +;;; Gareth Rees + +;; LCD Archive Entry: +;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| +;; MD5 cryptographic message digest algorithm| +;; 13-Nov-95|1.0|~/misc/md5.el.Z| + +;;; Details: ------------------------------------------------------------------ + +;; This is a direct translation into Emacs LISP of the reference C +;; implementation of the MD5 Message-Digest Algorithm written by RSA +;; Data Security, Inc. +;; +;; The algorithm takes a message (that is, a string of bytes) and +;; computes a 16-byte checksum or "digest" for the message. This digest +;; is supposed to be cryptographically strong in the sense that if you +;; are given a 16-byte digest D, then there is no easier way to +;; construct a message whose digest is D than to exhaustively search the +;; space of messages. However, the robustness of the algorithm has not +;; been proven, and a similar algorithm (MD4) was shown to be unsound, +;; so treat with caution! +;; +;; The C algorithm uses 32-bit integers; because GNU Emacs +;; implementations provide 28-bit integers (with 24-bit integers on +;; versions prior to 19.29), the code represents a 32-bit integer as the +;; cons of two 16-bit integers. The most significant word is stored in +;; the car and the least significant in the cdr. The algorithm requires +;; at least 17 bits of integer representation in order to represent the +;; carry from a 16-bit addition. + +;;; Usage: -------------------------------------------------------------------- + +;; To compute the MD5 Message Digest for a message M (represented as a +;; string or as a vector of bytes), call +;; +;; (md5-encode M) +;; +;; which returns the message digest as a vector of 16 bytes. If you +;; need to supply the message in pieces M1, M2, ... Mn, then call +;; +;; (md5-init) +;; (md5-update M1) +;; (md5-update M2) +;; ... +;; (md5-update Mn) +;; (md5-final) + +;;; Copyright and licence: ---------------------------------------------------- + +;; Copyright (C) 1995 by Gareth Rees +;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm +;; +;; md5.el 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. +;; +;; md5.el 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. +;; +;; The original copyright notice is given below, as required by the +;; licence for the original code. This code is distributed under *both* +;; RSA's original licence and the GNU General Public Licence. (There +;; should be no problems, as the former is more liberal than the +;; latter). + +;;; Original copyright notice: ------------------------------------------------ + +;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. +;; +;; License to copy and use this software is granted provided that it is +;; identified as the "RSA Data Security, Inc. MD5 Message- Digest +;; Algorithm" in all material mentioning or referencing this software or +;; this function. +;; +;; License is also granted to make and use derivative works provided +;; that such works are identified as "derived from the RSA Data +;; Security, Inc. MD5 Message-Digest Algorithm" in all material +;; mentioning or referencing the derived work. +;; +;; RSA Data Security, Inc. makes no representations concerning either +;; the merchantability of this software or the suitability of this +;; software for any particular purpose. It is provided "as is" without +;; express or implied warranty of any kind. +;; +;; These notices must be retained in any copies of any part of this +;; documentation and/or software. + +;;; Code: --------------------------------------------------------------------- + +(defvar md5-program "md5sum" + "*Program that reads a message on its standard input and writes an +MD5 digest on its output.") + +(defvar md5-maximum-internal-length 4096 + "*The maximum size of a piece of data that should use the MD5 routines +written in lisp. If a message exceeds this, it will be run through an +external filter for processing. Also see the `md5-program' variable. +This variable has no effect if you call the md5-init|update|final +functions - only used by the `md5' function's simpler interface.") + +(defvar md5-bits (make-vector 4 0) + "Number of bits handled, modulo 2^64. +Represented as four 16-bit numbers, least significant first.") +(defvar md5-buffer (make-vector 4 '(0 . 0)) + "Scratch buffer (four 32-bit integers).") +(defvar md5-input (make-vector 64 0) + "Input buffer (64 bytes).") + +(defun md5-unhex (x) + (if (> x ?9) + (if (>= x ?a) + (+ 10 (- x ?a)) + (+ 10 (- x ?A))) + (- x ?0))) + +(defun md5-encode (message) + "Encodes MESSAGE using the MD5 message digest algorithm. +MESSAGE must be a string or an array of bytes. +Returns a vector of 16 bytes containing the message digest." + (if (<= (length message) md5-maximum-internal-length) + (progn + (md5-init) + (md5-update message) + (md5-final)) + (save-excursion + (set-buffer (get-buffer-create " *md5-work*")) + (erase-buffer) + (insert message) + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") + t (current-buffer) nil + "-c" md5-program) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (let ((data (buffer-substring (point-min) (+ (point-min) 32))) + (vec (make-vector 16 0)) + (ctr 0)) + (while (< ctr 16) + (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) + (md5-unhex (aref data (1+ (* ctr 2)))))) + (setq ctr (1+ ctr))))))) + +(defsubst md5-add (x y) + "Return 32-bit sum of 32-bit integers X and Y." + (let ((m (+ (car x) (car y))) + (l (+ (cdr x) (cdr y)))) + (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) + +;; FF, GG, HH and II are basic MD5 functions, providing transformations +;; for rounds 1, 2, 3 and 4 respectively. Each function follows this +;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x +;; by y bits to the left): +;; +;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b +;; +;; so we use the macro `md5-make-step' to construct each one. The +;; helper functions F, G, H and I operate on 16-bit numbers; the full +;; operation splits its inputs, operates on the halves separately and +;; then puts the results together. + +(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) +(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) +(defsubst md5-H (x y z) (logxor x y z)) +(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) + +(defmacro md5-make-step (name func) + (` + (defun (, name) (a b c d x s ac) + (let* + ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) + (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) + (m2 (logand 65535 (+ m1 (lsh l1 -16)))) + (l2 (logand 65535 l1)) + (m3 (logand 65535 (if (> s 15) + (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) + (+ (lsh m2 s) (lsh l2 (- s 16)))))) + (l3 (logand 65535 (if (> s 15) + (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) + (+ (lsh l2 s) (lsh m2 (- s 16))))))) + (md5-add (cons m3 l3) b))))) + +(md5-make-step md5-FF md5-F) +(md5-make-step md5-GG md5-G) +(md5-make-step md5-HH md5-H) +(md5-make-step md5-II md5-I) + +(defun md5-init () + "Initialise the state of the message-digest routines." + (aset md5-bits 0 0) + (aset md5-bits 1 0) + (aset md5-bits 2 0) + (aset md5-bits 3 0) + (aset md5-buffer 0 '(26437 . 8961)) + (aset md5-buffer 1 '(61389 . 43913)) + (aset md5-buffer 2 '(39098 . 56574)) + (aset md5-buffer 3 '( 4146 . 21622))) + +(defun md5-update (string) + "Update the current MD5 state with STRING (an array of bytes)." + (let ((len (length string)) + (i 0) + (j 0)) + (while (< i len) + ;; Compute number of bytes modulo 64 + (setq j (% (/ (aref md5-bits 0) 8) 64)) + + ;; Store this byte (truncating to 8 bits to be sure) + (aset md5-input j (logand 255 (aref string i))) + + ;; Update number of bits by 8 (modulo 2^64) + (let ((c 8) (k 0)) + (while (and (> c 0) (< k 4)) + (let ((b (aref md5-bits k))) + (aset md5-bits k (logand 65535 (+ b c))) + (setq c (if (> b (- 65535 c)) 1 0) + k (1+ k))))) + + ;; Increment number of bytes processed + (setq i (1+ i)) + + ;; When 64 bytes accumulated, pack them into sixteen 32-bit + ;; integers in the array `in' and then tranform them. + (if (= j 63) + (let ((in (make-vector 16 (cons 0 0))) + (k 0) + (kk 0)) + (while (< k 16) + (aset in k (md5-pack md5-input kk)) + (setq k (+ k 1) kk (+ kk 4))) + (md5-transform in)))))) + +(defun md5-pack (array i) + "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." + (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) + (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) + +(defun md5-byte (array n b) + "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." + (let ((e (aref array n))) + (cond ((eq b 0) (logand 255 (cdr e))) + ((eq b 1) (lsh (cdr e) -8)) + ((eq b 2) (logand 255 (car e))) + ((eq b 3) (lsh (car e) -8))))) + +(defun md5-final () + (let ((in (make-vector 16 (cons 0 0))) + (j 0) + (digest (make-vector 16 0)) + (padding)) + + ;; Save the number of bits in the message + (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) + (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) + + ;; Compute number of bytes modulo 64 + (setq j (% (/ (aref md5-bits 0) 8) 64)) + + ;; Pad out computation to 56 bytes modulo 64 + (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) + (aset padding 0 128) + (md5-update padding) + + ;; Append length in bits and transform + (let ((k 0) (kk 0)) + (while (< k 14) + (aset in k (md5-pack md5-input kk)) + (setq k (+ k 1) kk (+ kk 4)))) + (md5-transform in) + + ;; Store the results in the digest + (let ((k 0) (kk 0)) + (while (< k 4) + (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) + (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) + (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) + (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) + (setq k (+ k 1) kk (+ kk 4)))) + + ;; Return digest + digest)) + +;; It says in the RSA source, "Note that if the Mysterious Constants are +;; arranged backwards in little-endian order and decrypted with the DES +;; they produce OCCULT MESSAGES!" Security through obscurity? + +(defun md5-transform (in) + "Basic MD5 step. Transform md5-buffer based on array IN." + (let ((a (aref md5-buffer 0)) + (b (aref md5-buffer 1)) + (c (aref md5-buffer 2)) + (d (aref md5-buffer 3))) + (setq + a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) + d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) + c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) + b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) + a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) + d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) + c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) + b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) + a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) + d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) + c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) + b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) + a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) + d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) + c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) + b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) + a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) + d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) + c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) + b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) + a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) + d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) + c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) + b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) + a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) + d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) + c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) + b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) + a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) + d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) + c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) + b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) + a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) + d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) + c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) + b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) + a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) + d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) + c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) + b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) + a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) + d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) + c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) + b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) + a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) + d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) + c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) + b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) + a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) + d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) + c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) + b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) + a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) + d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) + c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) + b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) + a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) + d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) + c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) + b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) + a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) + d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) + c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) + b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) + + (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) + (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) + (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) + (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Here begins the merger with the XEmacs API and the md5.el from the URL +;;; package. Courtesy wmperry@spry.com +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun md5 (object &optional start end) + "Return the MD5 (a secure message digest algorithm) of an object. +OBJECT is either a string or a buffer. +Optional arguments START and END denote buffer positions for computing the +hash of a portion of OBJECT." + (let ((buffer nil)) + (unwind-protect + (save-excursion + (setq buffer (generate-new-buffer " *md5-work*")) + (set-buffer buffer) + (cond + ((bufferp object) + (insert-buffer-substring object start end)) + ((stringp object) + (insert (if (or start end) + (substring object start end) + object))) + (t nil)) + (prog1 + (if (<= (point-max) md5-maximum-internal-length) + (mapconcat + (function (lambda (node) (format "%02x" node))) + (md5-encode (buffer-string)) + "") + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") + t buffer nil + "-c" md5-program) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (buffer-substring (point-min) (+ (point-min) 32))) + (kill-buffer buffer))) + (and buffer (kill-buffer buffer) nil)))) + +(provide 'md5) + +;;; md5.el ends here ---------------------------------------------------------- diff --git a/contrib/one-line-cookie.diff b/contrib/one-line-cookie.diff new file mode 100644 index 0000000..1cab64a --- /dev/null +++ b/contrib/one-line-cookie.diff @@ -0,0 +1,28 @@ +Index: url-cookie.el +=================================================================== +RCS file: /gd/gnu/anoncvsroot/url/lisp/url-cookie.el,v +retrieving revision 1.1.1.1 +diff -u -r1.1.1.1 url-cookie.el +--- url-cookie.el 1999/11/26 12:11:47 1.1.1.1 ++++ url-cookie.el 1999/12/10 06:53:05 +@@ -255,6 +255,10 @@ + (setq retval (cons cur retval)))))) + retval)) + ++(defvar url-cookie-multiple-line t ++ "If nil, use one line cookie. ++Some web servers, such as hotmail, only accept one line cookie.") ++ + ;;;###autolaod + (defun url-cookie-generate-header-lines (host path secure) + (let* ((cookies (url-cookie-retrieve host path secure)) +@@ -272,7 +276,8 @@ + (setq cur (car cookies) + cookies (cdr cookies) + chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur)) +- retval (if (< 80 (+ (length retval) (length chunk) 4)) ++ retval (if (and url-cookie-multiple-line ++ (< 80 (+ (length retval) (length chunk) 4))) + (concat retval "\r\nCookie: " chunk) + (if retval + (concat retval "; " chunk) diff --git a/contrib/timer.el b/contrib/timer.el new file mode 100644 index 0000000..70d9940 --- /dev/null +++ b/contrib/timer.el @@ -0,0 +1,308 @@ +;;; timer.el --- run a function with args at some time in future. + +;; Copyright (C) 1996 Free Software Foundation, Inc. + +;; Maintainer: FSF + +;; 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: + +;; This package gives you the capability to run Emacs Lisp commands at +;; specified times in the future, either as one-shots or periodically. + +;;; Code: + +(require 'itimer) + +(fset 'timer-create 'make-itimer) + +(fset 'timerp 'itimerp) + +;(defvar timer-idle-list nil +; "List of active idle-time timers in order of increasing time") +(defvaralias 'timer-idle-list 'itimer-list) +(defvaralias 'timer-list 'itimer-list) + + +(defun timer-set-time (timer time &optional delta) + "Set the trigger time of TIMER to TIME. +TIME must be in the internal format returned by, e.g., `current-time'. +If optional third argument DELTA is a non-zero integer, make the timer +fire repeatedly that many seconds apart." + (set-itimer-value timer (itimer-time-difference time (current-time))) + (and delta (check-nonnegative-number delta)) + (and delta (set-itimer-restart timer delta)) + timer) + +(defun timer-set-idle-time (timer secs &optional repeat) + "Set the trigger idle time of TIMER to SECS. +If optional third argument REPEAT is non-nil, make the timer +fire each time Emacs is idle for that many seconds." + (set-itimer-is-idle timer t) + (set-itimer-value timer secs) + (when repeat + (set-itimer-restart timer secs)) + timer) + +(defun timer-relative-time (time secs &optional usecs) + "Advance TIME by SECS seconds and optionally USECS microseconds. +SECS may be a fraction." + (let ((high (car time)) + (low (if (consp (cdr time)) (nth 1 time) (cdr time))) + (micro (if (numberp (car-safe (cdr-safe (cdr time)))) + (nth 2 time) + 0))) + ;; Add + (if usecs (setq micro (+ micro usecs))) + (if (floatp secs) + (setq micro (+ micro (floor (* 1000000 (- secs (floor secs))))))) + (setq low (+ low (floor secs))) + + ;; Normalize + (setq low (+ low (/ micro 1000000))) + (setq micro (mod micro 1000000)) + (setq high (+ high (/ low 65536))) + (setq low (logand low 65535)) + + (list high low (and (/= micro 0) micro)))) + +(defun timer-inc-time (timer secs &optional usecs) + "Increment the time set in TIMER by SECS seconds and USECS microseconds. +SECS may be a fraction." + (let ((time (itimer-value timer))) + (setq time (+ time secs (if (and usecs (fboundp 'lisp-float-type)) + (/ usecs (float 1000000)) + 0))) + (set-itimer-value timer time))) + +(defun timer-set-time-with-usecs (timer time usecs &optional delta) + "Set the trigger time of TIMER to TIME. +TIME must be in the internal format returned by, e.g., `current-time'. +If optional third argument DELTA is a non-zero integer, make the timer +fire repeatedly that many seconds apart." + (let ((list (list nil nil nil))) + (setcar list (car time)) + (setcar (nthcdr 1 list) (if (consp (cdr time)) + (car (cdr time)) + (cdr time))) + (setcar (nthcdr 2 list) usecs) + (set-itimer-value timer (itimer-time-difference list (current-time))) + (set-itimer-restart timer delta) + timer)) + +(defun timer-set-function (timer function &optional args) + "Make TIMER call FUNCTION with optional ARGS when triggering." + (set-itimer-function timer function) + (set-itimer-function-arguments timer args) + (set-itimer-uses-arguments timer t) + timer) + +(defun timer-activate (timer) + "Put TIMER on the list of active timers." + (activate-itimer timer)) + +(defun timer-activate-when-idle (timer) + "Arrange to activate TIMER whenever Emacs is next idle." + (set-itimer-is-idle timer t) + ;(set-itimer-uses-arguments timer nil) + ;(unless (memq timer timer-idle-list) + ;(setq timer-idle-list (cons timer timer-idle-list))) + (activate-itimer timer)) + +;; can't do this, different kind of timer +;;(defalias 'disable-timeout 'cancel-timer) + +(defun cancel-timer (timer) + "Remove TIMER from the list of active timers." + ;(setq timer-idle-list (delq timer timer-idle-list)) + (delete-itimer timer)) + +(defun cancel-function-timers (function) + "Cancel all timers scheduled by `run-at-time' which would run FUNCTION." + (interactive "aCancel timers of function: ") + (let ((p itimer-list)) + (while p + (if (eq function (itimer-function p)) + (progn + (setq p (cdr p)) + (delete-itimer (car p))) + (setq p (cdr p)))))) + +;;;###autoload +(defun run-at-time (time repeat function &rest args) + "Perform an action after a delay of SECS seconds. +Repeat the action every REPEAT seconds, if REPEAT is non-nil. +TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds +from now, or a value from `encode-time'. +REPEAT may be an integer or floating point number. +The action is to call FUNCTION with arguments ARGS. + +This function returns a timer object which you can use in `cancel-timer'." + (interactive "sRun at time: \nNRepeat interval: \naFunction: ") + + ;; Special case: nil means "now" and is useful when repeating. + (if (null time) + (setq time (current-time))) + + ;; Handle numbers as relative times in seconds. + (if (numberp time) + (setq time (timer-relative-time (current-time) time))) + + ;; Handle relative times like "2 hours and 35 minutes" + (if (stringp time) + (let ((secs (timer-duration time))) + (if secs + (setq time (timer-relative-time (current-time) secs))))) + + ;; Handle "11:23pm" and the like. Interpret it as meaning today + ;; which admittedly is rather stupid if we have passed that time + ;; already. (Though only Emacs hackers hack Emacs at that time.) + (if (stringp time) + (progn + (require 'diary-lib) + (let ((hhmm (diary-entry-time time)) + (now (decode-time))) + (if (>= hhmm 0) + (setq time + (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now) + (nth 4 now) (nth 5 now) (nth 8 now))))))) + + (or (consp time) + (error "Invalid time format")) + + (or (null repeat) + (numberp repeat) + (error "Invalid repetition interval")) + + (let ((timer (timer-create))) + (timer-set-time timer time repeat) + (timer-set-function timer function args) + (timer-activate timer) + timer)) + +;;;###autoload +(defun run-with-timer (secs repeat function &rest args) + "Perform an action after a delay of SECS seconds. +Repeat the action every REPEAT seconds, if REPEAT is non-nil. +SECS and REPEAT may be integers or floating point numbers. +The action is to call FUNCTION with arguments ARGS. + +This function returns a timer object which you can use in `cancel-timer'." + (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ") + (apply 'run-at-time secs repeat function args)) + +;;;###autoload +(defun run-with-idle-timer (secs repeat function &rest args) + "Perform an action the next time Emacs is idle for SECS seconds. +If REPEAT is non-nil, do this each time Emacs is idle for SECS seconds. +SECS may be an integer or a floating point number. +The action is to call FUNCTION with arguments ARGS. + +This function returns a timer object which you can use in `cancel-timer'." + (interactive + (list (read-from-minibuffer "Run after idle (seconds): " nil nil t) + (y-or-n-p "Repeat each time Emacs is idle? ") + (intern (completing-read "Function: " obarray 'fboundp t)))) + (let ((timer (timer-create))) + (timer-set-function timer function args) + (timer-set-idle-time timer secs repeat) + (timer-activate-when-idle timer) + timer)) + +(defun with-timeout-handler (tag) + (throw tag 'timeout)) + +;;;###autoload (put 'with-timeout 'lisp-indent-function 1) + +;;;###autoload +(defmacro with-timeout (list &rest body) + "Run BODY, but if it doesn't finish in SECONDS seconds, give up. +If we give up, we run the TIMEOUT-FORMS and return the value of the last one. +The call should look like: + (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...) +The timeout is checked whenever Emacs waits for some kind of external +event \(such as keyboard input, input from subprocesses, or a certain time); +if the program loops without waiting in any way, the timeout will not +be detected." + (let ((seconds (car list)) + (timeout-forms (cdr list))) + `(let ((with-timeout-tag (cons nil nil)) + with-timeout-value with-timeout-timer) + (if (catch with-timeout-tag + (progn + (setq with-timeout-timer + (run-with-timer ,seconds nil + 'with-timeout-handler + with-timeout-tag)) + (setq with-timeout-value (progn . ,body)) + nil)) + (progn . ,timeout-forms) + (cancel-timer with-timeout-timer) + with-timeout-value)))) + +(defun y-or-n-p-with-timeout (prompt seconds default-value) + "Like (y-or-n-p PROMPT), with a timeout. +If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." + (with-timeout (seconds default-value) + (y-or-n-p prompt))) + +(defvar timer-duration-words + (list (cons "microsec" 0.000001) + (cons "microsecond" 0.000001) + (cons "millisec" 0.001) + (cons "millisecond" 0.001) + (cons "sec" 1) + (cons "second" 1) + (cons "min" 60) + (cons "minute" 60) + (cons "hour" (* 60 60)) + (cons "day" (* 24 60 60)) + (cons "week" (* 7 24 60 60)) + (cons "fortnight" (* 14 24 60 60)) + (cons "month" (* 30 24 60 60)) ; Approximation + (cons "year" (* 365.25 24 60 60)) ; Approximation + ) + "Alist mapping temporal words to durations in seconds") + +(defun timer-duration (string) + "Return number of seconds specified by STRING, or nil if parsing fails." + (let ((secs 0) + (start 0) + (case-fold-search t)) + (while (string-match + "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*" + string start) + (let ((count (if (match-beginning 1) + (string-to-number (match-string 1 string)) + 1)) + (itemsize (cdr (assoc (match-string 2 string) + timer-duration-words)))) + (if itemsize + (setq start (match-end 0) + secs (+ secs (* count itemsize))) + (setq secs nil + start (length string))))) + (if (= start (length string)) + secs + (if (string-match "\\`[0-9.]+\\'" string) + (string-to-number string))))) + +(provide 'timer) + +;;; timer.el ends here diff --git a/contrib/vcard.el b/contrib/vcard.el new file mode 100644 index 0000000..000da5e --- /dev/null +++ b/contrib/vcard.el @@ -0,0 +1,308 @@ +;;; vcard.el --- vcard parsing and display routines + +;; Copyright (C) 1997 Noah S. Friedman + +;; Author: Noah Friedman +;; Maintainer: friedman@splode.com +;; Keywords: extensions +;; Created: 1997-09-27 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; The display routines here are just an example. The primitives in the +;; first section can be used to construct other vcard formatters. + +;;; Code: + +(defvar vcard-standard-filters '(vcard-filter-html) + "*Standard list of filters to apply to parsed vcard data. +These filters are applied sequentially to vcard data records when +the function `vcard-standard-filter' is supplied as the second argument to +`vcard-parse-string'.") + +(defun vcard-parse-string (raw &optional filter) + "Parse RAW vcard data as a string, and return an alist representing data. + +If the optional function FILTER is specified, apply that filter to the +data record of each key before splitting fields. Filters should accept +two arguments: the key and the data. They are expected to operate on +\(and return\) a modified data value. + +Vcard data is normally in the form + + begin: vcard + key1: field + key2;subkey1: field + key2;subkey2: field1;field2;field3 + end: vcard + +\(Whitespace after the colon separating the key and field is optional.\) +If supplied to this function an alist of the form + + ((\"key1\" \"field\") + (\"key2\" + (\"subkey2\" \"field1\" \"field2\" \"field3\") + (\"subkey1\" \"field\"))) + +would be returned." + (save-match-data + (let ((raw-pos 0) + (vcard-data nil) + key data) + (string-match "^[ \t]*begin:[ \t]*vcard[ \t]*[\r\n]+" raw raw-pos) + (setq raw-pos (match-end 0)) + (while (and (< raw-pos (length raw)) + (string-match + "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*[\n\r]+" + raw raw-pos)) + (setq key (vcard-matching-substring 1 raw)) + (setq data (vcard-matching-substring 2 raw)) + (setq raw-pos (match-end 0)) + (cond + ((string= key "end") + (setq raw-pos (length raw))) + (t + (and filter + (setq data (funcall filter key data))) + (setq vcard-data + (vcard-set-alist-slot vcard-data + (vcard-split-string key ";") + (vcard-split-string data ";")))))) + (nreverse vcard-data)))) + +(defun vcard-ref (key vcard-data) + "Return the vcard data associated with KEY in VCARD-DATA. +Key may be a list of nested keys or a single string of colon-separated +keys." + (cond ((listp key) + (vcard-alist-assoc key vcard-data)) + ((and (stringp key) + (save-match-data + (string-match ";" key))) + (vcard-alist-assoc (vcard-split-string key ";") vcard-data)) + ((stringp key) + (cdr (assoc key vcard-data))))) + + +;;; Vcard data filters. + +;; These receive both the key and data, but are expected to operate on (and +;; return) just the data. +;; +;; There is probably no overwhelming need for this, except that some lusers +;; put HTML in their vcards under the misguided notion that it's a standard +;; feature of vcards just because Netscape supports this feature. (Or +;; perhaps those lusers just don't care that their vcards look like shit in +;; every other MUA). +;; +;; On the other hand, perhaps someone will devise some other use for these +;; filters, such as noticing common phone number formats and re-formatting +;; them to fit personal preferences. + +(defun vcard-filter-apply-filter-list (filter-list key data) + (while filter-list + (setq data (funcall (car filter-list) key data)) + (setq filter-list (cdr filter-list))) + data) + +(defun vcard-standard-filter (key data) + (vcard-filter-apply-filter-list vcard-standard-filters key data)) + +(defun vcard-filter-html (key data) + (save-match-data + (while (string-match "<[^<>\n]+>" data) + (setq data (concat (substring data 0 (match-beginning 0)) + (substring data (match-end 0))))) + data)) + + +;;; Utility routines. + +;; This does most of the dirty work of key lookup for vcard-ref. +(defun vcard-alist-assoc (keys alist) + (while (and keys alist) + (setq alist (cdr (assoc (car keys) alist))) + (setq keys (cdr keys))) + alist) + +;; In ALIST, set KEY-LIST's value to VALUE, and return new value of ALIST. +;; KEY-LIST should be a list of nested keys, if ALIST is an alist of alists. +;; If any key is not present in an alist, the key and value pair will be +;; inserted into the parent alist. +(defun vcard-set-alist-slot (alist key-list value) + (let* ((key (car key-list)) + (elt (assoc key alist))) + (setq key-list (cdr key-list)) + (cond ((and (cdr elt) key-list) + (vcard-set-alist-slot (cdr elt) key-list value)) + ((and elt key-list) + (setcdr elt (vcard-set-alist-slot nil key-list value))) + (elt (setcdr elt value)) + (t + (let ((new)) + (setq key-list (nreverse (cons key key-list))) + (while key-list + (if new + (setq new (cons (car key-list) (cons new nil))) + (setq new (cons (car key-list) value))) + (setq key-list (cdr key-list))) + + (cond ((null alist) + (setq alist (cons new nil))) + (t + (setcdr alist (cons (car alist) (cdr alist))) + (setcar alist new)))))) + alist)) + +;; Return substring matched by last search. +;; N specifies which match data pair to use +;; Value is nil if there is no Nth match. +;; If STRING is not specified, the current buffer is used. +(defun vcard-matching-substring (n &optional string) + (if (match-beginning n) + (if string + (substring string (match-beginning n) (match-end n)) + (buffer-substring (match-beginning n) (match-end n))))) + +;; Split STRING at occurences of SEPARATOR. Return a list of substrings. +;; SEPARATOR can be any regexp, but anything matching the separator will +;; never appear in any of the returned substrings. +(defun vcard-split-string (string separator) + (let* ((list nil) + (pos 0)) + (save-match-data + (while (string-match separator string pos) + (setq list (cons (substring string pos (match-beginning 0)) list)) + (setq pos (match-end 0))) + (nreverse (cons (substring string pos) list))))) + +(defun vcard-flatten (l) + (if (consp l) + (apply 'nconc (mapcar 'vcard-flatten l)) + (list l))) + + +;;; Sample formatting routines. + +(defun vcard-format-box (vcard-data) + "Like `vcard-format-string', but put an ascii box around text." + (let* ((lines (vcard-format-lines vcard-data)) + (len (vcard-format-max-length lines)) + (edge (concat "\n+" (make-string (+ len 2) ?-) "+\n")) + (line-fmt (format "| %%-%ds |" len)) + (formatted-lines + (mapconcat (function (lambda (s) (format line-fmt s))) lines "\n"))) + (if (string= formatted-lines "") + formatted-lines + (concat edge formatted-lines edge)))) + +(defun vcard-format-string (vcard-data) + "Format VCARD-DATA into a string suitable for presentation. +VCARD-DATA should be a parsed vcard alist. The result is a string +with formatted vcard information which can be inserted into a mime +presentation buffer." + (mapconcat 'identity (vcard-format-lines vcard-data) "\n")) + +(defun vcard-format-lines (vcard-data) + (let* ((name (vcard-format-get-name vcard-data)) + (title (vcard-format-ref "title" vcard-data)) + (org (vcard-format-ref "org" vcard-data)) + (addr (vcard-format-get-address vcard-data)) + (tel (vcard-format-get-telephone vcard-data)) + (lines (delete nil (vcard-flatten (list name title org addr)))) + (col-template (format "%%-%ds%%s" + (vcard-format-offset lines tel))) + (l lines)) + (while tel + (setcar l (format col-template (car l) (car tel))) + ;; If we stripped away too many nil slots from l, add empty strings + ;; back in so setcar above will work on next iteration. + (and (cdr tel) + (null (cdr l)) + (setcdr l (cons "" nil))) + (setq l (cdr l)) + (setq tel (cdr tel))) + lines)) + + +(defun vcard-format-get-name (vcard-data) + (let ((name (vcard-format-ref "fn" vcard-data)) + (email (or (vcard-format-ref '("email" "internet") vcard-data) + (vcard-format-ref "email" vcard-data)))) + (if email + (format "%s <%s>" name email) + name))) + +(defun vcard-format-get-address (vcard-data) + (let* ((addr-raw (or (vcard-format-ref '("adr" "dom") vcard-data) + (vcard-format-ref "adr" vcard-data))) + (addr (if (consp addr-raw) + addr-raw + (list addr-raw))) + (street (delete "" (list (nth 0 addr) (nth 1 addr) (nth 2 addr)))) + (city-list (delete "" (nthcdr 3 addr))) + (city (cond ((null (car city-list)) nil) + ((cdr city-list) + (format "%s, %s" + (car city-list) + (mapconcat 'identity (cdr city-list) " "))) + (t (car city-list))))) + (delete nil + (if city + (append street (list city)) + street)))) + +(defun vcard-format-get-telephone (vcard-data) + (delete nil + (mapcar (function (lambda (x) + (let ((result (vcard-format-ref (car x) + vcard-data))) + (and result + (concat (cdr x) result))))) + '((("tel" "work") . "Work: ") + (("tel" "home") . "Home: ") + (("tel" "fax") . "Fax: "))))) + +(defun vcard-format-ref (key vcard-data) + (setq key (vcard-ref key vcard-data)) + (or (cdr key) + (setq key (car key))) + (and (stringp key) + (string= key "") + (setq key nil)) + key) + +(defun vcard-format-offset (row1 row2 &optional maxwidth) + (or maxwidth (setq maxwidth (frame-width))) + (let ((max1 (vcard-format-max-length row1)) + (max2 (vcard-format-max-length row2))) + (+ max1 (min 5 (max 1 (- maxwidth (+ max1 max2))))))) + +(defun vcard-format-max-length (strings) + (let ((maxlen 0) + (len 0)) + (while strings + (setq len (length (car strings))) + (setq strings (cdr strings)) + (and (> len maxlen) + (setq maxlen len))) + maxlen)) + +(provide 'vcard) + +;;; vcard.el ends here. diff --git a/etc/smilies/frown.pbm b/etc/smilies/frown.pbm new file mode 100644 index 0000000000000000000000000000000000000000..f51ea4f3094792da8a26946cf4bb8d9ccdda13dd GIT binary patch literal 37 scmWGA;W9K +2000-12-20 21:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.99 is released. + * message.el (message-mail-user-agent): Add :version. -1999-12-01 14:28:49 Lars Magne Ingebrigtsen +2000-12-21 Miles Bader - * dgnushack.el (dgnushack-compile): No webmail under Emacs. + * message.el (message-mode): Set `comment-start' to the yank prefix. - * gnus-sum.el (gnus-summary-refer-article): Wrong interactive - spec. +2000-12-20 17:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'. - (gnus-configure-posting-styles): No, don't. - (gnus-configure-posting-styles): Allow overriding files. + * message.el (message-mail-user-agent): New variable. + (message-setup): Renamed to message-setup-1. Support + mail-user-agent. + (message-mail-user-agent): New function. + (message-mail): Use it. + (message-reply): Use it. + (message-resend): Use it. + (message-mail-other-window): Use it. + (message-mail-other-frame): Use it. - * gnus-art.el (gnus-header-button-alist): Use browse-url - directly. + * gnus-msg.el (gnus-bug): Support mail-user-agent. - * mm-decode.el (mm-inline-media-tests): Check feature vcard. +2000-12-20 15:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-summary-yank-message): New command and - keystroke. - - * message.el (message-yank-buffer): New command. - (message-buffers): New function. - - * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Select - next group in a more normal fasion. - - * mml.el (mml-boundary-function): New variable. - (mml-compute-boundary): Use it. - - * nnmh.el (nnmh-active-number): Skip past files that have buffers - that exist for them. - - * gnus-async.el (gnus-async-prefetch-next): Cancel timers. - (gnus-async-timer): New variable. - -1999-11-30 02:07:18 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-request-list): Be more lenient with - root addresses. - -1999-11-28 20:22:37 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): Do - gnus-treat-capitalize-sentences. - -1999-11-30 09:07:53 Shenghuo ZHU - - * webmail.el (webmail-hotmail-article): Hotmail changes the - format. - -1999-11-29 Simon Josefsson - - * mm-decode.el (mm-display-external): For `copiousoutput' methods, - switch to buffer after calling program. - (mm-display-external): Use `shell-command-switch' instead of "-c". - -1999-11-27 15:21:25 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-possibly-change-server): Don't always - read groups file. - - * nnslashdot.el (nnslashdot-request-article): Convert

to -

. - -1999-11-24 20:18:24 Lars Magne Ingebrigtsen - - * message.el (message-mode): Doc fix. - -1999-11-24 09:25:00 Shenghuo ZHU - - * gnus-art.el (article-emphasize): Check group variable. - * rfc1843.el (rfc1843-decode-article-body): Ditto. - -1999-11-24 00:11:27 Shenghuo ZHU - - * mm-decode.el (mm-save-part-to-file): Inhibit jka-compr for any - type. - -1999-11-23 17:21:05 Shenghuo ZHU - - * webmail.el: Support www.netaddress.com, i.e. usa.net. - -1999-11-23 Hrvoje Niksic - - * mml.el (mml-quote-region): Insert ! after the hash. - -1999-11-23 05:08:23 Shenghuo ZHU - - * gnus-group.el (gnus-group-warchive-address-history): Change to - nil. - -1999-11-23 02:33:13 Shenghuo ZHU - - * webmail.el: Support mail.yahoo.com. - - * mail-source.el (mail-source-fetch-webmail): Add password check. - (mail-source-keyword-map): Use `subtype'. - -1999-11-22 04:35:43 Shenghuo ZHU - - * mail-source.el (mail-source-keyword-map): Add webmail. - (mail-source-fetcher-alist): Ditto. - (mail-source-fetch-webmail): New function. - * webmail.el: New file. - -1999-11-21 12:20:02 Shenghuo ZHU - - * nnwarchive.el (nnwarchive-request-group): Print 0 if it is nil. + * message.el (message-tool-bar-map): Simplify. + (message-narrow-to-head-1): New function. + (message-narrow-to-head): Use it. + (message-reply): Ditto. + (message-cancel-news): Ditto. + (message-supersede): Ditto. + (message-make-forward-subject): Ditto. + (message-bounce): Ditto. -1999-11-21 12:19:11 Shenghuo ZHU +2000-12-20 11:00:00 ShengHuo ZHU - * mailcap.el (mailcap-parse-mailcap): Don't skip double semicolon. + * uudecode.el (uudecode-decode-region-external): make-temp-file + may not be defined. -1999-11-20 12:54:25 Lars Magne Ingebrigtsen + * binhex.el (defalias): eval-and-compile. - * nnultimate.el (nnultimate-request-list): Add fetch-time slot. - (nnultimate-prune-days): New function. - (nnultimate-create-mapping): Use it. - (nnultimate-request-group): Only fetch the groups list if it has - not been done before. - (nnultimate-retrieve-headers): Don't write groups. - (nnultimate-create-mapping): Off-by-one error. + * message.el (message-tool-bar-map): New function. + (message-mode): Use it. -1999-11-19 12:17:25 Lars Magne Ingebrigtsen +2000-12-20 09:00:00 ShengHuo ZHU - * nnslashdot.el (nnslashdot-sane-retrieve-headers): Fix to match - threaded subjects. + * nntp.el (nntp-find-connection): Remove the entry. + (nntp-retrieve-groups): (gnus-buffer-live-p buf). -1999-11-20 02:22:52 Shenghuo ZHU +2000-12-20 05:00:00 ShengHuo ZHU - * nnwarchive.el: Lots of changes make agent happy. + * gnus-msg.el (gnus-summary-mail-forward): Use original buffer. -1999-11-19 21:37:41 Shenghuo ZHU + * message.el (message-forward): Copy buffer in unibyte mode. - * gnus-start.el (gnus-get-unread-articles): Assert group is in - hashtb. +2000-12-20 04:00:00 ShengHuo ZHU -1999-11-19 19:53:08 Shenghuo ZHU + * message.el (message-make-forward-subject): Don't widen. Decode. + (message-forward): Don't decode subject. - * mm-decode.el (mm-display-external): Write region with binary - mode. +2000-12-20 Christoph Conrad -1999-11-18 14:52:05 Shenghuo ZHU + * qp.el (quoted-printable-encode-region): Upcase QP. - * nnweb.el (nnweb-dejanews-create-mapping): Bind `text'. +2000-12-20 03:00:00 ShengHuo ZHU -1999-11-18 14:35:01 Shenghuo ZHU + * mm-decode.el (mm-possibly-verify-or-decrypt): Use + mail-extract-a-c instead. Don't depend on Gnus. - * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'. - (mm-uu-test): Now it is in restricted region. - - * gnus-art.el (article-decode-charset): Don't mm-uu-test. - - * mm-view.el (mm-view-message): Fix buffer leak. - (mm-inline-message): Support 'gnus-decoded. - - * mm-bodies.el (mm-decode-body): Ditto. + * mml.el (gnus-ems): Require it. - * rfc2047.el (rfc2047-decode-region): Ditto. + * gnus-msg.el (gnus-summary-mail-forward): -1999-11-18 Matthias Andree + * message.el (message-forward): Move mime-to-mml here. - * imap.el (require): Added autoload for base64-encode-string. +2000-12-20 02:00:00 ShengHuo ZHU -1999-11-17 Per Abrahamsen - - * gnus.el (gnus-refer-article-method): Made list value - customizable. - -1999-11-17 13:09:37 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-recenter): set-window-start with - NOFORCE in Emacs case. - -1999-11-17 13:04:01 Shenghuo ZHU - - * gnus-art.el (gnus-request-article-this-buffer): Set - gnus-newsgroup-name. - -1999-11-16 23:53:22 Shenghuo ZHU + * gnus-group.el, gnus-sum.el, message.el: Add :help unless Emacs. + * gnus-art.el (gnus-insert-mime-button): Simplify. + (gnus-mime-display-alternative): Ditto. + (gnus-insert-mime-security-button): Ditto. - * gnus-xmas.el (gnus-xmas-summary-recenter): set-window-start with - NOFORCE. +2000-12-20 01:00:00 ShengHuo ZHU -1999-11-17 Simon Josefsson + * gnus-util.el (gnus-add-text-properties-when): In XEmacs, + text-property-not-all doesn't return nil when start=mark(end). + (gnus-remove-text-properties-when): Ditto. - * gnus-start.el (gnus-get-unread-articles): Check server before - scanning. +2000-12-20 00:00:00 ShengHuo ZHU -1999-11-16 10:01:03 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-group-change-level): Remove group from + gnus-active-hashtb if real killed. - * gnus.el (gnus-valid-select-methods): nnslashdot is news. +2000-12-19 22:00:00 ShengHuo ZHU - * nnslashdot.el (nnslashdot-login-name): New variable. - (nnslashdot-password): Ditto. - (nnslashdot-request-post): New function. + * gnus-art.el (gnus-insert-mime-button): Emacs20 needs local-map. + (gnus-mime-display-alternative): Ditto. + (gnus-insert-mime-security-button): Ditto. - * gnus-art.el (gnus-treat-buttonize): More testing. +2000-12-19 21:00:00 ShengHuo ZHU - * mm-encode.el: Another CVS test. + * gnus-start.el (gnus-group-change-level): Don't add it into + killed-list if it was killed. - * gnus-art.el (gnus-treat-emphasize): Change default. - (gnus-treat-buttonize): Ditto. - (gnus-treat-buttonize): This is a test. +2000-12-19 19:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-build-old-threads): Bind mail-parse-charset. - (gnus-build-sparse-threads): Ditto. - (gnus-build-all-threads): Ditto. + * nnmbox.el (nnmbox-file-coding-system): Use binary. + (nnmbox-active-file-coding-system): Ditto. - * nnheader.el (make-full-mail-header): Make into a subst. + * gnus-cus.el (gnus-group-parameters): Add posting-style. - * dgnushack.el (dgnushack-compile): Skip all w3-dependent files - unless w3 is supplied. +2000-12-19 18:00:00 ShengHuo ZHU - * gnus.el (gnus-refer-article-method): Doc fix. + * gnus.el (gnus-version): + (gnus-version-number): Set to Oort Gnus 0.01. - * gnus-sum.el: Do not accept a prefix. - (gnus-summary-refer-article): Accept a list of select methods. + * gnus-art.el (gnus-mime-security-button-map): + (gnus-insert-mime-security-button): Fix for Emacs21. -1999-11-15 21:28:40 Shenghuo ZHU +2000-12-19 17:00:00 ShengHuo ZHU - * Makefile.in: Change `^ *' to `\t'. + * gnus-group.el, gnus-sum.el, message.el: Comment out :help in + easymenu, because XEmacs doesn't understand :help. -1999-11-11 Matt Pharr + * mm-uu.el: Require binhex. - * message.el (message-forward): Pay attention to prefix argument - again and forward all headers when it is set, regardless of the - value of message-forward-ignored-headers. +2000-12-19 16:00:00 ShengHuo ZHU -1999-11-15 20:44:50 William M. Perry + * gnus.el: Merged. Emacs21 CVS tag is zsh-merge-ognus-1. - * dgnushack.el (dgnushack-compile): Vpath file. +2000-12-19 ShengHuo ZHU - * Makefile.in (SHELL): VPATH support. + * mm-util.el (mm-charset-synonym-alist): Fix a typo. -1999-11-15 20:37:17 Lars Magne Ingebrigtsen +2000-12-18 Gerd Moellmann - * gnus-ems.el: Check for cygwin32. + * *.xpm, *.pbm: Convert icons icons to size 24x24. -1999-11-14 18:15:28 Shenghuo ZHU +2000-12-18 Dave Love - * mm-decode.el (mm-display-external): Use 'non-viewer. + * gnus-msg.el (news-setup, news-reply-mode): Don't autoload + (unused). -1999-11-14 15:21:06 Shenghuo ZHU +2000-12-13 Miles Bader - * base64.el (base64-encode-string): An alias for base64-encode for - compatibility. + * smiley-ems.el (smiley-region): Bind `inhibit-point-motion-hooks' + to t, so that we don't get stuck while trying to smilefy + intangible text. -1999-11-14 01:58:18 Shenghuo ZHU +2000-12-12 Gerd Moellmann - * nntp.el (nntp-retrieve-groups): Erase nntp-sever-buffer before - nntp-inhibit-erase. + * smiley-ems.el (smiley-regexp-alist): Make regexps match + at the end of the buffer. + (smiley-region): In the loop, move to the end of the submatch + matching the smiley instead of using the end of the match + of the whole regexp. -1999-11-13 Simon Josefsson +2000-12-12 Eli Zaretskii - * gnus-start.el (gnus-get-unread-articles): Use - nnfoo-retrieve-groups to find new news, if available. - (gnus-read-active-file-2): New function. - (gnus-get-unread-articles): Use it. - (gnus-read-active-file-1): Ditto. + * message.el (message-mode): Doc fix. -1999-11-13 17:59:18 Lars Magne Ingebrigtsen +2000-12-12 Gerd Moellmann - * mm-util.el (mm-find-mime-charset-region): Make sure - find-coding-systems-for-charsets is fbound. + * smiley-ems.el (smiley-region): Doc fix. + +2000-12-11 Miles Bader - * gnus-ems.el: Typo fix. + * gnus-sum.el (gnus-summary-recenter): When trying to keep the + bottom line visible, check to see if it's partially obscured, and + if so, either scroll one more line to make it fully visible, or + revert to showing the second line from the top. -1999-11-13 Florian Weimer +2000-12-07 Dave Love - * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if - it's available and makes sense. + * mailcap.el (mailcap-download-directory) + * gnus-audio.el (gnus-audio-directory) + * smiley-ems.el (smiley-data-directory): Fix :type. -1999-11-12 19:56:23 Fabrice POPINEAU +2000-11-30 Dave Love - * gnus-score.el (gnus-score-save): Translate score file. + * message.el (message-auto-save-directory): Use + file-name-as-directory. + (message-set-auto-save-file-name): Create + message-auto-save-directory if necessary. + (message-replace-chars-in-string): Removed -- unused. + (message-mail-alias-type): Customize. + (message-headers): Remove duplicate defgroup. -1999-11-13 Simon Josefsson +2000-11-29 Dave Love - * mail-source.el (mail-source-keyword-map): For IMAP mail source, - added fetchflag and dontexpunge keywords. - (mail-source-fetch-imap): Use them. + * qp.el (quoted-printable-decode-region): Use error, not message + to report malformed text (like base64). Amend message. -1999-11-12 Per Abrahamsen +2000-11-29 Miles Bader - * gnus-start.el (gnus-level-subscribed, gnus-level-unsubscribed, - gnus-level-zombie, gnus-level-killed): Changed from `defcustom' to - `defconst'. + * message.el (message-header-lines): Fontify tag. - * gnus-cus.el (gnus-group-parameters): Changed from `defcustom' to - `defconst'. - Mention that it is both for group and topic parameters. - (gnus-extra-topic-parameters): New constant, including `subscribe' - parameter. - (gnus-extra-group-parameters): New constant. - (gnus-group-customize): Use them. +2000-11-27 Dave Love - * gnus.el (gnus-select-method): Added default value and tag. - (gnus-refer-article-method): Added `DejaNews' customization option. + * nnlistserv.el: Ignore errors when requiring nnweb and avoid a + compiler warning. -1999-11-12 05:04:43 Lars Magne Ingebrigtsen +;2000-11-26 Dave Love +; +; * mm-uu.el (mm-uu-configure-list): Fix typo in :type. +; +2000-11-23 Dave Love - * gnus-int.el (gnus-server-opened): Ignore denied servers. + * uu-post.pbm, uu-decode.pbm: new files from XPMs. - * gnus-ems.el (gnus-mule-max-width-function): New backquote - syntax. + * mm-uu.el (uudecode): Require. + (uudecode-decode-region, uudecode-decode-region-external): Don't + autoload. + (mm-uu-copy-to-buffer): Doc fix. + (mm-uu-decode-function, mm-uu-binhex-decode-function): Doc, custom + type fix. + + * mailcap.el: Doc fixes. + (mailcap-mime-data): Various adjustments. + (mailcap): New group. + (mailcap-download-directory): Customize. + (mailcap-generate-unique-filename, mailcap-binary-suffixes) + (mailcap-temporary-directory): Deleted (unused). + (mailcap-unescape-mime-test): Simplify slightly. + (mailcap-viewer-passes-test): Use functionp. + (mailcap-command-p): Aliased to executable-find. - * nndoc.el (nndoc-mime-digest-type-p): Reinstated. + * rfc2047.el (rfc2047-encode-message-header): Don't encode if + default-enable-multibyte-characters is nil. - * nnslashdot.el (nnslashdot-group-number): Changed default. +2000-11-22 Gerd Moellmann - * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja. - (nnweb-dejanews-wash-article): Removed. - (nnweb-type-definition): Fetch by id. + * gnus-group.el (gnus-group-make-tool-bar): Fix a paren typo. - * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless - we mean it. +2000-11-21 Dave Love - * nnslashdot.el (nnslashdot-group-number): Doc fix. - (nnslashdot-request-list): Use Ultramode as well. - (nnslashdot-date-to-date): Be more lenient. - (nnslashdot-threaded): New function. + * gnus-art.el (gnus-mime-button-map): Don't inherit from + gnus-article-mode-map. +; (gnus-mime-button-menu): Use mouse-set-point. + (gnus-insert-mime-button, gnus-mime-display-alternative) + (gnus-mime-display-alternative): Don't use local-map property. -1999-11-11 17:40:54 Lars Magne Ingebrigtsen +2000-11-17 Dave Love - * gnus-art.el (gnus-mime-internalize-part): Doc fix. + * uudecode.el (uudecode-insert-char): Fix bogus feature test. + (uudecode-decode-region-external): Doc fix. Use with-temp-buffer + and make-temp-file. + (uudecode-decode-region): Doc fix. -1999-11-11 14:32:48 Steinar Bang +2000-11-14 Dave Love - * nnweb.el (nnweb-type-definition): /=dnc + * cu-exit.pbm, exit-summ.pbm, followup.pbm, fuwo.pbm: + * mail-reply.pbm, next-ur.pbm, post.pbm, prev-ur.pbm: + * reply-wo.pbm, reply.pbm, rot13.pbm, save-aif.pbm, save-art.pbm: + New files, derived from the XPMs. -1999-11-11 10:58:38 Lars Magne Ingebrigtsen +2000-11-10 Dave Love - * nnultimate.el (nnultimate-retrieve-headers): Work with american - dates. - (nnultimate-retrieve-headers): Wrong ordering. + * gnus-agent.el (gnus-agent-confirmation-function): Add :version. + (gnus-agent-lib-file, gnus-agent-load-alist) + (gnus-agent-save-alist, gnus-agent-article-name): Use + expand-file-name. -1999-11-11 07:31:51 Matt Pharr + * gnus-group.el (gnus-group-name-charset-method-alist): Add + :version. + (nnkiboze-score-file): Defvar when compiling. - * message.el (message-forward-as-mime): New variable. + * gnus-start.el (gnus-read-newsrc-file): Add :version. -1999-11-11 05:24:13 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-banner-alist) + (gnus-emphasize-whitespace-regexp, gnus-ignored-mime-types) + (gnus-article-date-lapsed-new-header) + (gnus-article-mime-match-handle-function, gnus-mime-action-alist) + (gnus-treat-strip-list-identifiers, gnus-treat-date-iso8601) + (gnus-treat-strip-headers-in-body) + (gnus-treat-capitalize-sentences, gnus-treat-play-sounds) + (gnus-treat-translate): Add :version. + (gnus-article-mime-part-function): Fix defcustom. - * gnus-util.el (gnus-dd-mmm): Beware buggy dates. + * nnmail.el (nnmail-expiry-target) + (nnmail-scan-directory-mail-source-once, nnmail-extra-headers) + (nnmail-split-header-length-limit): Add :version. -1999-11-10 16:50:01 Shenghuo ZHU + * gnus-sum.el (gnus-auto-expirable-marks) + (gnus-inhibit-user-auto-expire, gnus-list-identifiers) + (gnus-extra-headers, gnus-ignored-from-addresses) + (gnus-newsgroup-ignored-charsets) + (gnus-group-highlight-words-alist) + (gnus-summary-show-article-charset-alist): Add :version. - * mail-source.el (mail-source-movemail-and-remove): New function. - (mail-source-keyword-map): Add `function' for `maildir'. - (mail-source-fetch-maildir): Use it. + * catchup.pbm, describe-group.pbm, exit-gnus.pbm, get-news.pbm: + gnntg.pbm, kill-group.pbm, subscribe.pbm, unsubscribe.pbm: New + files, converted from the XPMs. -1999-11-10 13:48:10 Shenghuo ZHU + * gnus-cache.el (gnus-cache-active-file): Don't use + file-name-as-directory on directory. + (gnus-cache-file-name): Use expand-file-name, not concat. Don't + use file-name-as-directory on directory. - * nnwarchive.el: New file. - * gnus-group.el (gnus-group-make-warchive-group): New function. - * gnus.el (gnus-valid-select-methods): Add `nnwarchive'. + * time-date.el (timezone-make-date-arpa-standard): Autoload. + (date-to-time): Use it. -1999-11-10 12:13:30 Lars Magne Ingebrigtsen +; * message.el (message-mode) : +; : Use [:alnum:] in regexp range. +; (message-newline-and-reformat): Likewise. + (message-forward-as-mime, message-forward-ignored-headers) + (message-buffer-naming-style, message-default-charset) + (message-dont-reply-to-names, message-send-mail-partially-limit): + Add :version. - * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page - subjects. + * mm-util.el: Doc fixes. + (mm-mime-charset): Don't use the raw result of + mm-preferred-coding-system. + (mm-with-unibyte-buffer, mm-with-unibyte-current-buffer) + (mm-with-unibyte): Simplify. -1999-11-10 11:33:23 Rajappa Iyer + * gnus-int.el (gnus-start-news-server): Use expand-file-name, not + concat. - * gnus-salt.el (gnus-pick-article-or-thread): Don't move point. + * pop3.el (pop3-version): Deleted. + (pop3-make-date): New function, avoiding message-make-date. + (pop3-munge-message-separator): Use it. -1999-11-10 05:22:56 Lars Magne Ingebrigtsen +2000-11-09 Dave Love - * nnultimate.el (nnultimate-open-server): Do address. - (nnultimate-forum-table-p): New function. + * gnus-group.el (gnus-group-make-directory-group) + (gnus-group-fetch-faq): Use expand-file-name. + (gnus-group-fetch-faq): Simplify completing-read form. - * nnweb.el (nnweb-insert-html): Renamed. - (nnweb-insert): New function. + * mm-bodies.el (mm-encode-body): Use mm-multibyte-p, don't just + test for Mule. - * nnultimate.el (nnultimate-insert-html): New function. + * message.el (tool-bar-map): Defvar when compiling. - * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything - if nov is evil. - (nnslashdot-retrieve-headers): use the sane version instead. + * gnus-setup.el (running-xemacs, gnus-use-installed-tm) + (gnus-tm-lisp-directory): Deleted. + (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use + (featurep 'xemacs). + (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory) + (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove + version numbers from file names. -1999-11-09 00:13:25 Lars Magne Ingebrigtsen +2000-11-08 Dave Love - * nnslashdot.el (nnslashdot-request-article): Fold case. + * mm-view.el: Use featurep for XEmacs test. + (mm-inline-message): Test for `remove-specifier'; don't use + condition-case. - * nnultimate.el: New file. + * mm-bodies.el (mm-encode-body): Use mm-multibyte-p. - * nnslashdot.el (nnslashdot-retrieve-headers): Skip the article - unless wanted. + * gnus-score.el (gnus-score-load-file): Use expand-file-name. + (gnus-score-find-bnews): Don't concat "". - * gnus-start.el (gnus-active-to-gnus-format): Catch errors. - (gnus-read-active-file-1): Separated into own function. - (gnus-read-active-file): Catch quits. + * cu-exit.xpm, prev-ur.xpm, next-ur.xpm, post.xpm, fuwo.xpm: + * followup.xpm, uu-post.xpm, uu-decode.xpm, mail-reply.xpm: + * reply.xpm, reply-wo.xpm, rot13.xpm, save-aif.xpm, save-art.xpm: + * exit-summ.xpm: New files, renamed from icons by Luis Fernandes. - * nnslashdot.el (nnslashdot-request-article): Search better on - first article. - (nnslashdot-request-list): Fold case. - (nnslashdot-retrieve-headers): Ditto. + * gnus-sum.el: Put some defvars in eval-when-compile. + (gnus-summary-mode-hook): Add :options. + (gnus-summary-make-menu-bar): Add some :help, used by tool bar. + (gnus-summary-tool-bar-map): New variable. + (gnus-summary-make-tool-bar): New function. + (gnus-summary-mode): Put kill-all-local-variables first. -1999-11-08 05:33:15 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-toolbar-map): New variable. + (gnus-group-make-tool-bar): Rewritten. + (gnus-group-mode): Put kill-all-local-variables first. - * gnus.el: Autoload gnus-subscribe-topics. + * rfc2047.el: Require gnus-util. -1999-11-07 22:56:46 Shenghuo ZHU + * nnml.el (gnus-sorted-intersection): Autoload. - * gnus-agent.el (gnus-agent-save-group-info): Remove backslash - before dot. - * gnus-util.el (gnus-write-active-file): Ditto. + * nnheader.el: Wrap subst-char-in-string def in eval-and-compile. + Put some defvars in eval-when-compile. + (gnus-intersection, gnus-sorted-complement): Autoload. -1999-11-07 22:31:10 Shenghuo ZHU + * imap.el (imap-point-at-eol): New, replacing gnus-point-at-eol. - * nnheader.el (nnheader-replace-duplicate-chars-in-string): New - function. - * gnus-cache.el (gnus-cache-file-name): Use it. - * gnus-agent.el (gnus-agent-group-path): Use it. - * nnmail.el (nnmail-group-pathname): Use it. + * mm-encode.el (mm-body-7-or-8): Autoload. -1999-11-07 21:07:55 Shenghuo ZHU + * mm-decode.el (mm-insert-inline): Autoload. - * gnus-start.el (gnus-active-to-gnus-format): Don't insert backslash - if cooked. - * gnus-util.el (gnus-write-active-file): Write cooked active file. - * gnus-agent.el (gnus-agent-save-group-info): Ditto. - * gnus.el (gnus-short-group-name): "..." proof. + * mml.el: + * message.el: Put some defvars in eval-when-compile. -1999-11-07 20:03:16 Shenghuo ZHU + * gnus-msg.el: Put some defvars in eval-when-compile. + (gnus-msg-mail): Move after gnus-setup-message. - * gnus-srvr.el (gnus-browse-foreign-server): Keep using `read' to - support nnslashdot. + * smiley-ems.el (smiley-data-directory, smiley-regexp-alist): Doc fix. -1999-11-08 00:06:02 Lars Magne Ingebrigtsen +2000-11-07 Dave Love - * nnslashdot.el (nnslashdot-retrieve-headers): Don't fetch too - many articles. - (nnslashdot-generate-active): New function. - (nnslashdot-request-newgroups): Use it. + * gnus-util.el (nnheader): Don't require message (recursive + autoload). - * gnus-start.el (gnus-active-to-gnus-format): Intern strings group - names. + * uudecode.el: Avoid compiler warnings. - * nnslashdot.el (nnslashdot-request-newgroups): New function. - (nnslashdot-request-list): Not moderated. + * rfc2047.el: (rfc2047-fold-region): Use gnus-point-at-bol. + (rfc2047-charset-encoding-alist): Add iso-8859-1[45]. -1999-11-07 Simon Josefsson +2000-11-06 Dave Love - * nnimap.el (nnimap-open-server): Remove error signal if - nnimap-server-buffer is nil (the check should've been `boundp'). + * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode. - * imap.el (imap-log): - * nnimap.el (nnimap-debug): Disable debugging by default. + * uudecode.el: Use (featurep 'xemacs). Require cl when compiling. + (uudecode-char-int): New alias, replacing char-int. + (uudecode-decode-region): Don't call buffer-disable-undo. -1999-11-07 01:17:53 Lars Magne Ingebrigtsen +; * mm-uu.el (mm-uu-configure): Unquote lambda. +; (mm-uu-configure-list): Doc fix. +; +; * earcon.el (running-xemacs): Don't define. +; +;2000-11-03 Stefan Monnier +; +; * message.el (message-font-lock-keywords): Match a final newline +; to help font-lock's multiline support. +; +2000-11-03 Dave Love - * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix. + * gnus-nocem.el (gnus-nocem-check-article-limit): Default to 500. - * gnus-topic.el (gnus-subscribe-topic): New function. + * mm-partial.el (mm-inline-partial): Space-prefix temp buffer + name. - * nnslashdot.el (nnslashdot-request-list): Give out extended group - names. + * gnus-cus.el (gnus-group-parameters) : Fix custom type. + : Fix custom type, doc. - * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars - if starting with a quote. + * mm-decode.el (mm-display-external): Space-prefix temp buffer + name. Don't disable undo explicitly. -1999-11-07 13:06:11 Shenghuo ZHU +;2000-11-02 Dave Love +; +; * message.el (message-font-lock-keywords): Use [:alpha:] for +; cite-prefix. - * gnus-srvr.el (gnus-browse-foreign-server): Support backslash in - group name. +2000-11-01 Dave Love -1999-11-07 01:17:53 Lars Magne Ingebrigtsen + * rfc2047.el (base64): Require unconditionally. + (message-posting-charset): Defvar when compiling. + (rfc2047-encode-message-header, rfc2047-encodable-p): Require + message. - * nnslashdot.el: New file. + * gnus-sum.el (nnoo): Require. + (mm-uu-dissect): Autoload. - * nnheader.el (nnheader-insert-header): New function. + * mml.el (mml-parse-1): Clarify message. + (mml-minibuffer-read-type): Use mailcap-mime-types. - * gnus-art.el (gnus-mime-internalize-part): Bind - mm-inlined-types. +2000-11-01 Stefan Monnier - * nndraft.el (nndraft-request-expire-articles): Do all the backup - files. + * mml.el: Fix a typo in the requiring of CL. -1999-10-29 David S. Goldberg +2000-11-01 Dave Love - * emacs-mime.texi (Customization): Document mm-inline-override-types + * utf7.el: Require cl when compiling. -1999-10-29 David S. Goldberg + * binhex.el: Use (featurep 'xemacs). + (binhex-char-int): New alias, replacing char-int. Change callers. + (binhex-decode-region): Simplify work buffer code. + (binhex-decode-region-external): Use expand-file-name, not concat. - * emacs-mime.texi (Customization): Document mm-inline-override-types +2000-10-30 Dave Love -1999-10-29 David S. Goldberg + * gnus-art.el: Fix 2000-10-27 change properly. - * emacs-mime.texi (Customization): Document mm-inline-override-types +2000-10-28 Miles Bader -1999-10-26 Katsumi Yamaoka + * gnus-art.el (gnus-read-save-file-name): Remove extraneous paren. - * smiley.el (gnus-smiley-display): Use `smiley-toggle-buffer'. - (smiley-toggle-buffer): New function. - (smiley-buffer): Don't quote the function. - (smiley-toggle-extents): Ditto. +2000-10-27 Dave Love -1999-11-07 01:00:32 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-make-menu-bar): Add some :help + strings. + (gnus-group-make-tool-bar): New function. + (gnus-group-mode): Use it. - * gnus-topic.el (gnus-topic-goto-missing-topic): Work even in - empty buffers. + * message.el (message-mode-menu): Add some :help strings. + (message-mode) [message-tool-bar-map]: Define tool-bar-map. + (featurep): Use (featurep 'xemacs). Install tool bar for Emacs. -1999-11-06 23:16:24 Lars Magne Ingebrigtsen + * catchup.xpm, exit-gnus.xpm, gnntg.xpm, subscribe.xpm: + * describe-group.xpm, get-news.xpm, kill-group.xpm: + * unsubscribe.xpm: New files. Renamed icons from Luis Fernandes. - * gnus-art.el (gnus-article-mode-map): Use the summary article - edit. + * mm-decode.el (mm-valid-and-fit-image-p): Don't test + display-graphic-p here. -1999-11-06 22:56:49 Jens-Ulrik Petersen +2000-10-27 Miles Bader - * gnus-group.el (gnus-group-read-ephemeral-group): Doc fix. + * gnus-ems.el (gnus-ems-redefine): Use (featurep 'xemacs) instead + of the `gnus-xemacs' variable, as the latter has been removed. + * gnus-start.el (gnus-1, gnus-read-descriptions-file): Likewise. + * gnus-art.el (gnus-treat-display-xface) + (gnus-treat-display-smileys, gnus-treat-display-picons) + (gnus-article-read-summary-keys): Likewise. -1999-11-06 21:40:30 Lars Magne Ingebrigtsen +2000-10-26 Dave Love - * gnus-uu.el (gnus-uu-mark-thread): Don't move point around. + (defvar): Use rmail-spool-directory unconditionally. -1999-10-07 Katsumi Yamaoka +2000-10-18 Dave Love - * gnus-art.el (gnus-treat-predicate): Examine whether the argument - is list or not before condition. + * mm-bodies.el (mm-uu-decode-function) + (mm-uu-binhex-decode-function): Defvar when compiling. -1999-10-07 Yoshiki Hayashi + * gnus-nocem.el (gnus-nocem-issuers): Update. + (gnus-nocem-check-from): New option. + (gnus-nocem-scan-groups): Use it. + (gnus-nocem-check-article): Bind gnus-newsgroup-name. + (gnus-nocem-check-article-limit): Add :version. - * gnus-art.el (gnus-treat-predicate): Work for (typep "something"). +2000-10-16 Stefan Monnier -1999-11-06 19:18:14 Kevin the Bandicoot + * ietf-drums.el (mm-util): Require CL when compiling. - * gnus-art.el (gnus-emphasis-alist): New value. +2000-10-15 Dave Love -1999-11-06 13:57:13 Shenghuo ZHU + * qp.el: Require mm-util. - * gnus-srvr.el (gnus-browse-foreign-server): Use both `read' and - `buffer-substring'. +2000-10-13 Dave Love -1999-11-06 04:24:30 Lars Magne Ingebrigtsen + * qp.el (quoted-printable-decode-region): Avoid invalid + coding-systems. - * gnus-art.el (article-date-ut): Keep the updated timer. - (gnus-emphasis-underline-italic): Doc fix. +2000-10-12 Gerd Moellmann - * gnus-msg.el (gnus-post-method): Doc fix. - (gnus-post-method): Change default. + * mm-bodies.el: Don't require `mm-uu' at compile-time; it leads + to a recursive load. -1999-11-06 04:12:13 Francisco Solsona +2000-10-12 Dave Love - * message.el (message-newline-and-reformat): Improvements. + * mm-util.el (mm-charset-synonym-alist): Add windows-1252. -1999-11-06 03:51:24 Lars Magne Ingebrigtsen + * gnus.el (gnus-group-startup-message): Check for PBM image. - * message.el (message-newline-and-reformat): Don't insert too many - newlines. - (message-newline-and-reformat): Work even if not sc. +2000-10-09 Dave Love - * mm-view.el (mm-inline-message): Insert a delimiter at the end. + * mail-source.el (mail-source-fetch-imap): Bind + default-enable-multibyte-characters rather than using + mm-disable-multibyte. - * mm-decode.el (mm-inline-media-tests): Only if diff mode. +2000-10-05 Dave Love -1999-11-06 03:48:02 Toby Speight + * qp.el (mm-decode-coding-region, mm-encode-coding-region): + Autoload. + (quoted-printable-decode-region): Rename arg which confused + charset with coding-system. Don't use nonascii-insert-offset. + Coding-system encode the region initially. Don't recognize `==' + as valid QP. Coding-system decode the region finally. + (quoted-printable-decode-string): Rename arg which confused + charset with coding-system. - * mm-view.el (mm-display-patch-inline): New function. + * mm-bodies.el: Require mm-uu, Don't require qp, uudecode. + (mm-encode-body): Apply mm-charset-to-coding-system to arg of + mm-encode-coding-region. + (mm-decode-body, mm-decode-string): Rename variables which + confused charset with coding-system. + (binhex-decode-region): Don't autoload. + (mm-body-encoding): Require message. + (mm-decode-content-transfer-encoding): Require mm-uu in relevant + cond branches. -1999-11-06 03:47:54 Robert Bihlmeyer + * gnus-art.el (article-de-quoted-unreadable) + (article-de-base64-unreadable): Fold search case + rather than downcasing string. Apply mm-charset-to-coding-system + to arg of quoted-printable-decode-region. - * mm-view.el (mm-display-patch-inline): New function. +2000-10-04 Dave Love -1999-11-06 02:17:54 Lars Magne Ingebrigtsen + * gnus-ems.el: Don't turn off compiler warnings in local vars. + Require ring when compiling. + (gnus-article-compface-xbm): New variable. - * gnus-sum.el (gnus-read-move-group-name): Subscribe to the - group. +2000-10-04 Dave Love - * message.el (message-forward): Narrow to the right header. + * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use + pbm images. - * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus - dates. + * frown.pbm, smile.pbm, wry.pbm: New files. - * gnus-msg.el (gnus-configure-posting-styles): Use the - user-full-name function. + * frown.xbm, smile.xbm, wry.xbm: Deleted. - * mm-bodies.el (mm-body-encoding): Use the choosing function. - (mm-body-charset-encoding-alist): Default to nil. +2000-10-03 Dave Love - * message.el (message-elide-ellipsis): Fix typo. - (message-elide-region): Ditto. - (message-elide-region): Don't insert a newline first. + * mail-source.el (mail-sources): Revert to nil. -1999-11-05 20:28:27 Lars Magne Ingebrigtsen + * nnmail (nnmail-spool-file): Revert to `((file))'. - * gnus-sum.el (gnus-cut-thread): Also cut for numberp - gnus-fetch-old-headers. - (gnus-cut-threads): Ditto. - (gnus-summary-initial-limit): Ditto. - (gnus-summary-limit-children): Ditto. + * qp.el: Don't require mm-util. + (quoted-printable-decode-region): Rewritten. + (quoted-printable-decode-string, quoted-printable-encode-region): + Doc fix. + (quoted-printable-encode-region): Barf on multibyte characters. + Maybe make the class multibyte. Upcase chars, not formatted + strings. Allow mm-use-ultra-safe-encoding to be unbound. + (quoted-printable-encode-string): Don't use + mm-with-unibyte-buffer. - * gnus-msg.el (gnus-configure-posting-styles): Allow `header' - matches. +2000-09-29 Gerd Moellmann -1999-11-06 Simon Josefsson + * smiley-ems.el (smiley-update-cache): Use `:ascent center'. - * gnus-art.el (article-decode-encoded-words): - (gnus-mime-display-single): Don't assume gnus-summary-buffer is - live. +2000-09-21 Dave Love - * gnus.el (gnus-read-method): Add methods from - `gnus-opened-servers' to completion. Map entered method/address - into existing methods if possible. + * smiley-ems.el (smiley-region): Test if display-graphic-p bound + (for Emacs 20). Tidy somewhat. - * gnus-group.el (gnus-group-make-group): Simplify method. +2000-09-21 Dave Love - * gnus-srvr.el (gnus-browse-unsubscribe-group): Simplify method. + * gnus-ems.el (gnus-article-display-xface): Use unibyte for the + image processing. Rationalize logic somewhat. - * mml.el (mml-preview): Remove mail-header-separator before - encoding. +2000-09-20 Dave Love -1999-11-05 20:28:27 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-1) : Don't test for X + specifically. - * message.el (message-read-from-minibuffer): New function. + * gnus.el (gnus-version-number): Avoid some redundant + autoloads. -Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen +2000-09-20 Gerd Moellmann - * gnus.el: Pterodactyl Gnus v0.98 is released. + * gnus-ems.el (gnus-article-display-xface): Don't convert PBM + to XBM; we always have PBM support. -1999-11-05 01:27:49 Shenghuo ZHU +2000-09-14 Dave Love - * gnus-agent.el (gnus-agent-expire): Remove bad line in NOV. + * gnus.el (gnus-charset): + * mm-decode.el (mime-display): + * imap.el (imap) : Add :version. -1999-11-04 22:20:35 Shenghuo ZHU +2000-09-13 Gerd Moellmann - * mml.el (mml-generate-mime-1): Read attached binary file in - binary mode. + * parse-time.el: Fix author's mail address. -1999-11-03 16:08:56 Shenghuo ZHU + * earcon.el, flow-fill.el, gnus-cite.el, gnus-gl.el, gnus-ml.el: + * gnus-mlspl.el, gnus-nocem.el, gnus-range.el, gnus-salt.el: + * gnus-setup.el, gnus-soup.el, gnus-undo.el, gnus-vm.el: + * messcompat.el, nnbabyl.el, nndir.el, nneething.el: + * nngateway.el, nnheaderxm.el, nnkiboze.el, nnlistserv.el: + * nnmbox.el, nnmh.el, nnoo.el, nnsoup.el, nnspool.el, rfc2045.el: + * rfc2231.el, uudecode.el: Fix copyright notice. - * gnus-sum.el (gnus-summary-toggle-header): Fix arg bug. + * nnweb.el (toplevel): To make the file bootstrap in Emacs, + require `w3' at load-time only if not running in batch mode. -1999-11-03 15:27:38 Shenghuo ZHU +2000-12-19 16:00:00 ShengHuo ZHU - * mailcap.el (mailcap-viewer-lessp): Fix bug. + * gnus.el: Before merge with Emacs21. -1999-11-02 17:28:33 Shenghuo ZHU +2000-12-19 Raymond Scholz - * gnus-sum.el (gnus-summary-search-article): Fix loop search bug. + * gnus-art.el (gnus-article-dumbquotes-map): Add EUR symbol. -1999-10-31 21:24:59 Shenghuo ZHU +2000-12-19 Per Abrahamsen - * gnus-art.el (gnus-article-mime-match-handle-first): New function. - (gnus-article-mime-match-handle-function): New variable. - (gnus-article-view-part): Make `b' customizable. + * mml.el (mml-mode-map): Change mml prefix from `M-m' to `C-c C-m' + to avoid conflict with the standard `back-to-indentation' + binding. -1999-10-29 14:30:07 Shenghuo ZHU +2000-12-17 10:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-article-get-xrefs): Test eobp. + * mm-extern.el (mm-inline-external-body): g-a-m-h may be a handle. -1999-09-27 Hrvoje Niksic + * mm-util.el (mm-enable-multibyte-mule4): Test charsetp. + (mm-disable-multibyte-mule4): Ditto. + (mm-with-unibyte-current-buffer-mule4): Ditto. - * mm-decode.el (mm-attachment-override-types): Exclude text/plain. +2000-12-15 10:00:00 ShengHuo ZHU -1999-10-26 23:27:44 Shenghuo ZHU + * pop3.el (pop3-movemail): Use binary. + (pop3-movemail-file-coding-system): Removed. - * mm-decode.el (mm-dissect-buffer): CTE may come without CTL. +2000-12-14 13:00:00 ShengHuo ZHU -1999-10-26 21:44:05 Shenghuo ZHU + * mm-util.el (mm-charset-synonym-alist): Add cn-gb. - * gnus-srvr.el (gnus-browse-foreign-server): Use - `buffer-substring' instead of `read'. +2000-12-13 21:00:00 ShengHuo ZHU -1999-10-23 Simon Josefsson + * nnspool.el (nnspool-lib-dir): Check whether /usr/lib/news/active + exists. - * nnimap.el, imap.el, rfc2104.el: New files. +2000-12-13 13:00:00 ShengHuo ZHU - * gnus.el (gnus-valid-select-methods): Add nnimap. + * gnus-msg.el (gnus-post-method): Use backend name when the + address is "". - * gnus-group.el (gnus-group-group-map): Add - gnus-group-nnimap-edit-acl, gnus-group-nnimap-expunge. - (gnus-group-nnimap-expunge): New function. - (gnus-group-nnimap-edit-acl): New function. +2000-12-08 10:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-group-mode-map): Add - gnus-agent-synchronize. - (gnus-agent-synchronize): New function. - (gnus-agent-fetch-group-1): Check if server is open. + * gnus-art.el (article-verify-x-pgp-sig): Don't test + mm-verify-option. + (gnus-treat-x-pgp-sig): Default value. + (gnus-ignored-headers): Redundant. - * nnagent.el (nnagent-request-set-mark): Save marks. +2000-12-04 22:00:00 ShengHuo ZHU - * mail-source.el (mail-source-keyword-map): New imap mail-source. - (mail-source-fetcher-alist): Map to imap fetcher function. - (mail-source-fetch-imap): New function. + * gnus-win.el (gnus-configure-frame): Save selected window. - * gnus-art.el (article-hide-pgp): Hide all headers, not just - Hash:. +2000-02-15 Andrew Innes -1999-10-22 11:03:00 Shenghuo ZHU + * nnmbox.el: Require gnus-range. + (nnmbox-group-building-active-articles): New variable. + (nnmbox-group-active-articles): New variable; this is a cache of + all active articles by group and number. + (nnmbox-in-header-p): New function. + (nnmbox-find-article): New function. + (nnmbox-record-active-article): New function. + (nnmbox-record-deleted-article): New function. + (nnmbox-is-article-active-p): New function. + (nnmbox-retrieve-headers): Use nnmbox-find-article. + (nnmbox-request-article): Ditto. Also supply extra arg to + nnmbox-article-group-number. + (nnmbox-request-expire-articles): Ditto. + (nnmbox-request-move-article): Ditto. + (nnmbox-request-replace-article): Ditto. + (nnmbox-request-rename-group): Rename group entry in active + article cache. + (nnmbox-delete-mail): Update active article cache, unless article + is being replaced. + (nnmbox-possibly-change-newsgroup): Call nnmbox-read-mbox, rather + than partially duplicating it. + (nnmbox-article-group-number): Add extra `this-line' arg, to + handle articles belonging to multiple groups. + (nnmbox-save-mail): Update active article cache. + (nnmbox-read-mbox): Build active article cache when loading mbox. + Also do some repair work, if we find articles that are missing the + appropriate X-Gnus-Newsgroup lines in the header. We can usually + reconstruct these from Xref info. + +2000-12-04 18:00:00 ShengHuo ZHU - * gnus-topic.el (gnus-topic-sort-topics-1): New function. - (gnus-topic-sort-topics): New function. - (gnus-topic-make-menu-bar): Add sort-topics. - (gnus-topic-move): New function. - (gnus-topic-move-group): Move the topic if no group selected. + * mail-source.el (mail-source-report-new-mail): Use + nnheader-run-at-time. -1999-10-13 21:31:50 Shenghuo ZHU +2000-02-15 Andrew Innes - * gnus-art.el (gnus-article-setup-buffer): Fix buffer leak. + * mail-source.el (mail-source-fetch-pop): Clear pop password when + an error is thrown, and then rethrow the error. + (mail-source-check-pop): Ditto. + (mail-source-start-idle-timer): Prevent multiple pop checks + running if the check takes a long time. + +2000-12-04 14:00:00 ShengHuo ZHU -1999-10-13 12:52:18 Shenghuo ZHU + * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if + succeed. - * mm-view.el (mm-inline-message): Fix leaving group bug. +2000-12-04 13:00:00 ShengHuo ZHU -1999-10-07 17:59:49 Shenghuo ZHU + * gnus-win.el (gnus-configure-windows): Make sure + nntp-server-buffer is live. + (gnus-remove-some-windows): switch-to-buffer -> set-buffer. - * gnus-msg.el (gnus-post-method): Use normal method if current is - not available. +2000-11-21 Stefan Monnier -1999-10-07 17:09:34 Shenghuo ZHU + * gnus-win.el (gnus-configure-windows): switch-to-buffer -> set-buffer. - * nnmail.el (nnmail-insert-xref): Dealing with empty articles. - (nnmail-insert-lines): Ditto. +2000-12-04 Andreas Jaeger -1999-10-07 Shenghuo ZHU + * gnus-msg.el (gnus-summary-mail-forward): Fix typos in description. - * nnfolder.el (nnfolder-insert-newsgroup-line): Insert a blank - line. +2000-12-03 12:00:00 ShengHuo ZHU - * message.el (message-unsent-separator): One more separator. + * mml2015.el (mml2015-fix-micalg): Alg might be nil. -1999-10-06 Shenghuo ZHU +2000-12-01 Christopher Splinter - * nnfolder.el (nnfolder-request-move-article): For empty article, - search till (point-max). - (nnfolder-retrieve-headers): Ditto. - (nnfolder-request-accept-article): Ditto. - (nnfolder-save-mail): Ditto. - (nnfolder-insert-newsgroup-line): Ditto. + * gnus-sum.el (gnus-summary-limit-to-age): Fix typo. -1999-10-05 Shenghuo ZHU +2000-12-01 Simon Josefsson - * qp.el (quoted-printable-encode-region): Check eobp. + * mml-smime.el (mml-smime-verify): Fix address parsing. -1999-10-03 Shenghuo ZHU +2000-12-01 Simon Josefsson - * nntp.el (nntp-retrieve-headers-with-xover): Fix hanging problem. + * mml-smime.el (mml-smime-verify): Don't modify MM buffer. Handle + more than one certificate inside PKCS#7 blob. Better security + information (clamed / actual sender, openssl output, certificates + inside message). -1999-10-02 Shenghuo ZHU + * smime.el (smime-verify-region): Output to /dev/null. + (smime-buffer-as-string-region): Don't parse empty lines. - * nntp.el (nntp-send-xover-command): Wait for nothing if not - wait-for-reply. +2000-11-30 23:00:00 ShengHuo ZHU -1999-09-29 Shenghuo ZHU + * gnus-art.el (gnus-mime-security-button-line-format-alist): Add + ?d and ?D. + (gnus-mime-security-show-details-inline): New variable. + (gnus-mime-security-show-details): Use them. + (gnus-insert-mime-security-button): Ditto. - * mm-uu.el (mm-uu-forward-begin-line): Change the regexp. - (mm-uu-forward-end-line): Ditto. + * mml2015.el (mml2015-gpg-verify): Set details when succeed. + Suggest by Michael Duggan (md5i@cs.cmu.edu). + (mml2015-gpg-clear-verify): Ditto. + (mml2015-gpg-decrypt-1): Ditto. + (mml2015-use): Prefer 'gpg. -1999-09-29 Didier Verna +2000-11-30 19:00:00 ShengHuo ZHU - * binhex.el (binhex-decode-region): don't consider the value of - `enable-multibyte-characters' in XEmacs. + * gnus-util.el (gnus-add-text-properties-when): New function. + (gnus-remove-text-properties-when): Ditto. - * gnus-start.el (gnus-read-descriptions-file): ditto. + * gnus-cite.el (gnus-article-hide-citation): Use them. + (gnus-article-toggle-cited-text): Use them. + + * gnus-art.el (gnus-signature-toggle): Use them. + (gnus-article-show-hidden-text): Ditto. + (gnus-article-hide-text): Ditto. - * mm-util.el (mm-multibyte-p): ditto. - (mm-with-unibyte-buffer): ditto. - (mm-find-charset-region): use `mm-multibyte-p'. +2000-11-30 14:00:00 ShengHuo ZHU - * mm-bodies.el (mm-decode-body): ditto. - (mm-decode-string): ditto. + * mm-util.el (mm-find-charset-region): Remove eight-bit-*. - * lpath.el ((string-match "XEmacs" emacs-version)): Don't define - `enable-multibyte-characters' in XEmacs. +2000-11-30 Simon Josefsson -1999-09-29 Shenghuo ZHU + * smime.el (smime-point-at-eol): New alias. + (smime-buffer-as-string-region): Use it. - * mm-util.el (mm-binary-coding-system): Try binary first. +2000-11-29 21:00:00 ShengHuo ZHU -1999-09-14 Shenghuo ZHU + * nndraft.el (nndraft-request-restore-buffer): Remove Date field. - * rfc1843.el (rfc1843-decode-article-body): Don't decode twice. +2000-11-29 20:00:00 ShengHuo ZHU -1999-09-10 Shenghuo ZHU + * nnfolder.el (nnfolder-request-expire-articles): expiry-target. - * gnus-art.el (article-make-date-line): Add time-zone in iso8601 - format. - (article-date-ut): Find correct insert position. + * nnbabyl.el (nnbabyl-request-expire-articles): Ditto. -1999-09-03 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable - forwarded message. - -1999-09-27 20:33:41 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-find-groups): Work for unactivated - groups. - - * message.el (message-resend): Use message mode when prompting. - - * gnus-art.el (article-hide-headers): Mark wash. - (article-emphasize): Ditto. - -1999-09-27 19:52:14 Vladimir Volovich - - * message.el (message-newline-and-reformat): Work for SC. - -1999-09-27 19:38:33 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*. - - * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown. - -1999-10-20 David S. Goldberg - - * mm-decode.el mm-inline-override-types: New variable - - * mm-decode.el (mm-inline-override-p): New function - - * mm-decode.el (mm-inlined-p): Use it - -1999-10-20 David S. Goldberg - - * mm-decode.el mm-inline-override-types: New variable - - * mm-decode.el (mm-inline-override-p): New function - - * mm-decode.el (mm-inlined-p): Use it - -Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.97 is released. - -1999-09-01 Brendan Kehoe - - * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Use - gnus-summary-next-group, not gnus-summary-next-article. Only give - 3 args. - -1999-09-25 08:07:57 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-fetch-group-1): Look in the group - buffer for params. - - * gnus-xmas.el (gnus-xmas-summary-recenter): Display one more - line. - - * message.el (message-forward-ignored-headers): New variable. - - * gnus-art.el (gnus-article-prepare-display): Nix out - gnus-article-wash-types. - - * gnus-agent.el (gnus-agent-create-buffer): New function. - (gnus-agent-fetch-group-1): Use it. - (gnus-agent-start-fetch): Ditto. - - * gnus-sum.el (gnus-summary-exit): Don't use - `gnus-use-adaptive-scoring'. - - * mail-source.el (mail-source-fetch-pop): Only store password when - successful. - - * gnus-nocem.el (gnus-nocem-scan-groups): Message better. - -1999-09-24 18:43:23 Lars Magne Ingebrigtsen - - * message.el (message-reply): Use it. - (message-dont-reply-to-names): New variable. - - * nntp.el (nntp-open-telnet): Don't erase-buffer. - - * mm-util.el (mm-preferred-coding-system): Typo fix. - - * message.el (message-bounce): Work for non-MIME. - - * gnus.el (gnus-short-group-name): Short the right parts of the - name. - -1999-09-24 18:17:48 Johan Kullstam - - * mm-encode.el (mm-qp-or-base64): New version. - -1999-09-10 Shenghuo ZHU - - * gnus-art.el (article-make-date-line): Fix time-zone bug. - -1999-09-09 Shenghuo ZHU - - * gnus-art.el (gnus-article-add-buttons): Don't delete markers out - of restricted region. - (gnus-mime-display-single): Set beg at correct point. - -1999-09-09 Shenghuo ZHU - - * nnmail.el (nnmail-process-maildir-mail-format): Typo. - -1999-09-09 Jens-Ulrik Petersen - - * gnus-msg.el (gnus-configure-posting-styles): Let - `gnus-posting-styles' have its say in posting-style: local - variable `styles' is already bound to `gnus-posting-styles' so - don't rebind it to nil. - -1999-09-24 18:10:56 Robert Bihlmeyer - - * gnus-score.el (gnus-summary-increase-score): Allow editing of - Message-ID. - -1999-09-08 Shenghuo ZHU - - * mm-encode.el (mm-encode-content-transfer-encoding): Fold - quoted-printable-encode-region. - - * qp.el (quoted-printable-encode-region): Assume charset - encoded. Fold every line in the region. - -1999-09-02 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Read the first line - of active file. - -1999-09-01 Didier Verna - - * message.el (message-mode): allows whitespaces between multiple - instances of the fill character ">". - -1999-09-24 18:02:50 Kim-Minh Kaplan - - * mm-encode.el (mm-qp-or-base64): Fix. - -1999-09-01 12:18:01 Katsumi Yamaoka - - * message.el (message-send): Too much and. - -1999-09-24 17:58:07 Andreas Schwab - - * gnus-art.el (gnus-mime-view-part-as-type): Renamed. - -1999-08-28 12:44:20 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-headers): Work for nil scores. - -1999-08-27 20:46:11 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-write-active): Write full names. - - * gnus-util.el (gnus-write-active-file): Accept full name. - - * mm-decode.el (mm-inlinable-p): Use string-match on the types. - (mm-assoc-string-match): New function. - (mm-display-inline): Use it. - - * gnus-group.el (gnus-group-set-info): Work for nil group params. - - * gnus-msg.el (gnus-configure-posting-styles): Allow eval. - -1999-08-27 19:08:10 Florian Weimer + * nnmbox.el (nnmbox-request-expire-articles): Ditto. - * mml.el (mml-generate-multipart-alist): New variable. +2000-11-22 Jan Nieuwenhuizen -1999-08-27 15:30:02 Lars Magne Ingebrigtsen + * nnmh.el (nnmh-request-expire-articles): Implemented + expiry-target for nnmh backend. - * gnus-art.el (gnus-treat-predicate): Work for (not 5). +2000-11-30 Simon Josefsson -1999-08-27 Peter von der Ah-Ai + * mm-decode.el (mm-security-from): New variable. + (mm-possibly-verify-or-decrypt): Use it rather than `from'. - * message.el (message-send): More helpful error message if sending - fails + * mml-smime.el (mml-smime-verify): Use `mm-security-from' rather + than `from'. -Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen +2000-11-30 Simon Josefsson - * gnus.el: Pterodactyl Gnus v0.96 is released. + * mml-smime.el (mml-smime-verify): Verify that certificate mail + address match sender address. -1999-08-17 Simon Josefsson + * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address. - * gnus-start.el (gnus-groups-to-gnus-format): Only use agent - to get active info if method is covered by agent, otherwise - active info is lost. + * smime.el (smime-verify-region): Don't copy buffer. + (smime-decrypt-buffer): Use expand-file-name on keyfile. + (smime-pkcs7-region): New function. + (smime-pkcs7-certificates-region): Ditto. + (smime-pkcs7-email-region): Ditto. + (smime-buffer-as-string-region): Ditto. -1999-08-17 Simon Josefsson - - * gnus-sum.el (gnus-summary-move-article): Report backend errors. - -1999-08-09 Dave Love - - * mm-util.el: Use `defalias', not `fset' for dummy functions. - -1999-08-09 Simon Josefsson - - * gnus-art.el (gnus-ignored-headers): Remove "X-Pgp-*" - (already matched by "^X-Pgp"), removed duplicate - X-Mailing-List, added several new junk headers. - -1999-08-01 Simon Josefsson - - * gnus-art.el (article-decode-charset): Don't assume - gnus-summary-buffer is live. - -1999-08-27 15:07:43 Paul Flinders - - * smiley.el (smiley-deformed-regexp-alist): Fix % smileys. - -1999-08-27 15:02:58 Florian Weimer - - * gnus-score.el (gnus-home-score-file): Work with absolute path - names. - -1999-07-17 Shenghuo ZHU - - * gnus-sum.el (gnus-articles-to-read): Return cached articles if - nothing else in the group. - -1999-07-16 Shenghuo ZHU - - * gnus-bcklg.el (gnus-backlog-enter-article): Check the size of - the article. - -1999-07-15 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Fix for base64 message. - -1999-07-15 Shenghuo ZHU - - * mm-uu.el (mm-uu-forward-end-line): Support forwarded message - from mutt. - -1999-07-14 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): Delete - whitespace. - -1999-07-14 Shenghuo ZHU - - * mm-util.el (mm-text-coding-system-for-write): New variable. - (mm-append-to-file): New function. - (mm-write-region): New function. - - * gnus-art.el (gnus-output-to-file): Use it. - * gnus-util.el (gnus-output-to-rmail): Ditto. - (gnus-output-to-mail): Ditto. - * gnus-uu.el (gnus-uu-binhex-article): Ditto. - -1999-07-14 Shenghuo ZHU - - * nnmail.el (nnmail-find-file): Use mm-auto-mode-alist. - - * nnheader.el (nnheader-insert-file-contents): Revert and use - mm-insert-file-contents. - (nnheader-find-file-noselect): Use mm-auto-mode-alist. - (nnheader-auto-mode-alist): Removed. - - * mm-util.el (mm-inhibit-file-name-handlers): New variable. - (mm-insert-file-contents): Add a new parameter for inserting - compressed file literally. - - * mml.el (mml-generate-mime-1): Insert non-text literally. - - * gnus.el: Change most mm-insert-file-contents back to nnheader. - -1999-07-13 Hrvoje Niksic - - * gnus-art.el (gnus-unbuttonized-mime-types): Fix docstring. - -1999-08-27 14:53:42 Oleg S. Tihonov - - * gnus-sum.el (gnus-group-charset-alist): Default fido7 to - koi8-r. - -1999-07-11 Shenghuo ZHU - - * mml.el (mml-insert-mime): Decode text. - (mml-to-mime): Narrow to headers-or-head. - -1999-07-11 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Check - w3-meta-content-type-charset-regexp. - -1999-07-10 Simon Josefsson - - * gnus-agent.el (gnus-agent-fetch-group-1): Search topics for - predicate. - -1999-07-10 Alexandre Oliva - - * gnus-mlspl.el: Documentation fixes. - -1999-08-27 14:42:14 Rui Zhu - - * gnus-sum.el (gnus-summary-limit-to-age): Prompt better. - -1999-08-27 14:40:52 Michael Cook - - * gnus-art.el (gnus-article-setup-buffer): Kill all local - variables. - -1999-08-27 14:39:34 Hrvoje Niksic - - * nnmail.el (nnmail-get-new-mail): "Done". - -1999-08-27 14:38:14 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-kill-all-zombies): Only prompt when - interactive. - -1999-07-12 Shenghuo ZHU - - * gnus-art.el (article-decode-charset): Fix broken CT. - -1999-07-12 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-group-1): Recreate agent - overview buffer if it is killed. -1999-08-27 14:26:03 Eric Marsden - - * gnus-art.el (article-babel): New version. - -1999-08-27 14:22:39 Jon Kv - - * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry. - -1999-07-10 Mike McEwan - - * gnus.texi (More Threading): Document new variable - `gnus-sort-gathered-threads-function'. - -1999-07-10 Mike McEwan - - * gnus.texi (More Threading): Document new variable - `gnus-sort-gathered-threads-function'. - -1999-07-11 Andreas Jaeger - - * gnus-uu.el (gnus-uu-digest-mail-forward): Delete file after - usage. - -1999-07-10 Shenghuo ZHU - - * mm-util.el (mm-running-xemacs): Removed. - (mm-coding-system-p): New function. - (mm-binary-coding-system): Safe guess. - (mm-text-coding-system): Ditto. - (mm-auto-save-coding-system): Ditto. - -1999-07-11 11:02:03 Lars Magne Ingebrigtsen - - * mm-encode.el (mm-qp-or-base64): Also consider control chars. - (mm-qp-or-base64): Reversed logic. - - * mm-decode.el (mm-save-part-to-file): Let coding system be - binary. - -1999-07-15 Mike McEwan - - * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to - be set in topic parameters. - -1999-07-10 Mike McEwan - - * gnus-sum.el (gnus-sort-gathered-threads-function): New variable. - (gnus-sort-gathered-threads): Allow the user to specify the - function to use when sorting gathered threads. - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't - mark cached articles as `undownloaded'. - -Tue Jul 20 02:39:56 1999 Peter von der Ah-Ai - - * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring - to have buffer local values. - -1999-07-25 Matt Pharr - - * gnus-group.el (gnus-group-make-doc-group): Notice when user - types 'g' for 'guess group type. - -1999-07-30 Simon Josefsson - - * nnmail.el (nnmail-remove-list-identifiers): Remove whitespace - after each regexp in nnmail-list-identifiers, not just after last - one. - - * gnus-sum.el (gnus-list-identifiers): New variable. - (gnus-summary-remove-list-identifiers): New function. - (gnus-select-newsgroup): Use it. - (gnus-summary-wash-hide-map): Bind - `gnus-article-hide-list-identifiers' to W W l. - (gnus-summary-make-menu-bar): Add list-identifiers command. - - * gnus-art.el (gnus-treat-strip-list-identifiers): New variable. - (gnus-treatment-function-alist): Add variable. - (article-hide-list-identifiers): New function. - (mapcar): Add function. - (gnus-article-hide): Use it. - -Fri Jul 9 22:21:16 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.95 is released. - -1999-07-09 21:46:05 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-mailcap-command): New function. - (mm-display-external): Use it. - - * gnus-art.el (article-make-date-line): Work for India. - - * mm-encode.el (mm-qp-or-base64): Typo. - - * gnus-topic.el (gnus-topic-goto-topic): Made into command. - -Fri Jul 9 19:28:29 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.94 is released. - -1999-07-09 21:19:23 Stainless Steel Rat - - * pop3.el: New version. - -1999-07-09 20:01:44 Lars Magne Ingebrigtsen - - * mm-encode.el (mm-qp-or-base64): New function. - (mm-content-transfer-encoding): Use it. - - * gnus-util.el (gnus-parse-netrc): Allow quoted names. - -1999-07-08 Shenghuo ZHU - - * mm-decode.el (mm-display-external): Fix typo and use 'non-viewer. - - * mailcap.el (mailcap-mailcap-entry-passes-test): Add needsterminal. - -1999-07-09 18:52:22 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-part-as-media): New command and - keystroke. - - * mailcap.el (mailcap-mime-types): New function. - - * nnmh.el (nnmh-request-group): Update nnmh-group-alist. - - * message.el (message-goto-eoh): Really go to the end. - -1999-07-09 18:40:23 Puneet Goel - - * message.el (message-make-date): Do the right thing in with - sub-hour time zones. - -1999-07-09 18:36:21 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-menu-bar): Removed double bug - report. - -1999-07-08 Shenghuo ZHU - - * nnfolder.el (nnfolder-request-rename-group): Create directory. - -1999-07-08 Shenghuo ZHU - - * mailcap.el (mailcap-parse-mailcap): Skip \;. - (mailcap-parse-mailcap-extras): Fix "nonterminal;" and empty name, - and use t as default value. - -Wed Jul 7 18:40:30 1999 Shenghuo ZHU - - * gnus-sum.el (gnus-get-newsgroup-headers): Don't assume - gnus-summary-buffer is live. + * gnus-art.el (gnus-mime-security-show-details): Goto beginning of + buffer. -1999-07-09 17:44:03 Robert Pluim +2000-11-23 Jens Krinke - * mm-util.el (mm-enable-multibyte): Check whether var bound. + * smime.el (smime-decrypt-region): Fix keyfile argument. -1999-07-09 17:31:39 Lars Magne Ingebrigtsen +2000-11-29 00:00:00 ShengHuo ZHU - * message.el (message-bounce): Do MIME bounces MIMEy. + * nnmail.el (nnmail-cache-accepted-message-ids): Add doc. - * gnus-sum.el (gnus-summary-read-group-1): Update mark positions. +2000-11-28 17:00:00 ShengHuo ZHU -1999-07-08 08:41:10 Lars Magne Ingebrigtsen + * message.el (message-shoot-gnksa-feet): New variable. + (message-gnksa-enable-p): New function. + (message-send): Use it. + (message-check-news-body-syntax): Ditto. - * mailcap.el (mailcap-mime-extensions): Changed patch to - text/x-patch. +2000-11-28 Katsumi Yamaoka - * mm-decode.el (mm-display-external): Wrong placement of paren. + * message.el (message-make-message-id): Remove the redundancy. -Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen +2000-11-22 17:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.93 is released. + * message.el (message-setup): Discourage using mc-install-*-mode. -1999-07-08 Alexandre Oliva + * gnus-setup.el (gnus-use-mailcrypt): Don't hook mail-crypt. - * gnus-cus.el (gnus-group-parameters): New entries for - gnus-group-split. +2000-11-22 16:00:00 ShengHuo ZHU - * gnus-mlspl.el: Renamed functions and variables so as to - start with gnus-group-split. - * gnus.el: Adjust autoload entries. + * gnus-cite.el (gnus-cite-parse): Guess citation length. -1999-07-07 ??:??:?? Alexandre Oliva +2000-11-22 14:00:00 ShengHuo ZHU - * gnus-mlspl.el: Removed trailing t from comment and provide. - Renamed functions and variables to start with gnus-mlsplit. - Added autoload comments. - * gnus.el: Added autoload entries. + * gnus-ml.el (gnus-mailing-list-insinuate): New function. -1999-07-06 05:37:46 Alexandre Oliva +2000-11-22 13:00:00 ShengHuo ZHU - * nnmail.el (nnmail-split-it): Search the regexp multiple times, - so that matches excluded by RESTRICTs do not cause the whole split - to be ignored. This also fixes a long-standing bug in which a - split with \N substitutions wouldn't cause cross-posting as - expected. + * gnus-ml.el (gnus-mailing-list-archive): Find the real url. - * nnmail.el (nnmail-split-fancy): Document RESTRICT clauses. - (nnmail-split-it): Implement them. +2000-11-22 11:00:00 ShengHuo ZHU - * nnmail.el (nnmail-split-fancy): Document ! splits. + * gnus-xmas.el (gnus-xmas-article-display-xface): Use + insert-buffer-substring. -1999-07-07 10:41:11 Stainless Steel Rat + * message.el (message-send-mail): Use buffer-substring-no-properties. + (message-send-news): Ditto. - * pop3.el: New version. +2000-11-22 David Edmondson -1999-07-05 Simon Josefsson + * imap.el (imap-wait-for-tag): Message read info. - * gnus-srvr.el (gnus-browse-foreign-server): Use read. +2000-11-21 20:00:00 ShengHuo ZHU -1999-07-07 10:37:26 Lars Magne Ingebrigtsen + * mml2015.el (mml2015-mailcrypt-encrypt): Ensure the part is encrypted. + (mml2015-mailcrypt-encrypt): Use unibyte-buffer. + (mml2015-gpg-encrypt): Ditto. - * gnus-art.el (gnus-mime-display-alternative): Do treatment. +2000-11-21 09:00:00 ShengHuo ZHU -1999-07-06 Shenghuo ZHU + * mm-decode.el (mm-verify-option): Default value. - * gnus-util.el (gnus-write-active-file): Use real name. + * mml-sec.el (mml-secure-part): Error message. - * gnus-agent.el (gnus-agent-expire): Update active file - method by method. +2000-11-20 18:00:00 ShengHuo ZHU -1999-07-06 Shenghuo ZHU + * gnus-ml.el (gnus-mailing-list-archive): Use browse-url. - * nndraft.el (nndraft-request-article): Use difference - coding-systems for queue and drafts. +2000-11-20 17:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-setup-default-charset): Special-case - nndraft:drafts. + * gnus-art.el (gnus-article-make-menu-bar): Use easy-menu-add. - * mm-util.el (mm-auto-save-coding-system): New coding system. +2000-11-20 16:00:00 ShengHuo ZHU - * message.el (message-draft-coding-system): Use it. + * gnus-art.el (gnus-article-describe-key): Use prompt. + (gnus-article-describe-key-briefly): Ditto. -1999-07-06 Shenghuo ZHU +2000-11-20 15:00:00 ShengHuo ZHU - * mm-uu.el: More customizable and less aggressive. + * gnus-agent.el (gnus-agent-expire): Ignore corrupted history. -1999-07-07 07:53:23 Lars Magne Ingebrigtsen +2000-11-20 10:00:00 ShengHuo ZHU - * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active - when plugged. + * gnus-art.el (gnus-article-describe-key): New function. + (gnus-article-describe-key-briefly): New function. - * mml.el (mml-generate-mime-1): Don't insert nofile files. - (mml-insert-mml-markup): Accept a nofile. - (mml-insert-mime): Insert nofile. +2000-11-19 23:00:00 ShengHuo ZHU - * gnus-art.el (gnus-treat-strip-blank-lines): Removed. + * mm-decode.el (mm-decrypt-option): Doc typo. - * mm-decode.el (mm-handle-media-type): New function. - (mm-handle-media-supertype): New function. - (mm-handle-media-subtype): New function. - Use new functions throughout. "/")) + * gnus-art.el (gnus-article-read-summary-keys): lookup-key may + return a number. -1999-05-18 03:03:50 Katsumi Yamaoka +2000-11-19 21:00:00 ShengHuo ZHU - * gnus-art.el (gnus-treat-predicate): Typo. + * message.el (message-newline-and-reformat): Typo. -1999-07-07 06:21:36 Lars Magne Ingebrigtsen +2000-11-19 12:00:00 ShengHuo ZHU - * gnus-score.el (gnus-summary-score-entry): Made un-interactive. + * gnus-art.el (article-verify-x-pgp-sig): Check whether + original-article-buffer exists. -1999-07-06 17:57:16 Lars Magne Ingebrigtsen + * rfc2047.el (rfc2047-q-encoding-alist): Match Resent-. + (rfc2047-header-encoding-alist): Addresses are different from text. + (rfc2047-encode-message-header): Ditto. + (rfc2047-dissect-region): Extra parameter. + (rfc2047-encode-region): Ditto. + (rfc2047-encode-string): Ditto. - * gnus-art.el (article-date-ut): UT! Default it! +2000-11-19 00:00:00 ShengHuo ZHU -Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen + * mm-uu.el (mm-uu-pgp-encrypted-extract-1): New function. + (mm-uu-pgp-encrypted-extract): Use it. + (mm-uu-pgp-signed-extract-1): New function. + (mm-uu-pgp-signed-extract): Use it. - * gnus.el: Pterodactyl Gnus v0.92 is released. + * gnus-art.el (gnus-mime-display-security): New function. + (gnus-mime-display-part): Use it. + (gnus-mime-security-verify-or-decrypt): New function. + (gnus-mime-security-press-button): New function. + (gnus-insert-mime-security-button): Use it. -1999-07-06 12:30:59 Johannes Weinert + * mm-decode.el (mm-possibly-verify-or-decrypt): Use mm-h-m-c-p. + (mm-find-raw-part-by-type): Ditto. + (mm-verify-function-alist): Add x-gnus-pgp-signature handle. + (mm-decrypt-function-alist): Add x-gnus-pgp-encrypted handle. + (mm-destroy-parts): Kill nested multibyte buffer. - * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. + * mml2015.el (mml2015-mailcrypt-verify): Use mm-h-m-c-p. + (mml2015-gpg-verify): Ditto. -1999-07-06 07:41:07 Lars Magne Ingebrigtsen +2000-11-18 Simon Josefsson - * nntp.el (nntp-retrieve-groups): Don't do anything when not - connected. + * mml2015.el (mml2015-mailcrypt-clear-verify): New function. + (mml2015-function-alist): Use it. - * gnus-start.el (gnus-active-to-gnus-format): Only save active - when plugged. + * mml-sec.el (mml-sign-alist): Update names. + (mml-encrypt-alist): Ditto. + (mml-secure-part-smime-sign): Moved to mml-smime.el + as `mml-smime-sign-query'. + (mml-secure-part-smime-encrypt-by-file): Moved to mml-smime.el as + `mml-smime-get-file-cert'. + (mml-secure-part-smime-encrypt-by-dns): Moved to mml-smime.el as + `mml-smime-get-dns-cert'. + (mml-secure-part-smime-encrypt): Moved to mml-smime.el as + `mml-smime-encrypt-query'. + (mml-smime-sign-buffer): Use mml-smime-sign. + (mml-smime-encrypt-buffer): Use mml-smime-encrypt. - * mm-view.el (mm-inline-message): Ignore remove-spec. + * mml-smime.el (mml-smime-sign): New function. + (mml-smime-encrypt): + (mml-smime-sign-query): + (mml-smime-get-file-cert): + (mml-smime-get-dns-cert): + (mml-smime-encrypt-query): Moved from mml-sec.el. - * gnus-agent.el (gnus-agent-write-active): Check whether orig sym - is bound. +2000-11-16 Simon Josefsson - * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines. + * mml2015.el (mml2015-gpg-clear-verify): New function. + (mml2015-function-alist): Add it. - * nndoc.el (nndoc-guess-type): Remove blank lines at the start. +2000-11-17 14:21 ShengHuo ZHU - * nnfolder.el (nnfolder-read-folder): Remove blank lines at the - start. + * message.el (message-setup-fill-variables): Use + message-cite-prefix-regexp. + (message-newline-and-reformat): Check the end of citation, leading + WSP, break in the cite prefix. + (message-fill-paragraph): New function. - * message.el (message-fill-yanked-message): Remove `t' arg. +2000-11-17 13:44 ShengHuo ZHU - * gnus-group.el (gnus-group-kill-group): Message killing of - groups. + * lpath.el: Shut up. - * mm-util.el (mm-preferred-coding-system): New function. - (mm-mime-charset): Use it. +2000-11-17 Per Abrahamsen - * mml.el (mml-generate-mime-1): Charset-encode message parts. + * gnus-msg.el (gnus-group-posting-charset-alist): No longer allow + raw 8-bit in headers in dk.* newsgroups. -1999-07-06 07:03:31 Alexandre Oliva +2000-11-17 08:02 ShengHuo ZHU - * gnus-mlsplt.el: New file. + * message.el (message-newline-and-reformat): Match extra WSPs. -1999-07-06 05:47:57 Lars Magne Ingebrigtsen +2000-11-16 23:31 ShengHuo ZHU - * mm-decode.el (mm-inline-Media-tests): Changed from forms to - functions. - (mm-attachment-override-p): Take a handle instead of a type. - (mm-inlined-p): Ditto. - (mm-automatic-display-p): Ditto, - (mm-inlinable-p): Ditto. + * mml.el (mml-generate-mime-1): Ignore ascii. - * nndraft.el (nndraft-request-expire-articles): Delete backup - files. +2000-11-16 Justin Sheehy - * mailcap.el (mailcap-parse-mailcap): Regexp-quote stuff. + * gnus-sum.el (gnus-summary-make-menu-bar): Fix menu items. - * gnus-sum.el (gnus-summary-limit-to-extra): Typo. +2000-11-16 17:00 ShengHuo ZHU -1999-07-06 05:37:46 Alexandre Oliva + * message.el (message-cite-prefix-regexp): Prefix should not end + at space. - * nnmail.el (nnmail-split-it): Allow .*. +2000-11-15 18:09 ShengHuo ZHU -1999-07-05 05:04:57 Lars Magne Ingebrigtsen + * message.el (message-mode-syntax-table): Add - as a word + constituent as in articles. + (message-setup-fill-variables): Add -_. as supercite-style prefix. + * gnus-art.el (gnus-article-mode-syntax-table): Remove ?-. + * gnus-cite.el (gnus-cite-parse): Match from the beginning of line. - * mm-decode.el (mm-inline-large-images-p): Renamed. +2000-11-15 13:21 ShengHuo ZHU - * gnus-art.el (article-date-ut): Always look in the current buffer - for the Date header. + * gnus-msg.el (gnus-inews-do-gcc): Expire the article. - * mml.el (mml-validate): New command. +2000-11-12 David Edmondson - * mailcap.el (mailcap-possible-viewers): Revert to string-match - since we are dealing with regexps. + * message.el (message-font-lock-keywords): use + message-cite-prefix-regexp. -Sun Jul 4 06:31:01 1999 Lars Magne Ingebrigtsen +2000-11-15 Kai Gro,A_(Bjohann - * gnus.el: Pterodactyl Gnus v0.91 is released. + * gnus-group.el (gnus-group-jump-to-group-prompt): New variable by + Stein Arild Str,Ax(Bmme. + (gnus-group-jump-to-group): Use it. -1999-07-04 04:35:28 Lars Magne Ingebrigtsen +2000-11-14 10:32:42 ShengHuo ZHU - * gnus-agent.el (gnus-agent-save-active-1): New function. - (gnus-agent-save-active): use it. - (gnus-agent-save-groups): Ditto. + * mailcap.el (mailcap-possible-viewers): Match the entire string. - * gnus-cache.el (gnus-cache-write-active): Use it. +2000-11-14 10:20:56 ShengHuo ZHU - * gnus-agent.el (gnus-agent-write-active): Use it. + * mml2015.el (mml2015-mailcrypt-verify): replace-match is + incompatible. + (mml2015-mailcrypt-sign): Ditto. - * gnus-util.el (gnus-write-active-file): New function. +2000-11-14 10:12:05 ShengHuo ZHU - * gnus-agent.el (gnus-agent-write-active): New function to keep - lower boundaries and canceled groups. - (gnus-agent-save-groups): Use it. - (gnus-agent-save-active): Use it. - (gnus-agent-save-group-info): Only write active files. - (gnus-agent-expire): Update active file. + * gnus-msg.el (gnus-inews-do-gcc): Update summary data when the + group is open. - * mm-decode.el (mm-inlinable-part-p): Removed. - (mm-user-display-methods): Default to nil. - (mm-user-display-methods): Removed. - (add-mime-display-method): Removed. - (mm-automatic-display): Renamed. - (mm-automatic-display-p): Use it. - (mm-inlined-types): New variable. - (mm-inlined-p): New function. +2000-11-14 00:48:52 ShengHuo ZHU - * message.el (message-reply): Bind message-this-is-mail. + * gnus-bcklg.el (gnus-backlog-enter-article): Don't enter + nnvirtual articles. + (gnus-backlog-request-article): Don't request nnvirtual articles. -1999-07-03 13:16:31 Michael Klingbeil +2000-11-13 22:08:09 ShengHuo ZHU - * smiley.el (smiley-buffer): Fix for NT. + * mml2015.el (mml2015-mailcrypt-sign): Remove "-" escape. + * mml.el (mml-generate-mime-1): Save cont. skip multipart attributes. -1999-07-03 11:26:47 Lars Magne Ingebrigtsen +2000-11-13 20:43:37 ShengHuo ZHU - * mm-encode.el (mm-encode-buffer): Check whether we have 7bit. + * mm-decode.el (mm-get-part): Don't call mm-insert-part. + * mml.el (mml-generate-mime-1): Use charset attribute. + * mm-bodies.el (mm-encode-body): Add parameter charset. + * mm-util.el (mm-mime-charset): Show error when find 8-bit characters. - * message.el (message-check-news-header-syntax): Protect against - nil froms. +2000-11-13 16:09:09 ShengHuo ZHU - * mm-util.el (mm-auto-mode-alist): New. + * mml2015.el (mml2015-mailcrypt-decrypt): Handle quit. + (mml2015-mailcrypt-clear-decrypt): Ditto. + (mml2015-mailcrypt-verify): Ditto. + (mml2015-mailcrypt-clear-verify): Ditto. + (mml2015-gpg-verify): Ditto. - * mml.el (mml-generate-mime-1): Ditto. +2000-11-13 15:29:58 ShengHuo ZHU - * gnus.el: Use mm-insert-file-contents throughout instead of - nnheader. + * smime.el (smime-openssl-program): Test the existence of openssl. + * mml-smime.el: Require mm-decode. + (mml-smime-verify-test): New function. + * mm-decode.el (mm-verify-function-alist): Use it. - * mm-util.el (mm-insert-file-contents): New function. +2000-11-13 09:50:29 ShengHuo ZHU -Sat Jul 3 07:35:35 1999 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-repair-multipart): Fix Mime-Version + anyway. - * gnus.el: Pterodactyl Gnus v0.90 is released. +2000-11-13 Simon Josefsson -1999-07-03 09:31:10 Sven Fischer + * mm-uu.el (mm-uu-pgp-signed-extract): Explain why clear + verification doesn't work. - * mailcap.el (mailcap-possible-viewers): Use string=. +2000-11-12 23:36:45 ShengHuo ZHU -1999-07-01 Shenghuo ZHU + * gnus-msg.el (gnus-inews-mark-gcc-as-read): New variable. + (gnus-inews-do-gcc): Use it. - * mm-uu.el (mm-uu-forward-begin-line): New variable. - (mm-uu-forward-end-line): New variable. - (mm-uu-begin-line): Handle forwarded message. - (mm-uu-identifier-alist): Ditto. - (mm-uu-dissect): Ditto. +2000-11-12 21:35:04 ShengHuo ZHU -1999-06-29 Shenghuo ZHU + * rfc2231.el (rfc2231-encode-string): Insert semi-colon and + leading space. + * mm-extern.el (mm-inline-external-body): Report error when no + access-type. - * lpath.el: Two free variables. +2000-11-12 19:48:30 ShengHuo ZHU -1999-07-02 Shenghuo ZHU + * gnus-sum.el (gnus-select-newsgroup): Change the error message. - * nnheader.el (nnheader-file-coding-system): Use raw-text. - * gnus-agent.el (gnus-agent-file-coding-system): Ditto. - * gnus-cache.el (gnus-cache-coding-system): Ditto. +2000-11-12 11:53:18 ShengHuo ZHU - * nnfolder.el (nnfolder-file-coding-system): Use mm-text-coding-system. - (nnfolder-file-coding-system-for-write): New variable. - (nnfolder-active-file-coding-system): New variable. - (nnfolder-active-file-coding-system-for-write): New variable. - (nnfolder-save-active): New function. - (nnfolder-save-buffer): Use them. - (nnfolder-possibly-change-group): Ditto. - (nnfolder-request-list-newsgroups): Ditto. - (nnfolder-request-create-group): Ditto. - (nnfolder-request-expire-articles): Ditto. - (nnfolder-request-move-article): Ditto. - (nnfolder-request-accept-article): Ditto. - (nnfolder-request-delete-group): Ditto. - (nnfolder-request-rename-group): Ditto. - (nnfolder-possibly-change-folder): Ditto. - (nnfolder-read-folder): Ditto. - (nnfolder-request-list): Remove pathname-coding-system. - (nnfolder-possibly-change-group): Use nnmail-pathname-coding-system. + * gnus-art.el (gnus-mime-button-menu): Use select-window. - * nnmail.el (nnmail-file-coding-system): Use raw-text. - (nnmail-file-coding-system-1): Removed. - (nnmail-find-file): Use nnmail-pathname-coding-system. - (nnmail-write-region): Ditto. +2000-11-12 09:47:54 ShengHuo ZHU - * nnmbox.el (nnmbox-file-coding-system): New variable. - (nnmbox-file-coding-system-for-write): New variable. - (nnmbox-active-file-coding-system): New variable. - (nnmbox-active-file-coding-system-for-write): New variable. - (nnmbox-save-buffer): New function. - (nnmbox-save-active): New function. - (nnmbox-request-scan): Use them. - (nnmbox-request-expire-articles): Ditto. - (nnmbox-request-move-article): Ditto. - (nnmbox-request-accept-article): Ditto. - (nnmbox-request-replace-article): Ditto. - (nnmbox-request-delete-group): Ditto. - (nnmbox-request-rename-group): Ditto. - (nnmbox-request-create-group): Ditto. + * gnus-art.el (gnus-mime-display-part): Display multipart/related + as multipart/mixed. - * mm-util.el (mm-text-coding-system): raw-text or -dos. - (mm-running-ntemacs): Removed. +2000-11-12 David Edmondson + + * message.el (message-cite-prefix-regexp): moved from gnus-cite.el + and replace `.' with `\w' to allow for different syntax tables + (from Vladimir Volovich). + * message.el (message-newline-and-reformat): use + `message-cite-prefix-regexp'. + * gnus-cite.el (gnus-supercite-regexp): use + `message-cite-prefix-regexp'. + * gnus-cite.el (gnus-cite-parse): use + `message-cite-prefix-regexp'. - * nnml.el (nnml-file-coding-system): Use nnmail-file-coding-system. +2000-11-12 08:52:46 ShengHuo ZHU -1999-07-02 Shenghuo ZHU + * mml2015.el (mml2015-mailcrypt-verify): Replace armors with + PGP SIGNATURE. Escape leading "-"'s. + (mml2015-mailcrypt-sign): Replace armors with PGP MESSAGE. - * nnfolder.el (nnfolder-read-folder): Use nnheader-file-coding-system. +2000-11-11 15:55:35 ShengHuo ZHU -1999-07-01 Shenghuo ZHU + * mm-uu.el (mm-uu-type-alist): Stricter shar regexp. - * qp.el (quoted-printable-encoding-characters): Support lower case. +2000-11-11 Simon Josefsson -1999-07-01 Shenghuo ZHU + * mml2015.el (mml2015-gpg-verify): Set "OK" security status. - * rfc2047.el (rfc2047-encode): Fold before B-encoding. - (rfc2047-b-encode-region): Encode line by line. + * smime.el (smime-details-buffer): New variable. + (smime-sign-region): + (smime-encrypt-region): + (smime-verify-region): + (smime-decrypt-region): Copy OpenSSL output to the buffer. -1999-07-03 09:20:16 Lars Magne Ingebrigtsen + * mml-smime.el (mml-smime-verify): Support security info. - * mm-util.el (mm-find-mime-charset-region): Fix. +2000-11-10 17:11:22 ShengHuo ZHU -1999-06-30 KOSEKI Yoshinori + * mm-decode.el (mm-verify-option): Set default to nil. + (mm-decrypt-option): Ditto. + * gnus-art.el (article-verify-x-pgp-sig): New function. - * mm-util.el (mm-mime-mule-charset-alist): Fix iso-2022-jp(-2) bug. - (mm-find-mime-charset-region): Ditto. +2000-11-10 09:01:25 ShengHuo ZHU -1999-07-03 09:15:35 Simon Josefsson + * gnus-art.el (gnus-mime-display-alternative): Show button if no + preferred part. - * gnus-sum.el (gnus-summary-move-article): Fix something or - other. +2000-11-07 Kai Gro,A_(Bjohann -1999-06-29 Shenghuo ZHU + * gnus-sum.el (gnus-move-split-methods): Say that + `gnus-split-methods' uses file names, whereas this uses group + names. (Report from Nevin Kapur) - * gnus-sum.el (gnus-newsgroup-ephemeral-charset): New variable. - (gnus-newsgroup-ephemeral-ignored-charsets): New variable. - (gnus-summary-enter-digest-group): Use them. - (gnus-summary-setup-default-charset): Ditto. +2000-11-10 01:23:20 ShengHuo ZHU + + * mm-partial.el (mm-inline-partial): Insert MIME-Version. -1999-06-15 Shenghuo ZHU +2000-11-09 17:02:50 ShengHuo ZHU - * base64.el (base64-run-command-on-region): Use unibyte buffer. + * nnheader.el (nnheader-directory-files-is-safe): New variable. + (nnheader-directory-articles): Use it. + (nnheader-article-to-file-alist): Ditto. -1999-06-15 Shenghuo ZHU +2000-11-09 16:20:37 ShengHuo ZHU - * gnus-msg.el (gnus-configure-posting-styles): Fix bug when - gnus-newsgroup-name is nil. + * rfc2047.el (rfc2047-pad-base64): New function. + (rfc2047-decode): Use it. -1999-06-15 Shenghuo ZHU +2000-11-09 08:53:04 ShengHuo ZHU - * rfc2047.el (rfc2047-encode): Chop the tail newline. + * gnus-srvr.el (gnus-browse-foreign-server): Bind the original + select method. -1999-06-15 Shenghuo ZHU +2000-11-08 19:58:58 ShengHuo ZHU - * gnus-art.el (article-emphasize): Use correct - gnus-article-emphasis-alist. + * mml2015.el (mml2015-gpg-decrypt-1): + (mml2015-gpg-verify): buffer-string has no argument in Emacs. -1999-06-15 Shenghuo ZHU +2000-11-08 16:37:02 ShengHuo ZHU - * mm-view.el (mm-inline-text): Fix text/html bug. + * gnus-cache.el (gnus-cache-generate-nov-databases): Reopen cache. -Mon Jun 28 17:54:01 1999 Lars Magne Ingebrigtsen +2000-11-08 08:38:30 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.89 is released. + * pop3.el (pop3-munge-message-separator): A message may have an + empty body. + +2000-11-07 18:02:26 ShengHuo ZHU -1999-06-24 Shenghuo ZHU + * mm-uu.el (mm-uu-type-alist): Don't test pgp stuff. + (mm-uu-pgp-encrypted-extract): Clean mml2015 buffer. + (mm-uu-pgp-signed-extract): Use coding-system. - * nnmail.el (nnmail-file-coding-system-1): For NTEmacs in Windows. - * message.el (message-draft-coding-system): Ditto. - * mm-util.el (mm-running-ntemacs): Ditto. +2000-11-07 14:33:19 ShengHuo ZHU -1999-06-23 Shenghuo ZHU + * gnus-art.el (gnus-mime-display-part): Show MIME security button. + (gnus-insert-mime-security-button): New function. + * mm-decode.el (mm-possibly-verify-or-decrypt): Add security info. + * mml2015.el: Add security info when verify or decrypt. + * mm-uu.el (mm-uu-pgp-signed-extract): Use multipart. + (mm-uu-pgp-encrypted-extract): Ditto. - * gnus-xmas.el (gnus-xmas-summary-recenter): A blank line may - cause problem. +2000-11-07 08:49:36 ShengHuo ZHU -1999-06-23 Shenghuo ZHU + * mm-decode.el (mm-display-parts): New function. + * gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first. - * mm-view.el (mm-inline-text): Ignore error in w3-region. +2000-02-02 Alexandre Oliva -1999-06-23 Shenghuo ZHU + * gnus-mlspl.el: Documentation tweaks. + +2000-11-06 22:06:44 ShengHuo ZHU - * mml.el: require mm-decode. + * mm-decode.el (mm-possibly-verify-or-decrypt): Fix. + * gnus-art.el (gnus-article-encrypt-body): Rename and support prefix + argument. -1999-06-23 Shenghuo ZHU +2000-11-06 19:10:14 ShengHuo ZHU - * gnus-art.el (gnus-display-mime): Treat as head only if necessary. + * rfc2231.el (rfc2231-encode-string): Use us-ascii if charset is nil. -1999-06-23 Shenghuo ZHU +2000-11-06 18:17:53 ShengHuo ZHU - * mm-view.el (mm-inline-image): Fix image undisplayer. + * gnus-art.el (gnus-article-encrypt): New function. + (gnus-article-encrypt-protocol-alist): New variable. + (gnus-article-encrypt-protocol): New variable. + * mml2015.el (mml2015-self-encrypt): New function. + (mml2015-mailcrypt-encrypt): Set mc-pgp-always-sign. -1999-06-22 Shenghuo ZHU +2000-11-06 16:02:52 ShengHuo ZHU - * mml.el (mml-insert-multipart): Error in compeling-read. - (mml-insert-tag): Match tags. + * mm-uu.el (mm-uu-gpg-key-skip-to-last): New function. + (mm-uu-pgp-key-extract): Use application/pgp-keys, don't snarf, + let mailcap do it. + * mml2015.el: Remove snarf code. + * mm-decode.el: Remove snarf code. -1999-06-19 Shenghuo ZHU +2000-11-06 14:03:10 ShengHuo ZHU - * gnus-cache.el (gnus-cache-braid-nov): Fix coding-system bug. - (gnus-cache-braid-heads): Ditto. - (gnus-cache-retrieve-headers): Ditto. + * mml.el (mml-insert-mml-markup): Ignore internal stuff. + (mml-insert-mime): Understand gnus-decoded. + (mime-to-mml): New parameter handles. + * gnus-art.el (gnus-mime-save-part-and-strip): Use it. + * gnus-sum.el (gnus-summary-edit-article): Add argument `3'. -1999-06-16 Shenghuo ZHU +2000-11-06 13:51:37 ShengHuo ZHU - * gnus-draft.el (gnus-draft-send): Fix encoding bug. + * mm-decode.el (mime-security): New group. + (mm-verify-function-alist): Add test function. + (mm-decrypt-function-alist): Ditto. + (mm-snarf-option): Set default value as nil. + (mm-find-part-by-type): Recursive parameter. + (mm-possibly-verify-or-decrypt): Support draft-ietf-openpgp-multsig. + * mml2015.el: Support draft-ietf-openpgp-multsig. -1999-06-16 10:17:29 Katsumi Yamaoka +2000-11-06 13:01:27 ShengHuo ZHU - * gnus-art.el (gnus-article-read-summary-keys): Convert key events - to string under XEmacs. + * gnus-art.el (gnus-mime-view-part-as-charset): New function. + (gnus-article-view-part-as-charset): New function. -1999-06-28 19:34:03 Petersen Jens-Ulrik +2000-11-05 22:34:07 ShengHuo ZHU - * gnus-start.el (gnus-find-new-newsgroups): Doc fix. + * mm-decode.el (mm-verify-option): Default value. + (mm-possibly-verify-or-decrypt): Dealing with broken messages. -1999-06-22 Shenghuo ZHU +2000-11-05 15:06:05 ShengHuo ZHU - * mm-view.el (mm-inline-message): Fix message view bug. - * gnus-art.el (gnus-article-prepare): Ditto. + * nnvirtual.el (nnvirtual-request-expire-articles): Uncompress range. -1999-06-16 Shenghuo ZHU +2000-11-05 Simon Josefsson - * gnus-cache.el (gnus-cache-possibly-enter-article): Fetch headers. + * mml-smime.el (mml-smime-verify): Work in original multipart + buffert. -Tue Jun 15 04:13:01 1999 Lars Magne Ingebrigtsen + * mm-decode.el (mm-handle-multipart-original-buffer): New macro. + (mm-handle-multipart-ctl-parameter): Ditto. + (mm-alist-to-plist): New function. + (mm-dissect-buffer): Store CTL parameters and copy original buffer + for multiparts. + (mm-destroy-parts): Destroy multipart buffert. + (mm-remove-part): Ditto. - * gnus.el: Pterodactyl Gnus v0.88 is released. + * mml-smime.el (mml-smime-sign): Not used. + (mml-smime-encrypt): Ditto. -1999-06-15 04:13:45 Lars Magne Ingebrigtsen + * mm-decode.el (mml-smime-verify): Autoload mml-smime. - * gnus-sum.el (gnus-summary-save-parts): Destroy handles after - usage. + Verify S/MIME signature support. + + * mm-decode.el (mm-inline-media-tests): Add + application/{x-,}pkcs7-signature. + (mm-inlined-types): Ditto. + (mm-automatic-display): Ditto. + (mm-verify-function-alist): Ditto. Add name of method. + (mm-decrypt-function-alist): Add name of method. + (mm-find-part-by-type): Add documentation. + (mm-possibly-verify-or-decrypt): Use new format of + mm-{verify,decrypt}-function-alist. Use method names. - * nnmail.el (nnmail-get-new-mail): Save info. + * mml-smime.el (mml-smime-verify): New function. -Mon Jun 14 01:15:59 1999 Lars Magne Ingebrigtsen +2000-11-04 20:38:50 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.87 is released. + * mm-view.el (mm-inline-text): Move point to the end of inserted text. -1999-06-14 02:46:05 Lars Magne Ingebrigtsen +2000-11-04 19:07:08 ShengHuo ZHU - * mail-source.el (mail-source-fetch-file): Use prescript-delay. - (mail-source-run-script): New function. - (mail-source-fetch-pop): Use it. + * 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. -1999-06-13 09:52:11 Lars Magne Ingebrigtsen +2000-11-04 13:08:02 ShengHuo ZHU - * gnus-art.el (gnus-article-setup-highlight-words): Moved here. + * mm-util.el (mm-subst-char-in-string): New function. + (mm-replace-chars-in-string): Use it. + * message.el (message-replace-chars-in-string): Use it. + * nnheader.el (nnheader-replace-chars-in-string): Use it. + * gnus-mh.el (mh-lib-progs): Shut up. -Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen +2000-11-04 ShengHuo Zhu - * gnus.el: Pterodactyl Gnus v0.86 is released. + * base64.el, md5.el: Moved to contrib directory. -1999-06-13 08:51:25 Lars Magne Ingebrigtsen +2000-11-04 11:13:56 ShengHuo ZHU - * gnus-art.el (gnus-treat-translate): New variable. - (gnus-treat-predicate): Accept a list of regexps. - (gnus-article-treat-custom): Allow a list of regexps. + * gnus-sum.el (gnus-summary-search-article-forward): Don't move + the last article when search. -1999-06-09 Markus Rost +2000-11-04 10:34:29 ShengHuo ZHU - * gnus/gnus-group.el (gnus-permanently-visible-groups): Fix custom - type. + * nnheader.el (nnheader-pathname-coding-system): Default iso-8859-1. + * nnmail.el (nnmail-pathname-coding-system): Ditto. -1999-06-13 05:15:52 Lars Magne Ingebrigtsen +2000-09-29 David Edmondson - * gnus-art.el (article-babel): Narrow a bit. + * message.el (message-newline-and-reformat): Typo. - * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow. +2000-11-04 10:11:05 ShengHuo ZHU -1999-06-12 Simon Josefsson + * rfc2231.el (rfc2231-decode-encoded-string): Test mm-multibyte-p. - (gnus-agent-get-undownloaded-list): Operate on all articles, not - only unread ones. - (gnus-agent-fetch-headers): Fetch headers from unread and marked - articles, not only unread ones. +2000-11-04 09:53:42 ShengHuo ZHU -1999-06-13 03:01:35 Lars Magne Ingebrigtsen + * nntp.el (nntp-decode-text): Delete bogus status lines. - * gnus-sum.el (gnus-summary-limit-to-extra): New command and - keystroke. +2000-11-03 Stefan Monnier - * gnus-art.el (gnus-article-x-face-command): Ditto. + * message.el (message-font-lock-keywords): Match a final newline + to help font-lock's multiline support. + +2000-11-04 09:11:44 ShengHuo ZHU - * gnus-uu.el (gnus-uu-default-view-rules): Default to "display". + * nnoo.el (nnoo-set): New function. - * gnus.el (gnus-method-simplify): Accept server names. +2000-11-04 ShengHuo Zhu -1999-06-13 02:36:15 Per Abrahamsen + * gpg.el, gpg-ring.el: Moved to contrib directory. - * gnus-art.el (article-babel-prompt): New function. - (article-babel): New command. +2000-11-04 Simon Josefsson -1999-06-13 01:01:52 Lars Magne Ingebrigtsen + * nnimap.el (nnimap-split-inbox): Typo. - * gnus-art.el (gnus-article-part-wrapper): Go to part. +2000-11-03 10:46:44 ShengHuo ZHU - * mml.el (mml-generate-mime-1): Don't insert literally. + * gnus-msg.el (gnus-msg-mail): Move it backwards. - * gnus-util.el (gnus-parse-netrc): Skip lines with #'s. - (gnus-netrc-syntax-table): Removed. - (gnus-parse-netrc): Don't use syntax table; just use whitespace. +2000-11-03 Simon Josefsson -Wed May 5 13:51:13 1999 Shenghuo ZHU + * rfc2231.el (rfc2231-parse-qp-string): New function. + (require): rfc2047. - * mm-view.el (mm-inline-text): Fix charset for text/html. + * mail-parse.el (mail-header-parse-content-type): + (mail-header-parse-content-disposition): Support invalid QP + encoded strings, by using `rfc2231-parse-qp-string'. -Wed May 5 01:15:08 1999 Shenghuo ZHU +2000-11-03 08:58:08 ShengHuo ZHU - * message.el (message-draft-coding-system): Use emacs-mule-dos. + * rfc2231.el (rfc2231-parse-string): Decode when there is no number. + (rfc2231-decode-encoded-string): Typo "> X 1". + (rfc2231-encode-string): Insert the name of charset. + * mail-parse.el (mail-header-encode-parameter): Use RFC2231. -1999-06-12 07:29:39 Lars Magne Ingebrigtsen +2000-11-02 23:35:50 ShengHuo ZHU - * nnmail.el (nnmail-split-incoming): Return the number of split - mails. - (nnmail-process-babyl-mail-format): Ditto. - (nnmail-process-unix-mail-format): Ditto. - (nnmail-process-mmdf-mail-format): Ditto. - (nnmail-process-maildir-mail-format): Ditto. + * mm-decode.el (mm-save-part): Return the filename. + * gnus-sum.el (gnus-summary-edit-article): Remove a hack. + * gnus-art.el (gnus-mime-save-part-and-strip): New function. + (gnus-mime-action-alist): Use it. + (gnus-mime-button-commands): USe it. + * mm-extern.el (mm-extern-local-file): Error when the file is gone. + (mm-inline-external-body): unwind-protect. - * mail-source.el (mail-source-callback): Return the number from - the callback. +2000-11-02 21:08:49 ShengHuo ZHU - * message.el (message-send-mail): Generate Lines. + * gnus-art.el (gnus-insert-mime-button): Show url. - * mail-source.el (mail-source-call-script): New function. - (mail-source-call-script): New function. +2000-11-02 19:51:19 ShengHuo ZHU -Sun May 2 02:00:27 1999 Shenghuo ZHU + * mml.el (mml-generate-mime-1): Support external url. + * nnwarchive.el (nnwarchive-mail-archive-article): Use external url. - * gnus-sum.el (gnus-summary-setup-highlight-words): New function. - (gnus-select-newsgroup): Use it. - (gnus-group-highlight-words-alist): New variable. - (gnus-newsgroup-emphasis-alist): New variable. - (gnus-summary-local-variables): Use it. - * lpath.el: Use it. - * gnus-art.el (article-emphasize): Use it. - (gnus-emphasis-highlight-words): New face. - * gnus-cus.el (gnus-group-parameters): New parameter. +2000-11-02 16:53:32 ShengHuo ZHU -Sun May 2 01:00:02 1999 Shenghuo ZHU + * mm-partial.el (mm-inline-partial): Buffer name with a leading space. + * mm-decode.el (mm-display-external): Ditto. + * mm-extern.el: New file. + * mm-decode.el (mm-inline-media-tests): Hook it up. + (mm-inlined-types): Inline message/external-body. - * gnus-cache.el (gnus-cache-possibly-enter-article): Remove - parameter `headers'. - (gnus-cache-enter-article): Ditto. - (gnus-cache-update-article): Ditto. - * gnus-sum.el (gnus-summary-move-article): Ditto. - (gnus-summary-mark-article-as-unread): Ditto. - (gnus-summary-mark-article): Ditto. +2000-11-02 Simon Josefsson -1999-06-12 03:59:56 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-visible-headers): Add Mail-Followup-To. - * gnus-msg.el (gnus-message-insert-stylings): Removed. - (gnus-posting-style-alist): Removed. - (gnus-message-style-insertions): Ditto. - (gnus-configure-posting-styles): Reimplementation. + * message.el (message-get-reply-headers): Better handling when + Mail-Followup-To is very large. + +2000-11-02 13:27:56 ShengHuo ZHU - * mail-source.el (mail-source-fetch): Error the message. + * gnus-uu.el (gnus-uu-post-news): Comment out the redundancy. + * gnus-art.el (gnus-article-edit-done): + * gnus-sum.el (gnus-summary-edit-article-done): Move line + counting code here. + * gnus-msg.el (gnus-setup-message): Remove a hack. - * gnus-msg.el (gnus-inews-do-gcc): Do mml and encoding. +2000-11-02 09:33:01 ShengHuo ZHU -Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-newsgroup-variables): New variable. + (gnus-summary-mode): Make them local variables. + (gnus-set-global-variables): Globalize them. + (gnus-summary-exit): Kill them. - * gnus.el: Pterodactyl Gnus v0.85 is released. +2000-11-02 Hrvoje Niksic -1999-04-20 Michael Cook + * rfc2047.el (rfc2047-encoded-word-regexp): Allow empty encoded + word. - * gnus-cite.el (gnus-cite-attribution-prefix): Tweak for MS - Outlook citation regex. +2000-11-01 10:07:13 ShengHuo ZHU -1999-06-12 02:09:49 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-mime-display-part): Add to signed or encrypted. + gnus-article-wash-types. + * gnus-art.el (gnus-article-wash-status): Use them. - * nndoc.el (nndoc-mime-parts-type-p): Accept space before - semicolon. +2000-11-01 08:54:11 ShengHuo ZHU -1999-05-24 Simon Josefsson + * mml.el (mml-read-tag): Remove spaces and LF. - * gnus-range.el (gnus-remove-from-range): Document range1 - modification, protect range2. +2000-11-01 08:01:03 ShengHuo ZHU -1999-05-24 Simon Josefsson + * mml2015.el (mml2015-mailcrypt-encrypt): Use from and sign parameters. + * mml.el (mml-generate-mime-1): Add sender and recipients attributes. - * gnus-sum.el (gnus-update-marks): Protect lists from - gnus-remove-from-range, don't sort twice. +2000-11-01 07:39:24 ShengHuo ZHU -1999-05-21 Simon Josefsson + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): New function. - * gnus-start.el (gnus-read-descriptions-file): Protect if no - function in backend. +2000-10-31 22:06:13 ShengHuo ZHU -1999-05-15 Simon Josefsson + * gnus-sum.el (gnus-article-charset): New variable. + (gnus-summary-display-article): Set it. + * gnus-msg.el (gnus-copy-article-buffer): Use it. + * gnus-art.el (gnus-article-mode): Make it local variable. - * gnus-sum.el (gnus-valid-move-group-p): Check for a - request-accept-article function in the backend instead of using - the 'respool capability. +2000-11-01 01:12:29 Lars Magne Ingebrigtsen -1999-04-18 Hrvoje Niksic + * nnultimate.el (nnultimate-create-mapping): Use nreverse. - * mm-bodies.el (mm-decode-content-transfer-encoding): Handle - spurious whitespace at eob. +2000-10-31 23:45:31 Lars Magne Ingebrigtsen -1999-06-12 02:02:06 Adrian Aichner + * nnwfm.el: New file. - * nnmail.el (nnmail-get-new-mail): Check right variable. + * nnweb.el (nnweb-replace-in-string): New function. -1999-06-12 01:57:39 Karl Kleinpaste +2000-10-31 17:32:02 ShengHuo ZHU - * mailcap.el (mailcap-mime-data): Fix rfc822. + * mml2015.el: Wrap gpg.el. + * gpg.el (gpg-verify): The last argument of apply is a list. + (gpg-encrypt): Add passphrase as a parameter. -1999-06-11 23:48:50 TOZAWA Akihiko +2000-10-31 17:28:45 ShengHuo ZHU - * nndoc.el (nndoc-nsmail-type-p): New function. - (nndoc-type-alist): Recognize nsmail. + * gpg.el: New file. + * gpg-ring.el: New file. -1999-05-12 Mike McEwan +2000-10-31 11:44:29 ShengHuo ZHU - * gnus-art.el (gnus-treatment-function-alist): Display `x-face' - *before* `article-hide-headers' deletes the information. + * gnus-sum.el (gnus-summary-show-article): Fix the summary line. -1999-05-22 00:26:46 Lars Magne Ingebrigtsen +2000-10-31 Katsumi Yamaoka - * gnus-sum.el (gnus-summary-save-parts): New command and - keystroke. - (gnus-summary-save-parts-1): New function. - (gnus-summary-iterate): Buggy. + * gnus-sum.el (gnus-summary-insert-line): Work with quoted + double-quote characters. + (gnus-summary-prepare-threads): Ditto. - * mm-decode.el (mm-save-part-to-file): Made into own function. +2000-10-31 08:36:03 ShengHuo ZHU -1999-05-11 05:53:16 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-mime-display-single): Forward line -1. + * mml.el (mml-read-tag): Don't skip the leading space. + * lpath.el (font-lock-set-defaults): Shut up. - * gnus-group.el (gnus-group-set-info): Resist nils. +2000-10-31 00:04:35 ShengHuo ZHU -1999-05-04 19:26:08 Lars Magne Ingebrigtsen + * mml2015.el: Fix doc. Remove bogus mml2015-setup. - * mailcap.el (mailcap-mime-data): Ditto. +2000-10-30 23:37:07 ShengHuo ZHU - * gnus-uu.el (gnus-uu-default-view-rules): Ditto. + * qp.el (quoted-printable-encode-region): Replace leading - when + ultra safe. + * mml.el (mml-generate-mime-postprocess-function): Removed. + (mml-postprocess-alist): Removed. + (mml-generate-mime-1): Use ultra-safe when sign. + * mml2015.el (mml2015-fix-micalg): Uppercase. + (mml2015-verify): Insert LF. + (mml2015-mailcrypt-sign): Downcase; search backward. - * gnus-art.el (gnus-article-x-face-command): Default to ee. +2000-10-16 11:36:52 Lars Magne Ingebrigtsen -1999-05-02 Gareth Jones + * nnultimate.el (nnultimate-forum-table-p): Be a bit more + restrictive. + (nnultimate-table-regexp): New variable. + (nnultimate-forum-table-p): Use it. - * gnus-art.el (article-make-date-line): Put X-Sent below Date if - gnus-article-date-lapsed-new-header is t. +2000-10-30 Ed L Cashin -Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-expire-articles): Save point. - * gnus.el: Pterodactyl Gnus v0.84 is released. +2000-10-30 08:52:50 ShengHuo ZHU -1999-05-01 22:23:21 Lars Magne Ingebrigtsen + * mml-sec.el (mml-pgpmime-sign-buffer): Use mml2015-sign. + (mml-pgpmime-encrypt-buffer): Use mml2015-encrypt. - * gnus-msg.el (gnus-bug-message): Mime change. +2000-10-30 08:38:12 ShengHuo ZHU -1999-04-22 Simon Josefsson + * mml2015.el: Shut up. - * gnus-sum.el (gnus-update-marks): Process null mark lists. +2000-10-30 08:17:46 ShengHuo ZHU -1999-04-21 Hrvoje Niksic + * gnus.el (gnus-server-browse-hashtb): Removed. + * gnus-group.el (gnus-group-prepare-flat-list-dead): Use gnus-active. + (gnus-group-insert-group-line-info): Use simplified method. + * gnus-srvr.el (gnus-browse-foreign-server): Use gnus-set-active. - * mm-bodies.el (mm-decode-content-transfer-encoding): Recognize - `x-uue'. +2000-10-30 01:52:40 ShengHuo ZHU -1999-03-04 Aaron M. Ucko + * gnus-util.el (gnus-union): Renamed from gnus-agent-union, and + moved here. + * gnus-agent.el (gnus-agent-fetch-headers): Use it. + * gnus-group.el (gnus-group-prepare-flat): Use it. + * gnus-topic.el (gnus-group-prepare-topics): Use it. - * mail-source.el (mail-source-fetch-pop): Only prompt for password - when authentication is 'password. +2000-10-30 01:23:49 ShengHuo ZHU -1999-05-01 22:17:55 + * mml.el (mml-mode): Show menu in XEmacs. - * gnus-win.el (gnus-configure-windows): Accept a setting. +2000-10-30 00:49:33 ShengHuo ZHU -1999-04-21 20:51:13 Lars Magne Ingebrigtsen + * gnus-srvr.el (gnus-server-browse-in-group-buffer): New variable. + (gnus-server-read-server-in-server-buffer): New function. + (gnus-browse-foreign-server): Browse in group buffer. + * gnus-group.el (gnus-group-prepare-flat): List group not in list. + (gnus-group-prepare-flat-list-dead): Use gnus-group-insert-group-line. + * gnus-topic.el (gnus-group-prepare-topics): Ditto. + * gnus.el (gnus-server-browse-hashtb): New variable. - * mm-util.el (mm-quote-arg): Moved here. +2000-10-29 22:31:40 ShengHuo ZHU - * mm-decode.el (mm-quote-arg): Quote more chars. + * nnfolder.el (nnfolder-open-nov): Use group. -1999-04-18 20:12:49 Lars Magne Ingebrigtsen +2000-10-29 17:23:15 ShengHuo ZHU - * nnheader.el (nnheader-parse-head): Message-ID in In-Reply-To - with newlines would create buggy .nov files. + * nnfolder.el: Add NOV. Set version to 2.0. + (nnfolder-nov-is-evil): If non-nil, nnfolder acts like 1.0. - * gnus-art.el (gnus-article-date-lapsed-new-header): Default to nil. +2000-10-29 10:35:08 ShengHuo ZHU - * qp.el (quoted-printable-encode-region): Encode whitespace at the - end of lines. + * mml2015.el (mml2015-mailcrypt-sign): Use mc-sign-generic. - * message.el (message-mode): Doc fix. +2000-10-29 09:42:05 ShengHuo ZHU - * gnus-art.el (article-hide-headers): Delete the hidden headers. + * gnus-srvr.el (gnus-browse-foreign-server): Show level mark. + (gnus-browse-unsubscribe-group): Unsubscribed is not killed. - * gnus-msg.el (gnus-setup-posting-charset): Default group to "". +2000-10-29 08:28:58 ShengHuo ZHU - * gnus-art.el (article-date-ut): Rewrite. + * nnfolder.el (nnfolder-read-folder): Don't goto point-min. - * mm-decode.el (mm-preferred-alternative-precedence): Reverse the - order. +2000-10-28 19:11:01 ShengHuo ZHU - * gnus-msg.el (gnus-message-insert-stylings): Remove duplicate - headers. + * mm-decode.el (mm-verify-function-alist): New variable. + (mm-verify-option): New variable. + (mm-decrypt-function-alist): Ditto. + (mm-decrypt-option): Ditto. + (mm-find-raw-part-by-type): New function. + (mm-possibly-verify-or-decrypt): New function. + (mm-dissect-multipart): Use it. + * mml2015.el (mml2015-fix-micalg): New function. + (mml2015-decrypt): Use new interface. + (mml2015-verify): Use new interface. + (mml2015-setup): Make it bogus. - * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix. +2000-10-28 16:54:45 ShengHuo ZHU -1999-04-18 Didier Verna + * mml.el (mml-generate-mime-postprocess-function): Set to + mml-postprocess. + (autoload): Autoload mml2015 and mml-smime. + (mml-postprocess-alist): Use mml2015-sign and mml2015-encrypt. + * mml2015.el (mml2015-encrypt): New function. + (mml2015-sign): New function. + (mml2015-encrypt-function): New variable. + (mml2015-sign-function): New variable. + (mml2015-mailcrypt-encrypt): Use message-recipients. + (mml2015-setup): Don't set mml-generate-mime-postprocess-function. + * mml-smime.el (mml-smime-setup): Ditto. - * gnus-art.el (gnus-article-date-lapsed-new-header): new variable. - (article-date-ut): use it. +2000-10-28 Simon Josefsson -1999-04-18 20:06:20 Lars Magne Ingebrigtsen + * imap.el (imap-parse-resp-text-code): Workaround bug in Stalker + Communigate Pro 3.3.1 server. - * mail-source.el (mail-source-fetch-pop): Call script - asynchronously. + * mml-sec.el (mml-smime-encrypt-buffer): Support certfiles stored + in buffers. + (mml-secure-dns-server): Removed. + (mml-secure-part-smime-encrypt-by-dns): Use DIG interface. Don't + write certificates to files. -Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen + * smime.el (smime-dns-server): New variable. + (smime-mail-to-domain): + (smime-cert-by-dns): New functions. - * gnus.el: Pterodactyl Gnus v0.83 is released. + * dig.el: New file. -1999-04-18 10:55:57 Lars Magne Ingebrigtsen +2000-10-28 10:09:41 ShengHuo ZHU - * gnus-draft.el (gnus-draft-mode): Use mml minor mode. - - * gnus-cite.el (gnus-dissect-cited-text): Off-by-one error. - - * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads. - - * gnus-art.el (gnus-mime-inline-part): Don't do a charset param. - - * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp. - - * message.el (message-generate-headers): Accept continuation - headers. - -1999-04-18 10:48:57 Renaud Rioboo - - * gnus-demon.el (gnus-demon-time-to-step): Not strings. - -1999-04-18 08:21:52 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): use - maybe-hide-headers. - - * message.el (message-inhibit-body-encoding): Typo. - (message-resend): Inhibit encoding. - - * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047. - - * gnus-art.el (article-remove-cr): Use re-search. - - * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME - headers. - - * mm-decode.el (mm-quote-arg): Quote '. - - * gnus-ems.el (gnus-x-splash): Would place splash wrongly. - - * mm-decode.el (mm-insert-part): Use multibyte for text. - - * gnus-start.el (gnus-read-newsrc-file): New variable. - (gnus-read-newsrc-file): Use it. - -1999-04-17 18:51:54 Lars Magne Ingebrigtsen - - * nnvirtual.el (nnvirtual-request-expire-articles): New function. - - * gnus-group.el (gnus-group-expire-articles-1): Made into own - function. - -Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.82 is released. - -1999-04-15 Hrvoje Niksic - - * gnus-sum.el (gnus-group-charset-alist): Include Croatian groups - for iso8859-2. - -1999-04-17 18:23:50 Lars Magne Ingebrigtsen - - * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from - synonym alist. - -1999-04-17 18:03:38 Adam P. Jenkins - - * gnus-sum.el (gnus-summary-local-variables): Mark as global. - -1999-04-17 18:02:05 Ettore Perazzoli - - * mail-source.el (mail-source-fetch): Ask before bugging out. - -1999-03-19 Hrvoje Niksic - - * uudecode.el (uudecode-decode-region-external): Don't assume - uudecode-temporary-file-directory ends with a slash. - -1999-03-18 Simon Josefsson - - * gnus-sum.el (gnus-update-marks): - (gnus-update-read-articles): - (gnus-summary-expire-articles): Check server. - -1999-03-16 Simon Josefsson - - * mml.el (mml-preview): New function. - -1999-04-17 17:10:21 William M. Perry - - * mail-source.el (mail-source-fetch-file): Return the right - value. - -1999-04-17 07:52:17 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-parameter): New function. - (mml-insert-parameter-string): New function. - - * nnmail.el (nnmail-get-new-mail): Say how many new articles. - - * gnus-art.el (gnus-mime-multipart-functions): New variable. - (gnus-mime-display-part): Use it. - - * mm-decode.el (mm-alternative-precedence): Removed. - (mm-discouraged-alternatives): New variable. - (mm-preferred-alternative-precedence): New function. - - * nnmail.el (nnmail-get-new-mail): Use mail-sources. - - * mail-source.el (mail-sources): New variable. - - * gnus-art.el (article-remove-cr): Remove several trailing CRs. - - * mm-decode.el (mm-valid-image-format-p): New function. - (mm-inline-media-tests): Use it. - (mm-valid-and-fit-image-p): New function. - - * gnus-agent.el (gnus-agent-fetch-groups): Error when unplugged. - (gnus-agent-fetch-group): Ditto. - -1999-04-12 Didier Verna - - * nnmail.el (nnmail-article-group): in case of a group name - containing "\\n" constructs, be sure to pass the expanded value to - nn*-save-mail. - -Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.81 is released. - -1999-04-16 15:54:02 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-split-value): Reverse result. - -1999-04-03 00:17:24 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-always-read-dribble-file): Doc fix. - -1999-04-02 15:33:43 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-tag): Insert concluding part. - - * message.el (message-send-mail): Encode later. - (message-send-news): Ditto. - - * nnfolder.el: Don't use mail delim. - -1999-03-28 19:14:27 Lars Magne Ingebrigtsen - - * gnus-cus.el (gnus-group-customize): Put point at min. - - * mm-view.el (mm-inline-text): Allow toggling html. - -1999-03-28 17:11:15 William M. Perry - - * mail-source.el: Added prescript and postscript to file. - -1999-03-28 13:46:00 Lars Magne Ingebrigtsen - - * nnmail.el: Reverted. - - * gnus-msg.el (gnus-setup-posting-charset): Didn't work. - (gnus-setup-posting-charset): Did work. - -1999-03-28 13:19:50 Jae-you Chung - - * gnus.el (gnus-short-group-name): Use - gnus-group-uncollapsed-levels. - -1999-03-28 13:11:43 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-dissect-cited-text): Don't remove overlays. - -1999-03-26 13:18:45 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-strip-headers-in-body): New variable. - (article-strip-headers-from-body): New command and keystroke. - -1999-03-14 16:09:10 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-pop): Check for symbol first. - - * nnheader.el (nnheader-insert-file-contents): Bind - enable-local-eval to nil. - (nnheader-find-file-noselect): Ditto. - - * nnmail.el (nnmail-article-group): Don't remove long lines. - (nnmail-remove-long-lines): New function. - (nnmail-split-header-length-limit): Removed. - - * mml.el (mml-generate-mime-1): Use unibyte buffers. - - * gnus-group.el (gnus-group-kill-all-zombies): Query user. - -1999-03-06 07:20:05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-generic-mark): New function. - - * nnmail.el (nnmail-split-header-length-limit): Increased. - (nnmail-article-group): Allow nil. - - * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion. - - * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers - first. - - * mml.el (mml-minibuffer-read-type): Include types from - mailcap-mime-data. - - * nndraft.el (nndraft-request-article): Would clobber Japanese. - -1999-03-05 Hrvoje Niksic - - * mml.el (mml-insert-tag): New function. - (mml-read-file): Renamed to mml-minibuffer-read-file to avoid - confusion with functions like `mml-read-tag'. - (mml-read-type): Ditto with `mml-minibuffer-read-type'. - (mml-minibuffer-read-description): Ditto with - `mml-minibuffer-read-description'. - (mml-attach-buffer): New function. - (mml-mode-map): New entry for /. - (mml-minibuffer-read-type): Accept DEFAULT. - - * mml.el (mml-quote-region): Narrow the region. - - * message.el (message-mode-menu): message-mime-attach-file is now - mml-attach-file. - -1999-03-05 21:24:23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): Do emphasis earlier. - -1999-03-05 21:08:10 Robert Bihlmeyer - - * mml.el (mml-attach-buffer): New command. - -1999-02-27 Simon Josefsson - - * gnus-sum.el (gnus-update-marks): Call gnus-remove-from-range - with a proper range. Compress range. - - * gnus-range.el (gnus-remove-from-range): Protect arguments. - -1999-03-05 20:59:54 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-get-image): Create a temporary file for xbms. - -1999-03-04 04:20:25 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-x-face-file-name): Removed. - (gnus-picons-convert-x-face): Removed. - (gnus-picons-article-display-x-face): Removed. - (gnus-picons-x-face-sentinel): Ditto. - (gnus-picons-display-x-face): Ditto. - -Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.80 is released. - -1999-03-02 16:04:30 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mm-display-part): Narrow to the part itself. - - * gnus-sum.el (gnus-with-article): Moved here. - - * mail-source.el (mail-source-fetch-pop): Ask for password even - when program. - -1999-02-28 13:16:12 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-bug): Add description. - - * mml.el (mml-insert-mml-markup): Insert disposition. - - * message.el (message-send-mail): Always encode mail headers. - - * smiley.el (gnus-smiley-display): Goto body. - -1999-02-28 13:15:47 Petr Konecny - - * smiley.el (gnus-smiley-display): Don't search to blank line. - -1999-02-28 00:38:40 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-article): Only run the highlight stuff - when requested. - - * nnmail.el (nnmail-current-spool): Removed. - - * gnus-salt.el (gnus-tree-inhibit): New varible. - - * gnus.el (mm-util): Required. - -1999-02-27 23:44:52 paul stevenson - - * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first. - -1999-02-27 17:17:47 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-bind): Doc fix. - -1999-02-26 20:35:57 Lars Magne Ingebrigtsen - - * message.el (message-mode): Doc fix. - - * mm-encode.el (mm-content-transfer-encoding-defaults): Use 8bit - encoding. - - * gnus.el (gnus-methods-equal-p): Moved here. - - * mail-source.el: pop at 110. - - * pop3.el (pop3-movemail): Use write-region instead of - append-to-file to avoid excessive messaging. - -1999-02-27 lantz moore - - * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of - type directory. - -1999-03-04 Robert Bihlmeyer - - * gnus-art.el (article-hide-boring-headers): Field names must not - contain whitespace. - -Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.79 is released. - -1999-02-26 18:11:04 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting. - - * mml.el (mml-mode): Don't use add-minor-mode. - - * message.el (messgage-inhibit-body-encoding): New variable. - (message-encode-message-body): Use it. - -Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.78 is released. - -1999-02-26 07:45:30 Lars Magne Ingebrigtsen - - * message.el (message-mode): Switch on MML mode. - - * mml.el: Included commands and functions. - (mml-mode-map): New keymap. - - * message.el: Removed the insertion commands and functions. - - * gnus-ems.el (gnus-mule-cite-add-face): Removed. - - * gnus-sum.el (gnus-summary-sort-by-chars): New command and - keystroke. - - * gnus-art.el (gnus-narrow-to-page): Revert. - - * gnus-cite.el (gnus-cite-delete-overlays): New function. - (gnus-cite-parse-maybe): Always reparse. - - * message.el (message-encode-message-body): Don't insert - "multipart warning". - - * gnus-art.el (gnus-article-treat-head-custom): New variable. - -1999-02-25 Miles Bader - - * mail-source.el (mail-source-fetch-pop): Return 1 for success. - - * nnmail.el: Require mm-util. - -1999-02-26 07:39:33 Justin Sheehy - - * nnmail.el (nnmail-get-new-mail): Only get mail for the one - group. - -1999-02-26 07:38:08 SeokChan LEE - - * mm-bodies.el (mm-body-charset-encoding-alist): Add euc-kr. - -1999-02-21 Simon Josefsson - - * gnus-msg.el (gnus-extended-version): Better regexp. - -1999-02-25 Didier Verna - - * nnmail.el (nnmail-split-it): new syntax: `(! FUNC SPLIT)'. FUNC - is called with the result of SPLIT and should return a new split. - - * gnus.texi: update the doc. - -1999-02-23 Didier Verna - - * gnus-picon.el (gnus-picons-display-bar-p): when picons are - displayed in the article buffer, output bars if - `gnus-picons-display-article-move-p'. - -1999-02-20 Aaron M. Ucko - - * mail-source.el (mail-source-fetch-pop): Typo. - -1999-02-26 07:15:12 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-toggle-header): Save restriction. - -1999-02-23 03:07:58 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-cite-parse-wrapper): Always parse. - -1999-02-21 11:11:39 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-buffer): New function. - - * message.el (message-forward): Insert the buffer in the buffer. - -Sun Feb 21 01:20:50 1999 Shenghuo ZHU - - * mm-view.el (mm-inline-message): Insert part in narrowed region. - -Sat Feb 20 23:09:40 1999 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-toggle-header): Save restriction. - -Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.77 is released. - -1999-02-20 17:32:17 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-displaying-mime): New variable. - (article-narrow-to-head): New function. - - * mail-source.el (mail-source-fetch-pop): Include pre/postscript. - Default to pop instead of pop3. - -1999-02-19 16:16:04 Lars Magne Ingebrigtsen - - * gnus-art.el (article-hide-pgp): Goto body. - - * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer. - - * gnus-cite.el: Don't use goto-line. - - * gnus-art.el (gnus-article-treat-html): Removed. - (gnus-treat-article): Save restriction. - -1999-02-17 Per Abrahamsen - - * message.el (message-send-mail): Don't untabify. - (message-mode): Don't use tabs for indentation. - -1999-02-19 14:54:13 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Don't untabify. - - * nnml.el (nnml-save-mail): Typo fix. - -1999-02-19 Per Abrahamsen - - * message.el (message-cite-function): Add - `message-cite-original-without-signature' customization option. - -1999-02-18 Per Abrahamsen - - * nnmail.el (nnmail-fix-eudora-headers): Mark as option to - `nnmail-prepare-incoming-header-hook'. - -1999-02-19 14:41:43 Justin Sheehy - - * gnus-util.el (gnus-make-sort-function-1): Typo fix. - -1999-02-19 14:40:37 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-get-new-news): Require nnmail. - -1999-02-18 Michael Cook - - * Recognize Microsoft Outlook's cite attribution conventions. - -1999-02-19 14:33:11 James H. Cloos, Jr. - - * gnus-sum.el: Bind M. - -1999-02-19 14:31:29 Neil Crellin - - * mail-source.el (mail-source-fetch-pop): Bind pop3-port. - -1999-02-15 Didier Verna - - * gnus-picon.el (gnus-group-display-picons): ensures that - `article-goto-body' really goes to the article body. - -1999-02-19 12:57:19 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Bind url-standalone-mode. - - * gnus-msg.el (gnus-summary-mail-forward): Create unique names. - - * mm-view.el (mm-view-message): Enable multibyte. - -1999-02-11 18:37:15 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-get-new-mail): Message later. - - * mm-util.el (mm-find-charset-region): Revert to checking - multibyte. - -1999-02-11 Matt Pharr - - * gnus-msg.el (gnus-bug): Encode environment info as a MIME - attachment. - -Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.76 is released. - -1999-02-06 Felix Lee - - * gnus.el (gnus-group-change-level-function): Typo. - -1999-02-11 05:47:51 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-nov-skip-field): Removed. - (gnus-nov-field): Ditto. - (gnus-nov-parse-extra): Ditto. - (gnus-nov-read-integer): Ditto. - -1999-02-05 09:44:20 Katsumi Yamaoka - - * nnheader.el (nnheader-nov-read-message-id): New macro. - (nnheader-parse-nov): Use it. - - * gnus-sum.el (gnus-nov-read-message-id): New macro. - (gnus-nov-parse-line): Use it; use `(eobp)' instead of - `(eq (char-after) ?\n)'. - -1999-02-11 05:16:26 Lars Magne Ingebrigtsen - - * gnus.el (gnus-other-frame): Always pop up a new frame. - -Wed Feb 10 01:03:43 1999 Shenghuo ZHU - - * gnus-range.el (gnus-range-add): Rewrite. - -1999-02-02 18:12:00 Carsten Leonhardt - - * nnmail.el (nnmail-split-incoming): Added detection of maildir - format. - (nnmail-process-maildir-mail-format): New function. - - * mail-source.el (mail-source-fetch-maildir): New function. - (mail-source-keyword-map): Add default for maildir method. - (mail-source-fetcher-alist): Changed "qmail" to "maildir". - -1999-02-10 02:29:28 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetcher-alist): Remove apop. - - * nndoc.el (nndoc-type-alist): Remove MIME-digest. - (nndoc-mime-digest-type-p): Removed. - -1999-02-09 15:25:52 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-read-summary-keys): Set the point - where it is supposed to be. - (gnus-treat-play-sounds): New variable. - - * gnus-sum.el (gnus-newsgroup-ignored-charsets): New variable. - - * gnus-art.el (article-display-x-face): Narrow to head. - (gnus-article-washed-types): New variable. - (article-hide-pgp): Is not a toggle. - (gnus-article-hide-text-type): Save types. - (article-decode-charset): Use it. - - * nnmail.el (nnmail-get-new-mail): Ignore procmail. - - * message.el (message-forward-start-separator): Removed. - (message-forward-end-separator): Removed. - (message-signature-before-forwarded-message): Removed. - (message-included-forward-headers): Removed. - (message-check-news-body-syntax): Don't check forward. - (message-forward): Use MIME. - - * nnvirtual.el (nnvirtual-request-article): Bind - gnus-article-decode-hook to nil. - -1999-02-06 16:55:25 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for - us-ascii. - -1999-02-04 00:00:35 Lars Magne Ingebrigtsen - - * format-spec.el (format-spec): Be more robust. - - * message.el (message-encode-message-body): Default - mail-parse-charset to mail-parse-charset. - - * gnus-sum.el (gnus-summary-edit-article-done): Don't encode. - (gnus-summary-edit-article): Bind mail-parse-charset. - - * mml.el (mml-read-tag): Ignore white space after end of tag. - - * message.el (message-goto-body): Also work in separatorless - articles. - - * mml.el (mml-translate-from-mime): New function. - (mml-insert-mime): Ditto. - (mml-to-mime): New function. - (mime-to-mml): New name. - - * gnus-sum.el (gnus-summary-edit-article): Always select raw - article. - - * gnus-group.el (gnus-group-catchup-current): Unmark groups. - - * gnus-sum.el (gnus-summary-setup-default-charset): Don't - special-case nndraft groups. - -1999-02-03 16:44:19 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers): Bind charset. - (gnus-get-newsgroup-headers): Already bound. - - * message.el (message-encode-message-body): Use posting charset. - - * mm-bodies.el (mm-encode-body): Use MIME charsets. - (mm-body-encoding): Do CTE. - (mm-body-7-or-8): New function. - - * mm-util.el (mm-mime-charset): Always fall back on alist. - (mm-mime-mule-charset-alist): Include katakana-jisx0201. - (mm-mime-mule-charset-alist): Add arabic-*-column. - (mm-find-mime-charset-region): New function. - - * format-spec.el (format-spec-make): New function. - - * mail-source.el (format-spec): Required. - (mail-source-fetch-with-program): Removed. - (mail-source-fetch-with-program): New function. - - * format-spec.el: New file. - -1999-02-03 16:00:41 Tatsuya Ichikawa - - * mail-source.el (mail-source-fetch-with-program): Take optional - parameter. - -1999-02-03 00:31:21 Lars Magne Ingebrigtsen - - * gnus-start.el: Ignore some groups. - (gnus-setup-news): Bind nnmail-fetched-sources. - - * message.el (message-send-mail): Remove all tabs. - - * mm-util.el (mm-find-charset-region): Just check whether - find-charset-region is defined. - -1999-02-02 23:35:20 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-get-new-news): Use - nnmail-fetched-sources. - - * nnmail.el (nnmail-fetched-sources): New variable. - (nnmail-get-new-mail): Use it. - - * mail-source.el (mail-source-fetched-sources): New variable. - (mail-source-fetch): Use it. - -1999-02-02 23:20:20 Mark W. Eichin - - * gnus.el (gnus-getenv-nntpserver): if the file that - gnus-nntpserver-file names has a trailing newline, the - string-match will always match, and thus the file will never be - read. (^ matches start of "line", \\` matches start of "buffer", - which is what was intended...) - -1999-02-02 23:17:40 Kim-Minh Kaplan - - * gnus-picon.el (gnus-picons-parse-filenames): Quote group names. - -1999-01-28 04:15:46 Katsumi Yamaoka - - * gnus-start.el (gnus-read-active-file): Eliminate duplicated - select methods. - -1999-01-27 Simon Josefsson - - * gnus-range.el (gnus-remove-from-range): Sort second argument. - -1999-02-02 10:55:23 Scott Hofmann - - * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd. - -Mon Feb 1 23:23:03 1999 Shenghuo ZHU - - * gnus-cus.el (gnus-group-parameters): Charset as symbol, and fix - a typo. - * gnus-sum.el (gnus-summary-setup-default-charset): Set nndraft's - charset to nil. - * gnus-agent.el (gnus-agent-queue-setup): Remove charset setting. - * gnus-start.el (gnus-start-draft-setup): Ditto. - -1999-02-02 22:13:14 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-directory): Use the predicate. - (mail-source-value): Don't do variables. - - * nnmail.el (nnmail-get-new-mail): Set the predicate. - - * gnus-sum.el (gnus-summary-toggle-header): Fix, and bound to t. - -1999-02-01 Michael Cook - - * Defenestrate spurious ?a. - -1999-02-02 21:59:51 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-pop): Instead use - :authentication. - -1999-02-01 Tatsuya Ichikawa - - * lisp/mail-source.el : Support APOP authentication scheme. - -1999-02-02 21:56:14 Tatsuya Ichikawa - - * pop3.el (pop3-movemail): Return t. - -1999-02-02 21:48:46 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-fold-region): New function. - (rfc2047-encode-message-header): Use it. - -1999-02-02 21:07:27 Hallvard B. Furuseth - - * gnus-sum.el (gnus-group-charset-alist): Add more. - -Mon Feb 1 21:18:00 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.75 is released. - -1999-02-01 21:54:26 Lars Magne Ingebrigtsen - - * gnus-art.el (article-display-x-face): Don't narrow to head. - -1999-02-01 21:48:39 Michael Cook - - * gnus-cite.el (gnus-cited-lines-visible): Accept a cons. - -1999-02-01 20:59:38 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-directory): Ignore - directories. - - * gnus-cus.el (gnus-group-parameters): Addition. - - * gnus-art.el (article-strip-banner): Do symbolic banners. - (article-strip-banner): New keystroke. - -1999-02-01 20:54:32 Michael Cook - - * gnus-art.el (article-strip-banner): New command. - -1999-02-01 20:53:45 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-strip-banners): New variable. - -1999-01-28 05:34:56 Katsumi Yamaoka - - * mail-source.el (mail-source-read-passwd): Use `read-passwd' if it - has been exist. - -Thu Jan 28 01:38:34 1999 Shenghuo ZHU - - * message.el (message-draft-coding-system): Check coding-system. - * mm-util.el (mm-text-coding-system): Ditto. - -1999-01-28 12:11:31 Katsumi Yamaoka - - * mail-source.el (mail-source-fetch-pop): Save excursion. - -1999-01-28 08:14:21 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-movemail-args): Not constant. - (mail-source-movemail-args): Removed. - (mail-source-fetch-with-program): New function. - (mail-source-fetch-pop): Use program and function. - (mail-source-movemail-program): Removed. - - * gnus-art.el (gnus-treat-date-iso8601): New variable. - (gnus-treat-date-user-defined): New variable. - -1999-01-28 08:07:12 Per Abrahamsen - - * nnmail.el (nnmail-fix-eudora-headers): New function. - -1999-01-28 08:05:19 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-encode-body): Use mail-parse-charset. - -1999-01-27 08:06:38 Lars Magne Ingebrigtsen - - * smiley.el (smiley-deformed-regexp-alist): Removed =>. - (smiley-nosey-regexp-alist): Ditto. - - * gnus-art.el (gnus-treatment-function-alist): Do - gnus-article-add-buttons-to-head later. - (gnus-treat-capitalize-sentences): New variable. - (article-capitalize-sentences): New command and keystroke. - - * gnus-group.el (gnus-group-catchup-current): Do group. - - * message.el (message-default-charset): Add group. - -Wed Jan 27 05:24:53 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.74 is released. - -1999-01-27 05:56:29 Lars Magne Ingebrigtsen - - * gnus-art.el (article-fill-long-lines): Renamed. - (article-fill-long-lines): New keystroke. - -1999-01-26 06:35:07 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-setup-posting-charset): Check for group. - - * gnus-group.el (gnus-group-catchup-current): Skip groups now - displayed. - (gnus-group-catchup-current): Be more robus. - - * gnus-sum.el (gnus-summary-select-article): Reselect for showing - headers. - -1999-01-25 Dave Love - - * message.el (message-mode-menu): Add message-mime-attach-file. - (message-mode): Doc fix. - -1999-01-26 05:24:19 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-check-duplication): Insert the mail source - string. - - * mail-source.el (mail-source-fetch-pop): Bind mail-source-string. - (mail-source-fetch-directory): Ditto. - (mail-source-fetch-file): Ditto. - (mail-source-string): New variable. - - * gnus-start.el (gnus-get-unread-articles): Nix out groups over - the level. - - * rfc2047.el (rfc2047-encodable-p): Convert to MIME charsets - before handling. - - * mm-util.el (mm-mime-charset): Use the parameters. - (mm-mime-charset): Removed region paremeters. - - * nnmail.el (nnmail-get-new-mail): Don't message the entire - source. - -1999-01-25 12:05:16 Lloyd Zusman - - * nnmail.el (nnmail-get-split-group): Quote right. - -1999-01-25 05:55:41 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-movemail): Would kill an arbitrary - buffer. - -1999-01-24 03:02:31 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-clear-inboxes-moved): Removed. - (gnus-group-mode): Don't hook. - - * mail-source.el (mail-source-bind): Doc fix. - (mail-source-bind): Take only one param. - - * gnus-art.el (gnus-treat-highlight-signature): typep. - - * mail-source.el (mail-source-movemail): Ignore empty file. - (mail-source-callback): Check before deleting. - - * message.el (message-mime-attach-file): Include name. - -1999-01-23 17:01:12 Lars Magne Ingebrigtsen - - * mm-util.el (mm-read-charset): Return a symbol. - - * mm-view.el (mm-inline-text): Insert signature separator. - - * gnus-art.el (gnus-treat-predicate): New function. - (gnus-treat-article): Allow all types to be checked. - - * gnus-util.el (gnus-or): New function. - (gnus-and): Ditto. - - * gnus-art.el (gnus-mime-display-single): Use override. - - * mm-decode.el (mm-attachment-override-types): New variable. - (mm-attachment-override-p): New function. - - * gnus-picon.el (gnus-group-display-picons): Don't go backward. - -1999-01-23 16:45:06 Andrew J. Cosgriff - - * mm-view.el (mm-inline-text): Do vcards. - -Sat Jan 23 14:23:27 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.73 is released. - -1999-01-23 11:38:36 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-spool-file): Changed to use mail-source. - (nnmail-crash-box, nnmail-use-procmail, nnmail-procmail-directory, - nnmail-procmail-suffix, nnmail-resplit-incoming): Removed. - (nnmail-movemail-program): Removed. - (nnmail-movemail-args): Removed. - (nnmail-pop-password-required): Ditto. - (nnmail-tmp-directory): Ditto. - (nnmail-delete-incoming): Removed. - (nnmail-pop-password, nnmail-moved-inboxes, - nnmail-internal-password, nnmail-move-inbox): Removed. - (nnmail-read-passwd): Ditto. - (nnmail-get-spool-files): Removed. - (nnmail-resplit-incoming): Reinstated. - - * mail-source.el: New file. - -1999-01-23 09:08:31 James H. Cloos, Jr. - - * gnus-art.el (gnus-article-mode-map): Bind backspace. - -1999-01-23 09:05:04 Lars Magne Ingebrigtsen - - * gnus-art.el (article-make-date-line): Fix iso8601 display. - -1999-01-20 02:53:52 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-display-smileys): Check xpm. - - * gnus-picon.el (gnus-group-display-picons): Goto body. - - * gnus.el: Indented all functions; broke long lines; changed all - instances of illegal/legal to invalid/valid. Yes, I'm bored. - -Wed Jan 20 00:50:53 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.72 is released. - -1999-01-20 01:39:48 Lars Magne Ingebrigtsen - - * gnus.el: Cleaned up trailing whitespace. - - * mm-util.el (mm-read-charset): Work. - -1999-01-17 Matt Armstrong - - * gnus-score.el (gnus-score-find-bnews): Match regexp on the - nnheader-translate-file-chars'd group name. - -1999-01-20 01:30:30 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Fold case. - -1999-01-20 01:28:16 Alexei V. Barantsev - - * gnus-xmas.el (gnus-xmas-modeline-glyph): Backquote. - -1999-01-20 00:46:15 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-add): New function. - -1999-01-18 09:40:37 Lars Magne Ingebrigtsen - - * gnus-art.el (article-goto-body-goes-to-point-min-p): New variable. - (article-goto-body): Use it. - (gnus-treat-article): Ditto. - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Remove the - downloaded articles from the downloadeble list. - -1999-01-16 17:31:08 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Bind - mail-parse-charset. - - * mm-util.el (mm-charset-synonym-alist): New variable. - (mm-charset-to-coding-system): Use it. - (mm-charset-coding-system-alist): Removed. - (mm-charset-to-coding-system): Don't use it. - (mm-find-charset-region): Use mail-parse-charset. - - * gnus-art.el (gnus-treatment-function-alist): Use - gnus-article-display-picons. - (gnus-treat-display-xface): Only do if we have xface feature. - (gnus-part-display-hook): New function. - (gnus-treat-article): Use it. - (gnus-treat-article): Use gnus-visual. - - * gnus-msg.el (gnus-setup-posting-charset): Check elem. - - * gnus-art.el (gnus-mm-display-part): Fix the MIME button after - displaying. - - * mm-decode.el (mm-insert-part): Use insert-buffer-substring. - - * gnus-score.el (gnus-score-find-bnews): Protect against invalid - regexp file names. - -Sat Jan 16 03:15:57 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.71 is released. - -1999-01-16 00:13:31 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-image): Don't add a dot. - - * gnus-art.el (gnus-treat-article): New function. - - * gnus.el (gnus-article-display-hook): Removed. - - * gnus-art.el (gnus-article-treat-custom): New variable. - - * gnus-start.el (gnus-ignored-newsgroups-has-to-p): Removed. - - * gnus-msg.el (gnus-setup-posting-charset): Allow variables and - functions. - - * message.el (message-posting-charset): New variable. - (message-send-mail): Use it. - - * gnus-msg.el (gnus-group-posting-charset-alist): Moved here. - (gnus-setup-posting-charset): New function. - (gnus-setup-message): Use it. - - * message.el (message-encode-message-body): Just look for - Content-Type before inserting a new one. - -1999-01-15 23:08:47 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-default-charset): Removed. - - * mail-prsvr.el: New file. - (mail-parse-charset): New variable. - - * gnus-sum.el (gnus-newsgroup-charset): Changed name. - Changed name. - - * gnus.el (gnus-charset): New group. - - * nnmail.el (nnmail-pathname-coding-system): Default to binary. - - * gnus-sum.el (gnus-default-charset): Default to nil. - (gnus-newsgroup-iso-8859-1-forced-regexp): Removed. - (gnus-newsgroup-iso-8859-1-forced): Removed. - - * mm-util.el (mm-known-charsets): Removed. - (mm-default-coding-system): Removed. - (mm-default-charset): Removed. - (mm-read-charset): New function. - - * message.el (message-default-charset): Removed. - - * rfc2047.el (rfc2047-default-charset): Default to nil. - - * mm-util.el (mm-charset-iso-8859-1-forced): Removed. - -Fri Jan 15 20:50:38 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.70 is released. - -1999-01-15 00:06:04 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-save-part): Use mm-get-part. - (mm-insert-part): New function. - (mm-get-part): Use it. - (mm-get-image): Ditto. - (mm-display-external): Ditto. - - * mm-view.el (mm-inline-text): Ditto. - - * gnus-move.el (gnus-move-group-to-server): Protect against nil - ranges. - - * mm-decode.el (mm-display-external): Save the buffer. - (mm-remove-part): Kill it. - - * qp.el (quoted-printable-decode-region): Do the right thing at eobp. - - * nnagent.el (nnagent-request-set-mark): Defined stub. - -1999-01-14 23:05:31 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-load-score-alist): Bind - coding-system-for-read. - - * gnus-sum.el (gnus-summary-exit): Do adaptive scoring before - prepare-exit-hook. - - * mm-view.el (mm-setup-w3): Require w3. - -1999-01-13 Kiyokazu SUTO - - * lisp/nnspool.el (nnspool-retrieve-headers): Protect against empty - body. - -1999-01-14 21:17:35 Lars Magne Ingebrigtsen - - * mm-encode.el: Ditto. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Message the - error. - - * mailcap.el (mailcap-mime-data): SAFER ps. - - * message.el (message-encode-message-body): Always insert a - Content-Type header. - - * mm-decode.el (mm-inline-media-tests): Default all text/* to be - shown inline. - - * mm-view.el (mm-inline-text): Handle all sorts of text. - - * mailcap.el (mailcap-mime-data): non-viewer for viewers that - don't view. - - * mm-decode.el (mm-display-external): Use it. - - * gnus-art.el (gnus-visible-headers): Added bcc, gcc, fcc. - - * mm-decode.el (mm-save-part): Removed double code. - -1999-01-12 Dave Love - - * mm-decode.el (mm-save-part): Avoid doubly-compressed - application/octet-stream .gz & al files with jka-compr. - -1999-01-12 Dave Love - - * gnus-ems.el (gnus-down-mouse-3): New variable. - * gnus-art.el (gnus-mime-button-map): Use it. - (gnus-mime-button-menu): Set the clicked-on buffer initially. - -1999-01-13 19:41:57 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-data): Added ImageMagic and ee. - -1999-01-12 17:34:43 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-kill-buffer): Don't kill article - buffers. - - * gnus-sum.el (gnus-summary-exit): Destroy all MIME. - - * gnus-cache.el (gnus-cache-read-active): Reversed check. - -1999-01-12 17:18:25 Matt Armstrong - - * mml.el (mml-parameter-string): Strip directory component. - -1999-01-12 17:02:58 Lars Magne Ingebrigtsen - - * gnus.el (gnus-use-demon): Removed. - -1999-01-12 05:53:23 Katsumi Yamaoka - - * nnmail.el (nnmail-article-group): Don't infloop. - -1999-01-11 Colin Rafferty - - * gnus-art.el (article-update-date-lapsed): Made it work with - picons, and make it update on all visible frames. - (article-date-ut): Get summary-buffer's current-headers. - -1999-01-12 07:20:31 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-setup-buffer): Don't set major mode. - (gnus-picons-setup-p): New variable. - -1999-01-11 02:13:12 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-split-header-length-limit): Lowered to 512. - -1999-01-04 12:58:13 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit-no-update): Don't use run-hooks. - (gnus-summary-exit-no-update): Use mapcar. - -1999-01-02 14:36:32 Simon Josefsson - - * gnus-agent.el (gnus-category-write): Make directory. - -1998-09-26 19:39:31 Simon Josefsson - - * gnus-sum.el (gnus-update-read-articles): - (gnus-update-marks): Request backend update of mark. - -1999-01-03 15:29:52 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-body-encoding): Use mm-find. - -1999-01-03 15:28:27 Kim-Minh Kaplan - - * gnus-picon.el (gnus-article-display-picons): Fix. - -Sun Jan 3 13:32:02 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.69 is released. - -1999-01-03 06:45:10 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-setup-buffer): Run the hook. - - * gnus-agent.el (gnus-agent-remove-group): New command and - keystroke. - - * rfc2047.el (rfc2047-decode-region): Check for us-ascii. - -1999-01-02 14:12:41 Simon Josefsson - - * gnus-agent.el (gnus-agent-write-servers): Make directory. - -1998-12-26 02:38:01 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Bind current id. - - * mm-decode.el (mm-handle-id): New macro. - (mm-make-handle): Accept id. - (mm-dissect-singlepart): Use it. - -1998-12-23 Matt Pharr - - * message.el (message-cite-original-without-signature): Use - message-signature-separator when searching for signature in - message-cite-original-without-signature. - -1998-12-24 16:25:38 Simon Josefsson - - * gnus.el (gnus-server-to-method): Check named methods. - -1998-12-24 03:27:02 Lars Magne Ingebrigtsen - - * mm-view.el (mm-view-message): Goto point-min. - - * nnmail.el (nnmail-article-group): Don't delete lines, only - shorten them. - - * gnus-msg.el (gnus-configure-posting-styles): Also do nil - values. - - * nnheader.el (nnheader-temp-directory): New variable. - (nnheader-temp-directory): Removed. - -1998-12-22 Jack Vinson - - * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the - list of files to check for mailcap entries under windows-nt. - -1998-12-24 03:02:15 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the - summary buffer exists. - -1998-12-22 Aaron M. Ucko - - * nnsoup.el (nnsoup-store-reply): Remove code to deal with - irrelevant Sun sendmail bug. - (nnsoup-store-reply): Stop mucking with mail-header-separator. - - * message.el (message-send-news): Bind mail-header-separator to - "" when asking backend to post. - -1998-12-22 Karl Kleinpaste - - * mm-uu.el (mm-dissect-disposition): New variable. - (mm-uu-dissect): Use it. - -1998-12-21 21:34:22 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Bind url-current-object. - -1998-12-06 03:05:41 Simon Josefsson - - * gnus-range.el (gnus-remove-from-range): Rewrite. - -1998-12-09 SL Baur - - * gnus-picon.el (annotations): Remove bogus require 'xpm. - -1998-12-18 Hrvoje Niksic - - * message.el (message-encode-message-body): Insert `MIME-Version' - instead of `Mime-Version'. - -1998-12-04 Hrvoje Niksic - - * message.el (message-insert-mime-part): Add the attachment - disposition. - (message-insert-mime-part): Make TYPE and DESCRIPTION optional. - (message-mime-query-type): New function. - (message-mime-query-description): Ditto. - (message-mime-query-file): Ditto. - (message-insert-mime-part): Use them. - (message-mime-insert-external): Use the new stuff. - -1998-12-19 23:02:26 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-split-header-length-limit): New variable. - - * mm-decode.el (mm-dissect-buffer): Check syntax. - - * rfc2231.el (rfc2231-parse-string): Remove check for syntax. - - * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region. - (rfc2047-dissect-region): Ditto. - -1998-12-17 18:36:43 Lars Magne Ingebrigtsen - - * mm-view.el (mm-view-message): Decode charset. - -1998-12-16 16:01:22 Lars Magne Ingebrigtsen - - * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid - CT headers. - -Wed Dec 16 01:44:40 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): Use - mm-uu-*-function. - * mm-uu.el (mm-uu-dissect): Use x-uuencode. - -1998-12-16 10:20:52 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Do MML first. - (message-send-news): Ditto. - -1998-12-15 20:57:18 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-face): New face. - (gnus-picons-try-face): Use it. - -Tue Dec 15 19:17:43 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.68 is released. - -Tue Dec 15 18:28:24 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.67 is released. - -Tue Dec 15 17:31:44 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.66 is released. - -1998-12-13 11:00:43 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-insert-mime-button): Decode description. - -Sat Dec 5 16:50:49 1998 Shenghuo ZHU - - * gnus-art.el (article-decode-encoded-words): Rollback to 0.55. - (gnus-decode-header-methods): Ditto. - (gnus-decode-with-mail-decode-encoded-word-region): Ditto. - -1998-12-13 10:04:39 Lloyd Zusman - - * gnus-xmas.el (gnus-xmas-summary-recenter): Allow numbers. - -1998-12-13 09:32:38 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-mime-headers): Encode description. - - * nnfolder.el (nnfolder-request-expire-articles): Go to the date - line. - - * gnus-sum.el (gnus-default-charset): Doc fix. - -Wed Dec 9 15:18:39 1998 Shenghuo ZHU - - * mm-decode.el (mm-display-part): Forward a line. - -Wed Dec 9 13:30:29 1998 Shenghuo ZHU - - * mm-util.el (mm-running-ntemacs): New variable. - (mm-text-coding-system): Ditto. - * nnmail.el (nnmail-incoming-coding-system): Ditto. - (nnmail-split-incoming): Use nnmail-incoming-coding-system. - -1998-12-13 08:52:45 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-network-display-internal): Don't set - buffer. - - * message.el (message-insert-headers): New command and keystroke. - -1998-12-07 23:42:14 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): Recognize x-xbitmap. - (mm-get-image): Ditto. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Only for - base64, uudecode and binhex. - -Sun Dec 6 21:58:31 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF - in text/plain. - * mm-uu.el (mm-uu-dissect): Use inline. - -1998-12-07 23:19:14 Lars Magne Ingebrigtsen - - * mm-view.el (mm-view-message): New function. - - * mm-encode.el (mm-content-transfer-encoding-defaults): Changed to - qp. - -1998-12-07 Karl Kleinpaste - - * mm-encode.el (mm-content-transfer-encoding-defaults): Add an - entry for message/rfc822 as 8bit. - -1998-12-07 23:16:54 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-extensions): Add patch. - -1998-12-05 Dale Hagglund - - * gnus-sum.el (gnus-summary-display-buttonized): Use prefix - argument to force all multipart/* to look like multipart/mixed. - - * gnus-art.el (gnus-mime-display-multipart-as-mixed): New - variable. - (gnus-mime-display-part): Use it. - -1998-12-07 22:46:37 Lars Magne Ingebrigtsen - - * gnus-draft.el (gnus-draft-send): Only disable checks for - non-interactive use. - (gnus-draft-send-message): Use it. - -Sun Dec 6 19:36:53 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.65 is released. - -1998-12-06 20:11:02 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-prepare-display): Don't init w3. - - * mm-view.el (mm-inline-text): Bind url-standalone-mode here. - -Sat Dec 5 18:35:42 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.64 is released. - -1998-12-05 18:51:13 Lars Magne Ingebrigtsen - - * mm-view.el (mm-setup-w3): Don't load. - - * gnus-msg.el (gnus-setup-message): Set group name. - (gnus-group-mail): Avoid leaking local vars. - - * message.el (message-attach-file): Renamed. - (message-mime-attach-file): Renamed again. - -1998-12-05 Hrvoje Niksic - - * gnus-art.el (article-decode-encoded-words): Bind - rfc2047-default-charset here. - - * gnus-art.el (gnus-insert-mime-button): Nix slashes in file name. - -1998-12-05 18:33:27 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-setup-buffer): Run picons hook. - (gnus-picons-setup-hook): New hook. - -1998-12-05 Per Abrahamsen - - * mailcap.el (mailcap-mime-data): Remove "*" from documentation - string. - (mailcap-mime-extensions): Ditto. Made first sentense fit a - line. - -1998-12-05 17:11:04 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-prepare-display): Setup w3. - (gnus-mime-view-part): Ditto. - (gnus-mime-inline-part): Dotii. - (gnus-mime-externalize-part): Daddo. - (gnus-mime-internalize-part): Tutti frutti. - (gnus-widget-press-button): Da da do. - - * mm-view.el (mm-setup-w3): Require url-vars. - -Fri Dec 4 12:13:12 1998 Shenghuo ZHU - - * message.el (message-draft-coding-system): Fix for XEmacs-NT. - * mm-util.el (mm-find-charset-region): Ditto. - -1998-12-05 16:30:01 Lars Magne Ingebrigtsen - - * message.el (message-send): Don't encode here. - (message-send-mail): But here. - (message-send-news): And here. - -1998-12-04 15:29:02 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-message-insert-stylings): Don't insert twice. - -Fri Dec 4 04:09:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.63 is released. - -1998-12-04 04:59:20 Lars Magne Ingebrigtsen - - * mml.el (mml-base-boundary): Shorten. - - * message.el (message-insert-mime-part): Use default. - - * gnus-art.el (gnus-insert-mime-button): Bind gnus-tmp-type-long. - -1998-12-03 Per Abrahamsen - - * gnus-art.el (gnus-mime-display-alternative): Use (*) for radio - buttons, not [*]. - -1998-12-04 Hrvoje Niksic - - * gnus-art.el (gnus-insert-mime-button): Do proper help-echo. - -1998-12-04 04:48:37 Hrvoje Niksic - - * gnus-art.el (gnus-insert-mime-button): Fix. - -1998-12-03 Hrvoje Niksic - - * message.el (message-insert-mime-part): Nicify prompts. - (message-insert-mime-part): Really delete duplicates. - (message-insert-mime-part): Check against common errors. - (message-insert-mime-part): Fix docstring. - -1998-12-04 04:41:58 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-internalize-part): Bugged out. - -1998-12-03 Hrvoje Niksic - - * gnus-art.el (gnus-mime-button-line-format): Nicify. - (gnus-insert-mime-button): Modify accordingly. - -1998-12-04 01:50:53 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-display-mime): Set window point. - - * mm-decode.el (mm-display-external): Only decode when not - saving. - (mm-alternative-precedence): Prefer multiparts. - (mm-inline-media-tests): Inline multiparts. - - * gnus-picon.el (gnus-picons-next-job-internal): Do bar if asked. - Ignore errors when requiring url. - - * mml.el (mml-quote-region): New command. - - * message.el (message-cite-original): Use it. - (message-cite-original-without-signature): Ditto. - -Thu Dec 3 12:53:58 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.62 is released. - -1998-12-03 13:38:36 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-all-parts): Work with multiparts. - -1998-12-03 Hrvoje Niksic - - * mm-view.el (mm-inline-text): Use `point-min-marker' and - `point-max-marker'. - -1998-12-03 13:22:57 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-extensions): Use image/xpm for xpms. - - * gnus-art.el (gnus-mime-display-single): Check for attachment - before other tests. - -1998-12-03 Didier Verna - - * gnus-msg.el (gnus-configure-posting-styles): find a - posting-style entry in the group parameters, if any, and honor it - at the end. - -1998-12-03 13:03:37 Felix Lee - - * nntp.el (nntp-after-change-function): Fix. - -1998-12-03 12:44:30 Mike McEwan - - * mml.el (mml-generate-mime-1): Insert literally. - -1998-12-03 00:23:17 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-mime-headers): Removed debug. - -1998-12-02 22:22:03 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-show-article): Destroy parts when - prefixed. - - * mm-encode.el (mm-content-transfer-encoding-defaults): Default - application/emacs-lisp to 8bit. - -1998-12-03 Dale Hagglund - - * mm-decode.el (mm-quote-arg): Add quoting of '()', '<>', and '|'. - -Wed Dec 2 20:24:27 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.61 is released. - -1998-12-02 21:12:56 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-1): Skipped parts. - (mml-insert-mime-headers): Nil is a list. - (mml-generate-mime-1): Don't insert literally. - (mml-read-tag): Drop text props. - (mml-read-part): Ditto. - (mml-parse-singlepart-with-multiple-charsets): Ditto. - -Wed Dec 2 20:07:16 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.60 is released. - -1998-12-02 20:11:28 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-1): Don't throw contents away. - -1998-12-02 Hrvoje Niksic - - * mml.el (mml-compute-boundary-1): Regexp-quote the boundary. - -1998-12-02 18:42:24 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-singlepart-with-multiple-charsets): New - function. - (mml-parse-1): Use it. - -Tue Dec 1 23:04:25 1998 Shenghuo ZHU - - * gnus-art.el (gnus-decode-with-mail-decode-encoded-word-region): - Use gnus-newsgroup-default-charset. - (article-decode-encoded-words): Remove charset codes. - * gnus-sum.el (gnus-newsgroup-default-charset): Use - gnus-default-charset. - -1998-12-02 03:14:20 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Don't encode here. - (message-send-news): Nor here. - (message-send): ... but here instead. - - * gnus-picon.el (gnus-picons-display-article-move-p): Changed - default to nil. - (gnus-article-display-picons): Replace From line. - (gnus-group-display-picons): Replace Newsgroups line. - (gnus-picons-display-glyph): Set baseline. - (gnus-group-display-picons): Piconize the entire Newsgroups line. - (gnus-picons-xbm-face): Revert to old, standard colors. - - * message.el (message-fetch-field): Remove text props. - - * gnus-art.el (gnus-article-normalized-header-length): New - variable. - (article-normalize-headers): New command and keystroke. - - * gnus-picon.el (gnus-picons-xbm-face): Changed colors. - -Wed Dec 2 01:43:48 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.59 is released. - -1998-12-02 01:38:31 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-mime-headers): Beep at multiple charsets. - - * gnus-art.el (gnus-mime-copy-part): Set buffer-file-name. - -1998-11-30 Hrvoje Niksic - - * mml.el (mml-generate-mime-1): Handle unquoting end-tags. - -1998-12-02 00:15:30 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-all-images-fit): New variable. - (mm-image-fit-p): Use it. - - * gnus-art.el (gnus-mime-display-single): Use it. - (gnus-mime-internalize-part): New command and keystroke. - - * mm-decode.el (mm-user-automatic-external-display): New - variable. - (mm-automatic-external-display-p): New function. - - * gnus-picon.el (gnus-picons-xbm-face): Default to sensible - colors. - -1998-12-01 23:52:05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-repair-multipart): Reselect article. - - * gnus-art.el (gnus-with-article): Work in the original article - buffer. - (gnus-with-article): Work in read-only groups. - -Tue Dec 1 00:15:36 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-string): Return original string if not - decode. - -Mon Nov 30 23:38:02 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Use mm-make-handle. - -1998-12-01 01:53:49 Fran-Agois Pinard - - * nndoc.el (nndoc-mime-parts-type-p): Do related. - -Tue Dec 1 00:46:20 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.58 is released. - -1998-11-30 Hrvoje Niksic - - * mm-decode.el (mm-get-image): Return a glyph, not an image - specifier. - -1998-11-29 Hrvoje Niksic - - * rfc2047.el (rfc2047-decode): Bind mm-default-charset. - -1998-12-01 01:23:35 Lars Magne Ingebrigtsen - - * mail-parse.el (rfc2045): Required. - -1998-12-01 00:59:53 William M. Perry - - * mm-view.el (mm-inline-text): Remove props. - -1998-12-01 00:18:47 Lars Magne Ingebrigtsen - - * mm-view.el (mm-setup-w3): Protect url-misc. - - * message.el (message-ignored-resent-headers): Remove - Gnus-Warning. - - * mml.el (mml-insert-mime-headers): Use encoding. - (mml-parameter-string): Ditto. - - * rfc2045.el: New file. - (rfc2045-encode-string): New function. - -1998-11-30 23:11:22 Lars Magne Ingebrigtsen - - * mail-parse.el (mail-header-encode-parameter): New function. - - * rfc2231.el (rfc2231-encode-string): New function. - -Mon Nov 30 13:52:50 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-string): New function. - * mm-view.el (mm-inline-text): Use mm-decode-string. - -Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.57 is released. - -1998-11-23 Felix Lee - - * nntp.el (nntp-async-needs-kluge): new setting. - (nntp-async-timer): new var. - (nntp-async-process-list): new var. - (nntp-async-kluge): new function. - (nntp-async-timer-handler): new function. - (nntp-async-wait): new function. - (nntp-async-stop): new function. - (nntp-after-change-function): renamed, and split apart. - (nntp-async-trigger): new function. - (nntp-do-callback): new function. - (nntp-accept-process-output): add optional timeout arg. - - * gnus-async.el (gnus-async-request-fetched-article): fixed. - (gnus-async-wait-for-article): new function. - (gnus-async-with-semaphore): s/asynch/async/. - -1998-11-30 16:54:56 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-with-article): Don't encode. - (gnus-insert-mime-button): Fall back on filename from C-D. - (gnus-mime-display-single): Have dots right on text/plain - attachments. - - * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in - broken parts. - - * gnus-art.el (gnus-with-article): Flush cache and backlog. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Also do - binhex. - - * gnus-sum.el (gnus-summary-reparent-thread): Use new macro. - (gnus-summary-repair-multipart): New command and keystroke. - - * gnus-art.el (gnus-with-article-buffer): New macro. - -Sun Nov 29 23:51:57 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-inline-part): Do not get part when - undisplay the part. - -1998-11-30 03:38:35 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-make-sort-function-1): Allow lambdas. - - * mml.el (mml-read-part): Partition right. - - * mm-decode.el (mm-handle-set-cache): New macro. - (mm-handle-cache): Ditto. - (mm-make-handle): Ditto. - (mm-dissect-singlepart): Use it. - (mm-get-image): Use the cache. - -1998-11-29 23:44:44 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-mixed): Rewrite. - (gnus-mime-display-single): Don't insert lines between parts. - -Sun Nov 29 04:55:40 1998 Shenghuo ZHU - - * nnmail.el (nnmail-file-coding-system-1): New variable. - * nnfolder.el (nnfolder-file-coding-system): Ditto. - (nnfolder-read-folder): Use nnfolder-file-coding-system. - * nnml.el (nnml-file-coding-system): New variable. - (nnml-request-article): Use nnml-file-coding-system. - -Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.56 is released. - -1998-11-29 00:52:53 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-part): New function. - (gnus-mime-display-mixed): Use it. - - * mm-view.el (mm-setup-w3): Don't register. - - * message.el (message-cite-original): Cite parts. - -1998-11-28 23:51:25 Lars Magne Ingebrigtsen - - * mml.el (mml-parameter-string): New function. - (mml-insert-mime-headers): Separated into new function. - -1998-11-28 Hrvoje Niksic - - * mml.el (mml-make-boundary): Use `make-string'. - -1998-11-27 Hrvoje Niksic - - * binhex.el (binhex-insert-char): Ditto. - - * base64.el (base64-insert-char): Ditto. - - * uudecode.el (uudecode-insert-char): Code correctly. - -1998-11-28 01:08:19 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime): Don't generate multiparts for - empties. - - * gnus-art.el (gnus-display-mime): Save excursion. - - * message.el (message-remove-first-header): New function. - (message-encode-message-body): Use it. - -Fri Nov 27 12:26:10 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.55 is released. - -1998-11-27 12:38:52 Lars Magne Ingebrigtsen - - * mm-view.el (mm-setup-w3): New function. - - * mm-decode.el (mm-content-id-get-contents): New function. - (mm-content-id-get-type): Ditto. - (mm-content-id-get-encoding): Ditto. - (mm-get-handle-by-content-id): Removed. - -1998-11-25 Colin Rafferty - - * message.el (message-generate-new-buffers): Fix tag. - -1998-11-25 10:43:28 Lars Magne Ingebrigtsen - - * message.el (message-buffer-name): Check for unique first. - - * gnus-art.el (gnus-unbuttonized-mime-type-p): use - gnus-inhibit-mime-unbuttonizing. - - * gnus-sum.el (t): Bind M-t. - (gnus-inhibit-unbuttonizing): New variable. - (gnus-summary-toggle-display-buttonized): New command. - - * gnus-art.el (gnus-display-mime): Select article window. - (article-strip-trailing-space): New command and keystroke. - - * nneething.el (nneething-include-files): New variable. - (nneething-create-mapping): Use it. - - * nntp.el (nntp-possibly-change-group): Use nntp-send-command. - - * nnvirtual.el (nnvirtual-request-update-mark): Only yodate - ayto-expirable marks. - -1998-11-24 21:00:02 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-all-parts): Set buffer. - - * gnus-sum.el (gnus-summary-display-buttonized): Don't pass on - ARG. - - * gnus-art.el (gnus-article-mode-line-format): Doc fix. - -Tue Nov 24 14:57:41 1998 Shenghuo ZHU - - * mm-util.el (mm-binary-coding-system): New variable. - (mm-with-unibyte-buffer): Use mm-binary-coding-system. - * mm-decode.el (mm-display-external): Ditto. - -Tue Nov 24 10:43:06 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.54 is released. - -1998-11-24 11:21:32 Katsumi Yamaoka - - * gnus-sum.el (gnus-newsgroup-default-charset-alist): Note fj. - -1998-11-24 11:14:54 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-save-part): Unquote. - -1998-11-24 11:14:39 Matt Armstrong - - * mm-decode.el (mm-save-part): Bind coding system for write. - -1998-11-24 10:42:30 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode-line-format): New default. - (gnus-article-mime-part-status): New function. - - * message.el (message-send-news): Check the body syntax before - encoding. - - * gnus-art.el (gnus-unbuttonized-mime-type): New function. - (gnus-mime-display-single): Use it. - (gnus-mime-display-alternative): Ditto. - - * mm-decode.el: Check for whether we are running under a term. - -1998-11-22 08:12:25 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-preferred-alternative): Default to first - alternative. - (mm-preferred-alternative): No, we dont. - -Tue Nov 24 03:01:48 1998 Shenghuo ZHU - - * mm-decode.el (mm-display-external): Use binary instead of - no-conversion. - * gnus-agent.el (gnus-agent-file-coding-system): Ditto. - * nnheader.el (nnheader-file-coding-system): Ditto. - * mm-util.el (mm-with-unibyte-buffer): Use binary instead of nil. - -Mon Nov 23 01:51:57 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-newsgroup-setup-default-charset): Use group - name without method. - -Mon Nov 23 01:26:40 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-newsgroup-default-charset): Rename - coding-system -> default-charset. - (gnus-newsgroup-default-charset-alist): Ditto. - (gnus-summary-local-variables): Ditto. - (gnus-set-global-variables): Ditto. - (gnus-get-newsgroup-headers): Ditto. - (gnus-summary-from-or-to-or-newsgroups): Ditto. - (gnus-get-newsgroup-headers-xover): Ditto. - (gnus-newsgroup-setup-default-charset): Ditto. - (article-decode-mime-words): Ditto. - (article-decode-charset): Ditto. - (article-decode-encoded-words): Ditto. - (article-de-quoted-unreadable): Ditto. - (gnus-mime-view-all-parts): Ditto. - (gnus-mime-externalize-part): Ditto. - (gnus-mm-display-part): Ditto. - (gnus-mime-display-single): Ditto. - (gnus-mime-display-alternative): Ditto. - * lpath.el : Ditto. - -Mon Nov 23 00:54:33 1998 Shenghuo ZHU - - * rfc2047.el (rfc2047-decode-region): Do not decode nil charset. - * gnus-art.el (article-decode-charset): Overlay - rfc2047-default-charset. - * message.el (message-draft-coding-system): New variable. - (message-set-auto-save-file-name): Use message-draft-coding-system. - * nndraft.el (nndraft-request-article): Ditto. - * gnus-start.el (gnus-start-draft-setup): Set charset nil. - * gnus-agent.el (gnus-agent-queue-setup): Ditto. - -Sun Nov 22 04:42:22 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-test): New function. - (mm-uu-dissect): Inherit charset and cte from head. - * gnus-art.el (article-decode-charset): Use mm-uu-test. - -Sat Nov 21 09:57:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.53 is released. - -1998-11-21 05:54:19 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-get-image): New function. - (mm-image-fit-p): New function. - - * gnus-xmas.el (gnus-xmas-annotation-in-region-p): Ditto. - - * gnus-util.el (gnus-annotation-in-region-p): New definition. - - * gnus-art.el (gnus-article-insert-newline): New function. - (article-goto-body): New function. - -1998-11-20 10:34:04 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-single): Insert blank line before - buttons. - - * gnus-sum.el (gnus-summary-display-buttonized): New command and - keystroke. - - * gnus-art.el (gnus-mime-display-single): Don't insert a blank - line between parts. - - * message.el (message-remove-header): Go to end if wanted. - -1998-11-20 Karl Kleinpaste - - * gnus-art.el (gnus-mime-display-alternative): Avoid window - movement with save-window-excursion. - -Fri Nov 20 03:50:30 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-inline-part): Use argument as charset. - -Fri Nov 20 03:37:53 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-body): Remove buffer-file-coding-system. - -Fri Nov 20 01:20:38 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use - gnus-newsgroup-coding-system. - (gnus-get-newsgroup-headers): Ditto. - (gnus-get-newsgroup-headers-xover): Ditto. - (gnus-set-global-variables): Ditto. - * gnus-art.el (article-decode-mime-words): Ditto. - (article-decode-charset): Ditto. - (article-decode-encoded-words): Ditto. - (article-de-quoted-unreadable): Ditto. - (gnus-mime-view-all-parts): Ditto. - (gnus-mime-externalize-part): Ditto. - (gnus-mm-display-part): Ditto. - (gnus-mime-display-alternative): Ditto. - (gnus-mime-display-single): Ditto. - * mm-view.el (mm-inline-text): Use default coding system. - -Fri Nov 20 00:54:37 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-newsgroup-coding-system-alist): New variable. - (gnus-newsgroup-iso-8859-1-forced-regexp): New variable. - (gnus-newsgroup-coding-system): New local variable. - (gnus-newsgroup-iso-8859-1-forced): New local variable. - (gnus-summary-local-variables): Add two new local variables. - (gnus-newsgroup-setup-coding-system): New function. - (gnus-select-newsgroup): Setup coding system. - * lpath.el: Add two new variables. - * mm-util.el (mm-charset-iso-8859-1-forced): New variable. - (mm-charset-to-coding-system): Use mm-charset-iso-8859-1-forced. - * gnus-cus.el (gnus-group-parameters): Customizable - iso-8859-1-forced. - -Fri Nov 20 05:30:26 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.52 is released. - -1998-11-20 04:32:23 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-encode-message-header): Encode the default - encoding. - - * gnus-art.el (gnus-mime-display-single): Insert buttons for - undisplayed text types. - - * mm-decode.el (mm-automatic-display-p): Only prefer inlinable - types. - -1998-11-19 Felix Lee - - * nntp.el (nntp-after-change-function-callback): recover from C-g. - -1998-11-19 Felix Lee - - * gnus-async.el (gnus-asynch-obarray): rename to - gnus-async-hashtb, and don't buffer-local it. - - (gnus-async-article-callback): new function. - (gnus-make-async-article-function): use it. - - (gnus-async-current-prefetch-group): new var. - (gnus-async-current-prefetch-article): new var. - (gnus-async-request-fetched-article): are we fetching it already? - - (gnus-async-delete-prefected-entry): s/prefected/prefetched/ - -1998-11-20 02:49:21 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-show-article): Require. - - * message.el: Provide before hooks. - (message-send-news): Do MIME before headers. - - * gnus-art.el (gnus-article-check-buffer): New function. - (gnus-article-read-summary-keys): Use it. - - * mm-decode.el (mm-user-automatic-display): Display all inline - images. - - * gnus-art.el (gnus-mime-display-single): Don't buttonize so - much. - (gnus-unbuttonized-mime-types): New variable. - -1998-11-19 06:29:03 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t. - - * mm-decode.el (mm-quote-arg): Quote semicolons. - - * gnus-art.el (gnus-mime-display-single): Don't display - attachments. - (gnus-mime-externalize-part): New command and keystroke. - - * mm-decode.el (mm-dissect-buffer): Pass on the description info. - (mm-alternative-precedence): Changed order. - -1998-11-07 17:41:47 Simon Josefsson - - * gnus.el (gnus-method-simplify): New function. - (gnus-native-method-p): New function. - (gnus-secondary-method-p): Use gnus-method-equal. - - * gnus-start.el (gnus-group-change-level): Shorten select method. - -Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.51 is released. - -1998-11-19 04:02:34 Lars Magne Ingebrigtsen - - * gnus.el: Applied patches from 5.6.45. - - * gnus-score.el (gnus-score-find-trace): Print complete file - paths. - (gnus-score-find-trace): Truncate lines. - - * gnus.el (gnus-message-archive-group): Allow function. - - * message.el (message-encode-message-body): Remove Mime-Version - before inserting. - - * gnus-cus.el (gnus-group-customize): Optional topic. - - * gnus-sum.el (gnus-summary-customize-parameters): New command and - keystroke. - -Wed Nov 18 13:46:08 1998 Shenghuo ZHU - - * message.el (message-encode-message-body): Rewrite. - -1998-11-18 07:37:47 Lars Magne Ingebrigtsen - - * mml.el (mml-base-boundary): New variable. - (mml-make-boundary): New function. - - * gnus-cache.el (gnus-cache-coding-system): New variable. - (gnus-cache-request-article): Use it. - - * message.el (message-insert-mime-part): Delete duplicates. - -Wed Nov 18 11:52:19 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-display-alternative): Set end of - multipart and display even when nothing is preferred. - -Wed Nov 18 05:06:44 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.50 is released. - -1998-11-18 04:42:01 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): Check that device-type is - fbound. - - * gnus-sum.el (gnus-summary-sort): Didn't do reverse. - -1998-11-07 23:39:48 Simon Josefsson - - * gnus.el (gnus-similar-server-opened): Compare backend. - -1998-11-08 03:37:42 Simon Josefsson - - * gnus-topic.el (gnus-topic-expire-articles): New function. - (gnus-topic-mode-map): Bind it. - - * gnus.texi (Topic Commands): New expiry command. Reordered. - -1998-11-10 Miles Bader - - * gnus-sum.el - (gnus-auto-expirable-marks): New variable. - (gnus-inhibit-user-auto-expire): New variable. - (gnus-summary-mark-article-as-read, gnus-summary-mark-article): - When looking to see if we should expire instead, check - gnus-auto-expirable-marks instead of using a hard-wired list. - (gnus-summary-mark-as-read-forward, - gnus-summary-mark-as-read-backward): - Pass gnus-inhibit-user-auto-expire for the no-expire argument to - gnus-summary-mark-forward, instead of `t'. - -1998-11-18 03:30:26 Lars Magne Ingebrigtsen - - * mml.el (mml-compute-boundary): New function. - (mml-compute-boundary-1): New function. - (mml-generate-mime-1): Use it. - -1998-11-18 Hrvoje Niksic - - * mml.el (mml-generate-mime-1): Always precede closing boundary - with newline. - -1998-11-18 02:36:37 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime-1): Do right boundaries when several - multiparts. - - * mm-decode.el (mm-user-automatic-display): Default to inline - jpeg. - - * mml.el (mml-generate-mime-1): Encode non-text parts. - -Wed Nov 18 02:22:23 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.49 is released. - -1998-11-18 00:37:43 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Require w3-vars. - - * gnus-setup.el (gnus-use-tm): Removed. - - * gnus-art.el (gnus-article-goto-part): Don't beep. - (gnus-article-view-part): Check return value. - (gnus-mime-display-alternative): Don't display when there is - nothing to display. - - * mml.el (mml-generate-mime-1): Don't use a unibyte buffer. - (mml-generate-mime-1): Use unibyte for binaries. - - * gnus-art.el (gnus-display-mime): Call - gnus-article-mime-part-function. - (gnus-mime-part-function): New function. - (gnus-article-mime-part-function): New function. - - * mml.el (mml-generate-mime-1): Don't insert so many newlines. - -1998-11-16 06:44:19 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime-1): Do it in unibyte buffers. - - * message.el (message-font-lock-keywords): Highlight MML. - (message-mml-face): New font. - -Mon Nov 16 23:34:12 1998 Shenghuo ZHU - - * gnus-art.el (gnus-display-mime): Clean up even when no handles. - (gnus-mm-display-part): Do not select-window if the article window - is not found. - -Mon Nov 16 02:26:40 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m. - -Mon Nov 16 02:00:05 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.48 is released. - -1998-11-15 23:18:56 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-encode-body): Disbabled for nonmule. - - * mm-util.el (mm-find-charset-region): Bogus change for non-Mule. - - * message.el (message-cite-original-without-signature): Ditto. - (message-cite-original): Quote parts. - -Sun Nov 15 22:01:55 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.47 is released. - -1998-11-15 20:11:33 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Insert MIME warning. - - * mml.el (mml-read-tag): Look for #tag. - - * mm-util.el (mm-find-charset-region): Check whether - enable-multibyte-characters is bound. - -Sun Nov 15 02:01:31 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.46 is released. - -1998-11-15 01:54:40 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Insert headers at the - right spot. - -Sun Nov 15 01:13:41 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.45 is released. - -1998-11-15 00:28:49 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-save-mime-part): Removed. - (nndraft-get-mime-part): Ditto. - - * message.el (message-format-mime-old): Removed. - (message-encode-message-body): Removed. - (message-encode-message-body): Renamed. - -1998-11-14 18:27:19 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers): Translate \r's. - - * message.el (message-format-mime): Check message-mime-part. - - * mm-encode.el (mm-mime-file-types): Removed. - (mm-default-file-encoding): New definition. - -Sat Nov 14 01:29:39 1998 Shenghuo ZHU - - * mm-view.el (mm-inline-image): Use mm-insert-inline. - * gnus-art.el (gnus-mm-display-part): Go to correct position. - -Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.44 is released. - -1998-11-14 03:59:14 Lars Magne Ingebrigtsen - - * message.el (message-format-mime): New function. - - * nndraft.el (nndraft-save-mime-part): New function. - (nndraft-get-mime-part): New function. - - * mm-encode.el (mm-default-file-encoding): New function. - (mm-content-transfer-encoding): New function. - (mm-encode-buffer): New function. - - * message.el: New command. - (message-mime-part): New variable. - (message-insert-mime-part): New command. - - * mm-encode.el (mm-encode-content-transfer-encoding): New - function. - - * mm-util.el (mm-content-transfer-encoding-defaults): New - variable. - (mm-mime-file-types): Taken from TM. - -Sat Nov 14 01:51:06 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.43 is released. - -1998-11-07 Karl Kleinpaste - - * gnus-cus.el (gnus-score-customize): Add "Extra" element. - * gnus-score.el (gnus-score-default-header): Ditto. - (gnus-header-index): Ditto. - (gnus-summary-increase-score): Ditto, & process "extra" requests. - (gnus-summary-header): Handle extra headers. - (gnus-summary-score-entry): Ditto, & provide new score element. - (gnus-summary-score-effect): Ditto. - (gnus-score-string): Avoid "extra" string sort, & modify match in - "extra" case. - * gnus-sum.el (gnus-make-score-map): Add "extra" element. - -1998-11-13 20:30:40 Lars Magne Ingebrigtsen - - * message.el (message-resend): Bind message-required-mail-headers - to nil. - - * mm-view.el (mm-inline-text): Bind w3-strict-width. - - * nngateway.el (require): Require cl. - - * gnus-art.el (gnus-button-alist): Exclude more chars from news: - things. - -Wed Nov 11 02:15:06 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-headers): Create directory even - when no articles. - -1998-11-13 19:25:10 Lars Magne Ingebrigtsen - - * message.el (message-ignored-resent-headers): Remove X-Gnus. - -1998-11-10 Colin Rafferty - - * gnus-sum.el (gnus-ignored-from-addresses): Only quote - user-mail-address if non-nil. - -1998-11-13 18:50:18 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-make-sort-function): Do `reverse'. - (gnus-make-sort-function-1): Ditto. - - * gnus-art.el (gnus-mm-display-part): Switch to mm in right - window. - -1998-11-12 22:31:58 Lars Magne Ingebrigtsen - - * mm-util.el (mm-with-unibyte-buffer): Ditto. - - * binhex.el (binhex-decode-region): Quote. - -1998-11-10 05:32:28 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-charset): Don't downcase charset. - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Translate CR's. - -Sun Nov 8 23:17:24 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.42 is released. - -Sun Nov 8 02:36:33 1998 Shenghuo ZHU - - * gnus-art.el (gnus-display-mime): Add id for alternative part. - -1998-11-08 02:24:47 Simon Josefsson - - * nntp.el (nntp-send-mode-reader): Revert. - -Sun Nov 8 00:45:13 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-articles): Use with-temp-buffer. - -Sat Nov 7 23:07:24 1998 Shenghuo ZHU - - * message.el (message-make-date): Fix for negative time zones. - -Sun Nov 8 01:00:16 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.41 is released. - -1998-11-08 00:52:38 Hrvoje Niksic - - * mm-decode.el (mm-dissect-multipart): Quote regexp. - -1998-10-29 Sudish Joseph - - * gnus.el (gnus-short-group-name): When shortening foreign select - methods, do not scan for plusses beyond the first colon. - -1998-11-07 Mike McEwan - - * gnus-agent.el (gnus-agent-save-group-info): Cater for group info - lines where `group' is the last thing on the line. - -1998-11-08 00:35:09 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-view-part): Do alternative. - (gnus-mime-display-alternative): Insert marker. - -1998-11-07 14:33:46 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-dissect-multipart): Quote regexp. - - * nnmail.el (nnmail-expired-article-p): Protect against bogus - dates. - - * gnus-cus.el (gnus-topic): Required. - - * nnheader.el (nnheader-parse-nov): Parse extra. - (nnheader-nov-parse-extra): New macro. - -1998-10-31 12:33:22 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-view-part): Internal move. - -1998-10-28 Per Abrahamsen - - * gnus-cus-new.el (gnus-custom-topic): New free variable. - (gnus-group-customize): Support editing topic parameters. - -1998-10-29 12:09:20 Karl Kleinpaste - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add - indicators. - -1998-10-29 11:31:11 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mm-display-part): Return. - (gnus-article-view-part): Only go if external. - (gnus-article-dumbquotes-map): Do 205. - - * mm-decode.el (mm-display-part): Return what was done. - - * message.el (message-buffer-naming-style): New variable. - (message-generate-new-buffers): Extended. - (message-buffer-naming-style): Removed. - (message-buffer-name): Use it. - (message-do-send-housekeeping): Rename new styling. - - * gnus-sum.el (gnus-summary-recenter): Allow - gnus-auto-center-summary to be a number. - -Wed Nov 4 02:24:39 1998 Shenghuo ZHU - - * pop3.el (pop3-open-server): Use "binary" instead of - "no-conversion". - -Sun Nov 1 01:26:42 1998 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Set - gnus-browse-current-method to the result of gnus-server-to-method. - -Thu Oct 29 01:47:44 1998 Shenghuo ZHU - - * gnus-util.el (gnus-pull): Another optional argument. - * nnweb.el (nnweb-request-delete-group): Delete from - nnweb-group-alist and update active file. - -Thu Oct 29 01:05:08 1998 Shenghuo ZHU - - * gnus-group.el (gnus-group-make-group): Accept group of new - method. - -Wed Oct 28 02:19:16 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble. - -Tue Oct 27 11:59:31 1998 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Postion of html portion. - -1998-10-29 10:26:54 Lars Magne Ingebrigtsen - - * nntp.el (nntp-list-active-group): Waited for short strings. - (nntp-send-mode-reader): Ditto. - (nntp-open-connection): Ditto. - - * gnus-int.el (gnus-request-group-articles): New function. - - * nntp.el (nntp-request-listgroup): New function. - (nntp-request-group-articles): Renamed. - -1998-10-27 10:37:52 Karl Kleinpaste - - * nnheader.el (nnheader-parse-nov): Supply extra. - -1998-10-26 23:03:48 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-push): Don't go to - gnus-article-buffer. - - * mm-view.el (mm-inline-image): Add a newline. - - * gnus-start.el (gnus-check-first-time-used): Check more. - -1998-10-26 23:03:29 Francois Felix Ingrand - - * gnus-start.el (gnus-check-first-time-used): Check current. - -1998-10-26 22:07:52 Lars Magne Ingebrigtsen - - * mm-util.el (mm-find-charset-region): New function. - - * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header. - - * gnus-art.el (gnus-mime-button-menu): Fix. - -1998-10-26 22:07:43 Michael Welsh Duggan - - * gnus-art.el (gnus-mime-button-menu): New definition. - -1998-10-26 01:46:11 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-charset): Downcase charset. - (article-decode-charset): Pass on type. - (article-decode-charset): Check nil charsets. - (article-remove-cr): Translate CR to LF. - (gnus-ignored-mime-types): Default to nil. - - * nnheader.el (nnheader-insert-nov): Work when not Xref. - - * gnus-sum.el (gnus-ignored-from-addresses): Default to - user-mail-address. - (gnus-nov-parse-extra): Didn't return right thing. - -1998-10-25 23:25:27 Lars Magne Ingebrigtsen - - * gnus-xmas.el: Use compiled-function-p. - -Mon Oct 26 14:37:19 1998 Shenghuo ZHU - - * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header. - -Sun Oct 25 23:11:44 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.40 is released. - -1998-10-25 21:41:05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-mark-forward): Show thread. - - * gnus-start.el (gnus-check-first-time-used): Ignore dribble. - - * gnus-agent.el (gnus-agent-fetch-group-1): Bind name. - - * nnml.el (nnml-possibly-create-directory): Check before making. - -1998-10-25 19:43:08 Kai Grossjohann - - * nnheader.el (nnheader-insert-nov): Don't infloop. - -1998-10-25 19:26:11 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-set-mode-line): Check that the spec has been - set up. - -1998-10-25 19:22:03 Joerg Lenneis - - * nneething.el (nneething-file-name): New definition. - -1998-10-25 17:56:23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): Fix. - (gnus-summary-save-in-rmail): Use gnus-output-to-rmail. - - * nndoc.el (nndoc-dissect-mime-parts-sub): Recognize first part. - -Sun Oct 25 06:23:13 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.39 is released. - -1998-10-25 00:34:39 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-ignored-mime-types): New variable. - (gnus-mime-display-single): Use it. - (gnus-treatment-function-alist): New variable. - - * gnus.el (gnus-mime): New group. - - * gnus-art.el (gnus-mime-display-alternative): Don't destroy - things for other parts. - (gnus-mime-display-alternative): Place point. - - * gnus.el: autoload gnus-uu-post-news. - - * mailcap.el (mailcap-mailcap-entry-passes-test): Also check - needsterm/DISPLAY. - - * mm-decode.el (mm-display-part): Default to inline text/.* - parts. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Default to - 8bit. - - * gnus-art.el (gnus-mime-copy-part): Use normal-mode. - (gnus-mime-display-single): Inline all text parts. - (gnus-article-narrow-to-signature): Removed mime:: stubs. - -1998-10-24 21:38:37 Lars Magne Ingebrigtsen - - * nnml.el (nnml-possibly-create-directory): Rewrite. - (nnml-request-create-group): Change to right server. - - * gnus-xmas.el (gnus-xmas-define): Use byte-code-function-p. - - * gnus-sum.el (gnus-set-mode-line): Use truncate-string-to-width. - - * gnus.el: rmail-output-to-rmail-file autoload. - - * gnus-util.el (gnus-output-to-rmail): Didn't work if not in - Gnus. - - * nnheader.el (nnheader-parse-head): Checked wrong variable. - - * gnus-sum.el (gnus-summary-update-mark): Ignore nil'd marks. - -Tue Oct 20 23:37:43 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-display-mixed): Multipart in - mixed part. - -Tue Oct 20 23:36:43 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. - - * gnus-sum.el (gnus-summary-exit-no-update): Ditto. - -Tue Oct 20 16:22:51 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. - -1998-10-24 20:51:53 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-valid-move-group-p): Make sure group has a - value. - - * gnus-art.el (gnus-article-hidden-text-p): Return nil when not - hidden. - - * gnus-spec.el (gnus-update-format-specifications): Use the - article mode line spec. - - * gnus-art.el (gnus-insert-mime-button): Put right type. - (gnus-insert-prev-page-button): Ditto. - (gnus-insert-next-page-button): Dutti. - - * pop3.el: New version installed. - -Sat Oct 24 16:48:51 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Delete the begining spurious newline - and display last part. - -Sat Oct 24 20:31:55 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.38 is released. - -1998-10-24 07:54:58 Lars Magne Ingebrigtsen - - * gnus-art.el (article-mime-decode-quoted-printable-buffer): - Removed. - (article-de-quoted-unreadable): Narrow to default. - - * qp.el (quoted-printable-encode-region): Encode before QP-ing. - - * gnus-art.el (article-decode-charset): Decode even when broken - MIME. - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Return - name. - - * gnus-msg.el (gnus-copy-article-buffer): Delete headers. - - * gnus-cache.el (gnus-cache-possibly-enter-article): Use - nnheader. - - * nnmail.el (nnmail-extra-headers): New variable. - - * nnheader.el (nnheader-insert-nov): Insert extra. - - * gnus.el (gnus-summary-line-format): Doc fix. - - * gnus-sum.el (gnus-get-newsgroup-headers): Parse extra. - (gnus-nov-parse-line): Ditto. - (gnus-nov-parse-extra): New macro. - (gnus-header): New function. - (gnus-update-summary-mark-positions): Change. - (gnus-ignored-from-addresses): New variable. - (gnus-summary-insert-from-or-to): New function. - - * gnus.el (gnus-extra-headers): New variable. - - * nnheader.el (make-mail-header): Expand. - (mail-header-extra): New macro. - (mail-header-set-extra): Ditto. - (make-full-mail-header): Expand. - -Sat Oct 24 07:41:42 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.37 is released. - -1998-10-24 07:29:11 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-body): Check for multibyticity. - - * mm-util.el (mm-enable-multibyte): Don't always switch multibyte - on. - -1998-10-22 Didier Verna - - * gnus-spec.el (gnus-balloon-face-function): new function - (gnus-parse-format): understand the %< %> specifiers - (gnus-parse-complex-format): ditto. - -1998-10-24 06:31:33 Lars Magne Ingebrigtsen - - * gnus.el: Changed following-char to char-after throughout. - -1998-10-22 04:05:55 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Protect more and message. - -Wed Oct 21 03:26:30 1998 Shenghuo ZHU - - * gnus-xmas.el (gnus-xmas-article-push-button): Go to the - position. - -Tue Oct 20 23:37:43 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-display-mixed): Multipart in - mixed part. - -Tue Oct 20 23:36:43 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. - - * gnus-sum.el (gnus-summary-exit-no-update): Ditto. - -Tue Oct 20 16:22:51 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. - -1998-10-21 Hrvoje Niksic - - * mailcap.el (mailcap-save-binary-file): Use unwind-protect. - - * mm-decode.el (mm-display-external): Set undisplayer to mm - buffer, not the current buffer; use unwind-protect. - -1998-10-21 00:07:59 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit): Destroy parts. - (gnus-summary-exit-no-update): Ditto. - -1998-10-20 22:02:05 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): Look for w3. - - * mailcap.el (mailcap-mime-data): Inline html. - -Tue Oct 20 20:25:03 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.36 is released. - -1998-10-20 18:13:08 Lars Magne Ingebrigtsen - - * gnus-art.el (article-translate-strings): - (gnus-article-dumbquotes-map): Don't dot. - - * pop3.el (pop3-open-server): Set point right. - - * mm-decode.el (mm-dissect-multipart): Dissect hierarchically. - (mm-dissect-buffer): Ditto. - (mm-destroy-part): Ignore non-handles. - (mm-remove-part): Ditto. - (mm-destroy-parts): New function. - (mm-remove-parts): Ditto. - - * gnus-art.el (gnus-mm-display-part): Don't move point. - -Tue Oct 20 02:16:36 1998 Shenghuo ZHU - - * mm-uu.el : New file. - - * gnus-art.el (gnus-display-mime): Dissect uu stuffs. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Encoding as - a function. - -1998-10-20 00:35:05 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Check before selecting. - -Sat Sep 26 02:03:00 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-multi-decode-encoded-word-string): Rewrite. - - * gnus-sum.el (gnus-decode-encoded-word-methods): New variable. - - * gnus-sum.el (gnus-decode-encoded-word-methods-cache): New - variable. - - * gnus-sum.el (gnus-encoded-word-method-alist): Deleted. - - * gnus-art.el (gnus-decode-header-methods): New variable. - - * gnus-art.el (gnus-decode-header-methods-cache): New variable. - - * gnus-art.el (gnus-multi-decode-header): New function. - -Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.35 is released. - -1998-10-20 00:00:36 Lars Magne Ingebrigtsen - - * uudecode.el (uudecode-decode-region-external): Insert - literally. - - * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here. - - * mm-bodies.el (mm-decode-body): Optional encoding. - -1998-10-19 23:57:57 Lars Magne Ingebrigtsen - - * gnus-ems.el (gnus-mouse-3): New variable. - - * binhex.el (binhex-decode-region-external): Don't use -internally. - -1998-10-16 14:54:02 Simon Josefsson - - * mailcap.el (mailcap-parse-mailcaps): Only open regular - files. - -1998-09-26 22:28:01 Simon Josefsson - - * gnus-group.el (gnus-add-marked-articles): Request backend update - of flags. - -1998-09-26 19:39:31 Simon Josefsson - - * gnus-sum.el (gnus-update-read-articles): - (gnus-update-marks): Request backend update of mark. - -1998-09-26 19:33:58 Simon Josefsson - - * gnus.texi (Optional Backend Functions): New item, - nnchoke-request-set-mark. - -1998-09-26 16:27:27 Simon Josefsson - - * gnus-range.el (gnus-remove-from-range): Don't add stuff in - list to range. - -1998-10-19 23:45:13 Simon Josefsson - - * gnus-sum.el (gnus-summary-exit-no-update): Don't expire. - -1998-10-14 SL Baur - - * gnus-sum.el: Move gnus-save-hidden-threads above where it is - first used. - -1998-10-10 SL Baur - - * mm-view.el: Require mm-decode for macros. - - * mm-decode.el (mm-handle-type): Move macro declarations above the - place where they are used. - -Sun Oct 18 13:59:07 1998 Kurt Swanson - - * gnus-msg.el (gnus-summary-mail-forward): Erase old forward - buffer. - -1998-10-19 23:38:11 Katsumi Yamaoka - - * nnagent.el (nnagent-open-server): Error message. - -1998-10-19 23:35:08 Joerg Lenneis - - * nnheader.el (nnheader-article-p): Recognize lower-case headers. - -1998-10-19 Hrvoje Niksic - - * score-mode.el (gnus-score-mode-map): Ditto. - - * message.el (message-mode-map): Ditto. - - * gnus-uu.el (gnus-uu-post-news): Ditto. - - * gnus-kill.el (gnus-kill-file-mode-map): Ditto. - - * gnus-eform.el (gnus-edit-form-mode-map): Ditto. - - * gnus-art.el (gnus-article-edit-mode-map): Use - `set-keymap-parent' rather than `copy-keymap'. - -1998-10-18 Hrvoje Niksic - - * gnus-art.el (gnus-mime-button-commands): New variable. - (gnus-mime-button-map): Initialize it from - `gnus-mime-button-commands'. - (gnus-mime-button-menu): New function. - (gnus-insert-mime-button): Use `gnus-mime-button-map'. - -1998-10-11 Hrvoje Niksic - - * message.el (message-insert-to): Make `nobody' and `poster' - synonymous to `never' and `always' in Mail-Copies-To. - (message-reply): Ditto. - (message-followup): Ditto. - -1998-10-19 23:17:41 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-data): Save sound. - -1998-09-24 Hrvoje Niksic - - * message.el (message-ignored-supersedes-headers): Include - `NNTP-Posting-Date'. - -1998-10-19 01:25:27 Jonas Steverud - - * gnus-art.el (gnus-article-dumbquotes-table): New variable. - -1998-10-19 00:50:22 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-content-transfer-encoding): Use - uudecode. - -1998-10-18 18:20:34 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Don't switch on save. - -1998-10-18 18:14:06 Andy Piper - - * nnmail.el (nnmail-movemail-args): New variable. - -1998-10-18 00:17:02 Lars Magne Ingebrigtsen - - * gnus-art.el (article-translate-strings): - -1998-10-17 22:51:31 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-view-part): Use it. - (gnus-mm-display-part): New function. - (article-de-quoted-unreadable): Yse mm-default-coding-system. - - * mm-decode.el (mm-handle-displayed-p): New function. - - * gnus-art.el (gnus-mime-copy-part): Create better names. - (gnus-mime-button-line-format): Include dots spec. - -1998-10-15 Matt Pharr - - * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old - forward buffer first. - -1998-10-17 21:16:46 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-set-window-start): New function. - - * message.el (message-send): Don't check changed. - -1998-10-12 15:26:41 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-setup-buffer): Set params. - - * mm-decode.el (mm-user-display-methods): Inline - "message/delivery-status". - -1998-10-11 07:06:38 Lars Magne Ingebrigtsen - - * message.el (message-auto-save-directory): Rename. - (message-mode): Dof fix. - - * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat". - (gnus-summary-save-in-pipe): No, check gnus-last-shell-command. - - * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving. - - * message.el (message-make-date): Avoid locale. - - * gnus-art.el (gnus-article-edit-done): Allow update before doing - cache. - - * mm-decode.el (mm-display-inline): Goto point-min. - - * gnus-art.el (gnus-article-prepare-display): Not read-only. - - * mm-decode.el (mm-display-external): Reverse before sorting. - - * gnus-draft.el (gnus-draft-send): Allow mail. - -1998-10-10 -SL Baur - - * message.el (message-check): Move message-check macro above where - it is first used. - - * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line. - -1998-10-11 06:45:37 Lloyd Zusman - - * gnus-sum.el (gnus-summary-make-menu-bar): Fix. - -Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.34 is released. - -1998-10-11 02:15:41 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): delivery-status. - - * mm-view.el (mm-inline-text): Provide default. - -1998-10-11 01:01:37 Lloyd Zusman - - * mailcap.el (mailcap-possible-viewers): Fix nils. - -1998-10-11 00:03:37 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-edit-exit): Don't do updates. - (article-update-date-lapsed): Record the buffer. - (article-update-date-lapsed): Do all windows that display article - buffers. - - * nnml.el (nnml-generate-nov-databases-1): Ditto. - - * gnus-score.el (gnus-score-score-files-1): Ignore dotted files. - - * gnus-art.el (gnus-insert-mime-button): Mark buttons as - annoations. - - * gnus-msg.el (gnus-summary-mail-forward): Decode properly. - -1998-10-10 22:07:03 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-category-add): Change default category to - 'false. - - * nnvirtual.el (nnvirtual-update-read-and-marked): Don't nix out - scores. - - * gnus-draft.el (gnus-draft-send): Check server more. - - * gnus-art.el (gnus-article-view-part): New command and keystroke. - (gnus-article-goto-part): New function. - - * mm-view.el (mm-inline-text): Insert richtext properly. - - * gnus-art.el (gnus-insert-mime-button): Store handle in alist. - -1998-10-03 15:04:27 Lars Magne Ingebrigtsen - - * parse-time.el (parse-time-rules): Accept dates far into the past - and the future, and parse single-digit numbers as years. - -1998-10-02 04:46:46 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Chop off directories. - -1998-10-01 07:33:35 Lars Magne Ingebrigtsen - - * uudecode.el (uu-decode-region-external): Use - insert-file-contents-literally. - - * gnus-cache.el (gnus-cache-generate-active): Translate _ to :. - -1998-10-01 07:02:11 Shenghuo ZHU - - * uudecode.el: New file. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Do - x-uuencode. - -1998-10-01 05:19:35 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-alternative): Set faces. - - * message.el (message-fetch-field): Unfold properly. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF - in text/plain. - -1998-09-30 05:47:49 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-first-unread-subject): New command. - (gnus-auto-select-first): Removed. - (gnus-auto-select-first): Extended. - (gnus-summary-read-group-1): Use new value. - -1998-09-29 13:21:06 Lars Magne Ingebrigtsen - - * message.el (message-fix-before-sending): Space. - - * nnmail.el (nnmail-find-file): Don't erase. - -Wed Sep 30 23:49:03 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-headers): Do not decode headers. - -Wed Sep 30 23:46:29 1998 Shenghuo ZHU - - * gnus-soup.el (gnus-soup-add-article): Do not decode headers. - -Wed Sep 30 23:44:08 1998 Shenghuo ZHU - - * gnus-soup.el (gnus-soup-pack-packet): Pack only if necesary. - -Sat Sep 26 03:04:18 1998 Shenghuo ZHU - - * mm-util.el (mm-with-unibyte-buffer): Make it work in XEmacs - 20.4. - -1998-09-29 11:35:09 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-all-parts): New command and - keystroke. - - * mm-decode.el (mm-display-external): Translate slashes. - - * nnmail.el (nnmail-find-file): Restrict auto-mode-alist. - - * nndraft.el (nndraft-retrieve-headers): Don't copy so much. - - * mm-decode.el (mm-quote-arg): Quote spaces. - (mm-display-external): Quote args. - -1998-09-24 22:27:55 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inlinable-part-p): New function. - -1998-09-25 22:28:01 Simon Josefsson - - * mm-util.el (mm-disable-multibyte): New function. - -Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.33 is released. - -1998-09-24 18:47:31 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-insert-mime-button): Get buffer size. - - * mm-decode.el (mm-display-external): Don't switch for externals. - (mm-dissect-multipart): Don't include end-sep. - - * mm-util.el (mm-get-coding-system-list): New function. - (mm-coding-system-list): New variable. - -Thu Sep 24 02:08:10 1998 ZHU Shenghuo - - * gnus-cus.el (gnus-group-parameters): Add charset as a parameter - -Thu Sep 24 02:05:48 1998 ZHU Shenghuo - - * gnus-cus.el (gnus-group-customize): Use variable as cons not as - group - -Thu Sep 24 01:41:03 1998 ZHU Shenghuo - - * base64.el (base64-run-command-on-region): External base64 - decoder do not use coding system - -Thu Sep 24 01:39:44 1998 ZHU Shenghuo - - * mm-decode.el (mm-interactively-view-part): Typo. - -Thu Sep 24 01:37:30 1998 ZHU Shenghuo - - * mm-decode.el (mm-dissect-multipart): Display last part when the - article has no close-delimiter - -Thu Sep 24 01:28:54 1998 ZHU Shenghuo - - * mm-decode.el (mm-dissect-buffer): Display parts which have no - content-type. - -Thu Sep 24 01:23:57 1998 ZHU Shenghuo - - * gnus-art.el (gnus-display-mime): Typo. - -Thu Sep 24 02:29:57 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.32 is released. - -1998-09-24 00:27:11 Lars Magne Ingebrigtsen - - * gnus-kill.el (gnus-batch-score): Protect against errors. - - * gnus-art.el: Protect against broken headers. - - * mm-decode.el (mm-display-external): Respect needsterm. - (mm-display-external): Create buffer for external commands. - -1998-09-23 22:04:05 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-info): Return the proper viewer. - - * mm-decode.el (mm-display-external): Use file name. - -1998-09-22 Markus Rost - - * gnus-util.el (gnus-output-to-rmail): adjust to - `rmail-output-to-rmail-file' - -1998-09-23 20:07:00 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-output-to-rmail): Reinstated function. - - * gnus-sum.el (gnus-select-newsgroup): Set global variables before - headers. - - * gnus-art.el (article-decode-charset): Fold case. - -1998-09-17 15:49:10 Simon Josefsson - - * mailcap.el (mailcap-save-binary-file): Goto point-min. - -1998-09-23 19:48:52 Aaron M. Ucko - - * nnmail.el (nnmail-check-duplication): Enter into duplicate list - after being stored. - -Tue Sep 15 16:15:16 1998 Kurt Swanson - - * gnus-salt.el (gnus-pick-setup-message): Return from whence ye - come. - -1998-09-23 19:42:03 Lars Magne Ingebrigtsen - - * gnus-xmas.el (wid-edit): Required. - - * gnus-ems.el (gnus-widget-button-keymap): New variable. - -Sun Sep 20 00:27:55 1998 ZHU Shenghuo - - * gnus-art.el (gnus-mime-inline-part): remove part if necessary - -1998-09-23 19:30:52 Matt Armstrong - - * gnus-art.el (article-decode-charset): Narrow to the correct - region. - - * mm-bodies.el: Fix autoload. - -1998-09-22 18:35:12 Lee Willis - - * gnus-art.el (gnus-mime-button-line-format): Doc fix. - -1998-09-22 14:53:35 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-decode): Use rfc2047-default-charset. - -1998-09-19 13:58:35 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-insert-mime-button): Specify keymap. - (gnus-article-add-button): Ditto. - - * gnus-sum.el (gnus-summary-insert-pseudos): Use mm. - - * gnus-art.el (gnus-article-prepare-display): Make article mode. - (gnus-article-prepare-display): Bind url-standalone-mode. - - * mm-decode.el (mm-remove-part): Also delete directory. - (mm-display-external): Create a private sub-dir. - - * mailcap.el (mailcap-binary-suffixes): New variable. - (mailcap-command-p): Use it. - -1998-09-16 10:38:21 Lars Magne Ingebrigtsen - - * nnmbox.el (nnmbox-request-group): Change server. - (nnmbox-possibly-change-newsgroup): Enable multibyte. - - * message.el (message-encode-message-body): Don't stomp MIME - headers. - - * gnus-sum.el (gnus-summary-edit-article-done): Don't encode - unless useful. - (gnus-summary-exit): Check for a live article buffer. - (gnus-summary-exit-no-update): Ditto. - - * gnus-int.el (gnus-request-replace-article): Accept no-encode - param. - - * gnus-sum.el (gnus-article-decoded-p): New variable. - - * mm-decode.el (mm-display-external): Use no-conv. - - * rfc2047.el (rfc2047-q-encode-region): Bound properly. - (rfc2047-charset-encoding-alist): Use B encoding for koi8-r. - - * gnus-art.el (gnus-article-mode-map): Bind button2 to - mouse-click. - -1998-09-15 14:38:02 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-expire): Protect against nil infos. - -Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.31 is released. - -1998-09-14 15:12:59 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit): Destroy MIME. - - * mm-decode.el (mm-display-part): Accept no-default. - - * gnus-art.el (gnus-insert-mime-button): buffer-size doesn't take - a parameter. - - * gnus-sum.el (gnus-summary-insert-line): Don't exclude faces. - (gnus-summary-prepare-threads): Ditto. - - * gnus.el (gnus-article-mode-map): Make sparse keymap. - - * gnus-art.el (gnus-mime-button-line-format-alist): Allow a %d spec. - (gnus-mime-button-line-format): Doc fix. - (gnus-insert-mime-button): Use it. - (gnus-article-add-button): Use widget-convert-button. - - * gnus.el ((featurep 'gnus-xmas)): Defalias gnus-decode-rfc1522 to - ignore. - - * mm-decode.el (mm-alternative-precedence): Ditto. - -1998-09-14 15:12:49 Conrad Sauerwald - - * mm-decode.el (mm-user-automatic-display): Use enriched. - -1998-09-14 15:09:12 Paul Fisher - - * mm-decode.el (mm-dissect-multipart): Have the part start on the - right place. - -1998-09-14 14:33:34 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-add-send-actions): Mark silently. - - * gnus-art.el (article-update-date-lapsed): Only update header if - buffer is dispalyed in frame. - (gnus-article-prepare-display): New function. - (gnus-article-prepare): Use it. - -1998-09-14 08:16:43 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-inline-part): New command and keystroke. - - * mm-view.el (mm-insert-inline): New function. - - * mm-decode.el (mm-pipe-part): Bugged. - - * gnus-agent.el (gnus-agent-send-mail): Don't encode. - - * mm-bodies.el (mm-encode-body): Move over the body. - - * nnmbox.el (nnmbox-read-mbox): Enable multibyte. - - * rfc2047.el (rfc2047-q-encode-region): Would bug out. - -1998-09-13 Fran-Agois Pinard - - * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all - related functions. Handle message/rfc822 parts. Display subject on - multipart summary lines. Display name on sub-parts when available. - -1998-09-14 07:36:38 Hallvard B. Furuseth - - * mailcap.el (mailcap-command-p): New version. - -1998-09-13 Mike McEwan - - * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed - groups. - -1998-09-13 18:34:06 Lars Magne Ingebrigtsen - - * message.el (message-make-date): Remove weekday name. - - * mm-decode.el (mm-dissect-buffer): Protect against broken - headers. - - * mailcap.el (mailcap-command-in-path-p): New function. - (mailcap-command-p): Renamed. - -1998-09-13 17:58:47 Hallvard B. Furuseth - - * rfc2047.el (eval): Autoload. - -1998-09-13 12:22:40 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-decode-encoded-word-functions): New variable. - (gnus-multi-decode-encoded-word-string): New function. - (gnus-encoded-word-method-alist): New variable. - (gnus-decode-encoded-word-functions): Removed. - -1998-09-13 Shenghuo ZHU - - * gnus-int.el (gnus-request-replace-article): Replace - message-narrow-to-headers with message-narrow-to-head - -1998-09-13 12:05:41 Lars Magne Ingebrigtsen - - * drums.el (drums-quote-string): Reversed match. - - * message.el (message-make-date): Use weekday name. - -Sun Sep 11 10:27:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.30 is released. - -1998-09-13 08:00:41 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-encoded-words): Use it. - (gnus-decode-header-function): New variable. - - * gnus-sum.el (gnus-nov-parse-line): Use it. - (gnus-decode-encoded-word-function): New variable. - - * gnus-msg.el (gnus-copy-article-buffer): Decode the right - buffer. - - * gnus-art.el (gnus-insert-mime-button): Use widget. - (gnus-widget-press-button): New function. - (gnus-article-prev-button): Removed. - (gnus-article-next-button): Ditto. - (gnus-article-add-button): Ditto. - - * gnus.el (gnus-article-mode-map): Inherit from widget. - (gnus-article-mode-map): No, don't. - - * mm-decode.el (mm-dissect-buffer): Store Content-ID things. - (mm-content-id-alist): New variable. - (mm-get-content-id): New function. - - * gnus-art.el (gnus-request-article-this-buffer): Only decode - articles if we are fetching to the article buffer. - -1998-09-13 07:58:59 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-move-article): Don't decode accepting - articles. - -1998-09-13 07:23:28 Lars Magne Ingebrigtsen - - * mm-util.el (mm-mime-charset): Try to use safe-charsets. - (mm-default-mime-charset): New variable. - - * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials. - - * drums.el (drums-quote-string): Reversed test. - -1998-09-12 14:29:21 Lars Magne Ingebrigtsen - - * mm-util.el (mm-insert-rfc822-headers): Possibly not quote - string. - - * drums.el (drums-quote-string): New function. - - * rfc2047.el (rfc2047-encode-message-header): Goto point-min. - (rfc2047-b-encode-region): Chop lines. - (rfc2047-q-encode-region): Ditto. - -Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.29 is released. - -1998-09-12 12:46:30 Istvan Marko - - * mm-decode.el (mm-save-part): Message right. - -1998-09-12 11:30:01 Lars Magne Ingebrigtsen - - * drums.el (drums-parse-address): Returned a list instead of a - string. - (drums-remove-whitespace): Skip comments. - (drums-parse-addresses): Didn't work. - -Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.28 is released. - -1998-09-12 04:57:25 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-button-map): Use the article keymap as a - starting point. - (article-decode-encoded-words): Rename. - - * message.el (message-narrow-to-headers-or-head): New function. - - * gnus-int.el (gnus-request-accept-article): Narrow to the right - region. - - * message.el (message-send-news): Encode body after checking - syntax. - - * gnus-art.el (gnus-mime-button-line-format): Allow descriptions. - - * mm-decode.el (mm-save-part): Use Content-Disposition filename. - - * gnus-art.el (gnus-display-mime): Respect disposition. - - * mm-decode.el (mm-preferred-alternative): Respect disposition. - - * gnus-art.el (article-strip-multiple-blank-lines): Don't delete - text with annotations. - - * message.el (message-make-date): Fix sign for negative time - zones. - - * mm-view.el (mm-inline-image): Insert a space at the end of the - image. - - * mail-parse.el: New file. - - * rfc2231.el: New file. - - * drums.el (drums-content-type-get): Removed. - (drums-parse-content-type): Ditto. - - * mailcap.el (mailcap-mime-data): Use symbols instead of strings. - -Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.27 is released. - -1998-09-11 12:42:07 Lars Magne Ingebrigtsen- - - * mm-decode.el (mm-alternative-precedence): New variable. - (mm-preferred-alternative): New function. - - * gnus-art.el (gnus-mime-copy-part): New command. - - * mm-decode.el (mm-get-part): New function. - - * mm-view.el: New file. - - * mm-decode.el (mm-dissect-buffer): Downcase cte. - (mm-display-part): Default to mailcap-save-binary-file. - -Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.26 is released. - -1998-09-11 08:25:33 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-interactively-view-part): New function. - - * gnus-art.el (gnus-mime-view-part): New command. - - * mm-decode.el (mm-last-shell-command): New variable. - - * mailcap.el (mailcap-mime-info): Allow returning all matches. - - * mm-decode.el (mm-save-part): New function. - - * gnus-art.el (article-decode-charset): Protect against buggy - content-types. - (gnus-mime-pipe-part): New command. - (gnus-mime-save-part): New command. - (gnus-mime-button-map): New keymap. - (gnus-mime-button-line-format): New variable. - (gnus-insert-mime-button): New function. - (gnus-display-mime): Use it. - - * gnus-util.el (gnus-dd-mmm): Removed length spec. - - * mm-decode.el (mm-inline-text): Decode charsets. - - * gnus-art.el (gnus-article-save): Comment fix. - - * gnus-int.el (gnus-start-news-server): When in batch, don't - prompt. - - * gnus-cache.el (gnus-cache-possibly-enter-article): Don't - decode. - - * mm-decode.el (mm-inline-media-tests): Add audio. - (mm-inline-audio): New function. - -1998-09-11 08:19:22 Katsumi Yamaoka - - * gnus-art.el (article-make-date-line): Didn't work. - - * parse-time.el (parse-time-string): One too many nils. - -Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.25 is released. - -1998-09-11 07:38:14 Lars Magne Ingebrigtsen - - * gnus-art.el (article-remove-trailing-blank-lines): Don't remove - annotations. - - * gnus.el ((featurep 'gnus-xmas)): New - 'gnus-annotation-in-region-p alias. - -1998-09-10 06:20:52 Lars Magne Ingebrigtsen - - * mm-util.el (mm-with-unibyte-buffer): New function. - - * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Renamed. - - * mm-decode.el (mm-inline-media-tests): New variable. - - * gnus-sum.el (gnus-summary-exit): Destroy handles. - - * gnus-art.el (gnus-article-mime-handles): New variable. - - * drums.el (drums-narrow-to-header): New function. - - * gnus-art.el (article-decode-charset): Use it. - - * drums.el (drums-content-type-get): New function. - - * mm-util.el (mm-content-type-charset): Removed. - - * drums.el (drums-syntax-table): @ is word. - (drums-parse-content-type): New function. - - * parse-time.el (parse-time-rules): Parse "Wed, 29 Apr 98 0:26:01 - EDT" times. - - * gnus-util.el (gnus-date-get-time): Use safe date. - - * gnus-sum.el (gnus-show-mime): Removed. - (gnus-summary-toggle-mime): Removed. - - * gnus-art.el (gnus-strict-mime): Removed. - (gnus-article-prepare): Don't do MIME. - (gnus-decode-encoded-word-method): Removed. - (gnus-show-mime-method): Removed. - -Thu Sep 10 04:03:29 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.24 is released. - -1998-09-10 01:58:24 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-show-article): Don't decode chars if - PREFIX. - - * parse-time.el (parse-time-rules): Accept times that look like - "h:mm". - - * message.el (message-make-date): Use zone properly. - - * gnus.el: Autoload gnus-batch. - - * gnus-art.el (article-de-quoted-unreadable): Do not do - gnus-article-decode-rfc1522. - - * gnus-msg.el (gnus-inews-do-gcc): Use it. - - * gnus-int.el (gnus-request-accept-article): Accept a no-encode - param. - - * message.el (message-encode-message-body): Check for us-ascii. - - * gnus-msg.el (gnus-extended-version): Move Gnus version comments - to the left. - -1998-09-09 13:18:13 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-charset): Rename. - -Wed Sep 9 12:25:48 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.23 is released. - -1998-09-09 12:14:47 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-parent-id): Ditto. - (gnus-put-text-property-excluding-newlines): Ditto. - - * gnus-sum.el (gnus-dependencies-add-header): Make into subst. - -1998-09-08 Karl Kleinpaste - - * message.el (message-generate-headers): Generate User-Agent - instead of X-Mailer & X-Newsreader. - - * gnus-msg.el (gnus-extended-version): Reformat for USEFOR - User-Agent header format. - -Tue Sep 8 22:38:27 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.22 is released. - -1998-09-08 22:36:54 Lars Magne Ingebrigtsen - - * mm-util.el (mm-multibyte-p): Typo. - -Tue Sep 8 22:25:53 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.21 is released. - -1998-09-08 Hrvoje Niksic - - * gnus-art.el (article-treat-dumbquotes): Handle \224 correctly. - -1998-09-08 22:18:03 Lars Magne Ingebrigtsen - - * mm-util.el (mm-multibyte-p): New function. - -Tue Sep 8 21:43:03 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.20 is released. - -1998-09-08 11:40:45 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-decode-region): Only decode when in - multibyte. - - * nnheader.el (nnheader-pathname-coding-system): Changed to binary. - - * gnus-int.el (gnus-request-replace-article): Encode. - (gnus-request-accept-article): Encode. - - * gnus-art.el (gnus-request-article-this-buffer): Decode charsets - here. - - * gnus.el (gnus-article-display-hook): Take the charset functions - out. - - * time-date.el (safe-date-to-time): New function. - - * gnus-util.el (gnus-dd-mmm): Protect against bogus dates. - -Tue Sep 8 07:09:28 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.19 is released. - -1998-09-08 04:51:39 Lars Magne Ingebrigtsen - - * base64.el (base64-encode-region): Accept no-line-break. - - * mm-util.el (mm-mime-charset): New function. - - * gnus-draft.el (gnus-draft-edit-message): Delete article. - -Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.18 is released. - -1998-09-08 02:21:36 Lars Magne Ingebrigtsen - - * message.el (message-send-and-exit): Return t on success. - (message-make-date): Make a proper time zone. - - * gnus-draft.el (gnus-draft-send): Only remove article if the - sending is successful. - - * drums.el (drums-get-comment): Return the last comment. - (drums-parse-address): Parse old-style From headers. - -1998-09-07 SL Baur - - * gnus-sum.el (gnus-data-compute-positions): Move below - `gnus-save-hidden-threads' so the former is correctly detected as - a macro. - -1998-09-06 Dave Love - - * gnus/nnweb.el (require): Wrap requirement of w3 and url in - ignore-errors too, eval'd when compile. Require w3 stuff at load - time for nicer failure if it's not available. - -1998-09-08 00:38:39 Lars Magne Ingebrigtsen - - * time-date.el (time-to-seconds): Renamed. - - * parse-time.el (parse-time-string): Downcase before handling. - (parse-time-rules): Times without seconds have 0 seconds. - - * rfc2047.el (rfc2047-encode-region): New version. - (rfc2047-dissect-region): New function. - -1998-09-07 01:08:35 Lars Magne Ingebrigtsen - - * message.el (message-make-date): Use symbolic zone. - -1998-09-06 23:23:06 Lars Magne Ingebrigtsen - - * time-date.el (parse-time): Always use parse-time. - - * parse-time.el (parse-time-syntax): Use vectors. - -Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.17 is released. - -1998-09-06 05:45:17 Lars Magne Ingebrigtsen - - * time-date.el: Renamed from "date". - - * gnus.el: Removed all timezone dependencies. - - * score-mode.el: Removed. - (gnus-score-edit-insert-date): Use date. - - * date.el (float-to-time): New function. - - * nnspool.el (nnspool-seconds-since-epoch): Removed. - - * date.el (time-to-float): New function. - - * message.el (message-make-date): Use format-time-string. - (message-make-expires): Use make-date. - - * gnus-xmas.el (gnus-xmas-seconds-since-epoch): Removed. - - * gnus-util.el (gnus-dd-mmm): Use date. - (gnus-sortable-date): Ditto. - - * message.el (message-make-date): Take an optional time. - - * gnus: Applied patches from 5.6.43. - - * date.el (if): Use parse-time. - - * gnus-score.el (gnus-summary-score-entry): Make into a command - again. - - * gnus-group.el (gnus-group-get-new-news-this-group): Only call if - gnus-agent. - - * gnus.el (gnus-agent-meta-information-header): Moved here. - -1998-09-05 Mike McEwan - - * gnus-agent.el (gnus-agent-scoreable-headers): New variable. - (gnus-agent-fetch-group-1): Score article headers using normal - group score files if the download score rule of a category/group - is `file'. - (gnus-agent-fetch-group-1): Don't parse the entire .overview when - deciding what articles to download. - (gnus-agent-fetch-group-1): Don't push headers through scoring and - predicate processing if predicate is `true' or `false'. - -1998-09-06 01:56:02 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-load-score-alist): Bind coding system. - - * gnus-art.el (gnus-article-setup-buffer): Enable multibyte. - - * score-mode.el (score-mode-coding-system): New variable. - (gnus-score-edit-exit): Use it. - -1998-09-04 Jason R Mastaler - - * drums.el: Corrected typo. - -1998-09-05 23:24:43 Hallvard B. Furuseth - - * mm-bodies.el (mm-body-encoding): Faster version. - -1998-09-05 22:23:03 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-charset): Only decode text - things. - - * message.el (message-output): Use rmail. - - * rfc2047.el (rfc2047-encoded-word-regexp): Allow spaces in the - word part. - - * mm-util.el (mm-charset-to-coding-system): Use - rfc2047-default-charset. - (mm-known-charsets): New variable. - - * message.el (message-caesar-region): Bugged out. - -1998-09-06 Mike McEwan - - * gnus-agent.el (gnus-agent-fetch-group-1): Allow lists when - specifying `agent-predicate' in a group's parameters. - -Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.16 is released. - -1998-09-05 17:30:11 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-expired-article-p): Use predicate. - - * date.el (time-less-p): Renamed. - - * gnus-art.el (gnus-article-decode-charset): Really fetch headers - from the headers. - - * rfc2047.el (rfc2047-decode-region): Use the mm decoding - functions. - - * gnus-group.el (gnus-group-sort-selected-flat): Didn't work at - all. - (gnus-group-sort-selected-groups-by-alphabet): Changed interface - to all functions. - -Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.15 is released. - -1998-09-05 00:21:22 Lars Magne Ingebrigtsen - - * date.el: New file. - - * gnus-util.el (gnus-encode-date): Removed. - (gnus-time-less): Ditto. - - * nnmail.el (nnmail-date-to-time): Removed. - (nnmail-time-less): Ditto. - (nnmail-days-to-time): Ditto. - (nnmail-time-since): Ditto. - - * drums.el: New file. - -1998-09-04 00:25:52 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Encode headers with - body encoding. - - * rfc2047.el (rfc2047-default-charset): Renamed. - (rfc2047-encodable-p): Use it. - - * base64.el (mm-util): Required. - -1998-09-03 16:28:30 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-post-method): Peel off real info from opened - servers. - - * gnus-util.el (gnus-output-to-rmail): Removed. - - * gnus-art.el (gnus-summary-save-in-rmail): Use - gnus-output-to-rmailrmail-output-to-rmail-file. - - * rfc2047.el (rfc2047-decode-region): Fold case. - (rfc2047-decode): Use decode-string. - - * mm-util.el: Provide mm-char-int. - -Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.14 is released. - -1998-09-03 15:08:30 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-body-encoding): Go through the buffer to make - sure we have 7bit. - -1998-09-02 14:38:18 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-post-method): Use opened servers, and remove - ducplicates. - (gnus-inews-insert-mime-headers): Removed. - - * message.el (message-caesar-region): Protect against MULE chars. - -1998-09-02 00:36:23 Hallvard B. Furuseth - - * mm-util.el (if): fset the right function. - -1998-09-02 00:31:53 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-charset): Use real - read-coding-system. - -1998-09-01 17:58:40 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-body): Protect against malformed - base64. - (mm-decode-body): Check that buffer-file-coding-system is - non-nil. - -Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.13 is released. - -1998-09-01 09:14:33 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-strip-whitespace): Already defined. - Removed. - - * gnus-art.el (gnus-article-decode-charset): Strip whitespace. - - * gnus-util.el (gnus-strip-whitespace): New function. - - * mm-util.el (mm-content-type-charset): Downcase. - -1998-08-31 23:04:29 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-charset): Accept a prefix. - (gnus-article-decode-charset): Don't fetch all headers. - - * mm-util.el (mm-read-coding-system): New function. - - * mm-bodies.el (mm-decode-body): Check the right charset. - - * gnus-sum.el (gnus-summary-mode-line-format): Ditto. - - * gnus-art.el (gnus-article-mode-line-format): Use short group - format. - -Mon Aug 31 23:03:13 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.12 is released. - -1998-08-31 22:39:36 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-body): Don't do charset unless MULE. - - * gnus-art.el (gnus-article-decode-charset): Supply cte. - (gnus-article-decode-charset): Always run. - - * mm-bodies.el (mm-decode-body): Decode cte. - -Mon Aug 31 22:14:50 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.11 is released. - -1998-08-31 14:27:25 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Ditto. - - * gnus-art.el (gnus-article-decode-mime-words): New command and - keystroke. - (gnus-article-decode-charset): Ditto. - (gnus-article-decode-charset): Only work under MULE. - - * mm-util.el (mm-content-type-charset): New function. - - * nnmail.el (nnmail-delete-incoming): Changed to nil. - - * message.el (message-send-mail): Insert MIME headers. - (message-check-news-body-syntax): Don't warn for escape sequences. - (message-check-news-body-syntax): Insert MIME headers. - - * mm-bodies.el (mm-body-encoding): New function. - - * message.el (message-encode-message-body): New function. - - * mm-bodies.el: New file. - - * mm-util.el (mm-narrow-to-head): New function. - - * rfc2047.el (rfc2047-encode): Use it. - - * mm-util.el: Provide mm-encode-coding-region. - - * gnus-sum.el (gnus-summary-mode): Enable multibyte. - - * gnus-util.el (gnus-set-work-buffer): Enable multibyte. - - * mm-util.el (mm-enable-multibyte): New function. - - * message.el (message-set-work-buffer): Set multibyte. - - * gnus.el (gnus-continuum-version): Be valid forever and ever. - - * gnus-util.el (gnus-point-at-eol): Removed. - (gnus-point-at-bol): Ditto. - - * base64.el (base64-decode-region): Commented out messaging. - -1998-08-31 Didier Verna - - * gnus-msg.el (gnus-group-mail): make it behave like - gnus-group-post-news with regards to the prefix (this enables the - use of posting styles). - -1998-08-31 12:53:32 Lars Magne Ingebrigtsen - - * gnus.el (gnus-article-display-hook): Added - gnus-article-decode-rfc1522 to hook. - -Mon Aug 31 12:43:46 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.10 is released. - -1998-08-31 11:45:13 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-delete-mail): Narrow to mail and allow - hook to be run. - -1998-08-30 17:59:07 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-encodable-p): Use find-charset-region. - - * mm-util.el (mm-charsets-in-region): Removed. - - * rfc2047.el: Renamed file. - - * gnus-msg.el (gnus-copy-article-buffer): Multibyte. - - * message.el (message-mode): Set multibyte. - - * mm-util.el (mm-charsets-in-region): Copied here. - - * gnus-util.el: Removed gnus-truncate-string. - - * gnus-art.el (gnus-article-decode-mime-words): Use 1522. - - * rfc1522.el (rfc1522-unencoded-charsets): New variable. - (rfc1522-encodable-p): New function. - (rfc1522-encode-message-header): Use it. - -Sun Aug 30 17:46:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.9 is released. - -1998-08-30 16:13:08 Lars Magne Ingebrigtsen - - * mm-util.el: Shadow encode-coding-string. - - * base64.el (base64-encode-region): Don't add newline. - - * rfc1522.el (rfc1522-narrow-to-field): Copied here. - - * mm-util.el: New file. - - * mm-decode.el: Somewhat depleted. - * mm-encode.el: Ditto. - - * rfc1522.el: New file. - - * mm-util.el (mm-replace-chars-in-string): Copied here. - - * mm-encode.el (mm-q-encode-region): New function. - - * qp.el (quoted-printable-encode-region): Take an optional CLASS - param. - - * mm-encode.el (mm-encode-word-region): Downcase. - -Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.8 is released. - -1998-08-30 12:23:03 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Encode headers. - - * qp.el (quoted-printable-encode-region): Encode 8-bit words. - (quoted-printable-encode-region): Upcase. - - * message.el (message-default-charset): New variable. - - * qp.el (quoted-printable-encode-region): Optional param FOLD. - - * message.el (message-narrow-to-field): Changed name. - - * mm-encode.el: New file. - - * message.el (message-narrow-to-header): New function. - - * gnus-art.el (gnus-article-decode-mime-words): Place point in the - right buffer. - -Sun Aug 30 12:15:54 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.7 is released. - -1998-08-30 01:26:12 Lars Magne Ingebrigtsen - - * gnus.el: Remove autoload for - gnus-article-mime-decode-quoted-printable. - - * mm-decode.el (mm-charset-to-coding-system): Allow iso-8859-1 to - be decoded in non-MULE Emacsen. - - * gnus-xmas.el (gnus-xmas-logo-color-alist): More brown. - -1998-08-29 SL Baur - - * gnus-xmas.el (gnus-xmas-logo-color-alist): Try shades of brown. - -1998-08-30 01:04:57 Lars Magne Ingebrigtsen - - * mm-decode.el: Check for coding-system-list. - -Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.6 is released. - -1998-08-30 00:36:28 Lars Magne Ingebrigtsen - - * nnheader.el (fboundp): Protect code-coding-string. - - * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte - is available. - -Sat Aug 29 23:24:31 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.5 is released. - -1998-08-29 22:38:35 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode): Make article buffer multibyte. - (gnus-hack-decode-rfc1522): Removed. - - * mm-decode.el (mm-charset-coding-system-alist): Check better. - -Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v0.4 is released. - -1998-08-29 20:53:29 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-mime-words): New command and - keystroke. - - * qp.el (quoted-printable-decode-region): Don't use hexl. - - * gnus-xmas.el (gnus-xmas-logo-color-style): Changed to dino. - - * gnus-sum.el (gnus-parse-headers-hook): Default to nil. - (gnus-structured-field-decoder): Removed. - (gnus-unstructured-field-decoder): Ditto. - - * mm-decode.el: New file. - - * qp.el: New file. - - * gnus-art.el (article-mime-decode-quoted-printable): Removed. - - * gnus-ems.el (fboundp): Removed gnus-split-string. - - * gnus.el (gnus-splash-face): Doc fix. - - * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p. - - * gnus-art.el (article-mime-decode-quoted-printable): Don't use - hexl. - - * nnheader.el (nnheader-temp-write): Removed. - -Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v0.3 is released. - -Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v0.2 is released. + * message.el (message-options): New variable. + (message-options-set-recipient): New function. + (message-send): Use them. + * gnus-int.el (gnus-request-replace-article): Use them. + (gnus-request-accept-article): Ditto. + * mml.el (mml-preview): Use them. + * gnus-sum.el (gnus-summary-edit-article): Use them. + + * message.el (message-options-get): New function. + (message-options-get): New function. + * rfc2047.el (rfc2047-encode-message-header): Use them. + * mm-bodies.el (mm-encode-body): Use them. + +2000-10-28 Simon Josefsson + + * nnimap.el (nnimap-retrieve-which-headers): + (nnimap-request-article-part): Quote message-id. + + * smime.el (smime-CA-directory): Rename from `smime-CAs'. + (smime-CA-file): New variable. + (smime-call-openssl-region): Don't error. + (smime-sign-region): Return result value. + (smime-encrypt-region): Ditto. + (smime-verify-region): New function. + (smime-decrypt-region): Ditto. + (smime-verify-buffer): Ditto. + (smime-decrypt-buffer): Ditto. + + * mml.el: Require mml-sec. + (mml-generate-mime-1): Support "sign" and "encrypt" MML tags. + (mml-mode-map): Add "sign" and "encrypt" maps. + (mml-menu): Add security menu. + (mml-preview): Use generate-new-buffer. + + * mml-sec.el: New file. + +2000-10-28 03:43:03 ShengHuo ZHU + + * mm-decode.el (mm-find-part-by-type): Move it here. + * mml.el (mml-postprocess): Move it here. + (mml-postprocess-alist): Move it here. Merge them. + +2000-10-28 03:38:39 ShengHuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Make sure no + unencoded stuff in the header. + +2000-10-28 02:40:46 ShengHuo ZHU + + * gnus-group.el (gnus-group-listed-groups): New variable. + (gnus-group-list-option): New variable. + (gnus-group-list-limit-map): New keymap. + (gnus-group-list-flush-map): New keymap. + (gnus-group-list-plus-map): New keymap. + (gnus-group-prepare-logic): New function. + (gnus-group-prepare-flat): Merge with + gnus-group-prepare-flat-predicate. Use gnus-group-listed-groups. + (gnus-group-prepare-flat-list-dead): Ditto. + (gnus-group-list-matching): Use gnus-group-prepare-function. + (gnus-group-list-dormant): Ditto. + (gnus-group-list-cached): Ditto. + (gnus-group-listed-groups): New function. + (gnus-group-list-limit): New function. + (gnus-group-list-flush): New function. + (gnus-group-list-plus): New function. + * gnus-topic.el (gnus-group-prepare-topics): Accept predicate. + (gnus-topic-prepare-topic): Ditto. + +2000-10-27 Paul Jarc + + * message.el (message-insert-to, message-get-reply-headers): + (message-reply, message-followup): Mail-{Followup,Reply}-To. + +2000-10-27 19:45:58 ShengHuo ZHU + + * mml2015.el: New file. + * smime.el: New file. + * mml-smime.el: New file. + +2000-10-27 19:42:12 ShengHuo ZHU + + * ChangeLog: Moved to ChangeLog.1. + +;; Local Variables: +;; coding: iso-2022-7bit +;; End: diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1 new file mode 100644 index 0000000..3cfb883 --- /dev/null +++ b/lisp/ChangeLog.1 @@ -0,0 +1,10100 @@ +2000-10-27 Jason Rumney + + * gnus-art.el (gnus-signature-face): Use italic on any frame that + supports it. + +2000-10-27 14:19:53 ShengHuo ZHU + + * gnus-mlspl.el: Require cl when compiling. + * messagexmas.el: Ditto. + * mm-util.el: Ditto. + * rfc2047.el: Ditto. + * rfc2231.el: Ditto. + * smiley-ems.el: Ditto. + * uudecode.el: Ditto. + + * smiley-ems.el (smiley-region): Use mapcar. + +2000-10-27 Stefan Monnier + + * ietf-drums.el: Require cl when compiling. + +2000-10-27 Dave Love + + * mm-decode.el (mm-valid-and-fit-image-p): Don't test + window-system here. + + * gnus-art.el (gnus-article-x-face-command): Check + gnus-article-compface-xbm. + (gnus-treat-display-xface): Check for uncompface. + + * nnheader.el (nnheader-translate-file-chars): Only kludge things + under Doze with XEmacs. + +2000-10-26 Simon Josefsson + + * mail-source.el (mail-sources): IMAP predicate is a string. + (mail-sources): Add default values for IMAP mailbox, predicate and + fetchflag. + +2000-10-26 Dave Love + + * flow-fill.el: Require cl when compiling. + + * mail-source.el: Require imap when compiling and defvar + display-time-mail-function. Require mm-util. + (nnheader-cancel-timer): Autoload. + (mail-source-imap-authenticators, mail-source-imap-streams): New + variables. + (mail-sources): Use them. + +2000-10-25 20:13:02 ShengHuo ZHU + + * mm-decode.el (mm-viewer-completion-map): New. + (mm-interactively-view-part): Use it. + +2000-10-25 18:51:12 ShengHuo ZHU + + * rfc2047.el (rfc2047-q-encode-region): Don't break if a QP-word + could be fitted in one line. + +2000-10-25 Dirk Meyer + + * gnus-demon.el (gnus-demon-time-to-step): theHour was set to + seconds instead of hour. + +2000-10-25 Per Abrahamsen + + * mail-source.el (mail-sources): Better `:type'. + +2000-10-24 18:31:29 ShengHuo ZHU + + * gnus-art.el (gnus-request-article-this-buffer): + gnus-refer-article-method might be a single method. + * gnus-sum.el (gnus-refer-article-methods): The second could be + a named method. + +2000-10-23 Simon Josefsson + + * flow-fill.el (fill-flowed): Don't flow "-- " lines. + (fill-flowed): Make "quote-depth wins" rule work when first line + is at level 0. + +2000-10-21 11:23:21 ShengHuo ZHU + + * mm-util.el (mm-multibyte-p): Test (featurep 'xemacs). + +2000-10-21 10:54:57 ShengHuo ZHU + + * gnus-art.el (gnus-article-mime-total-parts): New function. + (gnus-mm-display-part): Use it. + (gnus-mime-display-single): Ditto. + (gnus-mime-display-alternative): Ditto. + +2000-10-21 09:38:27 ShengHuo ZHU + + * mailcap.el (mailcap-parse-mailcaps): Don't use parse-colon-path, + because they are files, not directories. + (mailcap-parse-mimetypes): Ditto. + +2000-10-20 19:55:59 ShengHuo ZHU + + * gnus-art.el (gnus-mime-inline-part): Check validity of charset. + +2000-10-18 Dave Love + + * mail-source.el (mm-util): Require. + (defvar): Use rmail-spool-directory unconditionally. + + * gnus-nocem.el (gnus-nocem-issuers): Update. + (gnus-nocem-check-from): New option. + (gnus-nocem-scan-groups): Use it. + (gnus-nocem-check-article): Bind gnus-newsgroup-name. + +2000-10-18 Miles Bader + + * gnus-nocem.el (gnus-nocem-check-article-limit): New variable. + (gnus-nocem-scan-groups): Obey `gnus-nocem-check-article-limit'. + +2000-10-18 Simon Josefsson + + * nnheader.el (nnheader-parse-head): Try both "from:" and "from: ". + + * gnus-sum.el (gnus-get-newsgroup-headers): Ditto. + +2000-10-17 Simon Josefsson + + * gnus-sum.el (gnus-get-newsgroup-headers): Search for "from:" + instead of "from: " for rfc822 compliance. + + * gnus-uu.el (gnus-uu-digest-mail-forward): Ditto. Insert SPC. + + * nnheader.el (nnheader-parse-head): Ditto. + +2000-10-13 Kai Gro,A_(Bjohann + + * mail-source.el (mail-source-keyword-map): Use + `rmail-spool-directory' as a default directory for the `file' + source, if the variable is defined. Fall back to hardcoded + "/usr/spool/mail/", as before. Suggestion by Steven E. Harris + . + +2000-10-13 12:01:15 ShengHuo ZHU + + * message.el (message-send-mail-partially): Replace the header + delimiter with a blank line. + +2000-10-13 Kai Gro,A_(Bjohann + + * gnus-sum.el (gnus-get-split-value): Use first match only (Ed L + Cashin ). + +2000-10-13 10:52:00 ShengHuo ZHU + + * gnus-ems.el (gnus-article-compface-xbm): Ignore errors. + +2000-10-11 John Wiegley + + * gnus-topic.el (gnus-topic-mode): Use `setq' to clear + `gnus-group-change-level-function', instead of `remove-hook', + because it's not a hook! + + * gnus-mlspl.el (gnus-group-split-update): Check the value of + `nnmail-crosspost', and use it to set the `no-crosspost' + argument when calling `gnus-group-split-fancy'. Otherwise, it + assumes that cross-posting is always OK, no matter what + `nmail-crosspost' is set to. + (gnus-group-split-fancy): The argument order in the + second-to-last `push' call was wrong, but since `no-crosspost' + was always nil, it was never being triggered. + + * gnus-art.el (gnus-treat-hide-citation-maybe): Added this + variable to correspond with `gnus-article-hide-citation-maybe'. + (gnus-treatment-function-alist): Added entry for the above + correlation. + +2000-10-12 08:26:30 ShengHuo ZHU + + * mm-util.el (mm-with-unibyte-current-buffer): Revert to old. + (mm-with-unibyte-current-buffer-mule4): New function. + * qp.el (quoted-printable-encode-region): Use it. + * rfc2047.el (rfc2047-decode): Ditto. + * webmail.el (webmail-init): Revert to use mm-disable-multibyte. + +2000-10-10 08:44:13 ShengHuo ZHU + + * rfc2047.el (rfc2047-fold-region): "=?=" is not a break point. + +2000-10-10 00:00:28 ShengHuo ZHU + + * webmail.el (webmail-init): Use mm-disable-multibyte-mule4. + +2000-10-09 22:50:05 ShengHuo ZHU + + * base64.el (base64-decode-region): Just give a message if the end + is not sane. + +2000-10-09 20:09:11 ShengHuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Move fold into + encode-region. + (rfc2047-dissect-region): Rewrite. + (rfc2047-encode-region): Rewrite. + (rfc2047-fold-region): Fold any line longer than 76. + (rfc2047-unfold-region): New function. + (rfc2047-decode-region): Use it. + (rfc2047-q-encode-region): Don't break at bob. + +2000-10-09 17:12:00 ShengHuo ZHU + + * nntp.el (nntp-open-connection): Kill process buffer when quit. + (nntp-connection-timeout): Add a note. SIGALRM is ignored in both + FSF Emacs 20 and XEmacs 21. + * gnus-agent.el (gnus-agent-fetch-session): Catch quit. + +2000-10-09 Dave Love + + * gnus-audio.el: Don't require cl. + (gnus-audio): New custom group. + (gnus-audio-inline-sound): Change to work with Emacs. + (gnus-audio-directory, gnus-audio-directory) + (gnus-audio-au-player): Customize. + (gnus-audio-play): Try external player if play-sound-file fails. + Use file-name-extension, not string-match. + + * gnus-art.el (article-de-quoted-unreadable) + (article-de-base64-unreadable): Fold search case rather than + downcasing string. Apply mm-charset-to-coding-system to arg of + quoted-printable-decode-region. + (gnus-article-dumbquotes-map): Fix dashes. + (gnus-button-mailto, gnus-button-embedded-url): Doc fix. + (gnus-button-reply): Just alias it. + +2000-10-09 Stefan Monnier + + * mm-encode.el: Require CL. At least, for `incf'. + + * nnfolder.el (nnfolder-ignore-active-file): Typos. + + * gnus-mh.el (gnus-summary-save-in-folder): Obey mh-lib-progs. + + * gnus-kill.el (gnus-kill): Typo. + +2000-10-09 Gerd Moellmann + + * smiley-ems.el (smiley-update-cache): Use `:ascent center'. + +2000-10-09 Simon Josefsson + + * nnimap.el (nnimap-group-overview-filename): Create directory for + newfile (when use long filenames is nil). Copy+delete file if + rename didn't work. + (nnimap-group-overview-filename): `rename-file' and `copy-file' + doesn't return anything useful, use ignore-errors instead. + +2000-10-08 13:05:11 ShengHuo ZHU + + * dgnushack.el (dgnushack-compile): Delete old elc files first. + +2000-10-08 10:59:13 ShengHuo ZHU + + * gnus-ems.el (gnus-kill-all-overlays): Move here. + * gnus-util.el (gnus-kill-all-overlays): Move out. + * gnus-sum.el (gnus-cache-write-active): Auto load. + * lpath.el: Shut up. + * nnweb.el (nnweb-url-retrieve-asynch): url-retrieve is + asynchronous in Exp version. + +2000-10-08 08:57:13 ShengHuo ZHU + + * gnus-art.el, gnus-ems.el, gnus-start.el: Remove gnus-xemacs. + * gnus-ems.el: Autoload smiley. + * gnus-art.el (gnus-treat-display-smileys): Default value in Emacs 21. + +2000-10-08 08:45:48 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-display-article): Enable multibyte. + (gnus-summary-select-article): Don't enable multibyte here. + (gnus-summary-goto-article): Ditto. + +2000-10-08 Christoph Conrad + + * gnus-draft.el (gnus-draft-send-message): Typo. + +2000-10-08 Simon Josefsson + + * nnimap.el (nnimap-verify-uidvalidity): Delete overview file when + uid validity changes. + (nnimap-group-overview-filename): Store uidvalidity in filenames. + Rename old files into new format. + +2000-10-07 15:49:39 ShengHuo ZHU + + * mm-util.el (mm-enable-multibyte-mule4): New. + (mm-disable-multibyte-mule4): New. + * gnus-sum.el (gnus-summary-mode): Use it. + (gnus-summary-select-article): Ditto. + (gnus-summary-goto-article): Use enable multibyte. + * rfc2047.el (rfc2047-decode): Use unibyte. + +2000-10-07 15:42:59 ShengHuo ZHU + + * gnus-logic.el (gnus-advanced-string): Use "" if nil. + +2000-10-07 10:31:05 ShengHuo ZHU + + * rfc2047.el (rfc2047-q-encode-region): Better calculation of + break point. + (rfc2047-fold-region): Don't break the first non-LWSP characters. + +2000-10-07 09:18:53 ShengHuo ZHU + + * gnus.el (gnus-agent-fetching): New variable. + * gnus-agent.el (gnus-agent-with-fetch): Bind it. + * gnus-score.el (gnus-score-body): Don't score body when + agent-fetching. + (gnus-score-followup): Don't score followup either. + +2000-10-07 08:19:17 ShengHuo ZHU + + * gnus-art.el: Define dynamic variables in eval-when-compile. + * message.el (message-sending-message): New variable. + (message-send): Use it. + * gnus-draft.el (gnus-draft-send-message): Ditto. + (gnus-group-send-drafts): Ditto. + +2000-10-06 Dave Love + + * gnus-audio.el: Don't require cl. + (gnus-audio): New custom group. + (gnus-audio-inline-sound): Change to work with Emacs. + (gnus-audio-directory, gnus-audio-directory) + (gnus-audio-au-player): Customize. + (gnus-audio-play): Try external player if play-sound-file fails. + Use file-name-extension, not string-match. + +2000-10-06 17:38:03 ShengHuo ZHU + + * gnus-art.el (gnus-article-prepare): Configure it again. + +2000-10-06 15:11:07 ShengHuo ZHU + + * message.el (message-default-charset): Default value for non-Mule + Emacsen. + +2000-10-06 14:28:50 ShengHuo ZHU + + * message.el (message-alternative-emails): New. + (message-use-alternative-email-as-from): New. + (message-setup): Use them. + +2000-10-06 13:46:47 ShengHuo ZHU + + * base64.el, dgnushack.el, gnus-spec.el, messagexmas.el + * gnus-xmas.el, nnheaderxm.el, nndraft.el: Use defalias. + + * gnus-xmas.el (gnus-xmas-define): Defalias gnus-overlay-buffer, + gnus-overlay-start. + * gnus.el: Ditto. + * gnus-art.el (gnus-insert-mime-button): Use them. + +2000-10-06 10:01:08 ShengHuo ZHU + + * mm-util.el (mm-with-unibyte-current-buffer): Don't set unibyte + if eight-bit-control is a charset, e.g. Mule 5.0 in Emacs 21. + +2000-10-06 09:38:54 ShengHuo ZHU + + * qp.el (quoted-printable-encode-region): Use + mm-with-unibyte-current-buffer within narrowed region. + +2000-10-06 08:56:33 ShengHuo ZHU + + * webmail.el (webmail-type-definition): Fix my-deja open url. + +2000-10-06 Emerick Rogul + + * message.el (message-setup-fill-variables): New variable. + (message-mode): Use it. + +2000-10-05 Dave Love + + * rfc2047.el (rfc2047-fold-region): Use gnus-point-at-bol. + (rfc2047-charset-encoding-alist): Add iso-8859-1[45]. + + * binhex.el: Use defalias, not fset. + + * rfc1843.el: Require cl when compiling. + +2000-10-05 12:25:08 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-fetch-group-1): Score-param could be nil. + +2000-10-05 11:43:25 ShengHuo ZHU + + * rfc2047.el (rfc2047-encode-region): Merge only if regions are + adjacent. + +2000-10-05 09:41:33 ShengHuo ZHU + + * mm-util.el (mm-multibyte-p): In XEmacs, it is (feature 'mule). + (mm-find-charset-region): Merge conditions, delete ascii. + (mm-charset-after): Rewrite. + * mm-bodies.el (mm-encode-body): Use it. + +2000-10-05 09:04:32 ShengHuo ZHU + + * webmail.el (webmail-hotmail-list): Fix. + +2000-10-05 Stefan Monnier + + * nnimap.el (require): cl. + +2000-10-04 15:24:46 ShengHuo ZHU + + * gnus-art.el (gnus-article-prepare): Configure windows before + gnus-article-prepare-display is called. Otherwise, BBDB's popup + window might be overrided. + +2000-10-04 Dave Love + + * gnus-ems.el (gnus-article-display-xface) + [gnus-article-compface-xbm]: Fix. + (gnus-x-splash): Bind width, height. + +2000-10-04 11:45:04 ShengHuo ZHU + + * gnus-art.el (gnus-mime-inline-part): Use prefix argument only + when it is called interactively. + +2000-10-03 21:20:31 ShengHuo ZHU + + * gnus-art.el (gnus-mime-action-alist): New variable. + (gnus-mime-action-on-part): Use it. + (gnus-mime-button-commands): Add command ".". + +2000-10-03 20:37:42 ShengHuo ZHU + + * gnus-art.el (gnus-mime-inline-part): Support prefix argument. + +2000-10-03 Katsumi Yamaoka + + * lpath.el: "." is in the load-path because dgnushack.el. + +2000-10-03 Bjorn Torkelsson + + * uudecode.el: xemacs cleanup (use featurep ' xemacs) + + * nnheader.el: ditto + + * mm-util.el: ditto + + * message.el: ditto + + * binhex.el: ditto + + * gnus-audio.el: removed unnecessary xemacs test + + * earcon.el: ditto + +2000-10-03 19:55:55 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-decode-entities): Work for non-character + entities. + +2000-09-26 09:20:08 Lars Magne Ingebrigtsen + + * gnus.el: Message the quit parts. + +2000-10-03 08:08:29 ShengHuo ZHU + + * mail-source.el (mail-source-fetch-maildir): Don't insert + newlines. + +2000-10-02 20:14:27 ShengHuo ZHU + + * dgnushack.el (dgnushack-compile): Don't compile dgnushack.el, + lpath.el. Don't compile base64.el if there is builtin base64. + +2000-10-02 Bj,Av(Brn Torkelsson + + * base64.el (Repository): Use featurep for XEmacs test. + +2000-10-02 17:38:12 ShengHuo ZHU + + * nntp.el (nntp-retrieve-data): Don't ignore quit. + +2000-10-02 14:43:13 ShengHuo ZHU + + * gnus-art.el (gnus-article-banner-alist): New variable. + (article-strip-banner): Use it. + * gnus-cus.el (gnus-group-parameters): Allow symbol. + +2000-10-02 Dave Love + + * smiley-ems.el: New file. + + * gnus-ems.el (gnus-smiley-display): Autoload. + (mouse-set-point, set-face-foreground, set-face-background) + (x-popup-menu): Don't clobber these. + (gnus-article-compface-xbm): New variable. + (gnus-article-display-xface): Move graphic test. Use unibyte. + Obey gnus-article-compface-xbm. Use pbm, not xbm. + + * mml.el (require): Fix typo. + (mml-parse-1): Modify unknown encoding prompt. + + * mail-source.el (mail-sources): Revert to nil. + + * nnmail.el (nnmail-spool-file): Revert previous change. + + * gnus.el: Don't require custom, message. + (gnus-message-archive-method): Wrap initializer in progn and + require message here. + +2000-10-02 Gerd Moellmann + + * gnus.el (gnus-mode-line-buffer-identification) [Emacs]: Change + image's :ascent to 80. That gives a mode-line which is approx. + as tall as the normal one. + +2000-10-02 08:04:48 ShengHuo ZHU + + * webmail.el (webmail-hotmail-list): Fix. + +2000-10-01 20:55:53 ShengHuo ZHU + + Don't postpone GCC if none of GCC methods is agent-covered. This + fix presumes that the post-method must be agent-covered if any Gcc + method is agent-covered. + + * gnus-msg.el (gnus-inews-group-method): New function. + (gnus-inews-do-gcc): Use it. + * gnus-agent.el (gnus-agent-any-covered-gcc): New function. + (gnus-agent-possibly-save-gcc): Use it. + (gnus-agent-possibly-do-gcc): Ditto. + +2000-10-01 17:08:50 ShengHuo ZHU + + * mailcap.el (mailcap-mime-types): Use mailcap-mime-data. + * mml.el (mml-minibuffer-read-type): Use mailcap-mime-types. + +2000-10-01 13:07:21 ShengHuo ZHU + + * webmail.el (webmail-netscape-open, webmail-hotmail-article, + webmail-hotmail-list): Update. + +2000-10-01 08:36:09 ShengHuo ZHU + + * mail-source.el (mail-source-report-new-mail): Use + nnheader-cancel-timer. + +2000-10-01 08:35:38 ShengHuo ZHU + + * lpath.el (overlay-*): Shut up. + * dgnushack.el: Two implementations of smiley. + +2000-10-01 08:32:42 ShengHuo ZHU + + * gnus-ml.el: Usage. + (gnus-mailing-list-archive, gnus-mailing-list-owner, + gnus-mailing-list-post, gnus-mailing-list-unsubscribe, + gnus-mailing-list-subscribe, gnus-mailing-list-help): Bind list-*. + (gnus-mailing-list-menu): Define it. + (turn-on-gnus-mailing-list-mode, gnus-mailing-list-mode): Autoload. + + * gnus-xmas.el (gnus-xmas-mailing-list-menu-add): Move here. + +2000-09-30 18:52:51 ShengHuo ZHU + + * webmail.el (webmail-my-deja-*): Rewrite. + +2000-09-30 Simon Josefsson + + * nnimap.el (nnimap-request-accept-article): Remove \n's from + From_ lines. + +2000-08-05 Simon Josefsson + + Make GCC to remote groups work when unplugged + (postpone GCC until message is actually sent). + + * gnus-draft.el (gnus-draft-send): Call `gnus-agent-restore-gcc'. + + * gnus-agent.el (gnus-agent-possibly-do-gcc): + (gnus-agent-restore-gcc): + (gnus-agent-possibly-save-gcc): New functions. + + * gnus-msg.el (gnus-inews-add-send-actions): Use + `gnus-agent-possibly-do-gcc' if Agentized. + (gnus-inews-add-send-actions): Add `gnus-agent-possibly-save-gcc' + to `message-header-hook'. + + * gnus.el (gnus-agent-gcc-header): New variable. + +2000-07-13 Simon Josefsson + + Asks the user to synch flags with server when you plug in. + + * gnus-agent.el (gnus-agent-synchronize-flags): New variable. + (gnus-agent-possibly-synchronize-flags-server): New function, use it. + (gnus-agent-toggle-plugged): Call it. + (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'. + (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'. + (gnus-agent-possibly-synchronize-flags): New function. + (gnus-agent-possibly-synchronize-flags-server): New function. + +2000-09-30 Simon Josefsson + + * starttls.el: New file, by Daiki Ueno. + +2000-08-02 Stanislav Shalunov + + * message.el (message-make-in-reply-to): In-Reply-To is message-id + (see DRUMS). + +2000-09-29 Simon Josefsson + + * nntp.el (nntp-async-trigger): Fix authinfo in asynchronous + prefetch. + +2000-08-09 10:21:20 Katsumi Yamaoka + + * nntp.el (nntp-open-telnet): Wait for the telnet prompt before + sending a command; allow the rtelnet prompt as well. + +2000-09-29 Simon Josefsson + + * message.el (message-send): Make sure error is signalled if no + send method is specified. + +2000-09-29 Florian Weimer + + * qp.el (quoted-printable-encode-region): Wrap with + `mm-with-unibyte-current-buffer'. + +2000-09-29 12:12:49 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-fetch-group-1): Reimplement Mike + McEwan's proposal. + +2000-09-29 12:06:40 ShengHuo ZHU + + * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to + the GNU assignment issue. + +2000-09-29 09:56:34 ShengHuo ZHU + + * nndoc.el (nndoc-dissect-mime-parts-sub): Correctly mark body-begin. + +2000-09-29 09:14:08 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-enter-digest-group): Decode to-address. + +2000-09-28 Kai Gro,A_(Bjohann + + * gnus-art.el (article-strip-banner): Use + gnus-group-find-parameter rather than gnus-group-get-parameter, to + allow inheritance on the banner. + From elkin@tverd.astro.spbu.ru. + +2000-09-26 Richard M. Alderson III + + * gnus-art.el (gnus-read-save-file-name): expand-file-name. + +2000-09-26 Dave Love + + * gnus-draft.el: Don't require gnus-agent. + + * mm-view.el: Use featurep for XEmacs test. + (mm-inline-message): Test for `remove-specifier'; don't use + condition-case. + +2000-09-24 Simon Josefsson + + * nnimap.el (nnimap-request-accept-article): Remove From[^:] lines. + + * gnus-group.el (gnus-group-nnimap-edit-acl): Check if server + support ACL's. + + * nnimap.el (nnimap-acl-get): Check capability. + + * mail-source.el (mail-source-imap-file-coding-system): New variable. + (mail-source-fetch-imap): Use it. + + * rfc2104.el (rfc2104-hexstring-to-bitstring): New function. + (rfc2104-hash): Use it. + + * imap.el (imap-starttls-p): Check for starttls binary. + (imap-starttls-open): More verbose. + (imap-gssapi-auth): Ditto. + (imap-kerberos4-auth): Ditto. + (imap-cram-md5-auth): Ditto. + (imap-login-auth): Ditto. + (imap-anonymous-auth): Ditto. + (imap-digest-md5-auth): Ditto. + (imap-open): Ditto. + (imap-digest-md5-p): Check capability first. + +2000-09-24 Simon Josefsson + + * imap.el (imap-parse-flag-list): Correctly parse empty lists. + (imap-login-p): Support LOGINDISABLED. + +2000-09-23 Simon Josefsson + + * rfc2104.el: Add SHA-1 example. + +2000-09-22 Simon Josefsson + + * imap.el (imap-parse-body): Work around bug in Sun SIMS. + +2000-09-21 21:54:48 ShengHuo ZHU + + * lpath.el: Bind nnkiboze-score-file. + +2000-09-21 16:15:25 ShengHuo ZHU + + * gnus-score.el (gnus-score-use-all-scores): New variable. + (gnus-all-score-files): Use it. + * nnkiboze.el (nnkiboze-generate-group): Use it. Inhibit list groups. + (nnkiboze-enter-nov): Fix it when there is no xref. + (nnkiboze-generate-groups): List groups. + * gnus-group.el (gnus-group-make-kiboze-group): Use + nnkiboze-score-file. + + * nnkiboze.el (nnkiboze-request-article): Use + gnus-cache-request-article. + * gnus-group.el (gnus-group-make-kiboze-group): Fix prompt. + +2000-07-16 Dmitry Bely + + * nnheader.el (nnheader-translate-file-chars): Path splitting on NT. + +2000-09-20 18:33:00 ShengHuo ZHU + + * gnus-score.el (gnus-score-find-bnews): Use directory-sep-char. + +2000-09-20 17:37:46 ShengHuo ZHU + + * message.el (message-default-charset): Set default value in + non-MULE XEmacsen as iso-8859-1. + +2000-09-20 12:02:24 ShengHuo ZHU + + * gnus-demon.el: Use (featurep 'xemacs). + * gnus-agent.el: timer vs. itimer. + * mail-source.el: Ditto. + +2000-09-19 10:24:57 ShengHuo ZHU + + * gnus-group.el (gnus-group-make-kiboze-group): Makedir. + * nnheader.el (nnheader-parse-nov): Remove Xref in mail-header-xref. + * gnus-sum.el (gnus-nov-parse-line): Ditto. + * nnkiboze.el (nnkiboze-file-coding-system): New. + (nnkiboze-retrieve-headers): Use it. + (nnkiboze-request-group): Ditto. + (nnkiboze-close-group): Ditto. + (nnkiboze-generate-group): Ditto. + (nnkiboze-enter-nov): Insert first Xref properly. + +2000-09-19 Dave Love + + * nnmail.el (nnmail-cache-accepted-message-ids): Default to nil. + (nnmail-get-new-mail): Test `sources' in top-level conditional. + + * mail-source.el (mail-sources): Change default to '((file)). + Add useful custom type. + +2000-09-18 Kai Gro,A_(Bjohann + + * gnus-util.el (gnus-time-iso8601): Correct doc string (four digit + year). + (gnus-date-iso8601): Ditto. + +2000-09-18 09:05:46 ShengHuo ZHU + + * mail-source.el (mail-source-fetch-imap): Disable multibyte. + +2000-09-17 01:13:46 ShengHuo ZHU + + * rfc2047.el (rfc2047-q-encoding-alist): Remove = and _ from the + pattern. Avoid using 8 bit chars. + * qp.el (quoted-printable-encode-region): Avoid using 8 bit chars. + +2000-09-16 15:57:42 ShengHuo ZHU + + * smiley.el (smiley-buffer-ems, smiley-create-glyph-ems, + smiley-toggle-extent-ems, smiley-toggle-extents-ems, + smiley-toggle-buffer-ems): New functions for Emacs 21. Toggle + functions are not implemented yet. + + * dgnushack.el (dgnushack-compile): Remove smiley.el and + x-overlay.el from the FSF Emacs black list. + +2000-09-15 21:10:20 ShengHuo ZHU + + * mm-decode.el (mm-inlined-types): Add application/emacs-lisp. + (mm-inline-media-tests): Ditto. + (mm-automatic-display): Ditto. + * mm-view.el (mm-display-inline-fontify): Generalize from + mm-display-patch-inline. + (mm-display-patch-inline): Use it. + (mm-display-elisp-inline): Ditto. + +2000-09-15 14:03:00 ShengHuo ZHU + + * gnus-topic.el (gnus-topic-find-groups): Add recursive parameter. + (gnus-topic-unmark-topic): Ditto. + (gnus-topic-mark-topic): Ditto. + (gnus-topic-get-new-news-this-topic): Use it. + +2000-09-15 09:01:40 ShengHuo ZHU + + * gnus-art.el (gnus-treat-display-xface): By default, Emacs 21 + display xface. + +2000-08-23 02:54:46 Katsumi Yamaoka + + * gnus-group.el (gnus-group-rename-group): Inhibit renaming of + zombie or killed groups. + +2000-09-15 00:09:56 ShengHuo ZHU + + * mml.el (mml-preview): Reinsert unibyte content. + (mml-parse-1): Remove with-unibyte-current-buffer. + (mml-generate-mime-1): Ditto. + * gnus-msg.el (gnus-summary-mail-forward): Ditto. + * message.el (message-forward): Ditto. + +2000-09-14 23:13:50 ShengHuo ZHU + + * gnus-art.el (article-de-quoted-unreadable): Guess charset from + original article buffer. + (article-de-base64-unreadable): Ditto. + (article-wash-html): Ditto. + +2000-09-14 18:55:30 ShengHuo ZHU + + * gnus-msg.el (gnus-summary-mail-forward): Disable multibyte + unless forward-show-mml. + +2000-09-14 14:48:57 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-save-parts-type-history): New. + (gnus-summary-save-parts-last-directory): New. + (gnus-summary-save-parts): Save history. + +2000-09-14 Ben Gertzfield + + * gnus-sum.el (gnus-summary-save-parts-default-mime): New + variable. + (gnus-summary-save-parts): Use it. + +2000-09-14 11:31:28 ShengHuo ZHU + + * gnus-art.el (gnus-article-setup-buffer): Clean handle-alist. + * gnus-sum.el (gnus-summary-exit): Ditto. + (gnus-summary-exit-no-update): Ditto. + (gnus-summary-show-article): Ditto. + +2000-09-14 08:42:48 ShengHuo ZHU + + * nndoc.el (nndoc-dissect-mime-parts-sub): Remove + Content-Disposition. + +2000-09-13 23:58:40 ShengHuo ZHU + + * webmail.el: Hotmail updated. Add X-Gnus-Webmail. + +2000-09-13 21:41:25 ShengHuo ZHU + + * gnus-art.el (gnus-article-setup-buffer): Set + gnus-article-mime-handles to nil. + * gnus-sum.el (gnus-summary-exit): Ditto. + (gnus-summary-exit-no-update): Ditto. + (gnus-summary-show-article): Ditto. + (gnus-summary-save-parts): Use gnus-article-mime-handles if + dissected. + * mm-partial.el (mm-partial-find-parts): Remove redundancy. + +2000-09-13 16:59:33 ShengHuo ZHU + + * gnus-sum.el (gnus-summary-sort): Sort loose threads too. + (gnus-sort-threads-1): New function. Sort threads recursively. + (gnus-sort-threads): Use it. + (gnus-sort-gathered-threads): Doc fix. + +2000-09-13 Dave Love + + * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode. + + * gnus-ems.el (gnus-ems-redefine): Don't alias + gnus-summary-set-display-table. + + * message.el (message-user-agent): Don't wrap ignore-errors around + it. + + * mm-encode.el (mm-insert-multipart-headers): Avoid redundant + `format'. + (mm-content-transfer-encoding): Don't use cadar. + + * uudecode.el (uudecode-decoder-program) + (uudecode-decoder-switches): Customize. + + * gnus-score.el (gnus-home-score-file): Improve custom type. + + * gnus-cus.el (gnus-custom-mode): Conditionally set local + variables for Emacs 21. + (gnus-group-customize): Disable undo while laying out the buffer. + +2000-09-13 09:38:26 ShengHuo ZHU + + * gnus-util.el (gnus-write-active-file): Bind + coding-system-for-write. + +2000-09-13 09:14:57 ShengHuo ZHU + + * nnmail.el (nnmail-get-new-mail): Don't test nnmail-spool-file. + + * gnus-cache.el (gnus-jog-cache): Temporarily disable mail-sources. + * gnus-kill.el (gnus-batch-score): Ditto. + * gnus-move.el (gnus-change-server): Ditto. + * nnkiboze.el (nnkiboze-generate-groups): Ditto. + +2000-09-12 Simon Josefsson + + * gnus-sum.el (gnus-update-read-articles): Undo + `gnus-request-set-mark' operation. + +2000-09-11 Dave Love + + * Changelog: Use iso-2022 coding. + + * gnus-msg.el (gnus-msg-mail): New function. + (gnus-user-agent): New mail agent. + +2000-09-10 Dave Love + + * message.el: Require mail-abbrevs for XEmacs for a problem with + keybinding despite the autoloads for it. + +2000-09-08 Simon Josefsson + + * imap.el (imap-kerberos4-open): Erase more (fixes race condition?). + + * nnimap.el (nnimap-request-update-info-internal): Remove tick + marks from dormant articles. (See nnimap-request-set-mark.) + (nnimap-retrieve-headers-progress): Demule. + (nnimap-open-server): Call nnoo-change-server twice, once for + getting the nnimap-server-buffer and once for letting n-c-s set + the variables in that buffer. + +2000-09-08 David Edmondson + + * gnus.el (gnus-short-group-name): Guess separator. + +2000-09-07 Tadashi Watanabe + + * smiley.el (smiley-buffer, smiley-create-glyph): Work with GTK + XEmacs as well. + +2000-09-06 Francis Litterio + + * gnus-group.el (gnus-group-insert-group-line): Fix. + +2000-09-04 Dave Love + + * mm-decode.el (mime-display) : Add `multimedia' group. + (mm-get-image): Avoid the losing `make-glyph' from W3. + +2000-09-03 Simon Josefsson + + * gnus-sum.el (gnus-summary-delete-article): Check server. + +2000-09-01 Simon Josefsson + + * imap.el (imap-parse-flag-list): Rewrite. + + * nnimap.el (nnimap-retrieve-headers-from-file): Ignore errors. + + * imap.el (imap-parse-flag-list): Hack. + +2000-08-29 Dave Love + + * gnus-mlspl.el (gnus-group-split-fancy): Eschew mapcon. + + * dgnushack.el (mapcon, union): Remove compiler macros. + + * gnus-agent.el (gnus-agent-union): new function. + (gnus-agent-fetch-headers): Use it. + + * gnus.el (gnus-group-startup-message): Specify foreground and + background for xpm image. Centre image vertically. + From Katsumi Yamaoka with mods. + +2000-08-24 23:49:23 ShengHuo ZHU + + * message.el (message-send-mail): Narrow-to-headers. + +2000-08-24 Dave Love + + * gnus-art.el (gnus-insert-mime-button): Fix help-echo for Emacs + 21. + +2000-08-23 Dave Love + + * dgnushack.el: Remove `member-if' compiler macro. + +2000-08-21 Dave Love + + * nnimap.el (nnimap-request-newgroups): Eschew member-if. + +2000-08-21 10:09:47 ShengHuo ZHU + + * gnus-topic.el (gnus-topic-hide-topic): Use find-topology if + permanent is used. + (gnus-topic-show-topic): Read topic when to show permanent hidden + topic. + (gnus-topic-remove-topic): Revert to the old behavior, not using + hide. + +2000-08-21 Dave Love + + * gnus-ems.el (gnus-add-minor-mode): Add &rest arg. + (gnus-xemacs): Use featurep. + + * mm-util.el (mm-read-charset): Maybe use builtin. + (mm-replace-chars-in-string): Maybe use subst-char-in-string. + (mm-multibyte-p, mm-with-unibyte-current-buffer) + (mm-with-unibyte): Use featurep, not string-match. + (mm-with-unibyte-buffer): Simplify. + (mm-quote-arg): Maybe use shell-quote-argument. + + * mml.el (mml-make-string): Deleted (unused). + + * gnus.el (gnus-mode-line-buffer-identification): Supply + definition for Emacs 21. + + * gnus-salt.el: Small doc fixes. + (gnus-pick-mode, gnus-binary-mode): Supply a toggle-func arg to + gnus-add-minor-mode. + + * gnus-topic.el (gnus-topic-mode): Supply a toggle-func arg to + gnus-add-minor-mode. + +2000-08-20 Simon Josefsson + + * nnimap.el (nnimap-before-find-minmax-bugworkaround): New + function, thanks to Lloyd Zusman for debugging. + (nnimap-request-group): + (nnimap-request-list): + (nnimap-retrieve-groups): + (nnimap-request-newgroups): Use it. + + * nnimap.el (nnimap-request-article-part): Less verbose. + +2000-08-19 Andreas Jaeger + + * lpath.el ((string-match "XEmacs" emacs-version)): Remove + subst-char-in-string since we test elsewhere whether it's bound. + +2000-08-18 Dave Love + + * gnus-score.el (gnus-score-find-score-files-function): Fix doc, + custom type. + + * gnus-xmas.el (gnus-group-icon-create-glyph): Don't test + gnus-group-running-xemacs. + + * nnheader.el (nnheader-replace-chars-in-string): Use + subst-char-in-string if available. + + * gnus-art.el (gnus-read-save-file-name, gnus-plain-save-name) + (gnus-request-article-this-buffer): Use expand-file-name. + (gnus-mime-view-part-as-type): Simplify interactive spec. + (gnus-mime-button-map): Define it all in defvar. + +2000-08-17 Dave Love + + * gnus-group.el (gnus-group-running-xemacs): Deleted. + + * gnus-demon.el (gnus-demon): Bind use-dialog-box and + last-nonmenu-event. + + * uudecode.el (char-int): Use defalias, not fset. + + * score-mode.el: Don't require easymenu. Require mm-util. + (score-mode-coding-system): Use mm-auto-save-coding-system. + + * nneething.el (nneething-create-mapping): Don't use cadar & al. + (nneething-file-name): Use expand-file-name, not concat. + +2000-08-16 13:05:46 ShengHuo ZHU + + * nnslashdot.el (nnslashdot-threaded-retrieve-headers): + Failure proof for email addresses. + (nnslashdot-sane-retrieve-headers): Ditto. + +2000-08-14 20:08:40 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Only insert courtesy message + when text/plain. + +2000-08-14 19:55:04 Jesper Harder + + * message.el (message-cancel-news): Copy the From header from the + original article. + +2000-08-14 19:52:01 Lars Magne Ingebrigtsen + + * gnus-async.el (gnus-asynchronous): Removed. + +2000-08-14 16:12:11 ShengHuo ZHU + + * mail-source.el (mail-source-fetch-maildir): Use MMDF mail + format. + +2000-08-14 19:12:22 Rod Whitby + + * nnmail.el (nnmail-expiry-target-group): Fixed. + +2000-08-14 Rod Whitby + + * nnmail.el (nnmail-expiry-target-group): Fix the call to + gnus-request-accept-article so that body encoding is *not* done. + Encoding is not done on incoming mail, so why should it be done on + expired mail? + + +2000-08-14 Rod Whitby + + * nnml.el (nnml-request-expire-articles): Fix the calls to + nnml-request-article (the filename was being passed instead of the + article number) and nnmail-expiry-target-group + (nnml-current-directory is changed by nnml-request-accept-article, + causing it to be incorrect for the next article to be expired). + +2000-08-14 Rod Whitby + + * gnus-sum.el (gnus-summary-expire-articles): Fix the handling of + expiry-target group parameters. + +2000-08-13 18:53:08 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-select-group): Touch the dribble + buffer. + (gnus-topic-hide-topic): Take a PERMANENT parameter. + (gnus-topic-show-topic): Ditto. + + * gnus-dup.el (gnus-dup-suppress-articles): Do auto-expiry. + +2000-08-12 21:48:00 John H. Palmieri + + * mail-source.el (mail-source-incoming-file-prefix): New + variable. + +2000-08-12 20:29:53 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-check-first-time-used): Clean up a bit. + + * mailcap.el (mailcap-maybe-eval): Be even more warning. + +2000-08-11 Florian Weimer + + * message.el (message-syntax-checks): New check quotin-style: + Text must be written below quoted text. + (message-check-news-body-syntax): Check it. + +2000-08-11 Simon Josefsson + + * imap.el (imap-authenticator-alist): Fix typo. + (imap-gssapi-open): Copy krb4 fixes for modern imtest's, thanks to + Jonas Oberg for debugging. + +2000-08-11 Simon Josefsson + + * gnus-async.el (gnus-asynchronous): Disable by default. + +2000-08-10 20:22:09 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Bind fill-column. + + * nnvirtual.el (nnvirtual-request-expire-articles): Return the + list of unexpired articles. + + * gnus-group.el (gnus-group-expire-articles-1): Return the list of + un-expired articles. + + * gnus-sum.el (gnus-summary-reparent-thread): Narrow to the + headers. + + * gnus-topic.el (gnus-topic-kill-group): Move up one line so that + we update the right topic.. + + * mm-decode.el (mm-display-external): Put point at start. + +2000-08-10 Kai Gro,A_(Bjohann + + * nnmail.el (nnmail-expiry-target): More explicit documentation. + + * gnus-cus.el (gnus-group-parameters): Add parameter `expiry-wait'. + +2000-08-09 Simon Josefsson + + * imap.el (imap-parse-body): + (imap-parse-string-list): Add bug workarounds for Stalker + Communigate Pro 3.0 server. + (imap-body-lines): Remove bogus comment. + + * imap.el (imap-range-to-message-set): Move from nnimap.el. + + * nnimap.el (nnimap-retrieve-which-headers): + (nnimap-retrieve-headers-from-server): + (nnimap-request-set-mark): + (nnimap-request-expire-articles): Use `i-r-t-m-set' instead. + +2000-08-08 00:53:41 ShengHuo ZHU + + * message.el (message-dont-reply-to-names): + rmail-dont-reply-to-names may not be defined. + +2000-08-07 09:37:01 ShengHuo ZHU + + * gnus-group.el (gnus-group-iterate): Uncompiled function should + not use pop. + +2000-07-19 Dave Love + + * gnus-ems.el: Defalias some dummy funcs to `ignore'. + (gnus-x-splash): Use expand-file-name. Remove redundant facep + check. + (gnus-article-display-xface): Special-case for dark backgrounds. + +2000-07-19 Kim-Minh Kaplan + + * imap.el (imap-calculate-literal-size-first): New variable. + (imap-local-variables): Add it. + (imap-kerberos4-open): Set it. + (imap-send-command): Use it. + +2000-07-17 14:18:16 ShengHuo ZHU + + * mailcap.el (mailcap-mimetypes-parsed-p): New variable. + (mailcap-parse-mimetypes): Use it. + (mailcap-extension-to-mime): Parse mimetype. + (mailcap-mime-types): Ditto. + * mml.el (mml-minibuffer-read-type): Ditto. + +2000-07-16 18:25:07 ShengHuo ZHU + + * nndoc.el (nndoc-type-alist): Add outlook. + (nndoc-outlook-type-p): New function. + (nndoc-outlook-article-begin): Ditto. + +2000-07-16 Daiki Ueno + + * gnus-sum.el (gnus-restore-hidden-threads-configuration): Save + excursion. + +2000-07-15 Simon Josefsson + + * gnus-cus.el (gnus-group-parameters, banner): Type is regexp. + + * imap.el (imap): + (imap-kerberos4-program): + (imap-gssapi-program): + (imap-ssl-program): Customization. + (imap-shell-program): + (imap-shell-host): New variables. + (imap-streams): + (imap-stream-alist): Add shell. + (imap-shell-p): + (imap-shell-open): New functions. + (imap-open): Don't call authenticator if preauth. + (imap-authenticate): Return t if already authenticated. + +2000-07-14 Simon Josefsson + + * gnus.el (gnus-invalid-group-regexp): New variable. + (gnus-read-group): Use it. + +2000-07-14 12:40:51 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-fetch-group-1): mark-below, + expunge-below and orphan-score are "group variables". + +2000-07-13 Simon Josefsson + + * gnus-srvr.el (gnus-browse-read-group): Don't pass fully + qualified group names to `gnus-group-read-ephemeral-group'. + +2000-07-13 07:40:39 Katsumi Yamaoka + + * dgnushack.el (srcdir): Define it before use it. + +2000-07-12 19:37:50 ShengHuo ZHU + + * gnus-sum.el: `W t' is toggle-header in info. + +2000-07-12 16:50:06 ShengHuo ZHU + + * lpath.el: Fbind subst-char-in-string. + +2000-07-12 15:48:29 ShengHuo ZHU + + * Makefile.in: Use W3DIR and lispdir. + * dgnushack.el: Ditto. + +2000-07-12 10:12:31 ShengHuo ZHU + + * gnus-art.el (article-de-base64-unreadable): Typo. + +2000-07-12 Simon Josefsson + + * gnus-agent.el (require): Require timer. + +2000-07-11 18:29:50 ShengHuo ZHU + + * message.el (message-bounce): Call mime-to-mml. + +2000-07-11 18:00:49 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-close): New function. + +2000-07-04 23:23:23 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Get the + right line number for the article. + +2000-07-10 22:41:58 ShengHuo ZHU + + * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Save point. + * webmail.el (webmail-fetch): Bind + url-http-silence-on-insecure-redirection. + +2000-07-10 11:43:22 ShengHuo ZHU + + * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Use + unibyte. + (nnslashdot-sane-retrieve-headers): Ditto. + (nnslashdot-request-article): Ditto. + +2000-07-10 11:12:32 William M. Perry + + * mailcap.el (mailcap-parse-mimetype-file): + +2000-07-07 23:46:22 ShengHuo ZHU + + * nnweb.el (nnweb-insert): Stricter test. + * webmail.el (webmail-refresh-redirect): Ditto. + +2000-07-06 14:17:48 ShengHuo ZHU + + * mm-decode.el (mm-dissect-multipart): Match the EOL of boundary. + +2000-07-05 21:19:22 ShengHuo ZHU + + * nnheader.el (nnheader-insert-nov): Remove EOLs of all fields. + +2000-07-05 Dave Love + + * utf7.el: Doc and header fixes. + + * gnus-sum.el: Doc fixes. + + * gnus-util.el (gnus-point-at-eol, gnus-point-at-bol): Use + defalias, not fset. + + * flow-fill.el (fill-flowed-point-at-eol) + (fill-flowed-point-at-bol): Use defalias, not fset. + + * gnus-art.el: Don't alias article-mime-decode-quoted-printable. + (gnus-Plain-save-name): Delete -- apparently bogus. + +2000-07-03 00:12:26 Lars Magne Ingebrigtsen + + * nnsoup.el: Use expand-file-name throughout. + +2000-07-03 00:07:51 Kjetil Torgrim Homme + + * nnmail.el (nnmail-read-incoming-hook): New example. + +2000-07-02 23:17:23 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Check whether the text has already + been decoded. + +2000-07-04 15:17:05 ShengHuo ZHU + + * nnslashdot.el (nnslashdot-sid-strip): To strip or not to strip? + +2000-07-03 Stainless Steel Rat + + * gnus-sum.el (gnus-recenter): Fix horizontal recenter. + +2000-07-03 Simon Josefsson + + * gnus-sum.el (gnus-update-marks): Don't propagate download and + unsend flags. + +2000-07-03 Simon Josefsson + + * nnimap.el (nnimap-open-connection): Don't look up virtual server + name in authinfo (.authinfo now support ports, no need for the + hack). + (nnimap-split-find-rule): Fix. + (nnimap-open-connection): Look for nnimap-server-address in authinfo. + +2000-07-03 Paul Stodghill + + * message.el (message-unquote-tokens): Remove all quotes. + +2000-07-03 00:29:08 Julien Gilles + + * gnus-ml.el: New file. + +2000-07-02 16:11:25 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-request-close): New function. + + * gnus-start.el (gnus-clear-system): Clear nnmail-split-history. + +2000-06-18 Norbert Koch + + * Makefile.in: Better support for xemacs builds + +Sun Jul 2 15:11:35 2000 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.8.7 is released. + +2000-05-19 06:32:52 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-insert-part): Characters doubly decoded. + +2000-07-01 10:23:08 Shenghuo ZHU + + * message.el (message-do-fcc): Encode MIME. + +2000-06-28 13:52:57 Shenghuo ZHU + + * lpath.el: Fbind image-size. + +2000-06-28 Simon Josefsson + + * nnimap.el (nnimap-split-rule): Update doc with extended syntax. + (nnimap-assoc-match): New function. + (nnimap-split-find-rule): Support extended syntax. + +2000-06-28 Simon Josefsson + + * nnimap.el (nnimap-open-connection): Use port stuff. + + * gnus-util.el (gnus-netrc-machine): Add defaultport parameter, + document port and defaultport. + +2000-06-27 Paul Stodghill + + * gnus-agent.el (gnus-agent-synchronize): Kill flags buffer. + +2000-06-26 Dave Love + + * mm-decode.el (mm-image-fit-p): Use `image-size' in Emacs. + + * message.el: Remove unnecessary `require'ments. Defvar + gnus-list-identifiers when compiling. Don't try to autoload + variable `gnus-list-identifiers'. Autoload + gnus-group-name-charset. + (message-fetch-field): Don't assume `format' removes text + properties. + (message-strip-list-identifiers, message-reply, message-followup): + Require gnus-sum. + (message-mode): Tidy XEmacs conditionals. + (message-replace-chars-in-string): Use subst-char-in-string when + available. + + * gnus-xmas.el (gnus-xmas-define) : + Define if necessary. + + * gnus-art.el (gnus-article-edit-exit): Don't assume `format' + removes text properties. + + * gnus-srvr.el (gnus-browse-group-name): Likewise. + + * gnus-msg.el (gnus-copy-article-buffer): Likewise. + + * gnus-score.el (gnus-summary-score-entry): Likewise. + +2000-06-26 11:18:57 Katsumi Yamaoka + + * nnimap.el (nnimap-request-post): Fix parenthesis. + +2000-06-26 Paul Stodghill + + * message.el (message-unquote-tokens): New function. + + * gnus-msg.el (gnus-inews-do-gcc): Unquote gcc tokens. + + * nnimap.el (nnimap-request-post): Ditto. + +2000-06-21 Simon Josefsson + + * gnus.el (gnus-asynchronous): Removed (defined in gnus-async.el). + + * nnimap.el (nnimap-callback): Update for IMAP4rev1 servers (see + patch commited 2000-04-02). + +2000-06-20 Simon Josefsson + + * imap.el (imap-mailbox-examine-1): New function. + (imap-message-copyuid-1): + (imap-message-appenduid-1): Use it, instead of + `imap-mailbox-examine' which would utf-7 encode mailbox name + twice. + +2000-06-19 Dave Love + + * mm-uu.el Don't require message. Require cl when compiling. + +2000-06-17 18:58:46 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-local-variables): gnus-orphan-score is + a local variable. + * gnus-sum.el (gnus-orphan-score): Move here. + +2000-06-10 09:33:36 Shenghuo ZHU + + * message.el (message-forward): Remove show-mml condition. + (message-forward-ignored-headers): Remove X-Gnus headers. + +2000-06-08 Simon Josefsson + + * gnus-cus.el (gnus-extra-group-parameters): Add uidvalidity. + +2000-06-08 12:34:26 Urban Engberg + + * gnus-demon.el (gnus-demon-scan-mail): Bind nnmail-fetched-sources. + +2000-06-08 12:27:55 Shenghuo ZHU + + * message.el (message-syntax-checks): Add type. + +2000-06-07 Dave Love + + * mm-view.el (mm-inline-image-emacs): Don't specify string for + put-image. + (mm-inline-image): Defalias, not fset. + + * gnus.el (gnus-group-startup-message): Don't specify string for + insert-image. + + * gnus-ems.el (gnus-add-minor-mode): Make it an alias if + add-minor-mode is available. + (gnus-article-display-xface): Don't specify string for + insert-image. + +2000-06-06 13:28:53 Shenghuo ZHU + + * gnus-topic.el (gnus-topic-remove-topic): Set hidden. + (gnus-topic-insert-topic-line): Use shownp. + (gnus-topic-hide-topic): Don't use hidden. + (gnus-topic-show-topic): Don't use hidden. + +2000-06-05 22:25:12 Shenghuo ZHU + + * gnus-cache.el (gnus-cache-possibly-enter-article): Bind coding + system. + * gnus-soup.el (gnus-soup-write-prefixes): Ditto. + * gnus-start.el (gnus-slave-save-newsrc): Ditto. + * gnus-util.el (gnus-output-to-rmail): Ditto. + (gnus-output-to-mail): Ditto. + (gnus-write-buffer): Ditto. + * gnus-uu.el (gnus-uu-save-article): Ditto. + +2000-06-04 15:05:16 Shenghuo ZHU + + * message.el (message-read-from-minibuffer): Typo. + +2000-06-03 13:36:46 Shenghuo ZHU + + * gnus-art.el (article-decode-charset): Override non-MIME forward + charset. + +2000-06-02 12:04:26 Shenghuo ZHU + + * mml.el (mml-quote-region): Correct the regexp. + * gnus-msg.el (gnus-summary-reply): mml-quote it. + +2000-06-02 11:57:15 Shenghuo ZHU + + * message.el (message-forward): Insert raw text. + * mml.el (mml-parse-1): Get raw text in unibyte mode. + (mml-generate-mime-1): Insert raw text in unibyte mode. + +2000-06-01 Florian Weimer + + * mm-bodies.el (mm-body-encoding): Always encoded if + `mm-use-ultra-safe-encoding' is set. + +2000-05-31 14:50:52 Shenghuo ZHU + + * mml.el (ange-ftp-name-format): Typo. + +2000-05-30 Simon Josefsson + + * gnus-start.el (gnus-get-unread-articles): If + `gnus-activate-group' and/or `gnus-check-server' return nil, don't + try to do anything on that server. + +2000-05-25 Simon Josefsson + + * gnus-group.el (gnus-group-nnimap-edit-acl): Help text updated + from latest draft. + +2000-05-08 Simon Josefsson + + * gnus-group.el (gnus-group-expire-articles-1): Make sure server + is open. + +2000-05-24 Dave Love + + * mml.el (mml-parse-file-name): Fix ange-ftp part. + +2000-05-22 Didier Verna + + * gnus.el (gnus-redefine-select-method-widget): new function, call + it once. Add an "other" entry for unknown but editable backend + name symbols. + * gnus-start.el (gnus-declare-backend): use it. + +2000-05-19 Dave Love + + * gnus-art.el (gnus-article-next-page): Revert last change. + +2000-05-19 09:56:07 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-open-history): Open history in binary mode. + +2000-05-19 Dave Love + + * gnus-art.el (gnus-mime-externalize-part): Bind mm-inlined-types, + not mm-inline-large-images. + +2000-05-19 01:45:40 Shenghuo ZHU + + * mml.el (mml-parse-1): Don't test multiple-charsets within mml tag. + +2000-05-18 Dave Love + + * gnus-art.el: Use defalias, not fset. + (gnus-article-x-face-command): Don't test for xbm. + (gnus-article-next-page): Redisplay before testing point in window. + +2000-05-17 21:16:54 Shenghuo ZHU + + * gnus-group.el (gnus-group-mode-map): Add M-SPACE. + * mml.el (mml-mode-map): Comment out mml-narrow-to-part. + +2000-05-17 21:13:38 Jim Davidson + + * gnus-sum.el (gnus-summary-save-article-rmail): Use + gnus-summary-save-in-rmail. + * message.el (message-output): Ditto. + +2000-05-17 22:37:25 Katsumi Yamaoka + + * gnus-art.el (gnus-emphasize-whitespace-regexp): Doc fix. + +2000-05-17 14:03:49 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Encode if the method + is a charset. + * message.el (message-send-news): Check group name charset. + * gnus-msg.el (gnus-post-news): Decode group name. + (gnus-inews-do-gcc): Encode group name. + +2000-05-17 10:16:32 Karl Kleinpaste + + * gnus-art.el (gnus-emphasize-whitespace-regexp): New variable. + * gnus-util.el (gnus-put-text-property-excluding-newlines): Use it. + +2000-05-17 02:25:11 Shenghuo ZHU + + * gnus-group.el (gnus-group-mark-line-p): New function. + (gnus-group-goto-group): New parameter. + (gnus-group-remove-mark): Use it. + * gnus-topic.el (gnus-topic-move-group): Ditto. + (gnus-topic-remove-group): Ditto. + +2000-05-17 00:49:09 Shenghuo ZHU + + * gnus-group.el (gnus-group-list-dormant): New function. + +2000-05-16 23:20:42 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-synchronize): Use + nnheader-insert-file-contents. + (gnus-agent-save-active-1): Ditto. + (gnus-agent-write-active): Ditto. + (gnus-agent-expire): Ditto. + * gnus-cache.el (gnus-cache-read-active): Ditto. + * gnus-start.el (gnus-master-read-slave-newsrc): Ditto. + * gnus-sum.el (gnus-summary-import-article): Ditto. + + * gnus-agent.el (gnus-agent-write-servers): Bind coding-system. + (gnus-agent-save-group-info): Ditto. + (gnus-agent-save-alist): Ditto. + * gnus-util.el (gnus-make-directory): Ditto. + + * gnus-agent.el (gnus-agent-save-group-info): Disable multibyte. + +2000-05-16 21:13:24 Shenghuo ZHU + + * mml.el (mml-generate-mime-preprocess-function): New variable. + (mml-generate-mime-postprocess-function): New variable. + (mml-generate-mime-1): Use them. + +2000-05-16 18:15:24 Shenghuo ZHU + + * gnus-group.el (gnus-group-apropos): Group name charset. + * gnus-sum.el (gnus-set-mode-line): Ditto. + * gnus-group.el (gnus-group-decoded-name): New function. + (gnus-group-edit-group): Use it. + * gnus-cus.el (gnus-group-customize): Use it. + +2000-05-16 17:55:57 Karl Kleinpaste + + * gnus-util.el (gnus-put-text-property-excluding-newlines): Improve. + +2000-05-16 16:22:17 Shenghuo ZHU + + * gnus-group.el (gnus-group-name-charset-method-alist): New variable. + (gnus-group-name-charset-group-alist): Ditto. + (gnus-group-name-charset): New function. + (gnus-group-name-decode): New function. + (gnus-group-insert-group-line): Use them. + (gnus-group-prepare-flat-list-dead): Ditto. + (gnus-group-list-active): Ditto. + (gnus-group-describe-all-groups): Ditto. + (gnus-group-prepare-flat-list-dead-predicate): Ditto. + * gnus-srvr.el: (gnus-browse-foreign-server): Decode group name and + add gnus-group property. + (gnus-browse-group-name): Read gnus-group property. + +2000-05-16 15:27:08 Shenghuo ZHU + + * nnfolder.el (nnfolder-possibly-change-group): Use + file-name-coding-system instead of pathname-coding-system. + * nnmail.el (nnmail-find-file): Ditto. + (nnmail-write-region): Ditto. + * nnmh.el (nnmh-retrieve-headers): Ditto. + (nnmh-request-article): Ditto. + (nnmh-request-group): Ditto. + (nnmh-request-list): Ditto. + (nnmh-possibly-change-directory): Ditto. + (nnmh-active-number): Ditto. + * nnml.el (nnml-possibly-change-directory): Ditto. + (nnml-request-list): Ditto. + (nnml-request-article): Ditto. + (nnml-retrieve-headers): Ditto. + +2000-05-16 Simon Josefsson + + * nnimap.el (nnimap-request-accept-article): Don't unselect + mailbox if no mailbox is selected. + +2000-05-15 Per Abrahamsen + + * gnus-art.el (gnus-button-url-regexp): Revert earlier change. + Recognize domain names starting with `www.' as starting an URL. + +2000-05-15 09:46:47 Shenghuo ZHU + + * mail-source.el (mail-source-fetch-maildir): Insert "From ". + (mail-source-keyword-map): Add "subdirs" for maildir. + +2000-05-14 16:19:28 Shenghuo ZHU + + * nnmail.el (nnmail-scan-directory-mail-source-once): New variable. + (nnmail-get-new-mail): Use it. + * gnus-start.el (gnus-get-unread-articles): Ditto. + +2000-05-14 14:02:12 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-edit-article): Better support for + nndraft:drafts. + * nndraft.el (nndraft-request-replace-article): New function, + bind nnmail-file-coding-system. + +2000-05-14 Dave Love + + * nnheader.el: Replace uses of `fset' with `defalias'. + (jka-compr-compression-info-list): Only defvar when compiling. + +2000-05-14 12:30:28 Shenghuo ZHU + + * webmail.el (webmail-netaddress-article): Refresh redirect. + +2000-05-13 20:41:10 Shenghuo ZHU + + * mm-view.el (mm-inline-text): w3 might not recognize utf-8. + +2000-05-13 16:49:41 Shenghuo ZHU + + * webmail.el: Translate   to SP. + +2000-05-13 13:00:17 Robin S. Socha + + * message.el (message-bounce): Doc typo. + +2000-05-13 12:25:21 Shenghuo ZHU + + * gnus-soup.el (gnus-soup-encoding-type): u is USENET news format. + (gnus-soup-store): Ditto. + (gnus-soup-send-packet): Ditto. + * nnsoup.el (nnsoup-replies-format-type): Ditto. + (nnsoup-dissect-buffer): Ditto. + (nnsoup-narrow-to-article): Ditto. + (nnsoup-make-active): Ditto + +2000-05-13 12:03:29 Shenghuo ZHU + + * message.el (message-mode): Two parameters for local-variable-p. + +2000-05-13 00:54:46 Shenghuo ZHU + + * message.el (message-strip-list-identifiers): New function. + (message-reply): Use it and use message-strip-subject-re. + (message-followup): Ditto. + * gnus-art.el (article-hide-list-identifiers): Remove more. + * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto. + +2000-05-12 22:28:54 Shenghuo ZHU + + * gnus-uu.el (gnus-uu-digest-mail-forward): Bind + mail-parset-charset and use non-numeric argument. + +2000-05-12 20:54:11 Shenghuo ZHU + + * mml.el (mml-buffer-list): New variable. + (mml-generate-new-buffer): New function. + (mml-destroy-buffers): Ditto. + (mml-insert-mime): Use them. + * gnus-msg.el (gnus-setup-message): mml-buffer leaks. + * gnus-sum.el (gnus-summary-edit-article): Ditto. + * message.el (message-mode): Ditto. + * gnus-uu.el (gnus-uu-digest-headers): Keep MIME headers. + (gnus-uu-save-article): Support show-as-mml. + * message.el (message-forward): Ditto. + +2000-05-12 15:15:55 Shenghuo ZHU + + * nndoc.el (nndoc-type-alist): mime-digest head-begin. + (nndoc-mime-digest-type-p): Locate article head precisely. + * mml.el (mml-generate-default-type): New variable. + (mml-generate-mime-1): Use it. + (mml-insert-mime-headers): Use it. + * gnus-uu.el (gnus-uu-digest-buffer): New variable. + (gnus-uu-digest-mail-forward): Use it and call message-forward + with argument digest. + (gnus-uu-save-article): Support message-forward-as-mime. + * message.el (message-forward): Add parameter digest. + * mm-decode.el (mm-dissect-default-type): New variable. + (mm-dissect-buffer): Use it. + +2000-05-11 11:08:03 Shenghuo ZHU + + * mml.el (mml-parse-singlepart-with-multiple-charsets): Set space, + newline and paragraph to nil when got a non-ascii character. Test + paragraph before newline. + +2000-05-10 12:17:58 Shenghuo ZHU + + * qp.el (quoted-printable-encode-region): Bind tab-width to 1. Set + limit to 76. + +2000-05-10 09:11:48 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-sid-strip): New function. + (nnslashdot-threaded-retrieve-headers): New format. + (nnslashdot-sane-retrieve-headers): Ditto. + (nnslashdot-request-article): Ditto. + (nnslashdot-threaded-retrieve-headers): Thread properly. + (nnslashdot-request-article): Be more lenient. + (nnslashdot-threaded-retrieve-headers): Regexp search. + +2000-05-09 13:23:50 Shenghuo ZHU + + * gnus-sum.el (gnus-with-article): Define it before use it. + +2000-05-08 22:34:19 Shenghuo ZHU + + * message.el (message-supersede): Use mime-to-mml. + * mm-decode.el (mm-insert-part): Test the buffer if no encoding. + +2000-05-08 22:34:24 Katsumi Yamaoka + + * gnus-group.el (gnus-group-list-cached): Don't use + `subst-char-in-string'. + +2000-05-08 Dave Love + + * pop3.el (pop3-open-server): Fix creating name of trace buffer. + +2000-05-08 01:07:47 Shenghuo ZHU + + * mm-decode.el (mm-interactively-view-part): Append %s if the + method is a single word. + * nnwarchive.el (nnwarchive-type-definition): Typo. + +2000-05-07 17:24:01 Shenghuo ZHU + + * gnus-group.el (gnus-group-prepare-flat-list-dead-predicate): New + function. + (gnus-group-prepare-flat-predicate): Use it. + (gnus-group-list-cached): List dead groups. + +2000-05-07 10:50:02 Shenghuo ZHU + + * gnus-art.el (article-decode-charset): Don't decode message with + format. + +2000-05-07 Florian Weimer + + * mailcap.el (mailcap-maybe-eval): Honor user request not to + evaluate the Lisp code. + +2000-05-06 17:40:20 Shenghuo ZHU + + * gnus-art.el (article-wash-html): New function. + (gnus-article-wash-html): Bind. + (gnus-article-make-menu-bar): Menu item. + * gnus-sum.el (gnus-summary-wash-map): Bind 'h'. + (gnus-summary-make-menu-bar): Menu item. + * gnus.el: Autoload. + +2000-05-06 Florian Weimer + + * gnus-uu.el (gnus-uu-unshar-warning): New variable. + (gnus-uu-unshar-article): Use it. + + * mailcap.el (mailcap-maybe-eval-warning): New variable. + (mailcap-maybe-eval): Use it. + + * gnus-msg.el (gnus-group-posting-charset-alist): Speling mistake + in docstring. + + * mml.el (mml-generate-mime-1): Small comment. + +2000-05-05 12:27:53 Shenghuo ZHU + + * gnus-art.el (article-de-base64-unreadable): New function. + (gnus-article-de-base64-unreadable): Bind. + (gnus-article-make-menu-bar): Menu item. + * gnus-sum.el (gnus-summary-wash-map): Bind '6' and 'Z'. + (gnus-summary-make-menu-bar): Menu item. + * gnus.el: Autoload. + +2000-05-05 10:32:27 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-show-article): Remove en/disable multibyte. + (gnus-summary-select-article): Add en/disable multibyte. + +2000-05-05 02:47:23 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-edit-article): Enable multibyte. + (gnus-summary-edit-article): New feature: editing raw articles. + +2000-05-05 00:30:12 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-region): Insert a space before encoding. + Emacs MULE can not encode adjacent iso-2022-jp and cn-gb-2312. + * gnus-msg.el (gnus-summary-mail-forward): Use unibyte buffer. + Emacs MULE can not copy some 8bit characters in multibyte buffers. + * mm-decode.el (mm-insert-part): Ditto. + +2000-05-04 17:49:04 Shenghuo ZHU + + * nndoc.el (nndoc-type-alist): Extend forward regexp. + (nndoc-forward-type-p): Ditto. + +2000-05-04 17:13:04 Shenghuo ZHU + + * mm-util.el (mm-with-unibyte-current-buffer): Set the default + value of enable-multibyte-characters. + +2000-05-04 10:31:24 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-show-article): En/disable multibyte. + +2000-05-03 Dave Love + + * gnus-ems.el (gnus-article-xface-ring-internal) + (gnus-article-xface-ring-size): New variable. + (gnus-article-display-xface): Use them to cache data. Don't try + to use XPM. Set up binary coding for PBM's sake. + +2000-05-03 14:23:38 Shenghuo ZHU + + * gnus-msg.el (gnus-inews-do-gcc): Set mail-parse-charset. + * gnus-int.el (gnus-request-accept-article): Ditto. + (gnus-request-replace-article): Ditto. + * mm-util.el (mm-mime-mule-charset-alist): Add a fake mule-charset. + +2000-05-03 14:11:23 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode): Test the validity of coding-system. + +2000-05-03 11:35:15 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Encode field by + field. + * mml.el (mml-to-mime): Use message-default-charset. + (mml-preview): Narrow to headers. + * message.el (message-send-mail): Use message-default-charset. + (message-send-news): Narrow to headers; + use message-default-charset. + +2000-05-03 08:09:14 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): A better junk + detect. + * mml.el (mml-parse-singlepart-with-multiple-charsets): Save + restriction. + (mml-parse-1): Warning message. + (mml-preview): Disable multibyte. + +2000-05-03 Dave Love + + * gnus.el (gnus-group-startup-message): Add newline before image. + +2000-05-02 21:34:10 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Check the coding-system. + * message.el (message-send-mail): Use unibyte-buffer. + (message-send-mail): Ditto. + +Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.8.6 is released. + +2000-05-01 07:45:43 Shenghuo ZHU + + * mml.el (mml-parse-1): Set no-markup-p and warn to nil. + +2000-04-28 21:14:21 Shenghuo ZHU + + * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB. + +2000-04-28 16:37:09 Shenghuo ZHU + + * message.el (message-send-mail-partially): Use forward-line. + +2000-04-28 16:01:09 Shenghuo ZHU + + * gnus-art.el (gnus-mime-button-menu): Use call-interactively. + +2000-04-28 15:30:17 Shenghuo ZHU + + * mml.el (mml-generate-mime-1): Ignore 0x1b. + (mml-insert-mime): No markup only for text/plain. + (mime-to-mml): Remove MIME headers. + +2000-04-28 14:23:14 Shenghuo ZHU + + * mml.el (mml-preview): Set gnus-newsgroup-charset. + * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii + as 8-bit. + * lpath.el: Fbind image functions. + +2000-04-28 Dave Love + + * gnus.el (gnus-group-startup-message): Maybe use image in Emacs + 21. + + * mailcap.el (mailcap-parse-mailcaps): Revert last change to + search order. Use parse-colon-path and remove some redundancy. + Doc fix. + (mailcap-parse-mimetypes): Code consistently with + mailcap-parse-mailcaps. Doc fix. + + * gnus-start.el (gnus-unload): Iterate over `features', not + `load-history'. + +2000-04-28 09:52:21 Shenghuo ZHU + + * mml.el (mml-parse-1): Don't create blank parts. + (mml-read-part): Fix mml tag. + (mml-insert-mime): Convert message/rfc822. + (mml-insert-mml-markup): Add mmlp parameter. + +2000-04-28 01:16:10 Shenghuo ZHU + + * message.el (message-send-mail-partially): Remove CTE. + +2000-04-28 00:31:53 Shenghuo ZHU + + * lpath.el: Fbind put-image for XEmacs. + * mm-view.el (mm-inline-image): Fset it. + +2000-04-27 23:23:37 Shenghuo ZHU + + * nndoc.el (nndoc-type-alist): Change forward regexp. + +2000-04-27 21:57:10 Shenghuo ZHU + + * message.el (message-send-mail-partially-limit): Change the + default value. + +2000-04-27 21:53:32 Erik Toubro Nielsen + + * gnus-util.el (gnus-extract-address-components): Name might be + "". + +2000-04-27 20:32:06 Shenghuo ZHU + + * gnus-msg.el (gnus-summary-mail-forward): Use ARG. + (gnus-summary-post-forward): Ditto. + * message.el (message-forward-show-mml): New variable. + (message-forward): Use it. + * mml.el (mml-parse-1): Add tag mml. + (mml-read-part): Ditto. + (mml-generate-mime): Support reentance. + (mml-generate-mime-1): Support mml tag. + +2000-04-27 Dave Love + + * gnus-art.el: Don't bother to require custom, browse-url. + (gnus-article-x-face-command): Include gnus-article-display-xface. + + * gnus-ems.el: Assume only (X)Emacs 20+. Simplify XEmacs checks. + Use defalias, not fset. + (gnus-article-display-xface): New function. + + * mm-view.el (mm-inline-image-emacs): Use put-image, remove-images. + + * mm-decode.el: Small doc fixes. Require cl when compiling. + (mm-xemacs-p): Deleted. + (mm-get-image-emacs, mm-get-image-xemacs): Deleted. + (mm-get-image): Amalgamate Emacs and XEmacs code here; for Emacs, + use create-image and don't special-case xbm. + (mm-valid-image-format-p): Use display-graphic-p. + +2000-04-27 15:27:54 Shenghuo ZHU + + * message.el (message-send-mail-partially-limit): New variable. + (message-send-mail-partially): New function. + (message-send-mail): Use it. + * mm-bodies.el (mm-decode-content-transfer-encoding): Remove + all blank lines inside of base64. + * mm-partial.el (mm-inline-partial): Add an option. Remove tail + blank lines. + +2000-04-27 10:03:36 Shenghuo ZHU + + * mml.el (mml-insert-tag): Match more special characters. + +2000-04-27 09:06:29 Shenghuo ZHU + + * gnus-msg.el (gnus-bug): Avoid attaching the external buffer. + +2000-04-27 00:58:43 Shenghuo ZHU + + * mm-decode.el (mm-inline-media-tests): Add message/partial. + (mm-inlined-types): Ditto. + * mm-partial.el: New file. + +2000-04-27 Dave Love + + * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might + matter in Emacs 21. + +2000-04-26 Florian Weimer + + * mm-bodies.el (mm-encode-body): Remove reference to + mm-default-charset in comment. + +2000-04-24 00:56:00 Bj,Av(Brn Torkelsson + + * rfc2047.el (rfc2047-encode-message-header): Fixing typo. + +2000-04-26 12:27:41 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of + let. + +2000-04-26 12:26:10 Pavel Janik ml. + + * gnus-draft.el (gnus-draft-setup): Fix comments. + +2000-04-26 10:06:12 Shenghuo ZHU + + * nnmbox.el (nnmbox-create-mbox): Use nnmbox-file-coding-system, + if nnmbox-file-coding-system-for-write is nil. + +2000-04-26 02:17:44 Shenghuo ZHU + + * gnus-msg.el (gnus-configure-posting-styles): Just remove the + header if nil. + +2000-04-26 00:23:46 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Insert directly if decoded. + * mml.el (autoload): Typo. + +2000-04-25 22:46:36 Shenghuo ZHU + + * mml.el (mml-preview): Set up posting-charset. + * gnus-msg.el (gnus-group-posting-charset-alist): Add koi8-r. + +2000-04-25 21:23:54 Shenghuo ZHU + + * webmail.el: Fix yahoo mail. + +2000-04-25 20:12:17 Shenghuo ZHU + + * rfc2047.el (rfc2047-dissect-region): Don't include LWS ahead of + word if not necessary. + (rfc2047-encode-region): Put space between encoded words. + +2000-04-24 21:11:48 Shenghuo ZHU + + * gnus-util.el (gnus-netrc-machine): Another default to nntp. + +2000-04-24 18:14:12 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-setup): Restore mml only when + required. + (gnus-draft-edit-message): Require restoration. + +2000-04-24 16:51:04 Shenghuo ZHU + + * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored + back. + +2000-04-24 16:01:15 Shenghuo ZHU + + * gnus-art.el (gnus-treat-article): Make sure that the summary + buffer is live. + +2000-04-24 15:42:53 Shenghuo ZHU + + * mailcap.el (mailcap-parse-mailcaps): Reorder. + (mailcap-parse-mailcap): Backwards parsing. + (mailcap-possible-viewers): Remove nreverse. + (mailcap-mime-info): Ditto. + (mailcap-add-mailcap-entry): Keep alternative viewer. + +Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.8.5 is released. + +2000-04-24 16:29:07 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-header-encoding-alist): Doc fix. + + * gnus-util.el (gnus-netrc-machine): Default to nntp. + + * mml.el (mml-generate-mime-1): Force 8bit on message/rfc822. + +2000-04-23 23:27:25 Shenghuo ZHU + + * mm-view.el (mm-inline-message): Disable prepare-hook. + +2000-04-23 00:32:32 Lars Magne Ingebrigtsen + + * gnus.el: Fix copyright statements. + + * gnus-sum.el (gnus-alter-articles-to-read-function): New + variable. + (gnus-articles-to-read): Use it. + + * message.el (message-get-reply-headers): Bind free variable. + +2000-04-23 01:14:28 Shenghuo ZHU + + * message.el (message-get-reply-headers): Fix to-address. + +2000-04-22 22:51:46 Shenghuo ZHU + + * webmail.el: Hotmail fix. Add a debug function. + +2000-04-23 00:32:32 Lars Magne Ingebrigtsen + + * gnus-sum.el (t): M-down and M-up. + +2000-04-22 20:22:03 Kai Gro,A_(Bjohann + + * gnus-sum.el: Doc fix. + +2000-04-22 10:25:56 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-egroups-article): Remove < and >. + +2000-04-22 14:25:05 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-dejanews-create-mapping): Remove the context + string. + (nnweb-request-group): Don't scan twice. + (nnweb-request-scan): Don't nix out the hashtb. + + * message.el (message-get-reply-headers): Return a value. + +2000-04-22 14:12:41 David Aspinwall + + * gnus-art.el (gnus-button-url-regexp): New value to match naked + urls. + +2000-04-22 01:23:59 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-summary-insert-cached-articles): Reverse the + order messages are inserted. + + * mml.el (mml-generate-mime-1): rfc2047-encode the heads of + message/rfc822 parts. + + * gnus-art.el (gnus-article-read-summary-keys): Check for + numerical values. + + * message.el (message-get-headers): Made into own function. + (message-reply): Use it. + (message-get-reply-headers): Renamed. + (message-widen-reply): New command. + +2000-04-21 20:52:09 Shenghuo ZHU + + * nntp.el (nntp-retrieve-data): Report the error and return nil. + +2000-04-21 19:38:43 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): Don't remove + non-base64 text at the end if not found. + +2000-03-01 Simon Josefsson + + * gnus-sum.el (gnus-read-move-group-name): + (gnus-summary-move-article): Use `gnus-group-method' to find out + what method the manually entered group belong to. + `gnus-group-name-to-method' doesn't return any method parameters + and `gnus-find-method-for-group' uses `gnus-group-name-to-method' + for new groups so they wouldn't work. + +2000-04-21 22:27:15 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-configure-posting-styles): Allow nil values to + override. + +2000-04-21 21:58:20 Kai Gro,A_(Bjohann + + * nnmail.el (nnmail-cache-insert): Does some stuff that is + probably good to do, or something. I dunno. I just write these + ChangeLog entries, and my name is Lars. + +1999-12-06 Hrvoje Niksic + + * message.el (message-caesar-region): Use translate-region. + +2000-04-21 21:20:32 Mike Fabian + + * gnus-group.el (gnus-group-catchup-current): Doc fix. + +2000-04-21 20:36:21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-buffer): Don't kill local + variables, because that makes Emacs flash. + + * gnus-group.el (gnus-group-insert-group-line): Don't call + gnus-group-add-icon unconditionally. + + * gnus-xmas.el (gnus-group-add-icon): Moved here. + + * gnus-group.el (gnus-group-glyph-directory): Don't depend on + xmas. + (gnus-group-glyph-directory): Removed. + +2000-04-21 20:26:23 Jaap-Henk Hoepman + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't do stuff if + gnus-newsgroup-name is "". + +2000-04-21 Florian Weimer + + * mm-util.el (mm-mime-mule-charset-alist): Add support for UTF-8 + in conjunction with MULE-UCS. + +1999-12-13 Per Abrahamsen + + * rfc2047.el (rfc2047-fold-region): Don't use the same break twice. + +1999-12-14 04:14:44 Katsumi Yamaoka + + * dgnushack.el (last, mapcon, member-if, union): New compiler + macros for emulating cl functions. + +1999-12-21 Jan Vroonhof + + * message.el (message-shorten-references): Only cater to broken + INN for news. This caters for broken smtpd. + +2000-04-21 18:20:10 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-info): Use the first match; not the + last. + + * gnus-agent.el (gnus-category-kill): Save the category list. + +2000-04-21 16:41:50 Chris Brierley + + * gnus-sum.el (gnus-summary-move-article): Do something or other. + +2000-04-21 16:07:07 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-add-icon): Fixed indentation. + +2000-04-21 16:07:07 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-add-icon): Fixed indentation. + +2000-04-21 10:43:16 Shenghuo ZHU + + * gnus-group.el (gnus-group-prepare-flat-predicate): New function. + (gnus-group-list-cached): Use it. + +2000-04-21 16:07:07 Lars Magne Ingebrigtsen + + * gnus.el: Update all the copyright notices. + +2000-04-21 15:38:06 Vladimir Volovich + + * mm-bodies.el (mm-decode-content-transfer-encoding): Remove + non-base64 text at the end. + +2000-04-21 15:21:30 Katsumi Yamaoka + + * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized. + +2000-04-21 15:15:41 Lars Magne Ingebrigtsen + + * nnheader.el: Don't autoload cancel-function-timers. + + * message.el (message-fetch-field): Fold case. + +2000-04-21 15:11:09 + + * message.el (message-forward-before-signature): New variable. + +2000-04-21 15:10:31 Alexandre Oliva + + * gnus-mlspl.el: Fix stuff. + +2000-04-21 14:41:09 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-update-article-line): Don't hide + subjects when unthreaded. + +2000-04-21 14:11:39 David S. Goldberg + + * gnus-art.el (gnus-boring-article-headers): Work on long CCs as + well. + +2000-04-21 14:06:43 Rui Zhu + + * gnus-art.el (gnus-article-mode): Fix variable name. + +2000-04-21 13:54:51 Lars Magne Ingebrigtsen + + * mm-view.el: Fix autoload. + + * flow-fill.el (flow-fill): Fix provide. + + * gnus-draft.el (gnus-draft-send): Bind message-setup-hook to + nil. + +2000-04-20 22:24:04 Shenghuo ZHU + + * gnus-win.el (gnus-configure-windows): Revert to switch-to-buffer. + +2000-04-21 05:22:18 Katsumi Yamaoka + + * gnus-util.el (gnus-netrc-machine): Didn't work. + +2000-04-20 21:22:10 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-setup): Restore to mml. + +2000-04-21 01:24:41 Lars Magne Ingebrigtsen + + * flow-fill.el: Renamed from fill-flowed. + + * message.el (message-forward-ignored-headers): Default to + removing CTE. + +2000-04-21 00:48:48 + + * message.el (message-mode): Don't fill headers. + +2000-04-20 23:12:43 Lars Magne Ingebrigtsen + + * message.el (message-pipe-buffer-body): Use shell + +2000-02-21 Yoshiki Hayashi + + * nnvirtual.el (nnvirtual-request-article): + Bind gnus-override-method to nil. + (nnvirtual-request-update-mark): Don't update mark when + article is not there. + +2000-04-20 16:35:41 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Check forwarded message. + +2000-04-20 21:17:48 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-parse-netrc): Allow "port". + (gnus-netrc-machine): Take a port param. + (gnus-netrc-machine): + + * gnus-art.el (gnus-request-article-this-buffer): Allow + re-selecting referenced articles. + + * message.el (message-cancel-news): Allow editing. + (message-cancel-message): Add newline. + +2000-04-20 21:03:54 William M. Perry + + * mm-view.el (mm-inline-image-emacs): New function. + +2000-04-20 20:44:55 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-delete-incoming): Change default in + cvs. + +2000-04-20 20:43:34 Kim-Minh Kaplan + + * gnus-art.el (gnus-mime-view-part-as-type-internal): New + function. + +2000-04-20 14:45:20 Lars Magne Ingebrigtsen + + * nnml.el (nnml-request-expire-articles): Use it. + + * nnmail.el (nnmail-expiry-target): New variable. + (nnmail-expiry-target-group): New function. + +2000-04-20 02:36:31 Emerick Rogul + + * message.el (message-forward): Add non-MIME separators. + +2000-04-20 02:25:39 Lars Magne Ingebrigtsen + + * message.el (message-generate-headers): Respect the syntax check + spec. + + * gnus-sum.el (gnus-remove-thread-1): Show thread. + (gnus-remove-thread): Don't show all threads. + +Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v5.8.4 is released. + +2000-04-19 Dave Love + + * mailcap.el (mailcap-parse-mimetypes): Add ...mime.types. + +2000-04-18 12:28:24 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-type-definition): New egroups html. + (nnwarchive-egroups-*): Ditto. + (nnwarchive-url): Unibyte buffer and single line cookie. + +2000-04-14 18:50:04 Shenghuo ZHU + + * mm-util.el (mm-char-or-char-int-p): New alias. + * nnweb.el (nnweb-decode-entities): Check the validity of numeric + entities. + +2000-04-10 Daiki Ueno + + * lisp/imap.el (imap-body-lines): Check Content-Type: of the + article case insensitively. + +2000-04-10 20:35:46 Shenghuo ZHU + + * mail-source.el (mail-source-fetch-webmail): Use the default + password provided in mail-sources; use webmail:subtype:user as + the key. + +2000-04-10 20:35:46 John Wiegley + + * mail-source.el (mail-source-fetch-webmail): Use + mail-source-password-cache. + +2000-04-09 18:13:47 Shenghuo ZHU + + * webmail.el: Add netscape mail and fix HotMail mail. + +2000-04-08 Simon Josefsson + + * imap.el (imap-kerberos4-open): Work with recent `imtest's. + +2000-04-02 Simon Josefsson + + * nnimap.el (nnimap-request-article): Use BODY.PEEK[] instead of + RFC822.PEEK if server support IMAP4rev1. + (nnimap-request-body): Use BODY.PEEK[TEXT] instead of + RFC822.TEXT.PEEK if server support IMAP4rev1. + (nnimap-request-head): Use BODY.PEEK[HEADER] instead of + RFC822.HEADER if server support IMAP4rev1. + (nnimap-request-article-part): Support bodydetail in response + data. + +2000-03-11 Simon Josefsson + + * fill-flowed.el: New file. + + * mm-decode.el (mm-dissect-singlepart): Create a MIME handle for + text/plain parts with `format' parameters. + + * mm-view.el (autoload): Autoload fill-flowed. + (mm-inline-text): For "plain" parts with a format=flowed + parameter, call `fill-flowed'. + +2000-03-21 10:32:44 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-list): Fudge new-style + slashdot ids. + +2000-03-20 00:12:42 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-list): Use the new slashdot + format. + +2000-03-16 Simon Josefsson + + * imap.el: GSSAPI support, support kerberos 4 with Cyrus v1.6.x + `imtest' too. + (imap-kerberos4-program): Renamed from `imap-imtest-program'. + (imap-gssapi-program): New variable. + (imap-streams): Add gssapi. + (imap-stream-alist): Ditto. + (imap-authenticators): Ditto. + (imap-authenticator-alist): Ditto. + (imap-kerberos4-stream-p): Rename from `imap-kerberos4s-p'. + (imap-kerberos4-open): Loop over imtest programs, support Cyrus + 1.6.x `imtest' syntax. + (imap-gssapi-stream-p): New function. + (imap-gssapi-open): Ditto. + (imap-gssapi-auth-p): Ditto. + (imap-gssapi-auth): Ditto. + (imap-kerberos4-auth-p): Renamed from `imap-kerberos4a-p'. + (imap-send-command): Use buffer-local `imap-client-eol' value. + + * nnimap.el (nnimap-retrieve-headers-progress): Fold continuation + lines and turn TAB into SPC before parsing. + +2000-03-15 Simon Josefsson + + * nnheader.el (nnheader-group-pathname): Make sure to return a + directory. + * nnmail.el (nnmail-group-pathname): Ditto. + +2000-02-08 Per Abrahamsen + + * nnmail.el (nnmail-fix-eudora-headers): Fix `In-Reply-To' too, it + might split in the middle of a message-id. + +2000-03-13 13:51:38 Lars Magne Ingebrigtsen + + * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the + groups from the server. + + * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec. + (gnus-summary-toggle-header): Update the wash status. + + * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)): + Moved here. + + * gnus-agent.el (gnus-agent-save-group-info): Respect old + setting. + + * nnmail.el (nnmail-get-active): Use it. + (nnmail-parse-active): New function. + + * mm-view.el (mm-inline-text): Support the new version of + vcard.el. + + * gnus-sum.el (gnus-summary-move-article): Only delete article + when moving junk. + (gnus-deaden-summary): Bury the buffer. + + * nnmail.el (nnmail-group-pathname): Ditto. + + * nnheader.el (nnheader-group-pathname): Use expand-file-name. + +2000-03-13 20:23:06 Christoph Rohland + + * rfc2047.el (rfc2047-encode-message-header): Encode no matter + whether Mule. + +2000-03-10 14:57:58 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Protect against unloaded Gnus. + + * gnus-topic.el (gnus-topic-update-topic-line): Don't update the + parent. + (gnus-topic-update-topic-line): Yes, do. + (gnus-topic-goto-missing-group): Tally the correct number of + unread articles before inserting the topic line. + +2000-03-01 09:55:26 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-retrieve-headers): Ignore errors. + +2000-02-13 13:53:08 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-dissect-buffer): Ditto. + + * gnus-art.el (article-decode-charset): Strip CTE. + + * ietf-drums.el (ietf-drums-strip): New function. + + * gnus-sum.el (gnus-summary-move-article): Don't use the prefix + when prompting in read-only groups. + +2000-02-23 Simon Josefsson + + * imap.el (imap-send-command): Change EOL-chars when + `imap-client-eol' differs from default, not only for kerberos4. + (imap-mailbox-status): Get encoded mailbox's status. + +2000-02-19 Simon Josefsson + + * mail-source.el (mail-source-fetch-imap): Copy `imap-password' + into `mail-source-password-cache'. + +2000-02-17 Florian Weimer + + * mm-util.el (mm-mime-charset): Check for presence of + `coding-system-get' and `get-charset-property' (recent XEmacs has + the former, but not the latter). + +2000-01-28 Dave Love + + * message.el (message-check-news-header-syntax): Fix typo + `newsgroyps'. + (message-talkative-question): Put temp buffer in fundamental-mode. + (message-recover): Use fundamental-mode in the right buffer. + + * nnmail.el (nnmail-split-history): Use fundamental-mode in the + right buffer. + +2000-01-26 12:01:18 Shenghuo ZHU + + * qp.el (quoted-printable-decode-region): Add charset parameter. + (quoted-printable-decode-string): Ditto. + + * gnus-art.el (article-de-quoted-unreadable): Use it. + +2000-01-21 Simon Josefsson + + * nnimap.el (nnimap-split-predicate): New variable. + (nnimap-split-articles): Use it. + +2000-01-20 Simon Josefsson + + * utf7.el: Change email address. + +2000-01-18 22:03:51 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-catchup): Purge split history. + +2000-01-14 02:43:55 Shenghuo ZHU + + * nnmail.el (nnmail-generate-active): Support extended group name. + (nnmail-get-active): Ditto. + +2000-01-13 15:16:10 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-write-active): Since no prefix in + group names, don't remove anything. + +2000-01-13 15:10:53 Shenghuo ZHU + + * webmail.el (webmail-my-deja-open): My-deja changes. + +2000-01-13 Simon Josefsson + + * nnimap.el (nnimap-retrieve-headers-progress): Create xref field. + +2000-01-10 23:35:33 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-headers): Translate full path. + +2000-01-09 22:52:35 Shenghuo ZHU + + * gnus.el (gnus-other-frame): Fix typo. + +1999-06-25 Andreas Jaeger + + * gnus-cus.el (gnus-group-customize): Fix typo. + +2000-01-08 08:36:13 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-insert): Simplified. + +2000-01-06 18:32:53 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-mode-map): "e" is + gnus-summary-edit-article. + +2000-01-06 18:25:37 Jari Aalto + + * mailcap.el (mailcap-mime-extensions): Add .diff. + +2000-01-06 00:06:40 Kim-Minh Kaplan + + * mm-decode.el (mm-mailcap-command): handle "%%" and the case where + there is no "%s" in the method. + +2000-01-08 21:01:04 Kim-Minh Kaplan + + * gnus-sum.el (gnus-summary-select-article): Return 'old. + +2000-01-06 13:41:11 Lars Magne Ingebrigtsen + + * nnfolder.el (nnfolder-read-folder): Use nnfolder-save-buffer. + + * gnus.el: Really always pop up a new frame. + + * parse-time.el (parse-time-rules): Allow 100-110 to be + 2000-2010. + + * time-date.el (date-to-time): Don't use timezone. + +2000-01-06 Dave Love + + * time-date.el: Add keywords. + (date-to-time): Add autoload cookie. Canonicalize with + timezone-make-date-arpa-standard. + (time-to-seconds): Avoid caddr. + (safe-date-to-time): Add autoload cookie. + + * base64.el: Require cl when compiling. + +2000-01-05 BrYan P. Johnson + + * gnus-group.el (gnus-group-line-format-alist): Added %E for + eyecandy. + (gnus-group-insert-group-line): Now groks %E and inserts icon in + group line using gnus-group-add-icon. + (gnus-group-icons): Added customize group. + (gnus-group-icon-list): Added variable. + (gnus-group-glyph-directory): Added variable. + (gnus-group-icon-cache): Added variable. + (gnus-group-running-xemacs): Added variable. + (gnus-group-add-icon): Added function. Add an icon to the current + line according to gnus-group-icon-list. + (gnus-group-icon-create-glyph): Added function. + +2000-01-05 17:31:52 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-select-article): Return whether we + selected something new. + (gnus-summary-search-article): Start searching at the window + point. + + * gnus-group.el (gnus-fetch-group): Complete over + gnus-active-hashtb. + +Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v5.8.3 is released. + +2000-01-05 15:56:02 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-preserve-marks): New variable. + (gnus-summary-move-article): Use it. + (gnus-group-charset-alist): Added more entries. + +2000-01-03 01:18:36 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-override-types): Removed duplicate. + + * gnus-uu.el (gnus-uu-mark-over): Use gnus-summary-default-score + as the default score. + + * gnus-score.el (gnus-score-delta-default): Changed name. + +2000-01-04 Simon Josefsson + + * imap.el (imap-parse-literal): + (imap-parse-flag-list): Don't care about props. + (imap-parse-string): Handle quoted characters. + +2000-01-02 08:37:03 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-goto-unread): Doc fix. + (gnus-summary-mark-article): Doc fix. + (gnus-summary-mark-forward): Doc fix. + (t): Changed keystroke for gnus-summary-customize-parameters. + + * gnus-art.el (gnus-article-mode-map): Use gnus-article-edit for + "e". + (gnus-article-mode-map): No, don't. + + * gnus-sum.el (gnus-summary-next-subject): Don't show the thread + of the final article. + + * mm-decode.el (mm-interactively-view-part): Error on no method. + +2000-01-02 06:10:32 Stefan Monnier + + * gnus-score.el (gnus-score-insert-help): Something. + + * gnus-art.el (gnus-button-alist): Exclude < from + + * nnwarchive.el: Changed file perms. + +1999-12-19 21:42:15 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-delete-groups): New command. + (gnus-group-delete-group): Extra no-prompt parameters. + +1999-12-14 10:18:30 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-article): Translate
into +

. + +1999-12-28 12:20:18 Shenghuo ZHU + + * webmail.el (webmail-hotmail-article): Don't insert message id. + +1999-12-28 Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,A_(Bjohann) + + * nnimap.el (nnimap-split-fancy): New variable. + (nnimap-split-fancy): New function. + +1999-12-28 Simon Josefsson + + (nnimap-split-rule): Document symbol value. + +1999-12-28 Simon Josefsson + + * nnimap.el (nnimap-retrieve-headers-progress): Let + `nnheader-parse-head' parse article. + (nnimap-retrieve-headers-from-server): Don't request ENVELOPE, + request headers needed by `nnheader-parse-head'. + +1999-12-23 Florian Weimer + + * gnus-msg.el (gnus-group-posting-charset-alist): Correct default + value (crosspostings are handled), improve documentation. + + * smiley.el: Declare file coding system as iso-8859-1. + + * nnultimate.el: Dito. + + * message.el: Dito. + + * gnus-cite.el: Dito. + + * gnus-spec.el: Dito. + +1999-12-21 Florian Weimer + + * gnus-msg.el (gnus-group-posting-charset-alist): New layout. + (gnus-setup-message): No longer make `message-posting-charset' + buffer-local. + (gnus-setup-posting-charset): Reflect the new layout of + `gnus-group-posting-charset-alist' and `message-posting-charset'. + + * message.el (message-send-mail): Bind `message-this-is-mail' and + `message-posting-charset'. + (message-send-news): Dito, and honour new layout of + `message-posting-charset'. + (message-encode-message-body): Ignore `message-posting-charset'. + + * mm-bodies.el (mm-body-encoding): Consider + `message-posting-charset' when deciding whether to use 8bit. + + * rfc2047.el (rfc2047-encode-message-header): Back out change. + (rfc2047-encodable-p): Now solely for headers; use + `message-posting-charset'. + +1999-12-20 14:10:39 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-type-definition): Set default value. + +1999-12-19 22:49:13 Shenghuo ZHU + + * nnagent.el (nnagent-server-opened): Optional. + (nnagent-status-message): Optional. + +1999-12-19 Simon Josefsson + + * gnus-cite.el (gnus-article-toggle-cited-text): Restore beg and + end (referenced by instructions in + `gnus-cited-opened-text-button-line-format-alist'). + +1999-12-18 Simon Josefsson + + * imap.el (imap-starttls-open): Typo. + +1999-12-18 16:43:37 Shenghuo ZHU + + * mm-util.el (mm-charset-after): Non-MULE case. + * mail-prsvr.el (mail-parse-mule-charset): New variable. + * rfc2047.el (rfc2047-dissect-region): Bind it. + +1999-12-18 Florian Weimer + + * mml.el (mml-generate-multipart-alist): Correct default value. + + * mm-encode.el (mm-use-ultra-safe-encoding): New variable. + (mm-safer-encoding): New function. + (mm-content-transfer-encoding): Use both. + + * mm-bodies.el (mm-body-encoding): Use mm-use-ultra-safe-encoding. + * qp.el (quoted-printable-encode-region): Dito. + +1999-12-18 14:08:48 Shenghuo ZHU + + * webmail.el (webmail-hotmail-article): Snarf the raw file. + +1999-12-18 14:08:12 Victor S. Miller + + * webmail.el (webmail-hotmail-list): raw=0. + +1999-12-18 11:14:51 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-enter-history): Back-compatible in + group name. + +1999-12-18 11:02:00 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-expire): Convert to symbol if stringp. + +1999-12-18 Simon Josefsson + + * imap.el: Don't autoload digest-md5. + (imap-starttls-open): Bind coding-system-for-{read,write}. + (imap-starttls-p): Check if we can find starttls.el. + (imap-digest-md5-p): Check if we can find digest-md5.el. + +1999-12-17 Daiki Ueno + + * base64.el (base64-encode-string): Accept 2nd argument + `no-line-break'. + + * imap.el: Require `digest-md5' when compiling; add autoload + settings for `digest-md5-parse-digest-challenge', + `digest-md5-digest-response', `starttls-open-stream' and + `starttls-negotiate'. + (imap-authenticators): Add `digest-md5'. + (imap-authenticator-alist): Setup for `digest-md5'. + (imap-digest-md5-p): New function. + (imap-digest-md5-auth): New function. + (imap-stream-alist): Add STARTTLS entry. + (imap-starttls-p): New function. + (imap-starttls-open): New function. + +1999-12-18 01:08:10 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-enter-history): Bad group name. + +1999-12-17 19:36:47 Shenghuo ZHU + + * rfc2047.el (rfc2047-dissect-region): Use mapcar instead of + string-to-x function. + +1999-12-17 13:08:54 Shenghuo ZHU + + * rfc2047.el (rfc2047-fold-region): Fold a line more than once. + +1999-12-17 11:54:41 Shenghuo ZHU + + * webmail.el: Enhance hotmail-snarf. + +1999-12-17 10:38:10 Shenghuo ZHU + + * rfc2047.el (rfc2047-dissect-region): Rewrite. + +1999-12-16 22:59:22 Shenghuo ZHU + + * webmail.el (webmail-hotmail-list): Search no-error. + +1999-12-15 22:07:15 Shenghuo ZHU + + * nnwarchive.el: Support nov-is-evil. + * gnus-bcklg.el (gnus-backlog-request-article): Buffer is optional. + Set it if non-nil. + * gnus-agent.el (gnus-agent-fetch-articles): Use it. + +1999-12-15 08:55:19 Shenghuo ZHU + + * nnagent.el (nnagent-server-opened): Redefine. + (nnagent-status-message): Ditto. + +1999-12-14 23:37:44 Shenghuo ZHU + + * rfc1843.el (rfc1843-decode-region): Use + buffer-substring-no-properties. + * gnus-art.el (article-decode-HZ): New function. + +1999-12-14 22:07:26 Shenghuo ZHU + + * nnheader.el (nnheader-translate-file-chars): Only in full path. + +1999-12-14 16:21:45 Shenghuo ZHU + + * mm-util.el (mm-find-charset-region): mail-parse-charset is a + MIME charset not a MULE charset. + +1999-12-14 15:08:03 Shenghuo ZHU + + * gnus-ems.el: Translate more ugly characters. + * nnheader.el (nnheader-translate-file-chars): Don't translate + the second ':'. + +1999-12-14 10:40:33 Shenghuo ZHU + + * gnus-art.el (gnus-request-article-this-buffer): Use all refer + method if cannot find the article. + +1999-12-14 01:13:50 Shenghuo ZHU + + * gnus-art.el (gnus-request-article-this-buffer): Don't use refer + method if overrided. + +1999-12-13 23:38:53 Shenghuo ZHU + + * mail-source.el (mail-source-fetch-webmail): Parameter + dontexpunge. + +1999-12-13 23:31:17 Shenghuo ZHU + + * webmail.el: Support my-deja. Better error report. + +1999-12-13 18:59:33 Shenghuo ZHU + + * nnslashdot.el (nnslashdot-date-to-date): Error proof when input + is bad. + * gnus-sum.el (gnus-list-of-unread-articles): When (car read) + is not 1. + +1999-12-13 18:22:08 Shenghuo ZHU + + * nnslashdot.el (nnslashdot-request-article): A space. + +1999-12-13 17:20:25 Shenghuo ZHU + + * nnagent.el: Support different backend with same name. + +1999-12-13 13:14:42 Shenghuo ZHU + + * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Support + archived group. + (nnslashdot-sane-retrieve-headers): Ditto. + (nnslashdot-request-article): Ditto. + +1999-12-13 11:41:32 Shenghuo ZHU + + * nnweb.el (nnweb-insert): Narrow to point. + +1999-12-13 10:59:42 Shenghuo ZHU + + * nnweb.el (nnweb-insert): Follow refresh url. + * nnslashdot.el: Use it. + +1999-12-13 10:39:53 Shenghuo ZHU + + * nnweb.el (nnweb-decode-entities): Decode numerical entities. + (nnweb-decode-entities-string): New function. + + * nnwarchive.el (nnwarchive-decode-entities-string): Rename to + nnweb-* and move to nnweb.el. + * nnwarchive.el: Use nnweb-decode-entities, etc. + * webmail.el: Ditto. + + * nnslashdot.el: Use nnweb-decode-entities-string. + (nnslashdot-decode-entities): Remove. + +1999-12-13 10:40:56 Eric Marsden + + * nnslashdot.el: Decode entities. + +1999-12-12 Dave Love + + * gnus-agent.el (gnus-category-edit-groups) + (gnus-category-edit-score, gnus-category-edit-predicate): Replace + expansion of setf, fixed. + +1999-12-12 12:50:30 Shenghuo ZHU + + * gnus-agent.el: Revoke last Dave Love's patch, because of + incompatibility of XEmacs. + +1999-12-12 12:27:03 Shenghuo ZHU + + * mm-uu.el: Change headers. + * rfc1843.el: Ditto. + * uudecode.el: Ditto. + +1999-12-07 Dave Love + + * gnus-agent.el (gnus-category-edit-predicate) + (gnus-category-edit-score, gnus-category-edit-score): Expand setf + inside backquote to avoid it at runtime. + +1999-12-07 Dave Love + + * binhex.el: Require cl when compiling. + +1999-12-04 Dave Love + + * gnus-cus.el (gnus-group-parameters): Allow nil for banner. + +1999-12-04 Dave Love + + * mm-util.el (mm-delete-duplicates): New function. + (mm-write-region): Use it. + + * mml.el (mml-minibuffer-read-type): Use mm-delete-duplicates. + + * mailcap.el (mailcap-mime-types): Require mm-util. Use + mm-delete-duplicates. + + * imap.el (imap-open, imap-debug): Avoid mapc. + + * nnvirtual.el (nnvirtual-create-mapping): Likewise. + + * gnus-sum.el (gnus-summary-exit-no-update): Avoid copy-list. + (gnus-multi-decode-encoded-word-string): Avoid mapc. + + * gnus-start.el (gnus-site-init-file): Avoid ignore-errors at + runtime. + + * gnus.el (gnus-select-method): Likewise. + + * nnheader.el (nnheader-nov-read-integer): Likewise. + + * mm-view.el (mm-inline-message): Require cl when compiling. + Avoid ignore-errors at runtime. + (mm-inline-text): Avoid mapc. + +1999-12-12 10:36:51 Shenghuo ZHU + + * gnus-art.el (article-decode-charset): Widen is bad. + +1999-12-12 10:17:42 Shenghuo ZHU + + * mm-util.el (mm-charset-after): `charset-after' may not be defined. + +1999-12-12 Florian Weimer + + * rfc2047.el (rfc2047-encodable-p): New parameter header used to + indicate that only US-ASCII is permitted. + (rfc2047-encode-message-header): Use it. Now, Gnus should never + use unencoded 8-bit characters in message headers. + +1999-12-12 03:08:15 Shenghuo ZHU + + * ietf-drums.el (ietf-drums-narrow-to-header): Make it work with + CRLF. + +1999-12-11 14:42:26 Shenghuo ZHU + + * webmail.el: Require url-cookie. + +1999-12-11 14:21:23 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-make-caesar-translation-table): A + new function to make modified caesar table. + (nnwarchive-from-r13): Use it. + (nnwarchive-mail-archive-article): Improved. + +1999-12-11 12:30:20 Shenghuo ZHU + + * webmail.el (webmail-url): Use mm-with-unibyte-current-buffer. + +1999-12-10 16:22:24 Shenghuo ZHU + + * nnweb.el (nnweb-request-article): Return cons. + +1999-12-10 16:06:04 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-setup-default-charset): Typo. + +1999-12-10 12:14:04 Shenghuo ZHU + + * mm-util.el (mm-with-unibyte): New macro. + * nnweb.el (nnweb-init): Use it. + +1999-12-09 20:39:49 Shenghuo ZHU + + * mm-util.el (mm-charset-after): New function. + (mm-find-mime-charset-region): Set charsets after + delete-duplicates and use find-coding-systems-region. + (mm-find-charset-region): Remove composition. + + * mm-bodies.el (mm-encode-body): Use mm-charset-after. + + * mml.el (mml-parse-singlepart-with-multiple-charsets): Ditto. + +1999-12-09 17:47:56 Shenghuo ZHU + + * mm-util.el (mm-find-mime-charset-region): Revoke last change. + * mml.el (mml-confirmation-set): New variable. + (mml-parse-1): Ask user to confirm. + +1999-12-09 Simon Josefsson + + * gnus-start.el (gnus-get-unread-articles): Make sure all methods + are scanned when we have directory mail-sources (the mail source + is modified in that case, so we must scan it for all + groups/methods). + +1999-12-09 12:05:28 Shenghuo ZHU + + * nnml.el (nnml-request-move-article): Save nnml-current-directory + and nnml-article-file-alist. + +1999-12-09 10:20:07 Shenghuo ZHU + + * gnus-group.el (gnus-group-get-new-news-this-group): Binding + nnmail-fetched-sources. + +1999-12-09 10:19:01 Shenghuo ZHU + + * mm-util.el (mm-find-charset-region): Use the last charset. + +1999-12-08 Per Abrahamsen + + * gnus.el (gnus-select-method): Made the option list prettier. + +1999-12-08 Florian Weimer + + * gnus-msg.el (gnus-group-posting-charset-alist): Use iso-8859-1 + for the `de' newsgroups hierarchy, as it is common practice there. + + +1999-12-07 16:17:12 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-mail-archive-article): Fix + buffer-string arguments. Fix references. + +1999-12-07 15:04:18 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-confirmation-function): New variable. + (gnus-agent-batch-fetch): Use it. + (gnus-agent-fetch-session): Use it. + +1999-12-07 12:32:43 Shenghuo ZHU + + * mm-util.el (mm-find-mime-charset-region): Delete nil. + +1999-12-07 11:45:10 Shenghuo ZHU + + * mm-util.el (mm-find-charset-region): Don't capitalize. Delete + nil. + +1999-12-07 Per Abrahamsen + + * nnslashdot.el (nnslashdot-request-list): There were two + top-level body-forms. Put a `progn' around them. + + * gnus.el (gnus-select-method): Use `condition-case' + instead of `ignore-errors', since cl may not be loaded when the + form is evaluated. + +1999-12-06 23:57:47 Shenghuo ZHU + + * nnwarchive.el: Support www.mail-archive.com. + +1999-12-06 23:55:55 Shenghuo ZHU + + * nnmail.el (nnmail-get-new-mail): Remove fetched sources before + do anything. + +1999-12-06 Simon Josefsson + + * utf7.el: New file, written by Jon K Hellan. + + * imap.el (imap-use-utf7): Renamed from `imap-utf7-p', change + default to t. + +1999-12-06 04:40:24 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-delete-group): New function. + + * gnus-sum.el (gnus-summary-refer-article): Work for lists with + current. + (gnus-refer-article-methods): New function. + (gnus-summary-refer-article): Use it. + +1999-11-13 Simon Josefsson + + * nnimap.el (nnimap-retrieve-groups): Return active format. + + * nnimap.el (nnimap-replace-in-string): Removed. + (nnimap-request-list): + (nnimap-retrieve-groups): + (nnimap-request-newgroups): Quote group instead of escaping SPC. + +1999-12-05 Simon Josefsson + + * imap.el: Use format-spec for ssl program. + * imap.el (imap-ssl-arguments): Removed. + (imap-ssl-open-{1,2}): Removed. + +1999-12-04 Per Abrahamsen + + * gnus-start.el (gnus-site-init-file): Use `condition-case' + instead of `ignore-errors', since cl may not be loaded when the + form is evaluated. + +1999-12-04 11:34:22 Shenghuo ZHU + + * mm-bodies.el (mm-8bit-char-regexps): Removed. + (mm-7bit-chars): New variable. + (mm-body-7-or-8): Use it in both cases. + +1999-12-04 Michael Welsh Duggan + + * gnus-start.el (gnus-site-init-file): Don't use cl macros in + defcustom definitions. + +1999-12-04 Simon Josefsson + + * mm-decode.el (mm-display-part): Let mm-display-external return + inline or external. + (mm-display-external): For copiousoutput methods, insert output in + buffer. + +1999-12-04 03:29:13 Shenghuo ZHU + + * nntp.el (nntp-retrieve-headers-with-xover): Goto the end of + buffer. + +1999-12-04 08:31:10 Lars Magne Ingebrigtsen + + * gnus-audio.el: An M too far. + + * gnus-msg.el (gnus-setup-message): One backtick too many. + + * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is + a function, not a variable. + +1999-12-04 08:14:08 Max Froumentin + + * gnus-score.el (gnus-score-body): Widen before requesting. + +1999-12-04 08:06:13 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-prepare-flat): Comment fix. + +1999-12-04 03:01:55 Shenghuo ZHU + + * mail-source.el (mail-source-fetch-webmail): Bind + mail-source-string. + +1999-12-04 07:18:23 Matt Swift + + * gnus-uu.el (gnus-uu-mark-by-regexp): Doc fix. + (gnus-uu-unmark-by-regexp): Ditto. + + * gnus-group.el (gnus-group-catchup-current): Would bug out on + dead groups. + +1999-12-04 01:34:31 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-setup-message): Allow the charset setting to + do their real thing. + + * nnmh.el (nnmh-be-safe): Doc fix. + + * gnus-sum.el (gnus-summary-exit): Write cache active file. + + * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire + status line has arrived before we count it. + + * mailcap.el (mailcap-mime-data): Removed save-file from audio/*. + + * gnus-sum.el (gnus-thread-header): Fixed after indent. + Whitespace problems. + + * gnus-win.el (gnus-configure-windows): Error fix. + + * gnus-demon.el (gnus-demon-add-nntp-close-connection): Add the + right function. + + * gnus.el: Fixed all the doc strings to match the FSF convetions. + Indent all functions. Fix all comments to match the comment + conventions. Double-space after full stop. + +1999-12-04 01:14:55 YAMAMOTO Kouji + + * nnmail.el (nnmail-split-it): I redefined nnmail-split-fancy's + value to divide received mails into my favorite groups and I met + an error. It takes place if the length of a element "VALUE" in + nnmail-split-fancy is less than two. + +1999-10-10 Robert Bihlmeyer + + * mml.el (mml-insert-part): New function. + +1999-09-29 04:48:14 Katsumi Yamaoka + + * lpath.el: Add `sc-cite-regexp'. + +1999-12-02 Dave Love + + * mm-decode.el: Customize. + +1999-12-03 Dave Love + + * nnslashdot.el, nnultimate.el: Don't lose at compile time when + the W3 stuff isn't available. + +1999-12-03 Dave Love + + * imap.el, mailcap.el, nnvirtual.el, rfc2104.el: Don't require cl + at runtime. + +1999-12-04 00:47:35 Dan Christensen + + * gnus-score.el (gnus-score-headers): Fix orphan scoring. + +1999-12-01 Andrew Innes + + * nnmbox.el (nnmbox-read-mbox): Count messages correctly, and + don't be fooled by "From nobody" lines added by respooling. + + * pop3.el (pop3-movemail): Write crashbox in binary. + (pop3-get-message-count): New function. + + * mail-source.el (mail-source-primary-source): New variable. + (mail-source-report-new-mail-interval): New variable. + (mail-source-idle-time-delay): New variable. + (mail-source-new-mail-available): New internal variable. + (mail-source-fetch-pop): Clear new mail flag, when mail from + primary source has been fetched. + (mail-source-check-pop): New function. + (mail-source-new-mail-p): New function. + (mail-source-start-idle-timer): New function. + (mail-source-report-new-mail): New function. + (mail-source-report-new-mail): New internal variable. + (mail-source-report-new-mail-timer): New internal variable. + (mail-source-report-new-mail-idle-timer): New internal variables. + +1999-12-04 00:39:34 Andreas Schwab + + * gnus-cus.el (gnus-group-customize): Customize fix. + +1999-12-04 00:38:24 Andrea Arcangeli + + * message.el (message-send-mail-with-sendmail): Use + message-make-address. + +Fri Dec 3 20:34:11 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v5.8.2 is released. + +Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v5.8.1 is released. + +1999-11-11 Hrvoje Niksic + + * mml.el (mml-insert-tag): Don't close the tag. + (mml-insert-empty-tag): New function. + (mml-attach-file): Use mml-insert-empty-tag instead of + mml-insert-tag. + (mml-attach-buffer): Ditto. + (mml-attach-external): Ditto. + (mml-insert-multipart): Ditto. + +1999-12-03 08:49:53 Shenghuo ZHU + + * nnfolder.el (nnfolder-request-article): Return -1 if not find + the article number. + +1999-12-03 01:12:41 Shenghuo ZHU + + * gnus.el (gnus-find-method-for-group): The method of a new group + is not the native one. + +1999-12-03 01:26:55 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-embedded-url): Always call browse-url. + +1999-12-02 18:00:15 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-retrieve-headers): Use + mm-with-unibyte-current-buffer. + (nnultimate-request-article): Ditto. + +1999-12-02 14:57:46 Shenghuo ZHU + + * nntp.el (nntp-retrieve-groups): Set to process buffer. + +1999-12-02 11:14:50 Shenghuo ZHU + + * mm-util.el (mm-with-unibyte-current-buffer): New macro. + * nnweb.el (nnweb-retrieve-headers): Use it. + (nnweb-request-article): Use it. + + * nnweb.el (nnweb-dejanews-create-mapping): Set a default date in + case matching failed. + +1999-12-02 John Wiegley + + * mail-source.el (mail-source-keyword-map): Add backslash to + Delete-flag. + +1999-12-02 07:24:35 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-group-charset-alist): Default nnweb groups to + Latin-1. + (gnus-group-charset-alist): No, don't. + + * nnweb.el (nnweb-init): Make the buffer unibyte. + +1999-12-01 23:02:48 Shenghuo ZHU + + * mail-source.el (mail-source-set-common-1): Fix to get the + default value. + +1999-12-02 00:27:46 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-read-groups): Unibyte. + + * nnultimate.el (nnultimate-request-list): Use unibyte. + + * gnus-uu.el (gnus-uu-grab-articles): Bind + gnus-display-mime-function to nil. + + * message.el (message-send-mail-with-sendmail): Use the + user-mail-address variable. + + * gnus-art.el (gnus-ignored-headers): More headers. + + * message.el (message-shorten-1): Use list. + +1999-12-01 21:59:36 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-configure-posting-styles): Ignore nil + signatures. + + * nnweb.el (nnweb-dejanews-create-mapping): Get the data. + (nnweb-dejanews-create-mapping): Do the properish date. + +1999-12-01 17:41:21 Shenghuo ZHU + + * mail-source.el (mail-source-common-keyword-map): New variable. + (mail-source-bind-common): New macro. + (mail-source-fetch): Support plugged mail source. + * gnus-int.el (gnus-request-scan): Use them. + +1999-12-01 21:59:36 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-message): Check whether charset is a + string. + + * nnslashdot.el (nnslashdot-request-post): Insert

's. + + * message.el (message-mode-map): Changed keystroke for + message-yank-buffer. + +1999-11-26 Hrvoje Niksic + + * message.el (message-shorten-references): Cut references to 31 + elements, then either fold them or shorten them to 988 characters. + (message-shorten-1): New function. + (message-cater-to-broken-inn): New variable. + +1999-12-01 21:47:10 Eric Marsden + + * nnslashdot.el (nnslashdot-lose): New function. + +1999-12-01 21:08:48 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-message): Not the right type of charset is + being fetched here. Let the group charset rule. + (mm-inline-message): Ignore us-ascii. + +1999-11-24 Carsten Leonhardt + + * mail-source.el (mail-source-fetch-maildir): work around the + ommitted "file-regular-p" in efs/ange-ftp + +1999-12-01 19:59:25 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime-1): Don't insert extra empty line. + (mml-generate-mime-1): Use the encoding param. + + * gnus-sum.el (gnus-summary-show-article): Don't bind gnus-visual. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Require + gnus-art before binding its variables. + + * gnus-art.el (gnus-article-prepare-display): Run the prepare + after the MIME. + +1999-12-01 19:48:14 Rupa Schomaker + + * message.el (message-clone-locals): Use it. + + * gnus-msg.el (gnus-configure-posting-styles): Make + user-mail-address local. + +1999-11-20 Simon Josefsson + + * gnus-start.el (gnus-get-unread-articles): Scan each method only + once. + +1999-12-01 17:37:18 Lars Magne Ingebrigtsen + + * message.el (message-generate-new-buffer-clone-locals): Use varstr. + (message-clone-locals): Ditto. + + * gnus-sum.el (gnus-summary-enter-digest-group): Have the digest + group inherit reply-to or from. + +1999-12-01 13:04:09 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-show-article): Support numbered ARG + for charset. + (gnus-summary-show-article-charset-alist): New variable. + + * mm-bodies.el (mm-decode-string): Support gnus-all and + gnus-unknown. + (mm-decode-body): Ditto. + * rfc2047.el (rfc2047-decode): Ditto. + +1999-12-01 17:37:18 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-delete-incoming): Change default to + t. + +Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.99 is released. + +1999-12-01 14:28:49 Lars Magne Ingebrigtsen + + * dgnushack.el (dgnushack-compile): No webmail under Emacs. + + * gnus-sum.el (gnus-summary-refer-article): Wrong interactive + spec. + + * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'. + (gnus-configure-posting-styles): No, don't. + (gnus-configure-posting-styles): Allow overriding files. + + * gnus-art.el (gnus-header-button-alist): Use browse-url + directly. + + * mm-decode.el (mm-inline-media-tests): Check feature vcard. + + * gnus-msg.el (gnus-summary-yank-message): New command and + keystroke. + + * message.el (message-yank-buffer): New command. + (message-buffers): New function. + + * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Select + next group in a more normal fasion. + + * mml.el (mml-boundary-function): New variable. + (mml-compute-boundary): Use it. + + * nnmh.el (nnmh-active-number): Skip past files that have buffers + that exist for them. + + * gnus-async.el (gnus-async-prefetch-next): Cancel timers. + (gnus-async-timer): New variable. + +1999-11-30 02:07:18 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-request-list): Be more lenient with + root addresses. + +1999-11-28 20:22:37 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treatment-function-alist): Do + gnus-treat-capitalize-sentences. + +1999-11-30 09:07:53 Shenghuo ZHU + + * webmail.el (webmail-hotmail-article): Hotmail changes the + format. + +1999-11-29 Simon Josefsson + + * mm-decode.el (mm-display-external): For `copiousoutput' methods, + switch to buffer after calling program. + (mm-display-external): Use `shell-command-switch' instead of "-c". + +1999-11-27 15:21:25 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-possibly-change-server): Don't always + read groups file. + + * nnslashdot.el (nnslashdot-request-article): Convert

to +

. + +1999-11-24 20:18:24 Lars Magne Ingebrigtsen + + * message.el (message-mode): Doc fix. + +1999-11-24 09:25:00 Shenghuo ZHU + + * gnus-art.el (article-emphasize): Check group variable. + * rfc1843.el (rfc1843-decode-article-body): Ditto. + +1999-11-24 00:11:27 Shenghuo ZHU + + * mm-decode.el (mm-save-part-to-file): Inhibit jka-compr for any + type. + +1999-11-23 17:21:05 Shenghuo ZHU + + * webmail.el: Support www.netaddress.com, i.e. usa.net. + +1999-11-23 Hrvoje Niksic + + * mml.el (mml-quote-region): Insert ! after the hash. + +1999-11-23 05:08:23 Shenghuo ZHU + + * gnus-group.el (gnus-group-warchive-address-history): Change to + nil. + +1999-11-23 02:33:13 Shenghuo ZHU + + * webmail.el: Support mail.yahoo.com. + + * mail-source.el (mail-source-fetch-webmail): Add password check. + (mail-source-keyword-map): Use `subtype'. + +1999-11-22 04:35:43 Shenghuo ZHU + + * mail-source.el (mail-source-keyword-map): Add webmail. + (mail-source-fetcher-alist): Ditto. + (mail-source-fetch-webmail): New function. + * webmail.el: New file. + +1999-11-21 12:20:02 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-request-group): Print 0 if it is nil. + +1999-11-21 12:19:11 Shenghuo ZHU + + * mailcap.el (mailcap-parse-mailcap): Don't skip double semicolon. + +1999-11-20 12:54:25 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-request-list): Add fetch-time slot. + (nnultimate-prune-days): New function. + (nnultimate-create-mapping): Use it. + (nnultimate-request-group): Only fetch the groups list if it has + not been done before. + (nnultimate-retrieve-headers): Don't write groups. + (nnultimate-create-mapping): Off-by-one error. + +1999-11-19 12:17:25 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-sane-retrieve-headers): Fix to match + threaded subjects. + +1999-11-20 02:22:52 Shenghuo ZHU + + * nnwarchive.el: Lots of changes make agent happy. + +1999-11-19 21:37:41 Shenghuo ZHU + + * gnus-start.el (gnus-get-unread-articles): Assert group is in + hashtb. + +1999-11-19 19:53:08 Shenghuo ZHU + + * mm-decode.el (mm-display-external): Write region with binary + mode. + +1999-11-18 14:52:05 Shenghuo ZHU + + * nnweb.el (nnweb-dejanews-create-mapping): Bind `text'. + +1999-11-18 14:35:01 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'. + (mm-uu-test): Now it is in restricted region. + + * gnus-art.el (article-decode-charset): Don't mm-uu-test. + + * mm-view.el (mm-view-message): Fix buffer leak. + (mm-inline-message): Support 'gnus-decoded. + + * mm-bodies.el (mm-decode-body): Ditto. + + * rfc2047.el (rfc2047-decode-region): Ditto. + +1999-11-18 Matthias Andree + + * imap.el (require): Added autoload for base64-encode-string. + +1999-11-17 Per Abrahamsen + + * gnus.el (gnus-refer-article-method): Made list value + customizable. + +1999-11-17 13:09:37 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-recenter): set-window-start with + NOFORCE in Emacs case. + +1999-11-17 13:04:01 Shenghuo ZHU + + * gnus-art.el (gnus-request-article-this-buffer): Set + gnus-newsgroup-name. + +1999-11-16 23:53:22 Shenghuo ZHU + + * gnus-xmas.el (gnus-xmas-summary-recenter): set-window-start with + NOFORCE. + +1999-11-17 Simon Josefsson + + * gnus-start.el (gnus-get-unread-articles): Check server before + scanning. + +1999-11-16 10:01:03 Lars Magne Ingebrigtsen + + * gnus.el (gnus-valid-select-methods): nnslashdot is news. + + * nnslashdot.el (nnslashdot-login-name): New variable. + (nnslashdot-password): Ditto. + (nnslashdot-request-post): New function. + + * gnus-art.el (gnus-treat-buttonize): More testing. + + * mm-encode.el: Another CVS test. + + * gnus-art.el (gnus-treat-emphasize): Change default. + (gnus-treat-buttonize): Ditto. + (gnus-treat-buttonize): This is a test. + + * gnus-sum.el (gnus-build-old-threads): Bind mail-parse-charset. + (gnus-build-sparse-threads): Ditto. + (gnus-build-all-threads): Ditto. + + * nnheader.el (make-full-mail-header): Make into a subst. + + * dgnushack.el (dgnushack-compile): Skip all w3-dependent files + unless w3 is supplied. + + * gnus.el (gnus-refer-article-method): Doc fix. + + * gnus-sum.el: Do not accept a prefix. + (gnus-summary-refer-article): Accept a list of select methods. + +1999-11-15 21:28:40 Shenghuo ZHU + + * Makefile.in: Change `^ *' to `\t'. + +1999-11-11 Matt Pharr + + * message.el (message-forward): Pay attention to prefix argument + again and forward all headers when it is set, regardless of the + value of message-forward-ignored-headers. + +1999-11-15 20:44:50 William M. Perry + + * dgnushack.el (dgnushack-compile): Vpath file. + + * Makefile.in (SHELL): VPATH support. + +1999-11-15 20:37:17 Lars Magne Ingebrigtsen + + * gnus-ems.el: Check for cygwin32. + +1999-11-14 18:15:28 Shenghuo ZHU + + * mm-decode.el (mm-display-external): Use 'non-viewer. + +1999-11-14 15:21:06 Shenghuo ZHU + + * base64.el (base64-encode-string): An alias for base64-encode for + compatibility. + +1999-11-14 01:58:18 Shenghuo ZHU + + * nntp.el (nntp-retrieve-groups): Erase nntp-sever-buffer before + nntp-inhibit-erase. + +1999-11-13 Simon Josefsson + + * gnus-start.el (gnus-get-unread-articles): Use + nnfoo-retrieve-groups to find new news, if available. + (gnus-read-active-file-2): New function. + (gnus-get-unread-articles): Use it. + (gnus-read-active-file-1): Ditto. + +1999-11-13 17:59:18 Lars Magne Ingebrigtsen + + * mm-util.el (mm-find-mime-charset-region): Make sure + find-coding-systems-for-charsets is fbound. + + * gnus-ems.el: Typo fix. + +1999-11-13 Florian Weimer + + * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if + it's available and makes sense. + +1999-11-12 19:56:23 Fabrice POPINEAU + + * gnus-score.el (gnus-score-save): Translate score file. + +1999-11-13 Simon Josefsson + + * mail-source.el (mail-source-keyword-map): For IMAP mail source, + added fetchflag and dontexpunge keywords. + (mail-source-fetch-imap): Use them. + +1999-11-12 Per Abrahamsen + + * gnus-start.el (gnus-level-subscribed, gnus-level-unsubscribed, + gnus-level-zombie, gnus-level-killed): Changed from `defcustom' to + `defconst'. + + * gnus-cus.el (gnus-group-parameters): Changed from `defcustom' to + `defconst'. + Mention that it is both for group and topic parameters. + (gnus-extra-topic-parameters): New constant, including `subscribe' + parameter. + (gnus-extra-group-parameters): New constant. + (gnus-group-customize): Use them. + + * gnus.el (gnus-select-method): Added default value and tag. + (gnus-refer-article-method): Added `DejaNews' customization option. + +1999-11-12 05:04:43 Lars Magne Ingebrigtsen + + * gnus-int.el (gnus-server-opened): Ignore denied servers. + + * gnus-ems.el (gnus-mule-max-width-function): New backquote + syntax. + + * nndoc.el (nndoc-mime-digest-type-p): Reinstated. + + * nnslashdot.el (nnslashdot-group-number): Changed default. + + * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja. + (nnweb-dejanews-wash-article): Removed. + (nnweb-type-definition): Fetch by id. + + * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless + we mean it. + + * nnslashdot.el (nnslashdot-group-number): Doc fix. + (nnslashdot-request-list): Use Ultramode as well. + (nnslashdot-date-to-date): Be more lenient. + (nnslashdot-threaded): New function. + +1999-11-11 17:40:54 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-internalize-part): Doc fix. + +1999-11-11 14:32:48 Steinar Bang + + * nnweb.el (nnweb-type-definition): /=dnc + +1999-11-11 10:58:38 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-retrieve-headers): Work with american + dates. + (nnultimate-retrieve-headers): Wrong ordering. + +1999-11-11 07:31:51 Matt Pharr + + * message.el (message-forward-as-mime): New variable. + +1999-11-11 05:24:13 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-dd-mmm): Beware buggy dates. + +1999-11-10 16:50:01 Shenghuo ZHU + + * mail-source.el (mail-source-movemail-and-remove): New function. + (mail-source-keyword-map): Add `function' for `maildir'. + (mail-source-fetch-maildir): Use it. + +1999-11-10 13:48:10 Shenghuo ZHU + + * nnwarchive.el: New file. + * gnus-group.el (gnus-group-make-warchive-group): New function. + * gnus.el (gnus-valid-select-methods): Add `nnwarchive'. + +1999-11-10 12:13:30 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page + subjects. + +1999-11-10 11:33:23 Rajappa Iyer + + * gnus-salt.el (gnus-pick-article-or-thread): Don't move point. + +1999-11-10 05:22:56 Lars Magne Ingebrigtsen + + * nnultimate.el (nnultimate-open-server): Do address. + (nnultimate-forum-table-p): New function. + + * nnweb.el (nnweb-insert-html): Renamed. + (nnweb-insert): New function. + + * nnultimate.el (nnultimate-insert-html): New function. + + * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything + if nov is evil. + (nnslashdot-retrieve-headers): use the sane version instead. + +1999-11-09 00:13:25 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-article): Fold case. + + * nnultimate.el: New file. + + * nnslashdot.el (nnslashdot-retrieve-headers): Skip the article + unless wanted. + + * gnus-start.el (gnus-active-to-gnus-format): Catch errors. + (gnus-read-active-file-1): Separated into own function. + (gnus-read-active-file): Catch quits. + + * nnslashdot.el (nnslashdot-request-article): Search better on + first article. + (nnslashdot-request-list): Fold case. + (nnslashdot-retrieve-headers): Ditto. + +1999-11-08 05:33:15 Lars Magne Ingebrigtsen + + * gnus.el: Autoload gnus-subscribe-topics. + +1999-11-07 22:56:46 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-save-group-info): Remove backslash + before dot. + * gnus-util.el (gnus-write-active-file): Ditto. + +1999-11-07 22:31:10 Shenghuo ZHU + + * nnheader.el (nnheader-replace-duplicate-chars-in-string): New + function. + * gnus-cache.el (gnus-cache-file-name): Use it. + * gnus-agent.el (gnus-agent-group-path): Use it. + * nnmail.el (nnmail-group-pathname): Use it. + +1999-11-07 21:07:55 Shenghuo ZHU + + * gnus-start.el (gnus-active-to-gnus-format): Don't insert backslash + if cooked. + * gnus-util.el (gnus-write-active-file): Write cooked active file. + * gnus-agent.el (gnus-agent-save-group-info): Ditto. + * gnus.el (gnus-short-group-name): "..." proof. + +1999-11-07 20:03:16 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Keep using `read' to + support nnslashdot. + +1999-11-08 00:06:02 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-retrieve-headers): Don't fetch too + many articles. + (nnslashdot-generate-active): New function. + (nnslashdot-request-newgroups): Use it. + + * gnus-start.el (gnus-active-to-gnus-format): Intern strings group + names. + + * nnslashdot.el (nnslashdot-request-newgroups): New function. + (nnslashdot-request-list): Not moderated. + +1999-11-07 Simon Josefsson + + * nnimap.el (nnimap-open-server): Remove error signal if + nnimap-server-buffer is nil (the check should've been `boundp'). + + * imap.el (imap-log): + * nnimap.el (nnimap-debug): Disable debugging by default. + +1999-11-07 01:17:53 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix. + + * gnus-topic.el (gnus-subscribe-topic): New function. + + * nnslashdot.el (nnslashdot-request-list): Give out extended group + names. + + * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars + if starting with a quote. + +1999-11-07 13:06:11 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Support backslash in + group name. + +1999-11-07 01:17:53 Lars Magne Ingebrigtsen + + * nnslashdot.el: New file. + + * nnheader.el (nnheader-insert-header): New function. + + * gnus-art.el (gnus-mime-internalize-part): Bind + mm-inlined-types. + + * nndraft.el (nndraft-request-expire-articles): Do all the backup + files. + +1999-10-29 David S. Goldberg + + * emacs-mime.texi (Customization): Document mm-inline-override-types + +1999-10-29 David S. Goldberg + + * emacs-mime.texi (Customization): Document mm-inline-override-types + +1999-10-29 David S. Goldberg + + * emacs-mime.texi (Customization): Document mm-inline-override-types + +1999-10-26 Katsumi Yamaoka + + * smiley.el (gnus-smiley-display): Use `smiley-toggle-buffer'. + (smiley-toggle-buffer): New function. + (smiley-buffer): Don't quote the function. + (smiley-toggle-extents): Ditto. + +1999-11-07 01:00:32 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-goto-missing-topic): Work even in + empty buffers. + +1999-11-06 23:16:24 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-mode-map): Use the summary article + edit. + +1999-11-06 22:56:49 Jens-Ulrik Petersen + + * gnus-group.el (gnus-group-read-ephemeral-group): Doc fix. + +1999-11-06 21:40:30 Lars Magne Ingebrigtsen + + * gnus-uu.el (gnus-uu-mark-thread): Don't move point around. + +1999-10-07 Katsumi Yamaoka + + * gnus-art.el (gnus-treat-predicate): Examine whether the argument + is list or not before condition. + +1999-10-07 Yoshiki Hayashi + + * gnus-art.el (gnus-treat-predicate): Work for (typep "something"). + +1999-11-06 19:18:14 Kevin the Bandicoot + + * gnus-art.el (gnus-emphasis-alist): New value. + +1999-11-06 13:57:13 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Use both `read' and + `buffer-substring'. + +1999-11-06 04:24:30 Lars Magne Ingebrigtsen + + * gnus-art.el (article-date-ut): Keep the updated timer. + (gnus-emphasis-underline-italic): Doc fix. + + * gnus-msg.el (gnus-post-method): Doc fix. + (gnus-post-method): Change default. + +1999-11-06 04:12:13 Francisco Solsona + + * message.el (message-newline-and-reformat): Improvements. + +1999-11-06 03:51:24 Lars Magne Ingebrigtsen + + * message.el (message-newline-and-reformat): Don't insert too many + newlines. + (message-newline-and-reformat): Work even if not sc. + + * mm-view.el (mm-inline-message): Insert a delimiter at the end. + + * mm-decode.el (mm-inline-media-tests): Only if diff mode. + +1999-11-06 03:48:02 Toby Speight + + * mm-view.el (mm-display-patch-inline): New function. + +1999-11-06 03:47:54 Robert Bihlmeyer + + * mm-view.el (mm-display-patch-inline): New function. + +1999-11-06 02:17:54 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-read-move-group-name): Subscribe to the + group. + + * message.el (message-forward): Narrow to the right header. + + * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus + dates. + + * gnus-msg.el (gnus-configure-posting-styles): Use the + user-full-name function. + + * mm-bodies.el (mm-body-encoding): Use the choosing function. + (mm-body-charset-encoding-alist): Default to nil. + + * message.el (message-elide-ellipsis): Fix typo. + (message-elide-region): Ditto. + (message-elide-region): Don't insert a newline first. + +1999-11-05 20:28:27 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-cut-thread): Also cut for numberp + gnus-fetch-old-headers. + (gnus-cut-threads): Ditto. + (gnus-summary-initial-limit): Ditto. + (gnus-summary-limit-children): Ditto. + + * gnus-msg.el (gnus-configure-posting-styles): Allow `header' + matches. + +1999-11-06 Simon Josefsson + + * gnus-art.el (article-decode-encoded-words): + (gnus-mime-display-single): Don't assume gnus-summary-buffer is + live. + + * gnus.el (gnus-read-method): Add methods from + `gnus-opened-servers' to completion. Map entered method/address + into existing methods if possible. + + * gnus-group.el (gnus-group-make-group): Simplify method. + + * gnus-srvr.el (gnus-browse-unsubscribe-group): Simplify method. + + * mml.el (mml-preview): Remove mail-header-separator before + encoding. + +1999-11-05 20:28:27 Lars Magne Ingebrigtsen + + * message.el (message-read-from-minibuffer): New function. + +Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.98 is released. + +1999-11-05 01:27:49 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-expire): Remove bad line in NOV. + +1999-11-04 22:20:35 Shenghuo ZHU + + * mml.el (mml-generate-mime-1): Read attached binary file in + binary mode. + +1999-11-03 16:08:56 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-toggle-header): Fix arg bug. + +1999-11-03 15:27:38 Shenghuo ZHU + + * mailcap.el (mailcap-viewer-lessp): Fix bug. + +1999-11-02 17:28:33 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-search-article): Fix loop search bug. + +1999-10-31 21:24:59 Shenghuo ZHU + + * gnus-art.el (gnus-article-mime-match-handle-first): New function. + (gnus-article-mime-match-handle-function): New variable. + (gnus-article-view-part): Make `b' customizable. + +1999-10-29 14:30:07 Shenghuo ZHU + + * gnus-sum.el (gnus-article-get-xrefs): Test eobp. + +1999-09-27 Hrvoje Niksic + + * mm-decode.el (mm-attachment-override-types): Exclude text/plain. + +1999-10-26 23:27:44 Shenghuo ZHU + + * mm-decode.el (mm-dissect-buffer): CTE may come without CTL. + +1999-10-26 21:44:05 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Use + `buffer-substring' instead of `read'. + +1999-10-23 Simon Josefsson + + * nnimap.el, imap.el, rfc2104.el: New files. + + * gnus.el (gnus-valid-select-methods): Add nnimap. + + * gnus-group.el (gnus-group-group-map): Add + gnus-group-nnimap-edit-acl, gnus-group-nnimap-expunge. + (gnus-group-nnimap-expunge): New function. + (gnus-group-nnimap-edit-acl): New function. + + * gnus-agent.el (gnus-agent-group-mode-map): Add + gnus-agent-synchronize. + (gnus-agent-synchronize): New function. + (gnus-agent-fetch-group-1): Check if server is open. + + * nnagent.el (nnagent-request-set-mark): Save marks. + + * mail-source.el (mail-source-keyword-map): New imap mail-source. + (mail-source-fetcher-alist): Map to imap fetcher function. + (mail-source-fetch-imap): New function. + + * gnus-art.el (article-hide-pgp): Hide all headers, not just + Hash:. + +1999-10-22 11:03:00 Shenghuo ZHU + + * gnus-topic.el (gnus-topic-sort-topics-1): New function. + (gnus-topic-sort-topics): New function. + (gnus-topic-make-menu-bar): Add sort-topics. + (gnus-topic-move): New function. + (gnus-topic-move-group): Move the topic if no group selected. + +1999-10-13 21:31:50 Shenghuo ZHU + + * gnus-art.el (gnus-article-setup-buffer): Fix buffer leak. + +1999-10-13 12:52:18 Shenghuo ZHU + + * mm-view.el (mm-inline-message): Fix leaving group bug. + +1999-10-07 17:59:49 Shenghuo ZHU + + * gnus-msg.el (gnus-post-method): Use normal method if current is + not available. + +1999-10-07 17:09:34 Shenghuo ZHU + + * nnmail.el (nnmail-insert-xref): Dealing with empty articles. + (nnmail-insert-lines): Ditto. + +1999-10-07 Shenghuo ZHU + + * nnfolder.el (nnfolder-insert-newsgroup-line): Insert a blank + line. + + * message.el (message-unsent-separator): One more separator. + +1999-10-06 Shenghuo ZHU + + * nnfolder.el (nnfolder-request-move-article): For empty article, + search till (point-max). + (nnfolder-retrieve-headers): Ditto. + (nnfolder-request-accept-article): Ditto. + (nnfolder-save-mail): Ditto. + (nnfolder-insert-newsgroup-line): Ditto. + +1999-10-05 Shenghuo ZHU + + * qp.el (quoted-printable-encode-region): Check eobp. + +1999-10-03 Shenghuo ZHU + + * nntp.el (nntp-retrieve-headers-with-xover): Fix hanging problem. + +1999-10-02 Shenghuo ZHU + + * nntp.el (nntp-send-xover-command): Wait for nothing if not + wait-for-reply. + +1999-09-29 Shenghuo ZHU + + * mm-uu.el (mm-uu-forward-begin-line): Change the regexp. + (mm-uu-forward-end-line): Ditto. + +1999-09-29 Didier Verna + + * binhex.el (binhex-decode-region): don't consider the value of + `enable-multibyte-characters' in XEmacs. + + * gnus-start.el (gnus-read-descriptions-file): ditto. + + * mm-util.el (mm-multibyte-p): ditto. + (mm-with-unibyte-buffer): ditto. + (mm-find-charset-region): use `mm-multibyte-p'. + + * mm-bodies.el (mm-decode-body): ditto. + (mm-decode-string): ditto. + + * lpath.el ((string-match "XEmacs" emacs-version)): Don't define + `enable-multibyte-characters' in XEmacs. + +1999-09-29 Shenghuo ZHU + + * mm-util.el (mm-binary-coding-system): Try binary first. + +1999-09-14 Shenghuo ZHU + + * rfc1843.el (rfc1843-decode-article-body): Don't decode twice. + +1999-09-10 Shenghuo ZHU + + * gnus-art.el (article-make-date-line): Add time-zone in iso8601 + format. + (article-date-ut): Find correct insert position. + +1999-09-03 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable + forwarded message. + +1999-09-27 20:33:41 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-find-groups): Work for unactivated + groups. + + * message.el (message-resend): Use message mode when prompting. + + * gnus-art.el (article-hide-headers): Mark wash. + (article-emphasize): Ditto. + +1999-09-27 19:52:14 Vladimir Volovich + + * message.el (message-newline-and-reformat): Work for SC. + +1999-09-27 19:38:33 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*. + + * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown. + +1999-10-20 David S. Goldberg + + * mm-decode.el mm-inline-override-types: New variable + + * mm-decode.el (mm-inline-override-p): New function + + * mm-decode.el (mm-inlined-p): Use it + +1999-10-20 David S. Goldberg + + * mm-decode.el mm-inline-override-types: New variable + + * mm-decode.el (mm-inline-override-p): New function + + * mm-decode.el (mm-inlined-p): Use it + +Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.97 is released. + +1999-09-01 Brendan Kehoe + + * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Use + gnus-summary-next-group, not gnus-summary-next-article. Only give + 3 args. + +1999-09-25 08:07:57 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-group-1): Look in the group + buffer for params. + + * gnus-xmas.el (gnus-xmas-summary-recenter): Display one more + line. + + * message.el (message-forward-ignored-headers): New variable. + + * gnus-art.el (gnus-article-prepare-display): Nix out + gnus-article-wash-types. + + * gnus-agent.el (gnus-agent-create-buffer): New function. + (gnus-agent-fetch-group-1): Use it. + (gnus-agent-start-fetch): Ditto. + + * gnus-sum.el (gnus-summary-exit): Don't use + `gnus-use-adaptive-scoring'. + + * mail-source.el (mail-source-fetch-pop): Only store password when + successful. + + * gnus-nocem.el (gnus-nocem-scan-groups): Message better. + +1999-09-24 18:43:23 Lars Magne Ingebrigtsen + + * message.el (message-reply): Use it. + (message-dont-reply-to-names): New variable. + + * nntp.el (nntp-open-telnet): Don't erase-buffer. + + * mm-util.el (mm-preferred-coding-system): Typo fix. + + * message.el (message-bounce): Work for non-MIME. + + * gnus.el (gnus-short-group-name): Short the right parts of the + name. + +1999-09-24 18:17:48 Johan Kullstam + + * mm-encode.el (mm-qp-or-base64): New version. + +1999-09-10 Shenghuo ZHU + + * gnus-art.el (article-make-date-line): Fix time-zone bug. + +1999-09-09 Shenghuo ZHU + + * gnus-art.el (gnus-article-add-buttons): Don't delete markers out + of restricted region. + (gnus-mime-display-single): Set beg at correct point. + +1999-09-09 Shenghuo ZHU + + * nnmail.el (nnmail-process-maildir-mail-format): Typo. + +1999-09-09 Jens-Ulrik Petersen + + * gnus-msg.el (gnus-configure-posting-styles): Let + `gnus-posting-styles' have its say in posting-style: local + variable `styles' is already bound to `gnus-posting-styles' so + don't rebind it to nil. + +1999-09-24 18:10:56 Robert Bihlmeyer + + * gnus-score.el (gnus-summary-increase-score): Allow editing of + Message-ID. + +1999-09-08 Shenghuo ZHU + + * mm-encode.el (mm-encode-content-transfer-encoding): Fold + quoted-printable-encode-region. + + * qp.el (quoted-printable-encode-region): Assume charset + encoded. Fold every line in the region. + +1999-09-02 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Read the first line + of active file. + +1999-09-01 Didier Verna + + * message.el (message-mode): allows whitespaces between multiple + instances of the fill character ">". + +1999-09-24 18:02:50 Kim-Minh Kaplan + + * mm-encode.el (mm-qp-or-base64): Fix. + +1999-09-01 12:18:01 Katsumi Yamaoka + + * message.el (message-send): Too much and. + +1999-09-24 17:58:07 Andreas Schwab + + * gnus-art.el (gnus-mime-view-part-as-type): Renamed. + +1999-08-28 12:44:20 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-headers): Work for nil scores. + +1999-08-27 20:46:11 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-write-active): Write full names. + + * gnus-util.el (gnus-write-active-file): Accept full name. + + * mm-decode.el (mm-inlinable-p): Use string-match on the types. + (mm-assoc-string-match): New function. + (mm-display-inline): Use it. + + * gnus-group.el (gnus-group-set-info): Work for nil group params. + + * gnus-msg.el (gnus-configure-posting-styles): Allow eval. + +1999-08-27 19:08:10 Florian Weimer + + * mml.el (mml-generate-multipart-alist): New variable. + +1999-08-27 15:30:02 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-predicate): Work for (not 5). + +1999-08-27 Peter von der Ahe + + * message.el (message-send): More helpful error message if sending + fails + +1999-09-06 Robert Bihlmeyer + + * gnus-score.el (gnus-summary-increase-score): "Lars" was broken + in newer emacsen, where ?r isn't equal 114. + +Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.96 is released. + +1999-08-17 Simon Josefsson + + * gnus-start.el (gnus-groups-to-gnus-format): Only use agent + to get active info if method is covered by agent, otherwise + active info is lost. + +1999-08-17 Simon Josefsson + + * gnus-sum.el (gnus-summary-move-article): Report backend errors. + +1999-08-09 Dave Love + + * mm-util.el: Use `defalias', not `fset' for dummy functions. + +1999-08-09 Simon Josefsson + + * gnus-art.el (gnus-ignored-headers): Remove "X-Pgp-*" + (already matched by "^X-Pgp"), removed duplicate + X-Mailing-List, added several new junk headers. + +1999-08-01 Simon Josefsson + + * gnus-art.el (article-decode-charset): Don't assume + gnus-summary-buffer is live. + +1999-08-27 15:07:43 Paul Flinders + + * smiley.el (smiley-deformed-regexp-alist): Fix % smileys. + +1999-08-27 15:02:58 Florian Weimer + + * gnus-score.el (gnus-home-score-file): Work with absolute path + names. + +1999-07-17 Shenghuo ZHU + + * gnus-sum.el (gnus-articles-to-read): Return cached articles if + nothing else in the group. + +1999-07-16 Shenghuo ZHU + + * gnus-bcklg.el (gnus-backlog-enter-article): Check the size of + the article. + +1999-07-15 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Fix for base64 message. + +1999-07-15 Shenghuo ZHU + + * mm-uu.el (mm-uu-forward-end-line): Support forwarded message + from mutt. + +1999-07-14 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): Delete + whitespace. + +1999-07-14 Shenghuo ZHU + + * mm-util.el (mm-text-coding-system-for-write): New variable. + (mm-append-to-file): New function. + (mm-write-region): New function. + + * gnus-art.el (gnus-output-to-file): Use it. + * gnus-util.el (gnus-output-to-rmail): Ditto. + (gnus-output-to-mail): Ditto. + * gnus-uu.el (gnus-uu-binhex-article): Ditto. + +1999-07-14 Shenghuo ZHU + + * nnmail.el (nnmail-find-file): Use mm-auto-mode-alist. + + * nnheader.el (nnheader-insert-file-contents): Revert and use + mm-insert-file-contents. + (nnheader-find-file-noselect): Use mm-auto-mode-alist. + (nnheader-auto-mode-alist): Removed. + + * mm-util.el (mm-inhibit-file-name-handlers): New variable. + (mm-insert-file-contents): Add a new parameter for inserting + compressed file literally. + + * mml.el (mml-generate-mime-1): Insert non-text literally. + + * gnus.el: Change most mm-insert-file-contents back to nnheader. + +1999-07-13 Hrvoje Niksic + + * gnus-art.el (gnus-unbuttonized-mime-types): Fix docstring. + +1999-08-27 14:53:42 Oleg S. Tihonov + + * gnus-sum.el (gnus-group-charset-alist): Default fido7 to + koi8-r. + +1999-07-11 Shenghuo ZHU + + * mml.el (mml-insert-mime): Decode text. + (mml-to-mime): Narrow to headers-or-head. + +1999-07-11 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Check + w3-meta-content-type-charset-regexp. + +1999-07-10 Simon Josefsson + + * gnus-agent.el (gnus-agent-fetch-group-1): Search topics for + predicate. + +1999-07-10 Alexandre Oliva + + * gnus-mlspl.el: Documentation fixes. + +1999-08-27 14:42:14 Rui Zhu + + * gnus-sum.el (gnus-summary-limit-to-age): Prompt better. + +1999-08-27 14:40:52 Michael Cook + + * gnus-art.el (gnus-article-setup-buffer): Kill all local + variables. + +1999-08-27 14:39:34 Hrvoje Niksic + + * nnmail.el (nnmail-get-new-mail): "Done". + +1999-08-27 14:38:14 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-kill-all-zombies): Only prompt when + interactive. + +1999-07-12 Shenghuo ZHU + + * gnus-art.el (article-decode-charset): Fix broken CT. + +1999-07-12 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-group-1): Recreate agent + overview buffer if it is killed. + +1999-08-27 14:26:03 Eric Marsden + + * gnus-art.el (article-babel): New version. + +1999-08-27 14:22:39 Jon Kv + + * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry. + +1999-07-10 Mike McEwan + + * gnus.texi (More Threading): Document new variable + `gnus-sort-gathered-threads-function'. + +1999-07-10 Mike McEwan + + * gnus.texi (More Threading): Document new variable + `gnus-sort-gathered-threads-function'. + +1999-07-11 Andreas Jaeger + + * gnus-uu.el (gnus-uu-digest-mail-forward): Delete file after + usage. + +1999-07-10 Shenghuo ZHU + + * mm-util.el (mm-running-xemacs): Removed. + (mm-coding-system-p): New function. + (mm-binary-coding-system): Safe guess. + (mm-text-coding-system): Ditto. + (mm-auto-save-coding-system): Ditto. + +1999-07-11 11:02:03 Lars Magne Ingebrigtsen + + * mm-encode.el (mm-qp-or-base64): Also consider control chars. + (mm-qp-or-base64): Reversed logic. + + * mm-decode.el (mm-save-part-to-file): Let coding system be + binary. + +1999-07-15 Mike McEwan + + * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to + be set in topic parameters. + +1999-07-10 Mike McEwan + + * gnus-sum.el (gnus-sort-gathered-threads-function): New variable. + (gnus-sort-gathered-threads): Allow the user to specify the + function to use when sorting gathered threads. + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't + mark cached articles as `undownloaded'. + +Tue Jul 20 02:39:56 1999 Peter von der Ahe + + * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring + to have buffer local values. + +1999-07-25 Matt Pharr + + * gnus-group.el (gnus-group-make-doc-group): Notice when user + types 'g' for 'guess group type. + +1999-07-30 Simon Josefsson + + * nnmail.el (nnmail-remove-list-identifiers): Remove whitespace + after each regexp in nnmail-list-identifiers, not just after last + one. + + * gnus-sum.el (gnus-list-identifiers): New variable. + (gnus-summary-remove-list-identifiers): New function. + (gnus-select-newsgroup): Use it. + (gnus-summary-wash-hide-map): Bind + `gnus-article-hide-list-identifiers' to W W l. + (gnus-summary-make-menu-bar): Add list-identifiers command. + + * gnus-art.el (gnus-treat-strip-list-identifiers): New variable. + (gnus-treatment-function-alist): Add variable. + (article-hide-list-identifiers): New function. + (mapcar): Add function. + (gnus-article-hide): Use it. + +Fri Jul 9 22:21:16 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.95 is released. + +1999-07-09 21:46:05 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-mailcap-command): New function. + (mm-display-external): Use it. + + * gnus-art.el (article-make-date-line): Work for India. + + * mm-encode.el (mm-qp-or-base64): Typo. + + * gnus-topic.el (gnus-topic-goto-topic): Made into command. + +Fri Jul 9 19:28:29 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.94 is released. + +1999-07-09 21:19:23 Stainless Steel Rat + + * pop3.el: New version. + +1999-07-09 20:01:44 Lars Magne Ingebrigtsen + + * mm-encode.el (mm-qp-or-base64): New function. + (mm-content-transfer-encoding): Use it. + + * gnus-util.el (gnus-parse-netrc): Allow quoted names. + +1999-07-08 Shenghuo ZHU + + * mm-decode.el (mm-display-external): Fix typo and use 'non-viewer. + + * mailcap.el (mailcap-mailcap-entry-passes-test): Add needsterminal. + +1999-07-09 18:52:22 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-view-part-as-media): New command and + keystroke. + + * mailcap.el (mailcap-mime-types): New function. + + * nnmh.el (nnmh-request-group): Update nnmh-group-alist. + + * message.el (message-goto-eoh): Really go to the end. + +1999-07-09 18:40:23 Puneet Goel + + * message.el (message-make-date): Do the right thing in with + sub-hour time zones. + +1999-07-09 18:36:21 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-make-menu-bar): Removed double bug + report. + +1999-07-08 Shenghuo ZHU + + * nnfolder.el (nnfolder-request-rename-group): Create directory. + +1999-07-08 Shenghuo ZHU + + * mailcap.el (mailcap-parse-mailcap): Skip \;. + (mailcap-parse-mailcap-extras): Fix "nonterminal;" and empty name, + and use t as default value. + +Wed Jul 7 18:40:30 1999 Shenghuo ZHU + + * gnus-sum.el (gnus-get-newsgroup-headers): Don't assume + gnus-summary-buffer is live. + +1999-07-09 17:44:03 Robert Pluim + + * mm-util.el (mm-enable-multibyte): Check whether var bound. + +1999-07-09 17:31:39 Lars Magne Ingebrigtsen + + * message.el (message-bounce): Do MIME bounces MIMEy. + + * gnus-sum.el (gnus-summary-read-group-1): Update mark positions. + +1999-07-08 08:41:10 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-extensions): Changed patch to + text/x-patch. + + * mm-decode.el (mm-display-external): Wrong placement of paren. + +Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.93 is released. + +1999-07-08 Alexandre Oliva + + * gnus-cus.el (gnus-group-parameters): New entries for + gnus-group-split. + + * gnus-mlspl.el: Renamed functions and variables so as to + start with gnus-group-split. + * gnus.el: Adjust autoload entries. + +1999-07-07 ??:??:?? Alexandre Oliva + + * gnus-mlspl.el: Removed trailing t from comment and provide. + Renamed functions and variables to start with gnus-mlsplit. + Added autoload comments. + * gnus.el: Added autoload entries. + +1999-07-06 05:37:46 Alexandre Oliva + + * nnmail.el (nnmail-split-it): Search the regexp multiple times, + so that matches excluded by RESTRICTs do not cause the whole split + to be ignored. This also fixes a long-standing bug in which a + split with \N substitutions wouldn't cause cross-posting as + expected. + + * nnmail.el (nnmail-split-fancy): Document RESTRICT clauses. + (nnmail-split-it): Implement them. + + * nnmail.el (nnmail-split-fancy): Document ! splits. + +1999-07-07 10:41:11 Stainless Steel Rat + + * pop3.el: New version. + +1999-07-05 Simon Josefsson + + * gnus-srvr.el (gnus-browse-foreign-server): Use read. + +1999-07-07 10:37:26 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-alternative): Do treatment. + +1999-07-06 Shenghuo ZHU + + * gnus-util.el (gnus-write-active-file): Use real name. + + * gnus-agent.el (gnus-agent-expire): Update active file + method by method. + +1999-07-06 Shenghuo ZHU + + * nndraft.el (nndraft-request-article): Use difference + coding-systems for queue and drafts. + + * gnus-sum.el (gnus-summary-setup-default-charset): Special-case + nndraft:drafts. + + * mm-util.el (mm-auto-save-coding-system): New coding system. + + * message.el (message-draft-coding-system): Use it. + +1999-07-06 Shenghuo ZHU + + * mm-uu.el: More customizable and less aggressive. + +1999-07-07 07:53:23 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active + when plugged. + + * mml.el (mml-generate-mime-1): Don't insert nofile files. + (mml-insert-mml-markup): Accept a nofile. + (mml-insert-mime): Insert nofile. + + * gnus-art.el (gnus-treat-strip-blank-lines): Removed. + + * mm-decode.el (mm-handle-media-type): New function. + (mm-handle-media-supertype): New function. + (mm-handle-media-subtype): New function. + Use new functions throughout. "/")) + +1999-05-18 03:03:50 Katsumi Yamaoka + + * gnus-art.el (gnus-treat-predicate): Typo. + +1999-07-07 06:21:36 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-summary-score-entry): Made un-interactive. + +1999-07-06 17:57:16 Lars Magne Ingebrigtsen + + * gnus-art.el (article-date-ut): UT! Default it! + +Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.92 is released. + +1999-07-06 12:30:59 Johannes Weinert + + * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. + +1999-07-06 07:41:07 Lars Magne Ingebrigtsen + + * nntp.el (nntp-retrieve-groups): Don't do anything when not + connected. + + * gnus-start.el (gnus-active-to-gnus-format): Only save active + when plugged. + + * mm-view.el (mm-inline-message): Ignore remove-spec. + + * gnus-agent.el (gnus-agent-write-active): Check whether orig sym + is bound. + + * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines. + + * nndoc.el (nndoc-guess-type): Remove blank lines at the start. + + * nnfolder.el (nnfolder-read-folder): Remove blank lines at the + start. + + * message.el (message-fill-yanked-message): Remove `t' arg. + + * gnus-group.el (gnus-group-kill-group): Message killing of + groups. + + * mm-util.el (mm-preferred-coding-system): New function. + (mm-mime-charset): Use it. + + * mml.el (mml-generate-mime-1): Charset-encode message parts. + +1999-07-06 07:03:31 Alexandre Oliva + + * gnus-mlsplt.el: New file. + +1999-07-06 05:47:57 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-Media-tests): Changed from forms to + functions. + (mm-attachment-override-p): Take a handle instead of a type. + (mm-inlined-p): Ditto. + (mm-automatic-display-p): Ditto, + (mm-inlinable-p): Ditto. + + * nndraft.el (nndraft-request-expire-articles): Delete backup + files. + + * mailcap.el (mailcap-parse-mailcap): Regexp-quote stuff. + + * gnus-sum.el (gnus-summary-limit-to-extra): Typo. + +1999-07-06 05:37:46 Alexandre Oliva + + * nnmail.el (nnmail-split-it): Allow .*. + +1999-07-05 05:04:57 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-large-images-p): Renamed. + + * gnus-art.el (article-date-ut): Always look in the current buffer + for the Date header. + + * mml.el (mml-validate): New command. + + * mailcap.el (mailcap-possible-viewers): Revert to string-match + since we are dealing with regexps. + +Sun Jul 4 06:31:01 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.91 is released. + +1999-07-04 04:35:28 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-save-active-1): New function. + (gnus-agent-save-active): use it. + (gnus-agent-save-groups): Ditto. + + * gnus-cache.el (gnus-cache-write-active): Use it. + + * gnus-agent.el (gnus-agent-write-active): Use it. + + * gnus-util.el (gnus-write-active-file): New function. + + * gnus-agent.el (gnus-agent-write-active): New function to keep + lower boundaries and canceled groups. + (gnus-agent-save-groups): Use it. + (gnus-agent-save-active): Use it. + (gnus-agent-save-group-info): Only write active files. + (gnus-agent-expire): Update active file. + + * mm-decode.el (mm-inlinable-part-p): Removed. + (mm-user-display-methods): Default to nil. + (mm-user-display-methods): Removed. + (add-mime-display-method): Removed. + (mm-automatic-display): Renamed. + (mm-automatic-display-p): Use it. + (mm-inlined-types): New variable. + (mm-inlined-p): New function. + + * message.el (message-reply): Bind message-this-is-mail. + +1999-07-03 13:16:31 Michael Klingbeil + + * smiley.el (smiley-buffer): Fix for NT. + +1999-07-03 11:26:47 Lars Magne Ingebrigtsen + + * mm-encode.el (mm-encode-buffer): Check whether we have 7bit. + + * message.el (message-check-news-header-syntax): Protect against + nil froms. + + * mm-util.el (mm-auto-mode-alist): New. + + * mml.el (mml-generate-mime-1): Ditto. + + * gnus.el: Use mm-insert-file-contents throughout instead of + nnheader. + + * mm-util.el (mm-insert-file-contents): New function. + +Sat Jul 3 07:35:35 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.90 is released. + +1999-07-03 09:31:10 Sven Fischer + + * mailcap.el (mailcap-possible-viewers): Use string=. + +1999-07-01 Shenghuo ZHU + + * mm-uu.el (mm-uu-forward-begin-line): New variable. + (mm-uu-forward-end-line): New variable. + (mm-uu-begin-line): Handle forwarded message. + (mm-uu-identifier-alist): Ditto. + (mm-uu-dissect): Ditto. + +1999-06-29 Shenghuo ZHU + + * lpath.el: Two free variables. + +1999-07-02 Shenghuo ZHU + + * nnheader.el (nnheader-file-coding-system): Use raw-text. + * gnus-agent.el (gnus-agent-file-coding-system): Ditto. + * gnus-cache.el (gnus-cache-coding-system): Ditto. + + * nnfolder.el (nnfolder-file-coding-system): Use mm-text-coding-system. + (nnfolder-file-coding-system-for-write): New variable. + (nnfolder-active-file-coding-system): New variable. + (nnfolder-active-file-coding-system-for-write): New variable. + (nnfolder-save-active): New function. + (nnfolder-save-buffer): Use them. + (nnfolder-possibly-change-group): Ditto. + (nnfolder-request-list-newsgroups): Ditto. + (nnfolder-request-create-group): Ditto. + (nnfolder-request-expire-articles): Ditto. + (nnfolder-request-move-article): Ditto. + (nnfolder-request-accept-article): Ditto. + (nnfolder-request-delete-group): Ditto. + (nnfolder-request-rename-group): Ditto. + (nnfolder-possibly-change-folder): Ditto. + (nnfolder-read-folder): Ditto. + (nnfolder-request-list): Remove pathname-coding-system. + (nnfolder-possibly-change-group): Use nnmail-pathname-coding-system. + + * nnmail.el (nnmail-file-coding-system): Use raw-text. + (nnmail-file-coding-system-1): Removed. + (nnmail-find-file): Use nnmail-pathname-coding-system. + (nnmail-write-region): Ditto. + + * nnmbox.el (nnmbox-file-coding-system): New variable. + (nnmbox-file-coding-system-for-write): New variable. + (nnmbox-active-file-coding-system): New variable. + (nnmbox-active-file-coding-system-for-write): New variable. + (nnmbox-save-buffer): New function. + (nnmbox-save-active): New function. + (nnmbox-request-scan): Use them. + (nnmbox-request-expire-articles): Ditto. + (nnmbox-request-move-article): Ditto. + (nnmbox-request-accept-article): Ditto. + (nnmbox-request-replace-article): Ditto. + (nnmbox-request-delete-group): Ditto. + (nnmbox-request-rename-group): Ditto. + (nnmbox-request-create-group): Ditto. + + * mm-util.el (mm-text-coding-system): raw-text or -dos. + (mm-running-ntemacs): Removed. + + * nnml.el (nnml-file-coding-system): Use nnmail-file-coding-system. + +1999-07-02 Shenghuo ZHU + + * nnfolder.el (nnfolder-read-folder): Use nnheader-file-coding-system. + +1999-07-01 Shenghuo ZHU + + * qp.el (quoted-printable-encoding-characters): Support lower case. + +1999-07-01 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode): Fold before B-encoding. + (rfc2047-b-encode-region): Encode line by line. + +1999-07-03 09:20:16 Lars Magne Ingebrigtsen + + * mm-util.el (mm-find-mime-charset-region): Fix. + +1999-06-30 KOSEKI Yoshinori + + * mm-util.el (mm-mime-mule-charset-alist): Fix iso-2022-jp(-2) bug. + (mm-find-mime-charset-region): Ditto. + +1999-07-03 09:15:35 Simon Josefsson + + * gnus-sum.el (gnus-summary-move-article): Fix something or + other. + +1999-06-29 Shenghuo ZHU + + * gnus-sum.el (gnus-newsgroup-ephemeral-charset): New variable. + (gnus-newsgroup-ephemeral-ignored-charsets): New variable. + (gnus-summary-enter-digest-group): Use them. + (gnus-summary-setup-default-charset): Ditto. + +1999-06-15 Shenghuo ZHU + + * base64.el (base64-run-command-on-region): Use unibyte buffer. + +1999-06-15 Shenghuo ZHU + + * gnus-msg.el (gnus-configure-posting-styles): Fix bug when + gnus-newsgroup-name is nil. + +1999-06-15 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode): Chop the tail newline. + +1999-06-15 Shenghuo ZHU + + * gnus-art.el (article-emphasize): Use correct + gnus-article-emphasis-alist. + +1999-06-15 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Fix text/html bug. + +Mon Jun 28 17:54:01 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.89 is released. + +1999-06-24 Shenghuo ZHU + + * nnmail.el (nnmail-file-coding-system-1): For NTEmacs in Windows. + * message.el (message-draft-coding-system): Ditto. + * mm-util.el (mm-running-ntemacs): Ditto. + +1999-06-23 Shenghuo ZHU + + * gnus-xmas.el (gnus-xmas-summary-recenter): A blank line may + cause problem. + +1999-06-23 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Ignore error in w3-region. + +1999-06-23 Shenghuo ZHU + + * mml.el: require mm-decode. + +1999-06-23 Shenghuo ZHU + + * gnus-art.el (gnus-display-mime): Treat as head only if necessary. + +1999-06-23 Shenghuo ZHU + + * mm-view.el (mm-inline-image): Fix image undisplayer. + +1999-06-22 Shenghuo ZHU + + * mml.el (mml-insert-multipart): Error in compeling-read. + (mml-insert-tag): Match tags. + +1999-06-19 Shenghuo ZHU + + * gnus-cache.el (gnus-cache-braid-nov): Fix coding-system bug. + (gnus-cache-braid-heads): Ditto. + (gnus-cache-retrieve-headers): Ditto. + +1999-06-16 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-send): Fix encoding bug. + +1999-06-16 10:17:29 Katsumi Yamaoka + + * gnus-art.el (gnus-article-read-summary-keys): Convert key events + to string under XEmacs. + +1999-06-28 19:34:03 Petersen Jens-Ulrik + + * gnus-start.el (gnus-find-new-newsgroups): Doc fix. + +1999-06-22 Shenghuo ZHU + + * mm-view.el (mm-inline-message): Fix message view bug. + * gnus-art.el (gnus-article-prepare): Ditto. + +1999-06-16 Shenghuo ZHU + + * gnus-cache.el (gnus-cache-possibly-enter-article): Fetch headers. + +Tue Jun 15 04:13:01 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.88 is released. + +1999-06-15 04:13:45 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-save-parts): Destroy handles after + usage. + + * nnmail.el (nnmail-get-new-mail): Save info. + +Mon Jun 14 01:15:59 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.87 is released. + +1999-06-14 02:46:05 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-file): Use prescript-delay. + (mail-source-run-script): New function. + (mail-source-fetch-pop): Use it. + +1999-06-13 09:52:11 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-highlight-words): Moved here. + +Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.86 is released. + +1999-06-13 08:51:25 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-translate): New variable. + (gnus-treat-predicate): Accept a list of regexps. + (gnus-article-treat-custom): Allow a list of regexps. + +1999-06-09 Markus Rost + + * gnus/gnus-group.el (gnus-permanently-visible-groups): Fix custom + type. + +1999-06-13 05:15:52 Lars Magne Ingebrigtsen + + * gnus-art.el (article-babel): Narrow a bit. + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow. + +1999-06-12 Simon Josefsson + + (gnus-agent-get-undownloaded-list): Operate on all articles, not + only unread ones. + (gnus-agent-fetch-headers): Fetch headers from unread and marked + articles, not only unread ones. + +1999-06-13 03:01:35 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-limit-to-extra): New command and + keystroke. + + * gnus-art.el (gnus-article-x-face-command): Ditto. + + * gnus-uu.el (gnus-uu-default-view-rules): Default to "display". + + * gnus.el (gnus-method-simplify): Accept server names. + +1999-06-13 02:36:15 Per Abrahamsen + + * gnus-art.el (article-babel-prompt): New function. + (article-babel): New command. + +1999-06-13 01:01:52 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-part-wrapper): Go to part. + + * mml.el (mml-generate-mime-1): Don't insert literally. + + * gnus-util.el (gnus-parse-netrc): Skip lines with #'s. + (gnus-netrc-syntax-table): Removed. + (gnus-parse-netrc): Don't use syntax table; just use whitespace. + +Wed May 5 13:51:13 1999 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Fix charset for text/html. + +Wed May 5 01:15:08 1999 Shenghuo ZHU + + * message.el (message-draft-coding-system): Use emacs-mule-dos. + +1999-06-12 07:29:39 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-split-incoming): Return the number of split + mails. + (nnmail-process-babyl-mail-format): Ditto. + (nnmail-process-unix-mail-format): Ditto. + (nnmail-process-mmdf-mail-format): Ditto. + (nnmail-process-maildir-mail-format): Ditto. + + * mail-source.el (mail-source-callback): Return the number from + the callback. + + * message.el (message-send-mail): Generate Lines. + + * mail-source.el (mail-source-call-script): New function. + (mail-source-call-script): New function. + +Sun May 2 02:00:27 1999 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-setup-highlight-words): New function. + (gnus-select-newsgroup): Use it. + (gnus-group-highlight-words-alist): New variable. + (gnus-newsgroup-emphasis-alist): New variable. + (gnus-summary-local-variables): Use it. + * lpath.el: Use it. + * gnus-art.el (article-emphasize): Use it. + (gnus-emphasis-highlight-words): New face. + * gnus-cus.el (gnus-group-parameters): New parameter. + +Sun May 2 01:00:02 1999 Shenghuo ZHU + + * gnus-cache.el (gnus-cache-possibly-enter-article): Remove + parameter `headers'. + (gnus-cache-enter-article): Ditto. + (gnus-cache-update-article): Ditto. + * gnus-sum.el (gnus-summary-move-article): Ditto. + (gnus-summary-mark-article-as-unread): Ditto. + (gnus-summary-mark-article): Ditto. + +1999-06-12 03:59:56 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-message-insert-stylings): Removed. + (gnus-posting-style-alist): Removed. + (gnus-message-style-insertions): Ditto. + (gnus-configure-posting-styles): Reimplementation. + + * mail-source.el (mail-source-fetch): Error the message. + + * gnus-msg.el (gnus-inews-do-gcc): Do mml and encoding. + +Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.85 is released. + +1999-04-20 Michael Cook + + * gnus-cite.el (gnus-cite-attribution-prefix): Tweak for MS + Outlook citation regex. + +1999-06-12 02:09:49 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-mime-parts-type-p): Accept space before + semicolon. + +1999-05-24 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Document range1 + modification, protect range2. + +1999-05-24 Simon Josefsson + + * gnus-sum.el (gnus-update-marks): Protect lists from + gnus-remove-from-range, don't sort twice. + +1999-05-21 Simon Josefsson + + * gnus-start.el (gnus-read-descriptions-file): Protect if no + function in backend. + +1999-05-15 Simon Josefsson + + * gnus-sum.el (gnus-valid-move-group-p): Check for a + request-accept-article function in the backend instead of using + the 'respool capability. + +1999-04-18 Hrvoje Niksic + + * mm-bodies.el (mm-decode-content-transfer-encoding): Handle + spurious whitespace at eob. + +1999-06-12 02:02:06 Adrian Aichner + + * nnmail.el (nnmail-get-new-mail): Check right variable. + +1999-06-12 01:57:39 Karl Kleinpaste + + * mailcap.el (mailcap-mime-data): Fix rfc822. + +1999-06-11 23:48:50 TOZAWA Akihiko + + * nndoc.el (nndoc-nsmail-type-p): New function. + (nndoc-type-alist): Recognize nsmail. + +1999-05-12 Mike McEwan + + * gnus-art.el (gnus-treatment-function-alist): Display `x-face' + *before* `article-hide-headers' deletes the information. + +1999-05-22 00:26:46 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-save-parts): New command and + keystroke. + (gnus-summary-save-parts-1): New function. + (gnus-summary-iterate): Buggy. + + * mm-decode.el (mm-save-part-to-file): Made into own function. + +1999-05-11 05:53:16 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-set-info): Resist nils. + +1999-05-04 19:26:08 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-data): Ditto. + + * gnus-uu.el (gnus-uu-default-view-rules): Ditto. + + * gnus-art.el (gnus-article-x-face-command): Default to ee. + +1999-05-02 Gareth Jones + + * gnus-art.el (article-make-date-line): Put X-Sent below Date if + gnus-article-date-lapsed-new-header is t. + +Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.84 is released. + +1999-05-01 22:23:21 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-bug-message): Mime change. + +1999-04-22 Simon Josefsson + + * gnus-sum.el (gnus-update-marks): Process null mark lists. + +1999-04-21 Hrvoje Niksic + + * mm-bodies.el (mm-decode-content-transfer-encoding): Recognize + `x-uue'. + +1999-03-04 Aaron M. Ucko + + * mail-source.el (mail-source-fetch-pop): Only prompt for password + when authentication is 'password. + +1999-05-01 22:17:55 + + * gnus-win.el (gnus-configure-windows): Accept a setting. + +1999-04-21 20:51:13 Lars Magne Ingebrigtsen + + * mm-util.el (mm-quote-arg): Moved here. + + * mm-decode.el (mm-quote-arg): Quote more chars. + +1999-04-18 20:12:49 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-parse-head): Message-ID in In-Reply-To + with newlines would create buggy .nov files. + + * gnus-art.el (gnus-article-date-lapsed-new-header): Default to nil. + + * qp.el (quoted-printable-encode-region): Encode whitespace at the + end of lines. + + * message.el (message-mode): Doc fix. + + * gnus-art.el (article-hide-headers): Delete the hidden headers. + + * gnus-msg.el (gnus-setup-posting-charset): Default group to "". + + * gnus-art.el (article-date-ut): Rewrite. + + * mm-decode.el (mm-preferred-alternative-precedence): Reverse the + order. + + * gnus-msg.el (gnus-message-insert-stylings): Remove duplicate + headers. + + * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix. + +1999-04-18 Didier Verna + + * gnus-art.el (gnus-article-date-lapsed-new-header): new variable. + (article-date-ut): use it. + +1999-04-18 20:06:20 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-pop): Call script + asynchronously. + +Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.83 is released. + +1999-04-18 10:55:57 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-draft-mode): Use mml minor mode. + + * gnus-cite.el (gnus-dissect-cited-text): Off-by-one error. + + * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads. + + * gnus-art.el (gnus-mime-inline-part): Don't do a charset param. + + * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp. + + * message.el (message-generate-headers): Accept continuation + headers. + +1999-04-18 10:48:57 Renaud Rioboo + + * gnus-demon.el (gnus-demon-time-to-step): Not strings. + +1999-04-18 08:21:52 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treatment-function-alist): use + maybe-hide-headers. + + * message.el (message-inhibit-body-encoding): Typo. + (message-resend): Inhibit encoding. + + * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047. + + * gnus-art.el (article-remove-cr): Use re-search. + + * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME + headers. + + * mm-decode.el (mm-quote-arg): Quote '. + + * gnus-ems.el (gnus-x-splash): Would place splash wrongly. + + * mm-decode.el (mm-insert-part): Use multibyte for text. + + * gnus-start.el (gnus-read-newsrc-file): New variable. + (gnus-read-newsrc-file): Use it. + +1999-04-17 18:51:54 Lars Magne Ingebrigtsen + + * nnvirtual.el (nnvirtual-request-expire-articles): New function. + + * gnus-group.el (gnus-group-expire-articles-1): Made into own + function. + +Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.82 is released. + +1999-04-15 Hrvoje Niksic + + * gnus-sum.el (gnus-group-charset-alist): Include Croatian groups + for iso8859-2. + +1999-04-17 18:23:50 Lars Magne Ingebrigtsen + + * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from + synonym alist. + +1999-04-17 18:03:38 Adam P. Jenkins + + * gnus-sum.el (gnus-summary-local-variables): Mark as global. + +1999-04-17 18:02:05 Ettore Perazzoli + + * mail-source.el (mail-source-fetch): Ask before bugging out. + +1999-03-19 Hrvoje Niksic + + * uudecode.el (uudecode-decode-region-external): Don't assume + uudecode-temporary-file-directory ends with a slash. + +1999-03-18 Simon Josefsson + + * gnus-sum.el (gnus-update-marks): + (gnus-update-read-articles): + (gnus-summary-expire-articles): Check server. + +1999-03-16 Simon Josefsson + + * mml.el (mml-preview): New function. + +1999-04-17 17:10:21 William M. Perry + + * mail-source.el (mail-source-fetch-file): Return the right + value. + +1999-04-17 07:52:17 Lars Magne Ingebrigtsen + + * mml.el (mml-insert-parameter): New function. + (mml-insert-parameter-string): New function. + + * nnmail.el (nnmail-get-new-mail): Say how many new articles. + + * gnus-art.el (gnus-mime-multipart-functions): New variable. + (gnus-mime-display-part): Use it. + + * mm-decode.el (mm-alternative-precedence): Removed. + (mm-discouraged-alternatives): New variable. + (mm-preferred-alternative-precedence): New function. + + * nnmail.el (nnmail-get-new-mail): Use mail-sources. + + * mail-source.el (mail-sources): New variable. + + * gnus-art.el (article-remove-cr): Remove several trailing CRs. + + * mm-decode.el (mm-valid-image-format-p): New function. + (mm-inline-media-tests): Use it. + (mm-valid-and-fit-image-p): New function. + + * gnus-agent.el (gnus-agent-fetch-groups): Error when unplugged. + (gnus-agent-fetch-group): Ditto. + +1999-04-12 Didier Verna + + * nnmail.el (nnmail-article-group): in case of a group name + containing "\\n" constructs, be sure to pass the expanded value to + nn*-save-mail. + +Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.81 is released. + +1999-04-16 15:54:02 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-split-value): Reverse result. + +1999-04-03 00:17:24 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-always-read-dribble-file): Doc fix. + +1999-04-02 15:33:43 Lars Magne Ingebrigtsen + + * mml.el (mml-insert-tag): Insert concluding part. + + * message.el (message-send-mail): Encode later. + (message-send-news): Ditto. + + * nnfolder.el: Don't use mail delim. + +1999-03-28 19:14:27 Lars Magne Ingebrigtsen + + * gnus-cus.el (gnus-group-customize): Put point at min. + + * mm-view.el (mm-inline-text): Allow toggling html. + +1999-03-28 17:11:15 William M. Perry + + * mail-source.el: Added prescript and postscript to file. + +1999-03-28 13:46:00 Lars Magne Ingebrigtsen + + * nnmail.el: Reverted. + + * gnus-msg.el (gnus-setup-posting-charset): Didn't work. + (gnus-setup-posting-charset): Did work. + +1999-03-28 13:19:50 Jae-you Chung + + * gnus.el (gnus-short-group-name): Use + gnus-group-uncollapsed-levels. + +1999-03-28 13:11:43 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-dissect-cited-text): Don't remove overlays. + +1999-03-26 13:18:45 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-strip-headers-in-body): New variable. + (article-strip-headers-from-body): New command and keystroke. + +1999-03-14 16:09:10 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-pop): Check for symbol first. + + * nnheader.el (nnheader-insert-file-contents): Bind + enable-local-eval to nil. + (nnheader-find-file-noselect): Ditto. + + * nnmail.el (nnmail-article-group): Don't remove long lines. + (nnmail-remove-long-lines): New function. + (nnmail-split-header-length-limit): Removed. + + * mml.el (mml-generate-mime-1): Use unibyte buffers. + + * gnus-group.el (gnus-group-kill-all-zombies): Query user. + +1999-03-06 07:20:05 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-generic-mark): New function. + + * nnmail.el (nnmail-split-header-length-limit): Increased. + (nnmail-article-group): Allow nil. + + * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion. + + * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers + first. + + * mml.el (mml-minibuffer-read-type): Include types from + mailcap-mime-data. + + * nndraft.el (nndraft-request-article): Would clobber Japanese. + +1999-03-05 Hrvoje Niksic + + * mml.el (mml-insert-tag): New function. + (mml-read-file): Renamed to mml-minibuffer-read-file to avoid + confusion with functions like `mml-read-tag'. + (mml-read-type): Ditto with `mml-minibuffer-read-type'. + (mml-minibuffer-read-description): Ditto with + `mml-minibuffer-read-description'. + (mml-attach-buffer): New function. + (mml-mode-map): New entry for /. + (mml-minibuffer-read-type): Accept DEFAULT. + + * mml.el (mml-quote-region): Narrow the region. + + * message.el (message-mode-menu): message-mime-attach-file is now + mml-attach-file. + +1999-03-05 21:24:23 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treatment-function-alist): Do emphasis earlier. + +1999-03-05 21:08:10 Robert Bihlmeyer + + * mml.el (mml-attach-buffer): New command. + +1999-02-27 Simon Josefsson + + * gnus-sum.el (gnus-update-marks): Call gnus-remove-from-range + with a proper range. Compress range. + + * gnus-range.el (gnus-remove-from-range): Protect arguments. + +1999-03-05 20:59:54 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-get-image): Create a temporary file for xbms. + +1999-03-04 04:20:25 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-x-face-file-name): Removed. + (gnus-picons-convert-x-face): Removed. + (gnus-picons-article-display-x-face): Removed. + (gnus-picons-x-face-sentinel): Ditto. + (gnus-picons-display-x-face): Ditto. + +Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.80 is released. + +1999-03-02 16:04:30 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mm-display-part): Narrow to the part itself. + + * gnus-sum.el (gnus-with-article): Moved here. + + * mail-source.el (mail-source-fetch-pop): Ask for password even + when program. + +1999-02-28 13:16:12 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-bug): Add description. + + * mml.el (mml-insert-mml-markup): Insert disposition. + + * message.el (message-send-mail): Always encode mail headers. + + * smiley.el (gnus-smiley-display): Goto body. + +1999-02-28 13:15:47 Petr Konecny + + * smiley.el (gnus-smiley-display): Don't search to blank line. + +1999-02-28 00:38:40 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-article): Only run the highlight stuff + when requested. + + * nnmail.el (nnmail-current-spool): Removed. + + * gnus-salt.el (gnus-tree-inhibit): New varible. + + * gnus.el (mm-util): Required. + +1999-02-27 23:44:52 paul stevenson + + * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first. + +1999-02-27 17:17:47 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-bind): Doc fix. + +1999-02-26 20:35:57 Lars Magne Ingebrigtsen + + * message.el (message-mode): Doc fix. + + * mm-encode.el (mm-content-transfer-encoding-defaults): Use 8bit + encoding. + + * gnus.el (gnus-methods-equal-p): Moved here. + + * mail-source.el: pop at 110. + + * pop3.el (pop3-movemail): Use write-region instead of + append-to-file to avoid excessive messaging. + +1999-02-27 lantz moore + + * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of + type directory. + +1999-03-04 Robert Bihlmeyer + + * gnus-art.el (article-hide-boring-headers): Field names must not + contain whitespace. + +Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.79 is released. + +1999-02-26 18:11:04 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting. + + * mml.el (mml-mode): Don't use add-minor-mode. + + * message.el (messgage-inhibit-body-encoding): New variable. + (message-encode-message-body): Use it. + +Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.78 is released. + +1999-02-26 07:45:30 Lars Magne Ingebrigtsen + + * message.el (message-mode): Switch on MML mode. + + * mml.el: Included commands and functions. + (mml-mode-map): New keymap. + + * message.el: Removed the insertion commands and functions. + + * gnus-ems.el (gnus-mule-cite-add-face): Removed. + + * gnus-sum.el (gnus-summary-sort-by-chars): New command and + keystroke. + + * gnus-art.el (gnus-narrow-to-page): Revert. + + * gnus-cite.el (gnus-cite-delete-overlays): New function. + (gnus-cite-parse-maybe): Always reparse. + + * message.el (message-encode-message-body): Don't insert + "multipart warning". + + * gnus-art.el (gnus-article-treat-head-custom): New variable. + +1999-02-25 Miles Bader + + * mail-source.el (mail-source-fetch-pop): Return 1 for success. + + * nnmail.el: Require mm-util. + +1999-02-26 07:39:33 Justin Sheehy + + * nnmail.el (nnmail-get-new-mail): Only get mail for the one + group. + +1999-02-26 07:38:08 SeokChan LEE + + * mm-bodies.el (mm-body-charset-encoding-alist): Add euc-kr. + +1999-02-21 Simon Josefsson + + * gnus-msg.el (gnus-extended-version): Better regexp. + +1999-02-25 Didier Verna + + * nnmail.el (nnmail-split-it): new syntax: `(! FUNC SPLIT)'. FUNC + is called with the result of SPLIT and should return a new split. + + * gnus.texi: update the doc. + +1999-02-23 Didier Verna + + * gnus-picon.el (gnus-picons-display-bar-p): when picons are + displayed in the article buffer, output bars if + `gnus-picons-display-article-move-p'. + +1999-02-20 Aaron M. Ucko + + * mail-source.el (mail-source-fetch-pop): Typo. + +1999-02-26 07:15:12 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-toggle-header): Save restriction. + +1999-02-23 03:07:58 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-cite-parse-wrapper): Always parse. + +1999-02-21 11:11:39 Lars Magne Ingebrigtsen + + * mml.el (mml-insert-buffer): New function. + + * message.el (message-forward): Insert the buffer in the buffer. + +Sun Feb 21 01:20:50 1999 Shenghuo ZHU + + * mm-view.el (mm-inline-message): Insert part in narrowed region. + +Sat Feb 20 23:09:40 1999 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-toggle-header): Save restriction. + +Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.77 is released. + +1999-02-20 17:32:17 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-displaying-mime): New variable. + (article-narrow-to-head): New function. + + * mail-source.el (mail-source-fetch-pop): Include pre/postscript. + Default to pop instead of pop3. + +1999-02-19 16:16:04 Lars Magne Ingebrigtsen + + * gnus-art.el (article-hide-pgp): Goto body. + + * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer. + + * gnus-cite.el: Don't use goto-line. + + * gnus-art.el (gnus-article-treat-html): Removed. + (gnus-treat-article): Save restriction. + +1999-02-17 Per Abrahamsen + + * message.el (message-send-mail): Don't untabify. + (message-mode): Don't use tabs for indentation. + +1999-02-19 14:54:13 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Don't untabify. + + * nnml.el (nnml-save-mail): Typo fix. + +1999-02-19 Per Abrahamsen + + * message.el (message-cite-function): Add + `message-cite-original-without-signature' customization option. + +1999-02-18 Per Abrahamsen + + * nnmail.el (nnmail-fix-eudora-headers): Mark as option to + `nnmail-prepare-incoming-header-hook'. + +1999-02-19 14:41:43 Justin Sheehy + + * gnus-util.el (gnus-make-sort-function-1): Typo fix. + +1999-02-19 14:40:37 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-get-new-news): Require nnmail. + +1999-02-18 Michael Cook + + * Recognize Microsoft Outlook's cite attribution conventions. + +1999-02-19 14:33:11 James H. Cloos, Jr. + + * gnus-sum.el: Bind M. + +1999-02-19 14:31:29 Neil Crellin + + * mail-source.el (mail-source-fetch-pop): Bind pop3-port. + +1999-02-15 Didier Verna + + * gnus-picon.el (gnus-group-display-picons): ensures that + `article-goto-body' really goes to the article body. + +1999-02-19 12:57:19 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Bind url-standalone-mode. + + * gnus-msg.el (gnus-summary-mail-forward): Create unique names. + + * mm-view.el (mm-view-message): Enable multibyte. + +1999-02-11 18:37:15 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-get-new-mail): Message later. + + * mm-util.el (mm-find-charset-region): Revert to checking + multibyte. + +1999-02-11 Matt Pharr + + * gnus-msg.el (gnus-bug): Encode environment info as a MIME + attachment. + +Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.76 is released. + +1999-02-06 Felix Lee + + * gnus.el (gnus-group-change-level-function): Typo. + +1999-02-11 05:47:51 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-nov-skip-field): Removed. + (gnus-nov-field): Ditto. + (gnus-nov-parse-extra): Ditto. + (gnus-nov-read-integer): Ditto. + +1999-02-05 09:44:20 Katsumi Yamaoka + + * nnheader.el (nnheader-nov-read-message-id): New macro. + (nnheader-parse-nov): Use it. + + * gnus-sum.el (gnus-nov-read-message-id): New macro. + (gnus-nov-parse-line): Use it; use `(eobp)' instead of + `(eq (char-after) ?\n)'. + +1999-02-11 05:16:26 Lars Magne Ingebrigtsen + + * gnus.el (gnus-other-frame): Always pop up a new frame. + +Wed Feb 10 01:03:43 1999 Shenghuo ZHU + + * gnus-range.el (gnus-range-add): Rewrite. + +1999-02-02 18:12:00 Carsten Leonhardt + + * nnmail.el (nnmail-split-incoming): Added detection of maildir + format. + (nnmail-process-maildir-mail-format): New function. + + * mail-source.el (mail-source-fetch-maildir): New function. + (mail-source-keyword-map): Add default for maildir method. + (mail-source-fetcher-alist): Changed "qmail" to "maildir". + +1999-02-10 02:29:28 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetcher-alist): Remove apop. + + * nndoc.el (nndoc-type-alist): Remove MIME-digest. + (nndoc-mime-digest-type-p): Removed. + +1999-02-09 15:25:52 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-read-summary-keys): Set the point + where it is supposed to be. + (gnus-treat-play-sounds): New variable. + + * gnus-sum.el (gnus-newsgroup-ignored-charsets): New variable. + + * gnus-art.el (article-display-x-face): Narrow to head. + (gnus-article-washed-types): New variable. + (article-hide-pgp): Is not a toggle. + (gnus-article-hide-text-type): Save types. + (article-decode-charset): Use it. + + * nnmail.el (nnmail-get-new-mail): Ignore procmail. + + * message.el (message-forward-start-separator): Removed. + (message-forward-end-separator): Removed. + (message-signature-before-forwarded-message): Removed. + (message-included-forward-headers): Removed. + (message-check-news-body-syntax): Don't check forward. + (message-forward): Use MIME. + + * nnvirtual.el (nnvirtual-request-article): Bind + gnus-article-decode-hook to nil. + +1999-02-06 16:55:25 Lars Magne Ingebrigtsen + + * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for + us-ascii. + +1999-02-04 00:00:35 Lars Magne Ingebrigtsen + + * format-spec.el (format-spec): Be more robust. + + * message.el (message-encode-message-body): Default + mail-parse-charset to mail-parse-charset. + + * gnus-sum.el (gnus-summary-edit-article-done): Don't encode. + (gnus-summary-edit-article): Bind mail-parse-charset. + + * mml.el (mml-read-tag): Ignore white space after end of tag. + + * message.el (message-goto-body): Also work in separatorless + articles. + + * mml.el (mml-translate-from-mime): New function. + (mml-insert-mime): Ditto. + (mml-to-mime): New function. + (mime-to-mml): New name. + + * gnus-sum.el (gnus-summary-edit-article): Always select raw + article. + + * gnus-group.el (gnus-group-catchup-current): Unmark groups. + + * gnus-sum.el (gnus-summary-setup-default-charset): Don't + special-case nndraft groups. + +1999-02-03 16:44:19 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers): Bind charset. + (gnus-get-newsgroup-headers): Already bound. + + * message.el (message-encode-message-body): Use posting charset. + + * mm-bodies.el (mm-encode-body): Use MIME charsets. + (mm-body-encoding): Do CTE. + (mm-body-7-or-8): New function. + + * mm-util.el (mm-mime-charset): Always fall back on alist. + (mm-mime-mule-charset-alist): Include katakana-jisx0201. + (mm-mime-mule-charset-alist): Add arabic-*-column. + (mm-find-mime-charset-region): New function. + + * format-spec.el (format-spec-make): New function. + + * mail-source.el (format-spec): Required. + (mail-source-fetch-with-program): Removed. + (mail-source-fetch-with-program): New function. + + * format-spec.el: New file. + +1999-02-03 16:00:41 Tatsuya Ichikawa + + * mail-source.el (mail-source-fetch-with-program): Take optional + parameter. + +1999-02-03 00:31:21 Lars Magne Ingebrigtsen + + * gnus-start.el: Ignore some groups. + (gnus-setup-news): Bind nnmail-fetched-sources. + + * message.el (message-send-mail): Remove all tabs. + + * mm-util.el (mm-find-charset-region): Just check whether + find-charset-region is defined. + +1999-02-02 23:35:20 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-get-new-news): Use + nnmail-fetched-sources. + + * nnmail.el (nnmail-fetched-sources): New variable. + (nnmail-get-new-mail): Use it. + + * mail-source.el (mail-source-fetched-sources): New variable. + (mail-source-fetch): Use it. + +1999-02-02 23:20:20 Mark W. Eichin + + * gnus.el (gnus-getenv-nntpserver): if the file that + gnus-nntpserver-file names has a trailing newline, the + string-match will always match, and thus the file will never be + read. (^ matches start of "line", \\` matches start of "buffer", + which is what was intended...) + +1999-02-02 23:17:40 Kim-Minh Kaplan + + * gnus-picon.el (gnus-picons-parse-filenames): Quote group names. + +1999-01-28 04:15:46 Katsumi Yamaoka + + * gnus-start.el (gnus-read-active-file): Eliminate duplicated + select methods. + +1999-01-27 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Sort second argument. + +1999-02-02 10:55:23 Scott Hofmann + + * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd. + +Mon Feb 1 23:23:03 1999 Shenghuo ZHU + + * gnus-cus.el (gnus-group-parameters): Charset as symbol, and fix + a typo. + * gnus-sum.el (gnus-summary-setup-default-charset): Set nndraft's + charset to nil. + * gnus-agent.el (gnus-agent-queue-setup): Remove charset setting. + * gnus-start.el (gnus-start-draft-setup): Ditto. + +1999-02-02 22:13:14 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-directory): Use the predicate. + (mail-source-value): Don't do variables. + + * nnmail.el (nnmail-get-new-mail): Set the predicate. + + * gnus-sum.el (gnus-summary-toggle-header): Fix, and bound to t. + +1999-02-01 Michael Cook + + * Defenestrate spurious ?a. + +1999-02-02 21:59:51 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-pop): Instead use + :authentication. + +1999-02-01 Tatsuya Ichikawa + + * lisp/mail-source.el : Support APOP authentication scheme. + +1999-02-02 21:56:14 Tatsuya Ichikawa + + * pop3.el (pop3-movemail): Return t. + +1999-02-02 21:48:46 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-fold-region): New function. + (rfc2047-encode-message-header): Use it. + +1999-02-02 21:07:27 Hallvard B. Furuseth + + * gnus-sum.el (gnus-group-charset-alist): Add more. + +Mon Feb 1 21:18:00 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.75 is released. + +1999-02-01 21:54:26 Lars Magne Ingebrigtsen + + * gnus-art.el (article-display-x-face): Don't narrow to head. + +1999-02-01 21:48:39 Michael Cook + + * gnus-cite.el (gnus-cited-lines-visible): Accept a cons. + +1999-02-01 20:59:38 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-directory): Ignore + directories. + + * gnus-cus.el (gnus-group-parameters): Addition. + + * gnus-art.el (article-strip-banner): Do symbolic banners. + (article-strip-banner): New keystroke. + +1999-02-01 20:54:32 Michael Cook + + * gnus-art.el (article-strip-banner): New command. + +1999-02-01 20:53:45 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-strip-banners): New variable. + +1999-01-28 05:34:56 Katsumi Yamaoka + + * mail-source.el (mail-source-read-passwd): Use `read-passwd' if it + has been exist. + +Thu Jan 28 01:38:34 1999 Shenghuo ZHU + + * message.el (message-draft-coding-system): Check coding-system. + * mm-util.el (mm-text-coding-system): Ditto. + +1999-01-28 12:11:31 Katsumi Yamaoka + + * mail-source.el (mail-source-fetch-pop): Save excursion. + +1999-01-28 08:14:21 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-movemail-args): Not constant. + (mail-source-movemail-args): Removed. + (mail-source-fetch-with-program): New function. + (mail-source-fetch-pop): Use program and function. + (mail-source-movemail-program): Removed. + + * gnus-art.el (gnus-treat-date-iso8601): New variable. + (gnus-treat-date-user-defined): New variable. + +1999-01-28 08:07:12 Per Abrahamsen + + * nnmail.el (nnmail-fix-eudora-headers): New function. + +1999-01-28 08:05:19 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-encode-body): Use mail-parse-charset. + +1999-01-27 08:06:38 Lars Magne Ingebrigtsen + + * smiley.el (smiley-deformed-regexp-alist): Removed =>. + (smiley-nosey-regexp-alist): Ditto. + + * gnus-art.el (gnus-treatment-function-alist): Do + gnus-article-add-buttons-to-head later. + (gnus-treat-capitalize-sentences): New variable. + (article-capitalize-sentences): New command and keystroke. + + * gnus-group.el (gnus-group-catchup-current): Do group. + + * message.el (message-default-charset): Add group. + +Wed Jan 27 05:24:53 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.74 is released. + +1999-01-27 05:56:29 Lars Magne Ingebrigtsen + + * gnus-art.el (article-fill-long-lines): Renamed. + (article-fill-long-lines): New keystroke. + +1999-01-26 06:35:07 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-setup-posting-charset): Check for group. + + * gnus-group.el (gnus-group-catchup-current): Skip groups now + displayed. + (gnus-group-catchup-current): Be more robus. + + * gnus-sum.el (gnus-summary-select-article): Reselect for showing + headers. + +1999-01-25 Dave Love + + * message.el (message-mode-menu): Add message-mime-attach-file. + (message-mode): Doc fix. + +1999-01-26 05:24:19 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-check-duplication): Insert the mail source + string. + + * mail-source.el (mail-source-fetch-pop): Bind mail-source-string. + (mail-source-fetch-directory): Ditto. + (mail-source-fetch-file): Ditto. + (mail-source-string): New variable. + + * gnus-start.el (gnus-get-unread-articles): Nix out groups over + the level. + + * rfc2047.el (rfc2047-encodable-p): Convert to MIME charsets + before handling. + + * mm-util.el (mm-mime-charset): Use the parameters. + (mm-mime-charset): Removed region paremeters. + + * nnmail.el (nnmail-get-new-mail): Don't message the entire + source. + +1999-01-25 12:05:16 Lloyd Zusman + + * nnmail.el (nnmail-get-split-group): Quote right. + +1999-01-25 05:55:41 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-movemail): Would kill an arbitrary + buffer. + +1999-01-24 03:02:31 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-clear-inboxes-moved): Removed. + (gnus-group-mode): Don't hook. + + * mail-source.el (mail-source-bind): Doc fix. + (mail-source-bind): Take only one param. + + * gnus-art.el (gnus-treat-highlight-signature): typep. + + * mail-source.el (mail-source-movemail): Ignore empty file. + (mail-source-callback): Check before deleting. + + * message.el (message-mime-attach-file): Include name. + +1999-01-23 17:01:12 Lars Magne Ingebrigtsen + + * mm-util.el (mm-read-charset): Return a symbol. + + * mm-view.el (mm-inline-text): Insert signature separator. + + * gnus-art.el (gnus-treat-predicate): New function. + (gnus-treat-article): Allow all types to be checked. + + * gnus-util.el (gnus-or): New function. + (gnus-and): Ditto. + + * gnus-art.el (gnus-mime-display-single): Use override. + + * mm-decode.el (mm-attachment-override-types): New variable. + (mm-attachment-override-p): New function. + + * gnus-picon.el (gnus-group-display-picons): Don't go backward. + +1999-01-23 16:45:06 Andrew J. Cosgriff + + * mm-view.el (mm-inline-text): Do vcards. + +Sat Jan 23 14:23:27 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.73 is released. + +1999-01-23 11:38:36 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-spool-file): Changed to use mail-source. + (nnmail-crash-box, nnmail-use-procmail, nnmail-procmail-directory, + nnmail-procmail-suffix, nnmail-resplit-incoming): Removed. + (nnmail-movemail-program): Removed. + (nnmail-movemail-args): Removed. + (nnmail-pop-password-required): Ditto. + (nnmail-tmp-directory): Ditto. + (nnmail-delete-incoming): Removed. + (nnmail-pop-password, nnmail-moved-inboxes, + nnmail-internal-password, nnmail-move-inbox): Removed. + (nnmail-read-passwd): Ditto. + (nnmail-get-spool-files): Removed. + (nnmail-resplit-incoming): Reinstated. + + * mail-source.el: New file. + +1999-01-23 09:08:31 James H. Cloos, Jr. + + * gnus-art.el (gnus-article-mode-map): Bind backspace. + +1999-01-23 09:05:04 Lars Magne Ingebrigtsen + + * gnus-art.el (article-make-date-line): Fix iso8601 display. + +1999-01-20 02:53:52 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-display-smileys): Check xpm. + + * gnus-picon.el (gnus-group-display-picons): Goto body. + + * gnus.el: Indented all functions; broke long lines; changed all + instances of illegal/legal to invalid/valid. Yes, I'm bored. + +Wed Jan 20 00:50:53 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.72 is released. + +1999-01-20 01:39:48 Lars Magne Ingebrigtsen + + * gnus.el: Cleaned up trailing whitespace. + + * mm-util.el (mm-read-charset): Work. + +1999-01-17 Matt Armstrong + + * gnus-score.el (gnus-score-find-bnews): Match regexp on the + nnheader-translate-file-chars'd group name. + +1999-01-20 01:30:30 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Fold case. + +1999-01-20 01:28:16 Alexei V. Barantsev + + * gnus-xmas.el (gnus-xmas-modeline-glyph): Backquote. + +1999-01-20 00:46:15 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-add): New function. + +1999-01-18 09:40:37 Lars Magne Ingebrigtsen + + * gnus-art.el (article-goto-body-goes-to-point-min-p): New variable. + (article-goto-body): Use it. + (gnus-treat-article): Ditto. + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Remove the + downloaded articles from the downloadeble list. + +1999-01-16 17:31:08 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Bind + mail-parse-charset. + + * mm-util.el (mm-charset-synonym-alist): New variable. + (mm-charset-to-coding-system): Use it. + (mm-charset-coding-system-alist): Removed. + (mm-charset-to-coding-system): Don't use it. + (mm-find-charset-region): Use mail-parse-charset. + + * gnus-art.el (gnus-treatment-function-alist): Use + gnus-article-display-picons. + (gnus-treat-display-xface): Only do if we have xface feature. + (gnus-part-display-hook): New function. + (gnus-treat-article): Use it. + (gnus-treat-article): Use gnus-visual. + + * gnus-msg.el (gnus-setup-posting-charset): Check elem. + + * gnus-art.el (gnus-mm-display-part): Fix the MIME button after + displaying. + + * mm-decode.el (mm-insert-part): Use insert-buffer-substring. + + * gnus-score.el (gnus-score-find-bnews): Protect against invalid + regexp file names. + +Sat Jan 16 03:15:57 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.71 is released. + +1999-01-16 00:13:31 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-image): Don't add a dot. + + * gnus-art.el (gnus-treat-article): New function. + + * gnus.el (gnus-article-display-hook): Removed. + + * gnus-art.el (gnus-article-treat-custom): New variable. + + * gnus-start.el (gnus-ignored-newsgroups-has-to-p): Removed. + + * gnus-msg.el (gnus-setup-posting-charset): Allow variables and + functions. + + * message.el (message-posting-charset): New variable. + (message-send-mail): Use it. + + * gnus-msg.el (gnus-group-posting-charset-alist): Moved here. + (gnus-setup-posting-charset): New function. + (gnus-setup-message): Use it. + + * message.el (message-encode-message-body): Just look for + Content-Type before inserting a new one. + +1999-01-15 23:08:47 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-default-charset): Removed. + + * mail-prsvr.el: New file. + (mail-parse-charset): New variable. + + * gnus-sum.el (gnus-newsgroup-charset): Changed name. + Changed name. + + * gnus.el (gnus-charset): New group. + + * nnmail.el (nnmail-pathname-coding-system): Default to binary. + + * gnus-sum.el (gnus-default-charset): Default to nil. + (gnus-newsgroup-iso-8859-1-forced-regexp): Removed. + (gnus-newsgroup-iso-8859-1-forced): Removed. + + * mm-util.el (mm-known-charsets): Removed. + (mm-default-coding-system): Removed. + (mm-default-charset): Removed. + (mm-read-charset): New function. + + * message.el (message-default-charset): Removed. + + * rfc2047.el (rfc2047-default-charset): Default to nil. + + * mm-util.el (mm-charset-iso-8859-1-forced): Removed. + +Fri Jan 15 20:50:38 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.70 is released. + +1999-01-15 00:06:04 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-save-part): Use mm-get-part. + (mm-insert-part): New function. + (mm-get-part): Use it. + (mm-get-image): Ditto. + (mm-display-external): Ditto. + + * mm-view.el (mm-inline-text): Ditto. + + * gnus-move.el (gnus-move-group-to-server): Protect against nil + ranges. + + * mm-decode.el (mm-display-external): Save the buffer. + (mm-remove-part): Kill it. + + * qp.el (quoted-printable-decode-region): Do the right thing at eobp. + + * nnagent.el (nnagent-request-set-mark): Defined stub. + +1999-01-14 23:05:31 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-load-score-alist): Bind + coding-system-for-read. + + * gnus-sum.el (gnus-summary-exit): Do adaptive scoring before + prepare-exit-hook. + + * mm-view.el (mm-setup-w3): Require w3. + +1999-01-13 Kiyokazu SUTO + + * lisp/nnspool.el (nnspool-retrieve-headers): Protect against empty + body. + +1999-01-14 21:17:35 Lars Magne Ingebrigtsen + + * mm-encode.el: Ditto. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Message the + error. + + * mailcap.el (mailcap-mime-data): SAFER ps. + + * message.el (message-encode-message-body): Always insert a + Content-Type header. + + * mm-decode.el (mm-inline-media-tests): Default all text/* to be + shown inline. + + * mm-view.el (mm-inline-text): Handle all sorts of text. + + * mailcap.el (mailcap-mime-data): non-viewer for viewers that + don't view. + + * mm-decode.el (mm-display-external): Use it. + + * gnus-art.el (gnus-visible-headers): Added bcc, gcc, fcc. + + * mm-decode.el (mm-save-part): Removed double code. + +1999-01-12 Dave Love + + * mm-decode.el (mm-save-part): Avoid doubly-compressed + application/octet-stream .gz & al files with jka-compr. + +1999-01-12 Dave Love + + * gnus-ems.el (gnus-down-mouse-3): New variable. + * gnus-art.el (gnus-mime-button-map): Use it. + (gnus-mime-button-menu): Set the clicked-on buffer initially. + +1999-01-13 19:41:57 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-data): Added ImageMagic and ee. + +1999-01-12 17:34:43 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-kill-buffer): Don't kill article + buffers. + + * gnus-sum.el (gnus-summary-exit): Destroy all MIME. + + * gnus-cache.el (gnus-cache-read-active): Reversed check. + +1999-01-12 17:18:25 Matt Armstrong + + * mml.el (mml-parameter-string): Strip directory component. + +1999-01-12 17:02:58 Lars Magne Ingebrigtsen + + * gnus.el (gnus-use-demon): Removed. + +1999-01-12 05:53:23 Katsumi Yamaoka + + * nnmail.el (nnmail-article-group): Don't infloop. + +1999-01-11 Colin Rafferty + + * gnus-art.el (article-update-date-lapsed): Made it work with + picons, and make it update on all visible frames. + (article-date-ut): Get summary-buffer's current-headers. + +1999-01-12 07:20:31 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-setup-buffer): Don't set major mode. + (gnus-picons-setup-p): New variable. + +1999-01-11 02:13:12 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-split-header-length-limit): Lowered to 512. + +1999-01-04 12:58:13 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-exit-no-update): Don't use run-hooks. + (gnus-summary-exit-no-update): Use mapcar. + +1999-01-02 14:36:32 Simon Josefsson + + * gnus-agent.el (gnus-category-write): Make directory. + +1998-09-26 19:39:31 Simon Josefsson + + * gnus-sum.el (gnus-update-read-articles): + (gnus-update-marks): Request backend update of mark. + +1999-01-03 15:29:52 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-body-encoding): Use mm-find. + +1999-01-03 15:28:27 Kim-Minh Kaplan + + * gnus-picon.el (gnus-article-display-picons): Fix. + +Sun Jan 3 13:32:02 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.69 is released. + +1999-01-03 06:45:10 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-setup-buffer): Run the hook. + + * gnus-agent.el (gnus-agent-remove-group): New command and + keystroke. + + * rfc2047.el (rfc2047-decode-region): Check for us-ascii. + +1999-01-02 14:12:41 Simon Josefsson + + * gnus-agent.el (gnus-agent-write-servers): Make directory. + +1998-12-26 02:38:01 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Bind current id. + + * mm-decode.el (mm-handle-id): New macro. + (mm-make-handle): Accept id. + (mm-dissect-singlepart): Use it. + +1998-12-23 Matt Pharr + + * message.el (message-cite-original-without-signature): Use + message-signature-separator when searching for signature in + message-cite-original-without-signature. + +1998-12-24 16:25:38 Simon Josefsson + + * gnus.el (gnus-server-to-method): Check named methods. + +1998-12-24 03:27:02 Lars Magne Ingebrigtsen + + * mm-view.el (mm-view-message): Goto point-min. + + * nnmail.el (nnmail-article-group): Don't delete lines, only + shorten them. + + * gnus-msg.el (gnus-configure-posting-styles): Also do nil + values. + + * nnheader.el (nnheader-temp-directory): New variable. + (nnheader-temp-directory): Removed. + +1998-12-22 Jack Vinson + + * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the + list of files to check for mailcap entries under windows-nt. + +1998-12-24 03:02:15 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the + summary buffer exists. + +1998-12-22 Aaron M. Ucko + + * nnsoup.el (nnsoup-store-reply): Remove code to deal with + irrelevant Sun sendmail bug. + (nnsoup-store-reply): Stop mucking with mail-header-separator. + + * message.el (message-send-news): Bind mail-header-separator to + "" when asking backend to post. + +1998-12-22 Karl Kleinpaste + + * mm-uu.el (mm-dissect-disposition): New variable. + (mm-uu-dissect): Use it. + +1998-12-21 21:34:22 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Bind url-current-object. + +1998-12-06 03:05:41 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Rewrite. + +1998-12-09 SL Baur + + * gnus-picon.el (annotations): Remove bogus require 'xpm. + +1998-12-18 Hrvoje Niksic + + * message.el (message-encode-message-body): Insert `MIME-Version' + instead of `Mime-Version'. + +1998-12-04 Hrvoje Niksic + + * message.el (message-insert-mime-part): Add the attachment + disposition. + (message-insert-mime-part): Make TYPE and DESCRIPTION optional. + (message-mime-query-type): New function. + (message-mime-query-description): Ditto. + (message-mime-query-file): Ditto. + (message-insert-mime-part): Use them. + (message-mime-insert-external): Use the new stuff. + +1998-12-19 23:02:26 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-split-header-length-limit): New variable. + + * mm-decode.el (mm-dissect-buffer): Check syntax. + + * rfc2231.el (rfc2231-parse-string): Remove check for syntax. + + * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region. + (rfc2047-dissect-region): Ditto. + +1998-12-17 18:36:43 Lars Magne Ingebrigtsen + + * mm-view.el (mm-view-message): Decode charset. + +1998-12-16 16:01:22 Lars Magne Ingebrigtsen + + * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid + CT headers. + +Wed Dec 16 01:44:40 1998 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): Use + mm-uu-*-function. + * mm-uu.el (mm-uu-dissect): Use x-uuencode. + +1998-12-16 10:20:52 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Do MML first. + (message-send-news): Ditto. + +1998-12-15 20:57:18 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-face): New face. + (gnus-picons-try-face): Use it. + +Tue Dec 15 19:17:43 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.68 is released. + +Tue Dec 15 18:28:24 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.67 is released. + +Tue Dec 15 17:31:44 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.66 is released. + +1998-12-13 11:00:43 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-insert-mime-button): Decode description. + +Sat Dec 5 16:50:49 1998 Shenghuo ZHU + + * gnus-art.el (article-decode-encoded-words): Rollback to 0.55. + (gnus-decode-header-methods): Ditto. + (gnus-decode-with-mail-decode-encoded-word-region): Ditto. + +1998-12-13 10:04:39 Lloyd Zusman + + * gnus-xmas.el (gnus-xmas-summary-recenter): Allow numbers. + +1998-12-13 09:32:38 Lars Magne Ingebrigtsen + + * mml.el (mml-insert-mime-headers): Encode description. + + * nnfolder.el (nnfolder-request-expire-articles): Go to the date + line. + + * gnus-sum.el (gnus-default-charset): Doc fix. + +Wed Dec 9 15:18:39 1998 Shenghuo ZHU + + * mm-decode.el (mm-display-part): Forward a line. + +Wed Dec 9 13:30:29 1998 Shenghuo ZHU + + * mm-util.el (mm-running-ntemacs): New variable. + (mm-text-coding-system): Ditto. + * nnmail.el (nnmail-incoming-coding-system): Ditto. + (nnmail-split-incoming): Use nnmail-incoming-coding-system. + +1998-12-13 08:52:45 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-network-display-internal): Don't set + buffer. + + * message.el (message-insert-headers): New command and keystroke. + +1998-12-07 23:42:14 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-media-tests): Recognize x-xbitmap. + (mm-get-image): Ditto. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Only for + base64, uudecode and binhex. + +Sun Dec 6 21:58:31 1998 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF + in text/plain. + * mm-uu.el (mm-uu-dissect): Use inline. + +1998-12-07 23:19:14 Lars Magne Ingebrigtsen + + * mm-view.el (mm-view-message): New function. + + * mm-encode.el (mm-content-transfer-encoding-defaults): Changed to + qp. + +1998-12-07 Karl Kleinpaste + + * mm-encode.el (mm-content-transfer-encoding-defaults): Add an + entry for message/rfc822 as 8bit. + +1998-12-07 23:16:54 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-extensions): Add patch. + +1998-12-05 Dale Hagglund + + * gnus-sum.el (gnus-summary-display-buttonized): Use prefix + argument to force all multipart/* to look like multipart/mixed. + + * gnus-art.el (gnus-mime-display-multipart-as-mixed): New + variable. + (gnus-mime-display-part): Use it. + +1998-12-07 22:46:37 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-draft-send): Only disable checks for + non-interactive use. + (gnus-draft-send-message): Use it. + +Sun Dec 6 19:36:53 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.65 is released. + +1998-12-06 20:11:02 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-prepare-display): Don't init w3. + + * mm-view.el (mm-inline-text): Bind url-standalone-mode here. + +Sat Dec 5 18:35:42 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.64 is released. + +1998-12-05 18:51:13 Lars Magne Ingebrigtsen + + * mm-view.el (mm-setup-w3): Don't load. + + * gnus-msg.el (gnus-setup-message): Set group name. + (gnus-group-mail): Avoid leaking local vars. + + * message.el (message-attach-file): Renamed. + (message-mime-attach-file): Renamed again. + +1998-12-05 Hrvoje Niksic + + * gnus-art.el (article-decode-encoded-words): Bind + rfc2047-default-charset here. + + * gnus-art.el (gnus-insert-mime-button): Nix slashes in file name. + +1998-12-05 18:33:27 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picons-setup-buffer): Run picons hook. + (gnus-picons-setup-hook): New hook. + +1998-12-05 Per Abrahamsen + + * mailcap.el (mailcap-mime-data): Remove "*" from documentation + string. + (mailcap-mime-extensions): Ditto. Made first sentense fit a + line. + +1998-12-05 17:11:04 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-prepare-display): Setup w3. + (gnus-mime-view-part): Ditto. + (gnus-mime-inline-part): Dotii. + (gnus-mime-externalize-part): Daddo. + (gnus-mime-internalize-part): Tutti frutti. + (gnus-widget-press-button): Da da do. + + * mm-view.el (mm-setup-w3): Require url-vars. + +Fri Dec 4 12:13:12 1998 Shenghuo ZHU + + * message.el (message-draft-coding-system): Fix for XEmacs-NT. + * mm-util.el (mm-find-charset-region): Ditto. + +1998-12-05 16:30:01 Lars Magne Ingebrigtsen + + * message.el (message-send): Don't encode here. + (message-send-mail): But here. + (message-send-news): And here. + +1998-12-04 15:29:02 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-message-insert-stylings): Don't insert twice. + +Fri Dec 4 04:09:15 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.63 is released. + +1998-12-04 04:59:20 Lars Magne Ingebrigtsen + + * mml.el (mml-base-boundary): Shorten. + + * message.el (message-insert-mime-part): Use default. + + * gnus-art.el (gnus-insert-mime-button): Bind gnus-tmp-type-long. + +1998-12-03 Per Abrahamsen + + * gnus-art.el (gnus-mime-display-alternative): Use (*) for radio + buttons, not [*]. + +1998-12-04 Hrvoje Niksic + + * gnus-art.el (gnus-insert-mime-button): Do proper help-echo. + +1998-12-04 04:48:37 Hrvoje Niksic + + * gnus-art.el (gnus-insert-mime-button): Fix. + +1998-12-03 Hrvoje Niksic + + * message.el (message-insert-mime-part): Nicify prompts. + (message-insert-mime-part): Really delete duplicates. + (message-insert-mime-part): Check against common errors. + (message-insert-mime-part): Fix docstring. + +1998-12-04 04:41:58 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-internalize-part): Bugged out. + +1998-12-03 Hrvoje Niksic + + * gnus-art.el (gnus-mime-button-line-format): Nicify. + (gnus-insert-mime-button): Modify accordingly. + +1998-12-04 01:50:53 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-display-mime): Set window point. + + * mm-decode.el (mm-display-external): Only decode when not + saving. + (mm-alternative-precedence): Prefer multiparts. + (mm-inline-media-tests): Inline multiparts. + + * gnus-picon.el (gnus-picons-next-job-internal): Do bar if asked. + Ignore errors when requiring url. + + * mml.el (mml-quote-region): New command. + + * message.el (message-cite-original): Use it. + (message-cite-original-without-signature): Ditto. + +Thu Dec 3 12:53:58 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.62 is released. + +1998-12-03 13:38:36 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-view-all-parts): Work with multiparts. + +1998-12-03 Hrvoje Niksic + + * mm-view.el (mm-inline-text): Use `point-min-marker' and + `point-max-marker'. + +1998-12-03 13:22:57 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-extensions): Use image/xpm for xpms. + + * gnus-art.el (gnus-mime-display-single): Check for attachment + before other tests. + +1998-12-03 Didier Verna + + * gnus-msg.el (gnus-configure-posting-styles): find a + posting-style entry in the group parameters, if any, and honor it + at the end. + +1998-12-03 13:03:37 Felix Lee + + * nntp.el (nntp-after-change-function): Fix. + +1998-12-03 12:44:30 Mike McEwan + + * mml.el (mml-generate-mime-1): Insert literally. + +1998-12-03 00:23:17 Lars Magne Ingebrigtsen + + * mml.el (mml-insert-mime-headers): Removed debug. + +1998-12-02 22:22:03 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-show-article): Destroy parts when + prefixed. + + * mm-encode.el (mm-content-transfer-encoding-defaults): Default + application/emacs-lisp to 8bit. + +1998-12-03 Dale Hagglund + + * mm-decode.el (mm-quote-arg): Add quoting of '()', '<>', and '|'. + +Wed Dec 2 20:24:27 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.61 is released. + +1998-12-02 21:12:56 Lars Magne Ingebrigtsen + + * mml.el (mml-parse-1): Skipped parts. + (mml-insert-mime-headers): Nil is a list. + (mml-generate-mime-1): Don't insert literally. + (mml-read-tag): Drop text props. + (mml-read-part): Ditto. + (mml-parse-singlepart-with-multiple-charsets): Ditto. + +Wed Dec 2 20:07:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.60 is released. + +1998-12-02 20:11:28 Lars Magne Ingebrigtsen + + * mml.el (mml-parse-1): Don't throw contents away. + +1998-12-02 Hrvoje Niksic + + * mml.el (mml-compute-boundary-1): Regexp-quote the boundary. + +1998-12-02 18:42:24 Lars Magne Ingebrigtsen + + * mml.el (mml-parse-singlepart-with-multiple-charsets): New + function. + (mml-parse-1): Use it. + +Tue Dec 1 23:04:25 1998 Shenghuo ZHU + + * gnus-art.el (gnus-decode-with-mail-decode-encoded-word-region): + Use gnus-newsgroup-default-charset. + (article-decode-encoded-words): Remove charset codes. + * gnus-sum.el (gnus-newsgroup-default-charset): Use + gnus-default-charset. + +1998-12-02 03:14:20 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Don't encode here. + (message-send-news): Nor here. + (message-send): ... but here instead. + + * gnus-picon.el (gnus-picons-display-article-move-p): Changed + default to nil. + (gnus-article-display-picons): Replace From line. + (gnus-group-display-picons): Replace Newsgroups line. + (gnus-picons-display-glyph): Set baseline. + (gnus-group-display-picons): Piconize the entire Newsgroups line. + (gnus-picons-xbm-face): Revert to old, standard colors. + + * message.el (message-fetch-field): Remove text props. + + * gnus-art.el (gnus-article-normalized-header-length): New + variable. + (article-normalize-headers): New command and keystroke. + + * gnus-picon.el (gnus-picons-xbm-face): Changed colors. + +Wed Dec 2 01:43:48 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.59 is released. + +1998-12-02 01:38:31 Lars Magne Ingebrigtsen + + * mml.el (mml-insert-mime-headers): Beep at multiple charsets. + + * gnus-art.el (gnus-mime-copy-part): Set buffer-file-name. + +1998-11-30 Hrvoje Niksic + + * mml.el (mml-generate-mime-1): Handle unquoting end-tags. + +1998-12-02 00:15:30 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-all-images-fit): New variable. + (mm-image-fit-p): Use it. + + * gnus-art.el (gnus-mime-display-single): Use it. + (gnus-mime-internalize-part): New command and keystroke. + + * mm-decode.el (mm-user-automatic-external-display): New + variable. + (mm-automatic-external-display-p): New function. + + * gnus-picon.el (gnus-picons-xbm-face): Default to sensible + colors. + +1998-12-01 23:52:05 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-repair-multipart): Reselect article. + + * gnus-art.el (gnus-with-article): Work in the original article + buffer. + (gnus-with-article): Work in read-only groups. + +Tue Dec 1 00:15:36 1998 Shenghuo ZHU + + * mm-bodies.el (mm-decode-string): Return original string if not + decode. + +Mon Nov 30 23:38:02 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Use mm-make-handle. + +1998-12-01 01:53:49 Francois Pinard + + * nndoc.el (nndoc-mime-parts-type-p): Do related. + +Tue Dec 1 00:46:20 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.58 is released. + +1998-11-30 Hrvoje Niksic + + * mm-decode.el (mm-get-image): Return a glyph, not an image + specifier. + +1998-11-29 Hrvoje Niksic + + * rfc2047.el (rfc2047-decode): Bind mm-default-charset. + +1998-12-01 01:23:35 Lars Magne Ingebrigtsen + + * mail-parse.el (rfc2045): Required. + +1998-12-01 00:59:53 William M. Perry + + * mm-view.el (mm-inline-text): Remove props. + +1998-12-01 00:18:47 Lars Magne Ingebrigtsen + + * mm-view.el (mm-setup-w3): Protect url-misc. + + * message.el (message-ignored-resent-headers): Remove + Gnus-Warning. + + * mml.el (mml-insert-mime-headers): Use encoding. + (mml-parameter-string): Ditto. + + * rfc2045.el: New file. + (rfc2045-encode-string): New function. + +1998-11-30 23:11:22 Lars Magne Ingebrigtsen + + * mail-parse.el (mail-header-encode-parameter): New function. + + * rfc2231.el (rfc2231-encode-string): New function. + +Mon Nov 30 13:52:50 1998 Shenghuo ZHU + + * mm-bodies.el (mm-decode-string): New function. + * mm-view.el (mm-inline-text): Use mm-decode-string. + +Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.57 is released. + +1998-11-23 Felix Lee + + * nntp.el (nntp-async-needs-kluge): new setting. + (nntp-async-timer): new var. + (nntp-async-process-list): new var. + (nntp-async-kluge): new function. + (nntp-async-timer-handler): new function. + (nntp-async-wait): new function. + (nntp-async-stop): new function. + (nntp-after-change-function): renamed, and split apart. + (nntp-async-trigger): new function. + (nntp-do-callback): new function. + (nntp-accept-process-output): add optional timeout arg. + + * gnus-async.el (gnus-async-request-fetched-article): fixed. + (gnus-async-wait-for-article): new function. + (gnus-async-with-semaphore): s/asynch/async/. + +1998-11-30 16:54:56 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-with-article): Don't encode. + (gnus-insert-mime-button): Fall back on filename from C-D. + (gnus-mime-display-single): Have dots right on text/plain + attachments. + + * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in + broken parts. + + * gnus-art.el (gnus-with-article): Flush cache and backlog. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Also do + binhex. + + * gnus-sum.el (gnus-summary-reparent-thread): Use new macro. + (gnus-summary-repair-multipart): New command and keystroke. + + * gnus-art.el (gnus-with-article-buffer): New macro. + +Sun Nov 29 23:51:57 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-inline-part): Do not get part when + undisplay the part. + +1998-11-30 03:38:35 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-make-sort-function-1): Allow lambdas. + + * mml.el (mml-read-part): Partition right. + + * mm-decode.el (mm-handle-set-cache): New macro. + (mm-handle-cache): Ditto. + (mm-make-handle): Ditto. + (mm-dissect-singlepart): Use it. + (mm-get-image): Use the cache. + +1998-11-29 23:44:44 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-mixed): Rewrite. + (gnus-mime-display-single): Don't insert lines between parts. + +Sun Nov 29 04:55:40 1998 Shenghuo ZHU + + * nnmail.el (nnmail-file-coding-system-1): New variable. + * nnfolder.el (nnfolder-file-coding-system): Ditto. + (nnfolder-read-folder): Use nnfolder-file-coding-system. + * nnml.el (nnml-file-coding-system): New variable. + (nnml-request-article): Use nnml-file-coding-system. + +Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.56 is released. + +1998-11-29 00:52:53 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-part): New function. + (gnus-mime-display-mixed): Use it. + + * mm-view.el (mm-setup-w3): Don't register. + + * message.el (message-cite-original): Cite parts. + +1998-11-28 23:51:25 Lars Magne Ingebrigtsen + + * mml.el (mml-parameter-string): New function. + (mml-insert-mime-headers): Separated into new function. + +1998-11-28 Hrvoje Niksic + + * mml.el (mml-make-boundary): Use `make-string'. + +1998-11-27 Hrvoje Niksic + + * binhex.el (binhex-insert-char): Ditto. + + * base64.el (base64-insert-char): Ditto. + + * uudecode.el (uudecode-insert-char): Code correctly. + +1998-11-28 01:08:19 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime): Don't generate multiparts for + empties. + + * gnus-art.el (gnus-display-mime): Save excursion. + + * message.el (message-remove-first-header): New function. + (message-encode-message-body): Use it. + +Fri Nov 27 12:26:10 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.55 is released. + +1998-11-27 12:38:52 Lars Magne Ingebrigtsen + + * mm-view.el (mm-setup-w3): New function. + + * mm-decode.el (mm-content-id-get-contents): New function. + (mm-content-id-get-type): Ditto. + (mm-content-id-get-encoding): Ditto. + (mm-get-handle-by-content-id): Removed. + +1998-11-25 Colin Rafferty + + * message.el (message-generate-new-buffers): Fix tag. + +1998-11-25 10:43:28 Lars Magne Ingebrigtsen + + * message.el (message-buffer-name): Check for unique first. + + * gnus-art.el (gnus-unbuttonized-mime-type-p): use + gnus-inhibit-mime-unbuttonizing. + + * gnus-sum.el (t): Bind M-t. + (gnus-inhibit-unbuttonizing): New variable. + (gnus-summary-toggle-display-buttonized): New command. + + * gnus-art.el (gnus-display-mime): Select article window. + (article-strip-trailing-space): New command and keystroke. + + * nneething.el (nneething-include-files): New variable. + (nneething-create-mapping): Use it. + + * nntp.el (nntp-possibly-change-group): Use nntp-send-command. + + * nnvirtual.el (nnvirtual-request-update-mark): Only yodate + ayto-expirable marks. + +1998-11-24 21:00:02 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-view-all-parts): Set buffer. + + * gnus-sum.el (gnus-summary-display-buttonized): Don't pass on + ARG. + + * gnus-art.el (gnus-article-mode-line-format): Doc fix. + +Tue Nov 24 14:57:41 1998 Shenghuo ZHU + + * mm-util.el (mm-binary-coding-system): New variable. + (mm-with-unibyte-buffer): Use mm-binary-coding-system. + * mm-decode.el (mm-display-external): Ditto. + +Tue Nov 24 10:43:06 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.54 is released. + +1998-11-24 11:21:32 Katsumi Yamaoka + + * gnus-sum.el (gnus-newsgroup-default-charset-alist): Note fj. + +1998-11-24 11:14:54 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-save-part): Unquote. + +1998-11-24 11:14:39 Matt Armstrong + + * mm-decode.el (mm-save-part): Bind coding system for write. + +1998-11-24 10:42:30 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-mode-line-format): New default. + (gnus-article-mime-part-status): New function. + + * message.el (message-send-news): Check the body syntax before + encoding. + + * gnus-art.el (gnus-unbuttonized-mime-type): New function. + (gnus-mime-display-single): Use it. + (gnus-mime-display-alternative): Ditto. + + * mm-decode.el: Check for whether we are running under a term. + +1998-11-22 08:12:25 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-preferred-alternative): Default to first + alternative. + (mm-preferred-alternative): No, we dont. + +Tue Nov 24 03:01:48 1998 Shenghuo ZHU + + * mm-decode.el (mm-display-external): Use binary instead of + no-conversion. + * gnus-agent.el (gnus-agent-file-coding-system): Ditto. + * nnheader.el (nnheader-file-coding-system): Ditto. + * mm-util.el (mm-with-unibyte-buffer): Use binary instead of nil. + +Mon Nov 23 01:51:57 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-newsgroup-setup-default-charset): Use group + name without method. + +Mon Nov 23 01:26:40 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-newsgroup-default-charset): Rename + coding-system -> default-charset. + (gnus-newsgroup-default-charset-alist): Ditto. + (gnus-summary-local-variables): Ditto. + (gnus-set-global-variables): Ditto. + (gnus-get-newsgroup-headers): Ditto. + (gnus-summary-from-or-to-or-newsgroups): Ditto. + (gnus-get-newsgroup-headers-xover): Ditto. + (gnus-newsgroup-setup-default-charset): Ditto. + (article-decode-mime-words): Ditto. + (article-decode-charset): Ditto. + (article-decode-encoded-words): Ditto. + (article-de-quoted-unreadable): Ditto. + (gnus-mime-view-all-parts): Ditto. + (gnus-mime-externalize-part): Ditto. + (gnus-mm-display-part): Ditto. + (gnus-mime-display-single): Ditto. + (gnus-mime-display-alternative): Ditto. + * lpath.el : Ditto. + +Mon Nov 23 00:54:33 1998 Shenghuo ZHU + + * rfc2047.el (rfc2047-decode-region): Do not decode nil charset. + * gnus-art.el (article-decode-charset): Overlay + rfc2047-default-charset. + * message.el (message-draft-coding-system): New variable. + (message-set-auto-save-file-name): Use message-draft-coding-system. + * nndraft.el (nndraft-request-article): Ditto. + * gnus-start.el (gnus-start-draft-setup): Set charset nil. + * gnus-agent.el (gnus-agent-queue-setup): Ditto. + +Sun Nov 22 04:42:22 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-test): New function. + (mm-uu-dissect): Inherit charset and cte from head. + * gnus-art.el (article-decode-charset): Use mm-uu-test. + +Sat Nov 21 09:57:01 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.53 is released. + +1998-11-21 05:54:19 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-get-image): New function. + (mm-image-fit-p): New function. + + * gnus-xmas.el (gnus-xmas-annotation-in-region-p): Ditto. + + * gnus-util.el (gnus-annotation-in-region-p): New definition. + + * gnus-art.el (gnus-article-insert-newline): New function. + (article-goto-body): New function. + +1998-11-20 10:34:04 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-single): Insert blank line before + buttons. + + * gnus-sum.el (gnus-summary-display-buttonized): New command and + keystroke. + + * gnus-art.el (gnus-mime-display-single): Don't insert a blank + line between parts. + + * message.el (message-remove-header): Go to end if wanted. + +1998-11-20 Karl Kleinpaste + + * gnus-art.el (gnus-mime-display-alternative): Avoid window + movement with save-window-excursion. + +Fri Nov 20 03:50:30 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-inline-part): Use argument as charset. + +Fri Nov 20 03:37:53 1998 Shenghuo ZHU + + * mm-bodies.el (mm-decode-body): Remove buffer-file-coding-system. + +Fri Nov 20 01:20:38 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use + gnus-newsgroup-coding-system. + (gnus-get-newsgroup-headers): Ditto. + (gnus-get-newsgroup-headers-xover): Ditto. + (gnus-set-global-variables): Ditto. + * gnus-art.el (article-decode-mime-words): Ditto. + (article-decode-charset): Ditto. + (article-decode-encoded-words): Ditto. + (article-de-quoted-unreadable): Ditto. + (gnus-mime-view-all-parts): Ditto. + (gnus-mime-externalize-part): Ditto. + (gnus-mm-display-part): Ditto. + (gnus-mime-display-alternative): Ditto. + (gnus-mime-display-single): Ditto. + * mm-view.el (mm-inline-text): Use default coding system. + +Fri Nov 20 00:54:37 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-newsgroup-coding-system-alist): New variable. + (gnus-newsgroup-iso-8859-1-forced-regexp): New variable. + (gnus-newsgroup-coding-system): New local variable. + (gnus-newsgroup-iso-8859-1-forced): New local variable. + (gnus-summary-local-variables): Add two new local variables. + (gnus-newsgroup-setup-coding-system): New function. + (gnus-select-newsgroup): Setup coding system. + * lpath.el: Add two new variables. + * mm-util.el (mm-charset-iso-8859-1-forced): New variable. + (mm-charset-to-coding-system): Use mm-charset-iso-8859-1-forced. + * gnus-cus.el (gnus-group-parameters): Customizable + iso-8859-1-forced. + +Fri Nov 20 05:30:26 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.52 is released. + +1998-11-20 04:32:23 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-encode-message-header): Encode the default + encoding. + + * gnus-art.el (gnus-mime-display-single): Insert buttons for + undisplayed text types. + + * mm-decode.el (mm-automatic-display-p): Only prefer inlinable + types. + +1998-11-19 Felix Lee + + * nntp.el (nntp-after-change-function-callback): recover from C-g. + +1998-11-19 Felix Lee + + * gnus-async.el (gnus-asynch-obarray): rename to + gnus-async-hashtb, and don't buffer-local it. + + (gnus-async-article-callback): new function. + (gnus-make-async-article-function): use it. + + (gnus-async-current-prefetch-group): new var. + (gnus-async-current-prefetch-article): new var. + (gnus-async-request-fetched-article): are we fetching it already? + + (gnus-async-delete-prefected-entry): s/prefected/prefetched/ + +1998-11-20 02:49:21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-show-article): Require. + + * message.el: Provide before hooks. + (message-send-news): Do MIME before headers. + + * gnus-art.el (gnus-article-check-buffer): New function. + (gnus-article-read-summary-keys): Use it. + + * mm-decode.el (mm-user-automatic-display): Display all inline + images. + + * gnus-art.el (gnus-mime-display-single): Don't buttonize so + much. + (gnus-unbuttonized-mime-types): New variable. + +1998-11-19 06:29:03 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t. + + * mm-decode.el (mm-quote-arg): Quote semicolons. + + * gnus-art.el (gnus-mime-display-single): Don't display + attachments. + (gnus-mime-externalize-part): New command and keystroke. + + * mm-decode.el (mm-dissect-buffer): Pass on the description info. + (mm-alternative-precedence): Changed order. + +1998-11-07 17:41:47 Simon Josefsson + + * gnus.el (gnus-method-simplify): New function. + (gnus-native-method-p): New function. + (gnus-secondary-method-p): Use gnus-method-equal. + + * gnus-start.el (gnus-group-change-level): Shorten select method. + +Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.51 is released. + +1998-11-19 04:02:34 Lars Magne Ingebrigtsen + + * gnus.el: Applied patches from 5.6.45. + + * gnus-score.el (gnus-score-find-trace): Print complete file + paths. + (gnus-score-find-trace): Truncate lines. + + * gnus.el (gnus-message-archive-group): Allow function. + + * message.el (message-encode-message-body): Remove Mime-Version + before inserting. + + * gnus-cus.el (gnus-group-customize): Optional topic. + + * gnus-sum.el (gnus-summary-customize-parameters): New command and + keystroke. + +Wed Nov 18 13:46:08 1998 Shenghuo ZHU + + * message.el (message-encode-message-body): Rewrite. + +1998-11-18 07:37:47 Lars Magne Ingebrigtsen + + * mml.el (mml-base-boundary): New variable. + (mml-make-boundary): New function. + + * gnus-cache.el (gnus-cache-coding-system): New variable. + (gnus-cache-request-article): Use it. + + * message.el (message-insert-mime-part): Delete duplicates. + +Wed Nov 18 11:52:19 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-display-alternative): Set end of + multipart and display even when nothing is preferred. + +Wed Nov 18 05:06:44 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.50 is released. + +1998-11-18 04:42:01 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-media-tests): Check that device-type is + fbound. + + * gnus-sum.el (gnus-summary-sort): Didn't do reverse. + +1998-11-07 23:39:48 Simon Josefsson + + * gnus.el (gnus-similar-server-opened): Compare backend. + +1998-11-08 03:37:42 Simon Josefsson + + * gnus-topic.el (gnus-topic-expire-articles): New function. + (gnus-topic-mode-map): Bind it. + + * gnus.texi (Topic Commands): New expiry command. Reordered. + +1998-11-10 Miles Bader + + * gnus-sum.el + (gnus-auto-expirable-marks): New variable. + (gnus-inhibit-user-auto-expire): New variable. + (gnus-summary-mark-article-as-read, gnus-summary-mark-article): + When looking to see if we should expire instead, check + gnus-auto-expirable-marks instead of using a hard-wired list. + (gnus-summary-mark-as-read-forward, + gnus-summary-mark-as-read-backward): + Pass gnus-inhibit-user-auto-expire for the no-expire argument to + gnus-summary-mark-forward, instead of `t'. + +1998-11-18 03:30:26 Lars Magne Ingebrigtsen + + * mml.el (mml-compute-boundary): New function. + (mml-compute-boundary-1): New function. + (mml-generate-mime-1): Use it. + +1998-11-18 Hrvoje Niksic + + * mml.el (mml-generate-mime-1): Always precede closing boundary + with newline. + +1998-11-18 02:36:37 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime-1): Do right boundaries when several + multiparts. + + * mm-decode.el (mm-user-automatic-display): Default to inline + jpeg. + + * mml.el (mml-generate-mime-1): Encode non-text parts. + +Wed Nov 18 02:22:23 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.49 is released. + +1998-11-18 00:37:43 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-text): Require w3-vars. + + * gnus-setup.el (gnus-use-tm): Removed. + + * gnus-art.el (gnus-article-goto-part): Don't beep. + (gnus-article-view-part): Check return value. + (gnus-mime-display-alternative): Don't display when there is + nothing to display. + + * mml.el (mml-generate-mime-1): Don't use a unibyte buffer. + (mml-generate-mime-1): Use unibyte for binaries. + + * gnus-art.el (gnus-display-mime): Call + gnus-article-mime-part-function. + (gnus-mime-part-function): New function. + (gnus-article-mime-part-function): New function. + + * mml.el (mml-generate-mime-1): Don't insert so many newlines. + +1998-11-16 06:44:19 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime-1): Do it in unibyte buffers. + + * message.el (message-font-lock-keywords): Highlight MML. + (message-mml-face): New font. + +Mon Nov 16 23:34:12 1998 Shenghuo ZHU + + * gnus-art.el (gnus-display-mime): Clean up even when no handles. + (gnus-mm-display-part): Do not select-window if the article window + is not found. + +Mon Nov 16 02:26:40 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m. + +Mon Nov 16 02:00:05 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.48 is released. + +1998-11-15 23:18:56 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-encode-body): Disbabled for nonmule. + + * mm-util.el (mm-find-charset-region): Bogus change for non-Mule. + + * message.el (message-cite-original-without-signature): Ditto. + (message-cite-original): Quote parts. + +Sun Nov 15 22:01:55 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.47 is released. + +1998-11-15 20:11:33 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Insert MIME warning. + + * mml.el (mml-read-tag): Look for #tag. + + * mm-util.el (mm-find-charset-region): Check whether + enable-multibyte-characters is bound. + +Sun Nov 15 02:01:31 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.46 is released. + +1998-11-15 01:54:40 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Insert headers at the + right spot. + +Sun Nov 15 01:13:41 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.45 is released. + +1998-11-15 00:28:49 Lars Magne Ingebrigtsen + + * nndraft.el (nndraft-save-mime-part): Removed. + (nndraft-get-mime-part): Ditto. + + * message.el (message-format-mime-old): Removed. + (message-encode-message-body): Removed. + (message-encode-message-body): Renamed. + +1998-11-14 18:27:19 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers): Translate \r's. + + * message.el (message-format-mime): Check message-mime-part. + + * mm-encode.el (mm-mime-file-types): Removed. + (mm-default-file-encoding): New definition. + +Sat Nov 14 01:29:39 1998 Shenghuo ZHU + + * mm-view.el (mm-inline-image): Use mm-insert-inline. + * gnus-art.el (gnus-mm-display-part): Go to correct position. + +Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.44 is released. + +1998-11-14 03:59:14 Lars Magne Ingebrigtsen + + * message.el (message-format-mime): New function. + + * nndraft.el (nndraft-save-mime-part): New function. + (nndraft-get-mime-part): New function. + + * mm-encode.el (mm-default-file-encoding): New function. + (mm-content-transfer-encoding): New function. + (mm-encode-buffer): New function. + + * message.el: New command. + (message-mime-part): New variable. + (message-insert-mime-part): New command. + + * mm-encode.el (mm-encode-content-transfer-encoding): New + function. + + * mm-util.el (mm-content-transfer-encoding-defaults): New + variable. + (mm-mime-file-types): Taken from TM. + +Sat Nov 14 01:51:06 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.43 is released. + +1998-11-07 Karl Kleinpaste + + * gnus-cus.el (gnus-score-customize): Add "Extra" element. + * gnus-score.el (gnus-score-default-header): Ditto. + (gnus-header-index): Ditto. + (gnus-summary-increase-score): Ditto, & process "extra" requests. + (gnus-summary-header): Handle extra headers. + (gnus-summary-score-entry): Ditto, & provide new score element. + (gnus-summary-score-effect): Ditto. + (gnus-score-string): Avoid "extra" string sort, & modify match in + "extra" case. + * gnus-sum.el (gnus-make-score-map): Add "extra" element. + +1998-11-13 20:30:40 Lars Magne Ingebrigtsen + + * message.el (message-resend): Bind message-required-mail-headers + to nil. + + * mm-view.el (mm-inline-text): Bind w3-strict-width. + + * nngateway.el (require): Require cl. + + * gnus-art.el (gnus-button-alist): Exclude more chars from news: + things. + +Wed Nov 11 02:15:06 1998 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-headers): Create directory even + when no articles. + +1998-11-13 19:25:10 Lars Magne Ingebrigtsen + + * message.el (message-ignored-resent-headers): Remove X-Gnus. + +1998-11-10 Colin Rafferty + + * gnus-sum.el (gnus-ignored-from-addresses): Only quote + user-mail-address if non-nil. + +1998-11-13 18:50:18 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-make-sort-function): Do `reverse'. + (gnus-make-sort-function-1): Ditto. + + * gnus-art.el (gnus-mm-display-part): Switch to mm in right + window. + +1998-11-12 22:31:58 Lars Magne Ingebrigtsen + + * mm-util.el (mm-with-unibyte-buffer): Ditto. + + * binhex.el (binhex-decode-region): Quote. + +1998-11-10 05:32:28 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-charset): Don't downcase charset. + + * gnus-sum.el (gnus-get-newsgroup-headers-xover): Translate CR's. + +Sun Nov 8 23:17:24 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.42 is released. + +Sun Nov 8 02:36:33 1998 Shenghuo ZHU + + * gnus-art.el (gnus-display-mime): Add id for alternative part. + +1998-11-08 02:24:47 Simon Josefsson + + * nntp.el (nntp-send-mode-reader): Revert. + +Sun Nov 8 00:45:13 1998 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-articles): Use with-temp-buffer. + +Sat Nov 7 23:07:24 1998 Shenghuo ZHU + + * message.el (message-make-date): Fix for negative time zones. + +Sun Nov 8 01:00:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.41 is released. + +1998-11-08 00:52:38 Hrvoje Niksic + + * mm-decode.el (mm-dissect-multipart): Quote regexp. + +1998-10-29 Sudish Joseph + + * gnus.el (gnus-short-group-name): When shortening foreign select + methods, do not scan for plusses beyond the first colon. + +1998-11-07 Mike McEwan + + * gnus-agent.el (gnus-agent-save-group-info): Cater for group info + lines where `group' is the last thing on the line. + +1998-11-08 00:35:09 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Do alternative. + (gnus-mime-display-alternative): Insert marker. + +1998-11-07 14:33:46 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-dissect-multipart): Quote regexp. + + * nnmail.el (nnmail-expired-article-p): Protect against bogus + dates. + + * gnus-cus.el (gnus-topic): Required. + + * nnheader.el (nnheader-parse-nov): Parse extra. + (nnheader-nov-parse-extra): New macro. + +1998-10-31 12:33:22 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Internal move. + +1998-10-28 Per Abrahamsen + + * gnus-cus-new.el (gnus-custom-topic): New free variable. + (gnus-group-customize): Support editing topic parameters. + +1998-10-29 12:09:20 Karl Kleinpaste + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add + indicators. + +1998-10-29 11:31:11 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mm-display-part): Return. + (gnus-article-view-part): Only go if external. + (gnus-article-dumbquotes-map): Do 205. + + * mm-decode.el (mm-display-part): Return what was done. + + * message.el (message-buffer-naming-style): New variable. + (message-generate-new-buffers): Extended. + (message-buffer-naming-style): Removed. + (message-buffer-name): Use it. + (message-do-send-housekeeping): Rename new styling. + + * gnus-sum.el (gnus-summary-recenter): Allow + gnus-auto-center-summary to be a number. + +Wed Nov 4 02:24:39 1998 Shenghuo ZHU + + * pop3.el (pop3-open-server): Use "binary" instead of + "no-conversion". + +Sun Nov 1 01:26:42 1998 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Set + gnus-browse-current-method to the result of gnus-server-to-method. + +Thu Oct 29 01:47:44 1998 Shenghuo ZHU + + * gnus-util.el (gnus-pull): Another optional argument. + * nnweb.el (nnweb-request-delete-group): Delete from + nnweb-group-alist and update active file. + +Thu Oct 29 01:05:08 1998 Shenghuo ZHU + + * gnus-group.el (gnus-group-make-group): Accept group of new + method. + +Wed Oct 28 02:19:16 1998 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble. + +Tue Oct 27 11:59:31 1998 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Postion of html portion. + +1998-10-29 10:26:54 Lars Magne Ingebrigtsen + + * nntp.el (nntp-list-active-group): Waited for short strings. + (nntp-send-mode-reader): Ditto. + (nntp-open-connection): Ditto. + + * gnus-int.el (gnus-request-group-articles): New function. + + * nntp.el (nntp-request-listgroup): New function. + (nntp-request-group-articles): Renamed. + +1998-10-27 10:37:52 Karl Kleinpaste + + * nnheader.el (nnheader-parse-nov): Supply extra. + +1998-10-26 23:03:48 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-push): Don't go to + gnus-article-buffer. + + * mm-view.el (mm-inline-image): Add a newline. + + * gnus-start.el (gnus-check-first-time-used): Check more. + +1998-10-26 23:03:29 Francois Felix Ingrand + + * gnus-start.el (gnus-check-first-time-used): Check current. + +1998-10-26 22:07:52 Lars Magne Ingebrigtsen + + * mm-util.el (mm-find-charset-region): New function. + + * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header. + + * gnus-art.el (gnus-mime-button-menu): Fix. + +1998-10-26 22:07:43 Michael Welsh Duggan + + * gnus-art.el (gnus-mime-button-menu): New definition. + +1998-10-26 01:46:11 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-charset): Downcase charset. + (article-decode-charset): Pass on type. + (article-decode-charset): Check nil charsets. + (article-remove-cr): Translate CR to LF. + (gnus-ignored-mime-types): Default to nil. + + * nnheader.el (nnheader-insert-nov): Work when not Xref. + + * gnus-sum.el (gnus-ignored-from-addresses): Default to + user-mail-address. + (gnus-nov-parse-extra): Didn't return right thing. + +1998-10-25 23:25:27 Lars Magne Ingebrigtsen + + * gnus-xmas.el: Use compiled-function-p. + +Mon Oct 26 14:37:19 1998 Shenghuo ZHU + + * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header. + +Sun Oct 25 23:11:44 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.40 is released. + +1998-10-25 21:41:05 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-mark-forward): Show thread. + + * gnus-start.el (gnus-check-first-time-used): Ignore dribble. + + * gnus-agent.el (gnus-agent-fetch-group-1): Bind name. + + * nnml.el (nnml-possibly-create-directory): Check before making. + +1998-10-25 19:43:08 Kai Grossjohann + + * nnheader.el (nnheader-insert-nov): Don't infloop. + +1998-10-25 19:26:11 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-set-mode-line): Check that the spec has been + set up. + +1998-10-25 19:22:03 Joerg Lenneis + + * nneething.el (nneething-file-name): New definition. + +1998-10-25 17:56:23 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treatment-function-alist): Fix. + (gnus-summary-save-in-rmail): Use gnus-output-to-rmail. + + * nndoc.el (nndoc-dissect-mime-parts-sub): Recognize first part. + +Sun Oct 25 06:23:13 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.39 is released. + +1998-10-25 00:34:39 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-ignored-mime-types): New variable. + (gnus-mime-display-single): Use it. + (gnus-treatment-function-alist): New variable. + + * gnus.el (gnus-mime): New group. + + * gnus-art.el (gnus-mime-display-alternative): Don't destroy + things for other parts. + (gnus-mime-display-alternative): Place point. + + * gnus.el: autoload gnus-uu-post-news. + + * mailcap.el (mailcap-mailcap-entry-passes-test): Also check + needsterm/DISPLAY. + + * mm-decode.el (mm-display-part): Default to inline text/.* + parts. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Default to + 8bit. + + * gnus-art.el (gnus-mime-copy-part): Use normal-mode. + (gnus-mime-display-single): Inline all text parts. + (gnus-article-narrow-to-signature): Removed mime:: stubs. + +1998-10-24 21:38:37 Lars Magne Ingebrigtsen + + * nnml.el (nnml-possibly-create-directory): Rewrite. + (nnml-request-create-group): Change to right server. + + * gnus-xmas.el (gnus-xmas-define): Use byte-code-function-p. + + * gnus-sum.el (gnus-set-mode-line): Use truncate-string-to-width. + + * gnus.el: rmail-output-to-rmail-file autoload. + + * gnus-util.el (gnus-output-to-rmail): Didn't work if not in + Gnus. + + * nnheader.el (nnheader-parse-head): Checked wrong variable. + + * gnus-sum.el (gnus-summary-update-mark): Ignore nil'd marks. + +Tue Oct 20 23:37:43 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-display-mixed): Multipart in + mixed part. + +Tue Oct 20 23:36:43 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. + + * gnus-sum.el (gnus-summary-exit-no-update): Ditto. + +Tue Oct 20 16:22:51 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. + +1998-10-24 20:51:53 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-valid-move-group-p): Make sure group has a + value. + + * gnus-art.el (gnus-article-hidden-text-p): Return nil when not + hidden. + + * gnus-spec.el (gnus-update-format-specifications): Use the + article mode line spec. + + * gnus-art.el (gnus-insert-mime-button): Put right type. + (gnus-insert-prev-page-button): Ditto. + (gnus-insert-next-page-button): Dutti. + + * pop3.el: New version installed. + +Sat Oct 24 16:48:51 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Delete the begining spurious newline + and display last part. + +Sat Oct 24 20:31:55 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.38 is released. + +1998-10-24 07:54:58 Lars Magne Ingebrigtsen + + * gnus-art.el (article-mime-decode-quoted-printable-buffer): + Removed. + (article-de-quoted-unreadable): Narrow to default. + + * qp.el (quoted-printable-encode-region): Encode before QP-ing. + + * gnus-art.el (article-decode-charset): Decode even when broken + MIME. + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Return + name. + + * gnus-msg.el (gnus-copy-article-buffer): Delete headers. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Use + nnheader. + + * nnmail.el (nnmail-extra-headers): New variable. + + * nnheader.el (nnheader-insert-nov): Insert extra. + + * gnus.el (gnus-summary-line-format): Doc fix. + + * gnus-sum.el (gnus-get-newsgroup-headers): Parse extra. + (gnus-nov-parse-line): Ditto. + (gnus-nov-parse-extra): New macro. + (gnus-header): New function. + (gnus-update-summary-mark-positions): Change. + (gnus-ignored-from-addresses): New variable. + (gnus-summary-insert-from-or-to): New function. + + * gnus.el (gnus-extra-headers): New variable. + + * nnheader.el (make-mail-header): Expand. + (mail-header-extra): New macro. + (mail-header-set-extra): Ditto. + (make-full-mail-header): Expand. + +Sat Oct 24 07:41:42 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.37 is released. + +1998-10-24 07:29:11 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-body): Check for multibyticity. + + * mm-util.el (mm-enable-multibyte): Don't always switch multibyte + on. + +1998-10-22 Didier Verna + + * gnus-spec.el (gnus-balloon-face-function): new function + (gnus-parse-format): understand the %< %> specifiers + (gnus-parse-complex-format): ditto. + +1998-10-24 06:31:33 Lars Magne Ingebrigtsen + + * gnus.el: Changed following-char to char-after throughout. + +1998-10-22 04:05:55 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Protect more and message. + +Wed Oct 21 03:26:30 1998 Shenghuo ZHU + + * gnus-xmas.el (gnus-xmas-article-push-button): Go to the + position. + +Tue Oct 20 23:37:43 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-display-mixed): Multipart in + mixed part. + +Tue Oct 20 23:36:43 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. + + * gnus-sum.el (gnus-summary-exit-no-update): Ditto. + +Tue Oct 20 16:22:51 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. + +1998-10-21 Hrvoje Niksic + + * mailcap.el (mailcap-save-binary-file): Use unwind-protect. + + * mm-decode.el (mm-display-external): Set undisplayer to mm + buffer, not the current buffer; use unwind-protect. + +1998-10-21 00:07:59 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-exit): Destroy parts. + (gnus-summary-exit-no-update): Ditto. + +1998-10-20 22:02:05 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-media-tests): Look for w3. + + * mailcap.el (mailcap-mime-data): Inline html. + +Tue Oct 20 20:25:03 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.36 is released. + +1998-10-20 18:13:08 Lars Magne Ingebrigtsen + + * gnus-art.el (article-translate-strings): + (gnus-article-dumbquotes-map): Don't dot. + + * pop3.el (pop3-open-server): Set point right. + + * mm-decode.el (mm-dissect-multipart): Dissect hierarchically. + (mm-dissect-buffer): Ditto. + (mm-destroy-part): Ignore non-handles. + (mm-remove-part): Ditto. + (mm-destroy-parts): New function. + (mm-remove-parts): Ditto. + + * gnus-art.el (gnus-mm-display-part): Don't move point. + +Tue Oct 20 02:16:36 1998 Shenghuo ZHU + + * mm-uu.el : New file. + + * gnus-art.el (gnus-display-mime): Dissect uu stuffs. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Encoding as + a function. + +1998-10-20 00:35:05 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Check before selecting. + +Sat Sep 26 02:03:00 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-multi-decode-encoded-word-string): Rewrite. + + * gnus-sum.el (gnus-decode-encoded-word-methods): New variable. + + * gnus-sum.el (gnus-decode-encoded-word-methods-cache): New + variable. + + * gnus-sum.el (gnus-encoded-word-method-alist): Deleted. + + * gnus-art.el (gnus-decode-header-methods): New variable. + + * gnus-art.el (gnus-decode-header-methods-cache): New variable. + + * gnus-art.el (gnus-multi-decode-header): New function. + +Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.35 is released. + +1998-10-20 00:00:36 Lars Magne Ingebrigtsen + + * uudecode.el (uudecode-decode-region-external): Insert + literally. + + * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here. + + * mm-bodies.el (mm-decode-body): Optional encoding. + +1998-10-19 23:57:57 Lars Magne Ingebrigtsen + + * gnus-ems.el (gnus-mouse-3): New variable. + + * binhex.el (binhex-decode-region-external): Don't use -internally. + +1998-10-16 14:54:02 Simon Josefsson + + * mailcap.el (mailcap-parse-mailcaps): Only open regular + files. + +1998-09-26 22:28:01 Simon Josefsson + + * gnus-group.el (gnus-add-marked-articles): Request backend update + of flags. + +1998-09-26 19:39:31 Simon Josefsson + + * gnus-sum.el (gnus-update-read-articles): + (gnus-update-marks): Request backend update of mark. + +1998-09-26 19:33:58 Simon Josefsson + + * gnus.texi (Optional Backend Functions): New item, + nnchoke-request-set-mark. + +1998-09-26 16:27:27 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Don't add stuff in + list to range. + +1998-10-19 23:45:13 Simon Josefsson + + * gnus-sum.el (gnus-summary-exit-no-update): Don't expire. + +1998-10-14 SL Baur + + * gnus-sum.el: Move gnus-save-hidden-threads above where it is + first used. + +1998-10-10 SL Baur + + * mm-view.el: Require mm-decode for macros. + + * mm-decode.el (mm-handle-type): Move macro declarations above the + place where they are used. + +Sun Oct 18 13:59:07 1998 Kurt Swanson + + * gnus-msg.el (gnus-summary-mail-forward): Erase old forward + buffer. + +1998-10-19 23:38:11 Katsumi Yamaoka + + * nnagent.el (nnagent-open-server): Error message. + +1998-10-19 23:35:08 Joerg Lenneis + + * nnheader.el (nnheader-article-p): Recognize lower-case headers. + +1998-10-19 Hrvoje Niksic + + * score-mode.el (gnus-score-mode-map): Ditto. + + * message.el (message-mode-map): Ditto. + + * gnus-uu.el (gnus-uu-post-news): Ditto. + + * gnus-kill.el (gnus-kill-file-mode-map): Ditto. + + * gnus-eform.el (gnus-edit-form-mode-map): Ditto. + + * gnus-art.el (gnus-article-edit-mode-map): Use + `set-keymap-parent' rather than `copy-keymap'. + +1998-10-18 Hrvoje Niksic + + * gnus-art.el (gnus-mime-button-commands): New variable. + (gnus-mime-button-map): Initialize it from + `gnus-mime-button-commands'. + (gnus-mime-button-menu): New function. + (gnus-insert-mime-button): Use `gnus-mime-button-map'. + +1998-10-11 Hrvoje Niksic + + * message.el (message-insert-to): Make `nobody' and `poster' + synonymous to `never' and `always' in Mail-Copies-To. + (message-reply): Ditto. + (message-followup): Ditto. + +1998-10-19 23:17:41 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-data): Save sound. + +1998-09-24 Hrvoje Niksic + + * message.el (message-ignored-supersedes-headers): Include + `NNTP-Posting-Date'. + +1998-10-19 01:25:27 Jonas Steverud + + * gnus-art.el (gnus-article-dumbquotes-table): New variable. + +1998-10-19 00:50:22 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-content-transfer-encoding): Use + uudecode. + +1998-10-18 18:20:34 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Don't switch on save. + +1998-10-18 18:14:06 Andy Piper + + * nnmail.el (nnmail-movemail-args): New variable. + +1998-10-18 00:17:02 Lars Magne Ingebrigtsen + + * gnus-art.el (article-translate-strings): + +1998-10-17 22:51:31 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Use it. + (gnus-mm-display-part): New function. + (article-de-quoted-unreadable): Yse mm-default-coding-system. + + * mm-decode.el (mm-handle-displayed-p): New function. + + * gnus-art.el (gnus-mime-copy-part): Create better names. + (gnus-mime-button-line-format): Include dots spec. + +1998-10-15 Matt Pharr + + * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old + forward buffer first. + +1998-10-17 21:16:46 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-set-window-start): New function. + + * message.el (message-send): Don't check changed. + +1998-10-12 15:26:41 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-buffer): Set params. + + * mm-decode.el (mm-user-display-methods): Inline + "message/delivery-status". + +1998-10-11 07:06:38 Lars Magne Ingebrigtsen + + * message.el (message-auto-save-directory): Rename. + (message-mode): Dof fix. + + * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat". + (gnus-summary-save-in-pipe): No, check gnus-last-shell-command. + + * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving. + + * message.el (message-make-date): Avoid locale. + + * gnus-art.el (gnus-article-edit-done): Allow update before doing + cache. + + * mm-decode.el (mm-display-inline): Goto point-min. + + * gnus-art.el (gnus-article-prepare-display): Not read-only. + + * mm-decode.el (mm-display-external): Reverse before sorting. + + * gnus-draft.el (gnus-draft-send): Allow mail. + +1998-10-10 -SL Baur + + * message.el (message-check): Move message-check macro above where + it is first used. + + * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line. + +1998-10-11 06:45:37 Lloyd Zusman + + * gnus-sum.el (gnus-summary-make-menu-bar): Fix. + +Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.34 is released. + +1998-10-11 02:15:41 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-media-tests): delivery-status. + + * mm-view.el (mm-inline-text): Provide default. + +1998-10-11 01:01:37 Lloyd Zusman + + * mailcap.el (mailcap-possible-viewers): Fix nils. + +1998-10-11 00:03:37 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-edit-exit): Don't do updates. + (article-update-date-lapsed): Record the buffer. + (article-update-date-lapsed): Do all windows that display article + buffers. + + * nnml.el (nnml-generate-nov-databases-1): Ditto. + + * gnus-score.el (gnus-score-score-files-1): Ignore dotted files. + + * gnus-art.el (gnus-insert-mime-button): Mark buttons as + annoations. + + * gnus-msg.el (gnus-summary-mail-forward): Decode properly. + +1998-10-10 22:07:03 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-category-add): Change default category to + 'false. + + * nnvirtual.el (nnvirtual-update-read-and-marked): Don't nix out + scores. + + * gnus-draft.el (gnus-draft-send): Check server more. + + * gnus-art.el (gnus-article-view-part): New command and keystroke. + (gnus-article-goto-part): New function. + + * mm-view.el (mm-inline-text): Insert richtext properly. + + * gnus-art.el (gnus-insert-mime-button): Store handle in alist. + +1998-10-03 15:04:27 Lars Magne Ingebrigtsen + + * parse-time.el (parse-time-rules): Accept dates far into the past + and the future, and parse single-digit numbers as years. + +1998-10-02 04:46:46 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Chop off directories. + +1998-10-01 07:33:35 Lars Magne Ingebrigtsen + + * uudecode.el (uu-decode-region-external): Use + insert-file-contents-literally. + + * gnus-cache.el (gnus-cache-generate-active): Translate _ to :. + +1998-10-01 07:02:11 Shenghuo ZHU + + * uudecode.el: New file. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Do + x-uuencode. + +1998-10-01 05:19:35 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-alternative): Set faces. + + * message.el (message-fetch-field): Unfold properly. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF + in text/plain. + +1998-09-30 05:47:49 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-first-unread-subject): New command. + (gnus-auto-select-first): Removed. + (gnus-auto-select-first): Extended. + (gnus-summary-read-group-1): Use new value. + +1998-09-29 13:21:06 Lars Magne Ingebrigtsen + + * message.el (message-fix-before-sending): Space. + + * nnmail.el (nnmail-find-file): Don't erase. + +Wed Sep 30 23:49:03 1998 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-headers): Do not decode headers. + +Wed Sep 30 23:46:29 1998 Shenghuo ZHU + + * gnus-soup.el (gnus-soup-add-article): Do not decode headers. + +Wed Sep 30 23:44:08 1998 Shenghuo ZHU + + * gnus-soup.el (gnus-soup-pack-packet): Pack only if necesary. + +Sat Sep 26 03:04:18 1998 Shenghuo ZHU + + * mm-util.el (mm-with-unibyte-buffer): Make it work in XEmacs + 20.4. + +1998-09-29 11:35:09 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-view-all-parts): New command and + keystroke. + + * mm-decode.el (mm-display-external): Translate slashes. + + * nnmail.el (nnmail-find-file): Restrict auto-mode-alist. + + * nndraft.el (nndraft-retrieve-headers): Don't copy so much. + + * mm-decode.el (mm-quote-arg): Quote spaces. + (mm-display-external): Quote args. + +1998-09-24 22:27:55 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inlinable-part-p): New function. + +1998-09-25 22:28:01 Simon Josefsson + + * mm-util.el (mm-disable-multibyte): New function. + +Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.33 is released. + +1998-09-24 18:47:31 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-insert-mime-button): Get buffer size. + + * mm-decode.el (mm-display-external): Don't switch for externals. + (mm-dissect-multipart): Don't include end-sep. + + * mm-util.el (mm-get-coding-system-list): New function. + (mm-coding-system-list): New variable. + +Thu Sep 24 02:08:10 1998 ZHU Shenghuo + + * gnus-cus.el (gnus-group-parameters): Add charset as a parameter + +Thu Sep 24 02:05:48 1998 ZHU Shenghuo + + * gnus-cus.el (gnus-group-customize): Use variable as cons not as + group + +Thu Sep 24 01:41:03 1998 ZHU Shenghuo + + * base64.el (base64-run-command-on-region): External base64 + decoder do not use coding system + +Thu Sep 24 01:39:44 1998 ZHU Shenghuo + + * mm-decode.el (mm-interactively-view-part): Typo. + +Thu Sep 24 01:37:30 1998 ZHU Shenghuo + + * mm-decode.el (mm-dissect-multipart): Display last part when the + article has no close-delimiter + +Thu Sep 24 01:28:54 1998 ZHU Shenghuo + + * mm-decode.el (mm-dissect-buffer): Display parts which have no + content-type. + +Thu Sep 24 01:23:57 1998 ZHU Shenghuo + + * gnus-art.el (gnus-display-mime): Typo. + +Thu Sep 24 02:29:57 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.32 is released. + +1998-09-24 00:27:11 Lars Magne Ingebrigtsen + + * gnus-kill.el (gnus-batch-score): Protect against errors. + + * gnus-art.el: Protect against broken headers. + + * mm-decode.el (mm-display-external): Respect needsterm. + (mm-display-external): Create buffer for external commands. + +1998-09-23 22:04:05 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-info): Return the proper viewer. + + * mm-decode.el (mm-display-external): Use file name. + +1998-09-22 Markus Rost + + * gnus-util.el (gnus-output-to-rmail): adjust to + `rmail-output-to-rmail-file' + +1998-09-23 20:07:00 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-output-to-rmail): Reinstated function. + + * gnus-sum.el (gnus-select-newsgroup): Set global variables before + headers. + + * gnus-art.el (article-decode-charset): Fold case. + +1998-09-17 15:49:10 Simon Josefsson + + * mailcap.el (mailcap-save-binary-file): Goto point-min. + +1998-09-23 19:48:52 Aaron M. Ucko + + * nnmail.el (nnmail-check-duplication): Enter into duplicate list + after being stored. + +Tue Sep 15 16:15:16 1998 Kurt Swanson + + * gnus-salt.el (gnus-pick-setup-message): Return from whence ye + come. + +1998-09-23 19:42:03 Lars Magne Ingebrigtsen + + * gnus-xmas.el (wid-edit): Required. + + * gnus-ems.el (gnus-widget-button-keymap): New variable. + +Sun Sep 20 00:27:55 1998 ZHU Shenghuo + + * gnus-art.el (gnus-mime-inline-part): remove part if necessary + +1998-09-23 19:30:52 Matt Armstrong + + * gnus-art.el (article-decode-charset): Narrow to the correct + region. + + * mm-bodies.el: Fix autoload. + +1998-09-22 18:35:12 Lee Willis + + * gnus-art.el (gnus-mime-button-line-format): Doc fix. + +1998-09-22 14:53:35 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-decode): Use rfc2047-default-charset. + +1998-09-19 13:58:35 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-insert-mime-button): Specify keymap. + (gnus-article-add-button): Ditto. + + * gnus-sum.el (gnus-summary-insert-pseudos): Use mm. + + * gnus-art.el (gnus-article-prepare-display): Make article mode. + (gnus-article-prepare-display): Bind url-standalone-mode. + + * mm-decode.el (mm-remove-part): Also delete directory. + (mm-display-external): Create a private sub-dir. + + * mailcap.el (mailcap-binary-suffixes): New variable. + (mailcap-command-p): Use it. + +1998-09-16 10:38:21 Lars Magne Ingebrigtsen + + * nnmbox.el (nnmbox-request-group): Change server. + (nnmbox-possibly-change-newsgroup): Enable multibyte. + + * message.el (message-encode-message-body): Don't stomp MIME + headers. + + * gnus-sum.el (gnus-summary-edit-article-done): Don't encode + unless useful. + (gnus-summary-exit): Check for a live article buffer. + (gnus-summary-exit-no-update): Ditto. + + * gnus-int.el (gnus-request-replace-article): Accept no-encode + param. + + * gnus-sum.el (gnus-article-decoded-p): New variable. + + * mm-decode.el (mm-display-external): Use no-conv. + + * rfc2047.el (rfc2047-q-encode-region): Bound properly. + (rfc2047-charset-encoding-alist): Use B encoding for koi8-r. + + * gnus-art.el (gnus-article-mode-map): Bind button2 to + mouse-click. + +1998-09-15 14:38:02 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-expire): Protect against nil infos. + +Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.31 is released. + +1998-09-14 15:12:59 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-exit): Destroy MIME. + + * mm-decode.el (mm-display-part): Accept no-default. + + * gnus-art.el (gnus-insert-mime-button): buffer-size doesn't take + a parameter. + + * gnus-sum.el (gnus-summary-insert-line): Don't exclude faces. + (gnus-summary-prepare-threads): Ditto. + + * gnus.el (gnus-article-mode-map): Make sparse keymap. + + * gnus-art.el (gnus-mime-button-line-format-alist): Allow a %d spec. + (gnus-mime-button-line-format): Doc fix. + (gnus-insert-mime-button): Use it. + (gnus-article-add-button): Use widget-convert-button. + + * gnus.el ((featurep 'gnus-xmas)): Defalias gnus-decode-rfc1522 to + ignore. + + * mm-decode.el (mm-alternative-precedence): Ditto. + +1998-09-14 15:12:49 Conrad Sauerwald + + * mm-decode.el (mm-user-automatic-display): Use enriched. + +1998-09-14 15:09:12 Paul Fisher + + * mm-decode.el (mm-dissect-multipart): Have the part start on the + right place. + +1998-09-14 14:33:34 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-add-send-actions): Mark silently. + + * gnus-art.el (article-update-date-lapsed): Only update header if + buffer is dispalyed in frame. + (gnus-article-prepare-display): New function. + (gnus-article-prepare): Use it. + +1998-09-14 08:16:43 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-inline-part): New command and keystroke. + + * mm-view.el (mm-insert-inline): New function. + + * mm-decode.el (mm-pipe-part): Bugged. + + * gnus-agent.el (gnus-agent-send-mail): Don't encode. + + * mm-bodies.el (mm-encode-body): Move over the body. + + * nnmbox.el (nnmbox-read-mbox): Enable multibyte. + + * rfc2047.el (rfc2047-q-encode-region): Would bug out. + +1998-09-13 Francois Pinard + + * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all + related functions. Handle message/rfc822 parts. Display subject on + multipart summary lines. Display name on sub-parts when available. + +1998-09-14 07:36:38 Hallvard B. Furuseth + + * mailcap.el (mailcap-command-p): New version. + +1998-09-13 Mike McEwan + + * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed + groups. + +1998-09-13 18:34:06 Lars Magne Ingebrigtsen + + * message.el (message-make-date): Remove weekday name. + + * mm-decode.el (mm-dissect-buffer): Protect against broken + headers. + + * mailcap.el (mailcap-command-in-path-p): New function. + (mailcap-command-p): Renamed. + +1998-09-13 17:58:47 Hallvard B. Furuseth + + * rfc2047.el (eval): Autoload. + +1998-09-13 12:22:40 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-decode-encoded-word-functions): New variable. + (gnus-multi-decode-encoded-word-string): New function. + (gnus-encoded-word-method-alist): New variable. + (gnus-decode-encoded-word-functions): Removed. + +1998-09-13 Shenghuo ZHU + + * gnus-int.el (gnus-request-replace-article): Replace + message-narrow-to-headers with message-narrow-to-head + +1998-09-13 12:05:41 Lars Magne Ingebrigtsen + + * drums.el (drums-quote-string): Reversed match. + + * message.el (message-make-date): Use weekday name. + +Sun Sep 11 10:27:15 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.30 is released. + +1998-09-13 08:00:41 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-encoded-words): Use it. + (gnus-decode-header-function): New variable. + + * gnus-sum.el (gnus-nov-parse-line): Use it. + (gnus-decode-encoded-word-function): New variable. + + * gnus-msg.el (gnus-copy-article-buffer): Decode the right + buffer. + + * gnus-art.el (gnus-insert-mime-button): Use widget. + (gnus-widget-press-button): New function. + (gnus-article-prev-button): Removed. + (gnus-article-next-button): Ditto. + (gnus-article-add-button): Ditto. + + * gnus.el (gnus-article-mode-map): Inherit from widget. + (gnus-article-mode-map): No, don't. + + * mm-decode.el (mm-dissect-buffer): Store Content-ID things. + (mm-content-id-alist): New variable. + (mm-get-content-id): New function. + + * gnus-art.el (gnus-request-article-this-buffer): Only decode + articles if we are fetching to the article buffer. + +1998-09-13 07:58:59 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-move-article): Don't decode accepting + articles. + +1998-09-13 07:23:28 Lars Magne Ingebrigtsen + + * mm-util.el (mm-mime-charset): Try to use safe-charsets. + (mm-default-mime-charset): New variable. + + * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials. + + * drums.el (drums-quote-string): Reversed test. + +1998-09-12 14:29:21 Lars Magne Ingebrigtsen + + * mm-util.el (mm-insert-rfc822-headers): Possibly not quote + string. + + * drums.el (drums-quote-string): New function. + + * rfc2047.el (rfc2047-encode-message-header): Goto point-min. + (rfc2047-b-encode-region): Chop lines. + (rfc2047-q-encode-region): Ditto. + +Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.29 is released. + +1998-09-12 12:46:30 Istvan Marko + + * mm-decode.el (mm-save-part): Message right. + +1998-09-12 11:30:01 Lars Magne Ingebrigtsen + + * drums.el (drums-parse-address): Returned a list instead of a + string. + (drums-remove-whitespace): Skip comments. + (drums-parse-addresses): Didn't work. + +Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.28 is released. + +1998-09-12 04:57:25 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-button-map): Use the article keymap as a + starting point. + (article-decode-encoded-words): Rename. + + * message.el (message-narrow-to-headers-or-head): New function. + + * gnus-int.el (gnus-request-accept-article): Narrow to the right + region. + + * message.el (message-send-news): Encode body after checking + syntax. + + * gnus-art.el (gnus-mime-button-line-format): Allow descriptions. + + * mm-decode.el (mm-save-part): Use Content-Disposition filename. + + * gnus-art.el (gnus-display-mime): Respect disposition. + + * mm-decode.el (mm-preferred-alternative): Respect disposition. + + * gnus-art.el (article-strip-multiple-blank-lines): Don't delete + text with annotations. + + * message.el (message-make-date): Fix sign for negative time + zones. + + * mm-view.el (mm-inline-image): Insert a space at the end of the + image. + + * mail-parse.el: New file. + + * rfc2231.el: New file. + + * drums.el (drums-content-type-get): Removed. + (drums-parse-content-type): Ditto. + + * mailcap.el (mailcap-mime-data): Use symbols instead of strings. + +Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.27 is released. + +1998-09-11 12:42:07 Lars Magne Ingebrigtsen- + + * mm-decode.el (mm-alternative-precedence): New variable. + (mm-preferred-alternative): New function. + + * gnus-art.el (gnus-mime-copy-part): New command. + + * mm-decode.el (mm-get-part): New function. + + * mm-view.el: New file. + + * mm-decode.el (mm-dissect-buffer): Downcase cte. + (mm-display-part): Default to mailcap-save-binary-file. + +Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.26 is released. + +1998-09-11 08:25:33 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-interactively-view-part): New function. + + * gnus-art.el (gnus-mime-view-part): New command. + + * mm-decode.el (mm-last-shell-command): New variable. + + * mailcap.el (mailcap-mime-info): Allow returning all matches. + + * mm-decode.el (mm-save-part): New function. + + * gnus-art.el (article-decode-charset): Protect against buggy + content-types. + (gnus-mime-pipe-part): New command. + (gnus-mime-save-part): New command. + (gnus-mime-button-map): New keymap. + (gnus-mime-button-line-format): New variable. + (gnus-insert-mime-button): New function. + (gnus-display-mime): Use it. + + * gnus-util.el (gnus-dd-mmm): Removed length spec. + + * mm-decode.el (mm-inline-text): Decode charsets. + + * gnus-art.el (gnus-article-save): Comment fix. + + * gnus-int.el (gnus-start-news-server): When in batch, don't + prompt. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Don't + decode. + + * mm-decode.el (mm-inline-media-tests): Add audio. + (mm-inline-audio): New function. + +1998-09-11 08:19:22 Katsumi Yamaoka + + * gnus-art.el (article-make-date-line): Didn't work. + + * parse-time.el (parse-time-string): One too many nils. + +Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.25 is released. + +1998-09-11 07:38:14 Lars Magne Ingebrigtsen + + * gnus-art.el (article-remove-trailing-blank-lines): Don't remove + annotations. + + * gnus.el ((featurep 'gnus-xmas)): New + 'gnus-annotation-in-region-p alias. + +1998-09-10 06:20:52 Lars Magne Ingebrigtsen + + * mm-util.el (mm-with-unibyte-buffer): New function. + + * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Renamed. + + * mm-decode.el (mm-inline-media-tests): New variable. + + * gnus-sum.el (gnus-summary-exit): Destroy handles. + + * gnus-art.el (gnus-article-mime-handles): New variable. + + * drums.el (drums-narrow-to-header): New function. + + * gnus-art.el (article-decode-charset): Use it. + + * drums.el (drums-content-type-get): New function. + + * mm-util.el (mm-content-type-charset): Removed. + + * drums.el (drums-syntax-table): @ is word. + (drums-parse-content-type): New function. + + * parse-time.el (parse-time-rules): Parse "Wed, 29 Apr 98 0:26:01 + EDT" times. + + * gnus-util.el (gnus-date-get-time): Use safe date. + + * gnus-sum.el (gnus-show-mime): Removed. + (gnus-summary-toggle-mime): Removed. + + * gnus-art.el (gnus-strict-mime): Removed. + (gnus-article-prepare): Don't do MIME. + (gnus-decode-encoded-word-method): Removed. + (gnus-show-mime-method): Removed. + +Thu Sep 10 04:03:29 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.24 is released. + +1998-09-10 01:58:24 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-show-article): Don't decode chars if + PREFIX. + + * parse-time.el (parse-time-rules): Accept times that look like + "h:mm". + + * message.el (message-make-date): Use zone properly. + + * gnus.el: Autoload gnus-batch. + + * gnus-art.el (article-de-quoted-unreadable): Do not do + gnus-article-decode-rfc1522. + + * gnus-msg.el (gnus-inews-do-gcc): Use it. + + * gnus-int.el (gnus-request-accept-article): Accept a no-encode + param. + + * message.el (message-encode-message-body): Check for us-ascii. + + * gnus-msg.el (gnus-extended-version): Move Gnus version comments + to the left. + +1998-09-09 13:18:13 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-charset): Rename. + +Wed Sep 9 12:25:48 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.23 is released. + +1998-09-09 12:14:47 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-parent-id): Ditto. + (gnus-put-text-property-excluding-newlines): Ditto. + + * gnus-sum.el (gnus-dependencies-add-header): Make into subst. + +1998-09-08 Karl Kleinpaste + + * message.el (message-generate-headers): Generate User-Agent + instead of X-Mailer & X-Newsreader. + + * gnus-msg.el (gnus-extended-version): Reformat for USEFOR + User-Agent header format. + +Tue Sep 8 22:38:27 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.22 is released. + +1998-09-08 22:36:54 Lars Magne Ingebrigtsen + + * mm-util.el (mm-multibyte-p): Typo. + +Tue Sep 8 22:25:53 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.21 is released. + +1998-09-08 Hrvoje Niksic + + * gnus-art.el (article-treat-dumbquotes): Handle \224 correctly. + +1998-09-08 22:18:03 Lars Magne Ingebrigtsen + + * mm-util.el (mm-multibyte-p): New function. + +Tue Sep 8 21:43:03 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.20 is released. + +1998-09-08 11:40:45 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-decode-region): Only decode when in + multibyte. + + * nnheader.el (nnheader-pathname-coding-system): Changed to binary. + + * gnus-int.el (gnus-request-replace-article): Encode. + (gnus-request-accept-article): Encode. + + * gnus-art.el (gnus-request-article-this-buffer): Decode charsets + here. + + * gnus.el (gnus-article-display-hook): Take the charset functions + out. + + * time-date.el (safe-date-to-time): New function. + + * gnus-util.el (gnus-dd-mmm): Protect against bogus dates. + +Tue Sep 8 07:09:28 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.19 is released. + +1998-09-08 04:51:39 Lars Magne Ingebrigtsen + + * base64.el (base64-encode-region): Accept no-line-break. + + * mm-util.el (mm-mime-charset): New function. + + * gnus-draft.el (gnus-draft-edit-message): Delete article. + +Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.18 is released. + +1998-09-08 02:21:36 Lars Magne Ingebrigtsen + + * message.el (message-send-and-exit): Return t on success. + (message-make-date): Make a proper time zone. + + * gnus-draft.el (gnus-draft-send): Only remove article if the + sending is successful. + + * drums.el (drums-get-comment): Return the last comment. + (drums-parse-address): Parse old-style From headers. + +1998-09-07 SL Baur + + * gnus-sum.el (gnus-data-compute-positions): Move below + `gnus-save-hidden-threads' so the former is correctly detected as + a macro. + +1998-09-06 Dave Love + + * gnus/nnweb.el (require): Wrap requirement of w3 and url in + ignore-errors too, eval'd when compile. Require w3 stuff at load + time for nicer failure if it's not available. + +1998-09-08 00:38:39 Lars Magne Ingebrigtsen + + * time-date.el (time-to-seconds): Renamed. + + * parse-time.el (parse-time-string): Downcase before handling. + (parse-time-rules): Times without seconds have 0 seconds. + + * rfc2047.el (rfc2047-encode-region): New version. + (rfc2047-dissect-region): New function. + +1998-09-07 01:08:35 Lars Magne Ingebrigtsen + + * message.el (message-make-date): Use symbolic zone. + +1998-09-06 23:23:06 Lars Magne Ingebrigtsen + + * time-date.el (parse-time): Always use parse-time. + + * parse-time.el (parse-time-syntax): Use vectors. + +Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.17 is released. + +1998-09-06 05:45:17 Lars Magne Ingebrigtsen + + * time-date.el: Renamed from "date". + + * gnus.el: Removed all timezone dependencies. + + * score-mode.el: Removed. + (gnus-score-edit-insert-date): Use date. + + * date.el (float-to-time): New function. + + * nnspool.el (nnspool-seconds-since-epoch): Removed. + + * date.el (time-to-float): New function. + + * message.el (message-make-date): Use format-time-string. + (message-make-expires): Use make-date. + + * gnus-xmas.el (gnus-xmas-seconds-since-epoch): Removed. + + * gnus-util.el (gnus-dd-mmm): Use date. + (gnus-sortable-date): Ditto. + + * message.el (message-make-date): Take an optional time. + + * gnus: Applied patches from 5.6.43. + + * date.el (if): Use parse-time. + + * gnus-score.el (gnus-summary-score-entry): Make into a command + again. + + * gnus-group.el (gnus-group-get-new-news-this-group): Only call if + gnus-agent. + + * gnus.el (gnus-agent-meta-information-header): Moved here. + +1998-09-05 Mike McEwan + + * gnus-agent.el (gnus-agent-scoreable-headers): New variable. + (gnus-agent-fetch-group-1): Score article headers using normal + group score files if the download score rule of a category/group + is `file'. + (gnus-agent-fetch-group-1): Don't parse the entire .overview when + deciding what articles to download. + (gnus-agent-fetch-group-1): Don't push headers through scoring and + predicate processing if predicate is `true' or `false'. + +1998-09-06 01:56:02 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-load-score-alist): Bind coding system. + + * gnus-art.el (gnus-article-setup-buffer): Enable multibyte. + + * score-mode.el (score-mode-coding-system): New variable. + (gnus-score-edit-exit): Use it. + +1998-09-04 Jason R Mastaler + + * drums.el: Corrected typo. + +1998-09-05 23:24:43 Hallvard B. Furuseth + + * mm-bodies.el (mm-body-encoding): Faster version. + +1998-09-05 22:23:03 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-decode-charset): Only decode text + things. + + * message.el (message-output): Use rmail. + + * rfc2047.el (rfc2047-encoded-word-regexp): Allow spaces in the + word part. + + * mm-util.el (mm-charset-to-coding-system): Use + rfc2047-default-charset. + (mm-known-charsets): New variable. + + * message.el (message-caesar-region): Bugged out. + +1998-09-06 Mike McEwan + + * gnus-agent.el (gnus-agent-fetch-group-1): Allow lists when + specifying `agent-predicate' in a group's parameters. + +Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.16 is released. + +1998-09-05 17:30:11 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-expired-article-p): Use predicate. + + * date.el (time-less-p): Renamed. + + * gnus-art.el (gnus-article-decode-charset): Really fetch headers + from the headers. + + * rfc2047.el (rfc2047-decode-region): Use the mm decoding + functions. + + * gnus-group.el (gnus-group-sort-selected-flat): Didn't work at + all. + (gnus-group-sort-selected-groups-by-alphabet): Changed interface + to all functions. + +Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.15 is released. + +1998-09-05 00:21:22 Lars Magne Ingebrigtsen + + * date.el: New file. + + * gnus-util.el (gnus-encode-date): Removed. + (gnus-time-less): Ditto. + + * nnmail.el (nnmail-date-to-time): Removed. + (nnmail-time-less): Ditto. + (nnmail-days-to-time): Ditto. + (nnmail-time-since): Ditto. + + * drums.el: New file. + +1998-09-04 00:25:52 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Encode headers with + body encoding. + + * rfc2047.el (rfc2047-default-charset): Renamed. + (rfc2047-encodable-p): Use it. + + * base64.el (mm-util): Required. + +1998-09-03 16:28:30 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-post-method): Peel off real info from opened + servers. + + * gnus-util.el (gnus-output-to-rmail): Removed. + + * gnus-art.el (gnus-summary-save-in-rmail): Use + gnus-output-to-rmailrmail-output-to-rmail-file. + + * rfc2047.el (rfc2047-decode-region): Fold case. + (rfc2047-decode): Use decode-string. + + * mm-util.el: Provide mm-char-int. + +Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.14 is released. + +1998-09-03 15:08:30 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-body-encoding): Go through the buffer to make + sure we have 7bit. + +1998-09-02 14:38:18 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-post-method): Use opened servers, and remove + ducplicates. + (gnus-inews-insert-mime-headers): Removed. + + * message.el (message-caesar-region): Protect against MULE chars. + +1998-09-02 00:36:23 Hallvard B. Furuseth + + * mm-util.el (if): fset the right function. + +1998-09-02 00:31:53 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-decode-charset): Use real + read-coding-system. + +1998-09-01 17:58:40 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-body): Protect against malformed + base64. + (mm-decode-body): Check that buffer-file-coding-system is + non-nil. + +Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.13 is released. + +1998-09-01 09:14:33 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-strip-whitespace): Already defined. + Removed. + + * gnus-art.el (gnus-article-decode-charset): Strip whitespace. + + * gnus-util.el (gnus-strip-whitespace): New function. + + * mm-util.el (mm-content-type-charset): Downcase. + +1998-08-31 23:04:29 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-decode-charset): Accept a prefix. + (gnus-article-decode-charset): Don't fetch all headers. + + * mm-util.el (mm-read-coding-system): New function. + + * mm-bodies.el (mm-decode-body): Check the right charset. + + * gnus-sum.el (gnus-summary-mode-line-format): Ditto. + + * gnus-art.el (gnus-article-mode-line-format): Use short group + format. + +Mon Aug 31 23:03:13 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.12 is released. + +1998-08-31 22:39:36 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-body): Don't do charset unless MULE. + + * gnus-art.el (gnus-article-decode-charset): Supply cte. + (gnus-article-decode-charset): Always run. + + * mm-bodies.el (mm-decode-body): Decode cte. + +Mon Aug 31 22:14:50 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.11 is released. + +1998-08-31 14:27:25 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Ditto. + + * gnus-art.el (gnus-article-decode-mime-words): New command and + keystroke. + (gnus-article-decode-charset): Ditto. + (gnus-article-decode-charset): Only work under MULE. + + * mm-util.el (mm-content-type-charset): New function. + + * nnmail.el (nnmail-delete-incoming): Changed to nil. + + * message.el (message-send-mail): Insert MIME headers. + (message-check-news-body-syntax): Don't warn for escape sequences. + (message-check-news-body-syntax): Insert MIME headers. + + * mm-bodies.el (mm-body-encoding): New function. + + * message.el (message-encode-message-body): New function. + + * mm-bodies.el: New file. + + * mm-util.el (mm-narrow-to-head): New function. + + * rfc2047.el (rfc2047-encode): Use it. + + * mm-util.el: Provide mm-encode-coding-region. + + * gnus-sum.el (gnus-summary-mode): Enable multibyte. + + * gnus-util.el (gnus-set-work-buffer): Enable multibyte. + + * mm-util.el (mm-enable-multibyte): New function. + + * message.el (message-set-work-buffer): Set multibyte. + + * gnus.el (gnus-continuum-version): Be valid forever and ever. + + * gnus-util.el (gnus-point-at-eol): Removed. + (gnus-point-at-bol): Ditto. + + * base64.el (base64-decode-region): Commented out messaging. + +1998-08-31 Didier Verna + + * gnus-msg.el (gnus-group-mail): make it behave like + gnus-group-post-news with regards to the prefix (this enables the + use of posting styles). + +1998-08-31 12:53:32 Lars Magne Ingebrigtsen + + * gnus.el (gnus-article-display-hook): Added + gnus-article-decode-rfc1522 to hook. + +Mon Aug 31 12:43:46 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.10 is released. + +1998-08-31 11:45:13 Lars Magne Ingebrigtsen + + * nnfolder.el (nnfolder-delete-mail): Narrow to mail and allow + hook to be run. + +1998-08-30 17:59:07 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-encodable-p): Use find-charset-region. + + * mm-util.el (mm-charsets-in-region): Removed. + + * rfc2047.el: Renamed file. + + * gnus-msg.el (gnus-copy-article-buffer): Multibyte. + + * message.el (message-mode): Set multibyte. + + * mm-util.el (mm-charsets-in-region): Copied here. + + * gnus-util.el: Removed gnus-truncate-string. + + * gnus-art.el (gnus-article-decode-mime-words): Use 1522. + + * rfc1522.el (rfc1522-unencoded-charsets): New variable. + (rfc1522-encodable-p): New function. + (rfc1522-encode-message-header): Use it. + +Sun Aug 30 17:46:01 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.9 is released. + +1998-08-30 16:13:08 Lars Magne Ingebrigtsen + + * mm-util.el: Shadow encode-coding-string. + + * base64.el (base64-encode-region): Don't add newline. + + * rfc1522.el (rfc1522-narrow-to-field): Copied here. + + * mm-util.el: New file. + + * mm-decode.el: Somewhat depleted. + * mm-encode.el: Ditto. + + * rfc1522.el: New file. + + * mm-util.el (mm-replace-chars-in-string): Copied here. + + * mm-encode.el (mm-q-encode-region): New function. + + * qp.el (quoted-printable-encode-region): Take an optional CLASS + param. + + * mm-encode.el (mm-encode-word-region): Downcase. + +Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.8 is released. + +1998-08-30 12:23:03 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Encode headers. + + * qp.el (quoted-printable-encode-region): Encode 8-bit words. + (quoted-printable-encode-region): Upcase. + + * message.el (message-default-charset): New variable. + + * qp.el (quoted-printable-encode-region): Optional param FOLD. + + * message.el (message-narrow-to-field): Changed name. + + * mm-encode.el: New file. + + * message.el (message-narrow-to-header): New function. + + * gnus-art.el (gnus-article-decode-mime-words): Place point in the + right buffer. + +Sun Aug 30 12:15:54 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.7 is released. + +1998-08-30 01:26:12 Lars Magne Ingebrigtsen + + * gnus.el: Remove autoload for + gnus-article-mime-decode-quoted-printable. + + * mm-decode.el (mm-charset-to-coding-system): Allow iso-8859-1 to + be decoded in non-MULE Emacsen. + + * gnus-xmas.el (gnus-xmas-logo-color-alist): More brown. + +1998-08-29 SL Baur + + * gnus-xmas.el (gnus-xmas-logo-color-alist): Try shades of brown. + +1998-08-30 01:04:57 Lars Magne Ingebrigtsen + + * mm-decode.el: Check for coding-system-list. + +Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.6 is released. + +1998-08-30 00:36:28 Lars Magne Ingebrigtsen + + * nnheader.el (fboundp): Protect code-coding-string. + + * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte + is available. + +Sat Aug 29 23:24:31 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.5 is released. + +1998-08-29 22:38:35 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-mode): Make article buffer multibyte. + (gnus-hack-decode-rfc1522): Removed. + + * mm-decode.el (mm-charset-coding-system-alist): Check better. + +Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v0.4 is released. + +1998-08-29 20:53:29 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-decode-mime-words): New command and + keystroke. + + * qp.el (quoted-printable-decode-region): Don't use hexl. + + * gnus-xmas.el (gnus-xmas-logo-color-style): Changed to dino. + + * gnus-sum.el (gnus-parse-headers-hook): Default to nil. + (gnus-structured-field-decoder): Removed. + (gnus-unstructured-field-decoder): Ditto. + + * mm-decode.el: New file. + + * qp.el: New file. + + * gnus-art.el (article-mime-decode-quoted-printable): Removed. + + * gnus-ems.el (fboundp): Removed gnus-split-string. + + * gnus.el (gnus-splash-face): Doc fix. + + * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p. + + * gnus-art.el (article-mime-decode-quoted-printable): Don't use + hexl. + + * nnheader.el (nnheader-temp-write): Removed. + +Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v0.3 is released. + +Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v0.2 is released. + +;; Local Variables: +;; coding: iso-2022-7bit +;; End: diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 2672f43..fa8df3b 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -12,41 +12,52 @@ INSTALL_DATA = @INSTALL_DATA@ SHELL = /bin/sh VPATH = @srcdir@ PACKAGEDIR = @PACKAGEDIR@ +W3DIR = @W3@ +GNUS_PRODUCT_NAME = @GNUS_PRODUCT_NAME@ +EXPORTING_FILES = $(EMACS) $(FLAGS) -f dgnushack-exporting-files 2>/dev/null all total: rm -f *.elc auto-autoloads.el custom-load.el - srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile + W3DIR=$(W3DIR) lispdir=$(lispdir) \ + srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile warn: rm -f *.elc - srcdir=$(srcdir) $(EMACS) $(FLAGS) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max" + W3DIR=$(W3DIR) lispdir=$(lispdir) srcdir=$(srcdir) $(EMACS) $(FLAGS) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max" # The "clever" rule is unsafe, since redefined macros are loaded from # .elc files, and not the .el file. clever some: - srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile + W3DIR=$(W3DIR) lispdir=$(lispdir) \ + srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile -install: clever - rm -f dgnushack.elc +install: clever install-lisp + +install-lisp: $(SHELL) $(top_srcdir)/mkinstalldirs $(lispdir) - @for p in *.el; do \ - if test "$$p" != "dgnuspath.el"; then \ - echo " $(INSTALL_DATA) $$p $(lispdir)/$$p"; \ - $(INSTALL_DATA) $$p $(lispdir)/$$p; \ - if test -f $$p"c"; then \ - echo " $(INSTALL_DATA) $$p""c"" $(lispdir)/$$p""c"; \ - $(INSTALL_DATA) $$p"c" $(lispdir)/$$p"c"; \ - fi; \ + @for p in `$(EXPORTING_FILES)`; do \ + echo " $(INSTALL_DATA) $$p $(lispdir)/$$p"; \ + $(INSTALL_DATA) $$p $(lispdir)/$$p; \ + if test -f $$p"c"; then \ + echo " $(INSTALL_DATA) $$p""c"" $(lispdir)/$$p""c"; \ + $(INSTALL_DATA) $$p"c" $(lispdir)/$$p"c"; \ fi; \ done -package: - srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-make-package +# Rule for XEmacs package. +install-package-manifest: + srcdir=$(srcdir) $(EMACS) $(FLAGS) \ + -f dgnushack-install-package-manifest \ + $(PACKAGEDIR) $(GNUS_PRODUCT_NAME) + +compose-package: + srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-make-autoloads -install-package: clever - rm -f dgnushack.elc - srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-make-package \ - -f dgnushack-install-package $(PACKAGEDIR) +remove-extra-files-in-package: + srcdir=$(srcdir) $(EMACS) $(FLAGS) \ + -f dgnushack-remove-extra-files-in-package \ + $(PACKAGEDIR) $(GNUS_PRODUCT_NAME) +# tags: etags *.el diff --git a/lisp/base64.el b/lisp/base64.el index a396808..7754162 100644 --- a/lisp/base64.el +++ b/lisp/base64.el @@ -1,278 +1,54 @@ -;;; base64.el,v --- Base64 encoding functions -;; Author: Kyle E. Jones -;; Created: 1997/03/12 14:37:09 -;; Version: 1.6 -;; Keywords: extensions - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (C) 1997 Kyle E. Jones -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'poe) - -;; For non-MULE -(if (not (fboundp 'char-int)) - (fset 'char-int 'identity)) - -(defvar base64-alphabet - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") +;;; base64.el --- Base64 encoding functions using MEL +;; Copyright (C) 2000 Free Software Foundation, Inc. -(defvar base64-decoder-program nil - "*Non-nil value should be a string that names a MIME base64 decoder. -The program should expect to read base64 data on its standard -input and write the converted data to its standard output.") - -(defvar base64-decoder-switches nil - "*List of command line flags passed to the command named by -base64-decoder-program.") - -(defvar base64-encoder-program nil - "*Non-nil value should be a string that names a MIME base64 encoder. -The program should expect arbitrary data on its standard -input and write base64 data to its standard output.") - -(defvar base64-encoder-switches nil - "*List of command line flags passed to the command named by -base64-encoder-program.") +;; Author: T-gnus development team +;; Keywords: extensions -(defconst base64-alphabet-decoding-alist - '( - ( ?A . 00) ( ?B . 01) ( ?C . 02) ( ?D . 03) ( ?E . 04) ( ?F . 05) - ( ?G . 06) ( ?H . 07) ( ?I . 08) ( ?J . 09) ( ?K . 10) ( ?L . 11) - ( ?M . 12) ( ?N . 13) ( ?O . 14) ( ?P . 15) ( ?Q . 16) ( ?R . 17) - ( ?S . 18) ( ?T . 19) ( ?U . 20) ( ?V . 21) ( ?W . 22) ( ?X . 23) - ( ?Y . 24) ( ?Z . 25) ( ?a . 26) ( ?b . 27) ( ?c . 28) ( ?d . 29) - ( ?e . 30) ( ?f . 31) ( ?g . 32) ( ?h . 33) ( ?i . 34) ( ?j . 35) - ( ?k . 36) ( ?l . 37) ( ?m . 38) ( ?n . 39) ( ?o . 40) ( ?p . 41) - ( ?q . 42) ( ?r . 43) ( ?s . 44) ( ?t . 45) ( ?u . 46) ( ?v . 47) - ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53) - ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59) - ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63) - )) +;; This file is part of T-gnus. -(defvar base64-alphabet-decoding-vector - (let ((v (make-vector 123 nil)) - (p base64-alphabet-decoding-alist)) - (while p - (aset v (car (car p)) (cdr (car p))) - (setq p (cdr p))) - v)) +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. -(defvar base64-binary-coding-system 'binary) +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. -(defun base64-run-command-on-region (start end output-buffer command - &rest arg-list) - (let ((tempfile nil) status errstring default-process-coding-system - (coding-system-for-write base64-binary-coding-system) - (coding-system-for-read base64-binary-coding-system)) - (unwind-protect - (progn - (setq tempfile (make-temp-name "base64")) - (setq status - (apply 'call-process-region - start end command nil - (list output-buffer tempfile) - nil arg-list)) - (cond ((equal status 0) t) - ((zerop (save-excursion - (set-buffer (find-file-noselect tempfile)) - (buffer-size))) - t) - (t (save-excursion - (set-buffer (find-file-noselect tempfile)) - (setq errstring (buffer-string)) - (kill-buffer nil) - (cons status errstring))))) - (ignore-errors - (delete-file tempfile))))) +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -(if (string-match "XEmacs" emacs-version) - (defalias 'base64-insert-char 'insert-char) - (defun base64-insert-char (char &optional count ignored buffer) - (if (or (null buffer) (eq buffer (current-buffer))) - (insert-char char count) - (with-current-buffer buffer - (insert-char char count)))) - (setq base64-binary-coding-system 'raw-text)) +;;; Commentary: -(defun-maybe base64-decode-region (start end) - (interactive "r") - ;;(message "Decoding base64...") - (let ((work-buffer nil) - (done nil) - (counter 0) - (bits 0) - (lim 0) inputpos - (non-data-chars (concat "^=" base64-alphabet))) - (unwind-protect - (save-excursion - (setq work-buffer (generate-new-buffer " *base64-work*")) - (buffer-disable-undo work-buffer) - (if base64-decoder-program - (let* ((binary-process-output t) ; any text already has CRLFs - (status (apply 'base64-run-command-on-region - start end work-buffer - base64-decoder-program - base64-decoder-switches))) - (if (not (eq status t)) - (error "%s" (cdr status)))) - (goto-char start) - (skip-chars-forward non-data-chars end) - (while (not done) - (setq inputpos (point)) - (cond - ((> (skip-chars-forward base64-alphabet end) 0) - (setq lim (point)) - (while (< inputpos lim) - (setq bits (+ bits - (aref base64-alphabet-decoding-vector - (char-int (char-after inputpos))))) - (setq counter (1+ counter) - inputpos (1+ inputpos)) - (cond ((= counter 4) - (base64-insert-char (lsh bits -16) 1 nil work-buffer) - (base64-insert-char (logand (lsh bits -8) 255) 1 nil - work-buffer) - (base64-insert-char (logand bits 255) 1 nil - work-buffer) - (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))))) - (cond - ((= (point) end) - (if (not (zerop counter)) - (error "at least %d bits missing at end of base64 encoding" - (* (- 4 counter) 6))) - (setq done t)) - ((eq (char-after (point)) ?=) - (setq done t) - (cond ((= counter 1) - (error "at least 2 bits missing at end of base64 encoding")) - ((= counter 2) - (base64-insert-char (lsh bits -10) 1 nil work-buffer)) - ((= counter 3) - (base64-insert-char (lsh bits -16) 1 nil work-buffer) - (base64-insert-char (logand (lsh bits -8) 255) - 1 nil work-buffer)) - ((= counter 0) t))) - (t (skip-chars-forward non-data-chars end))))) - (or (markerp end) (setq end (set-marker (make-marker) end))) - (goto-char start) - (insert-buffer-substring work-buffer) - (delete-region (point) end)) - (and work-buffer (kill-buffer work-buffer)))) - ;;(message "Decoding base64... done") - ) +;;; Code: -(defun-maybe base64-encode-region (start end &optional no-line-break) - (interactive "r") - (message "Encoding base64...") - (let ((work-buffer nil) - (counter 0) - (cols 0) - (bits 0) - (alphabet base64-alphabet) - inputpos) - (unwind-protect - (save-excursion - (setq work-buffer (generate-new-buffer " *base64-work*")) - (buffer-disable-undo work-buffer) - (if base64-encoder-program - (let ((status (apply 'base64-run-command-on-region - start end work-buffer - base64-encoder-program - base64-encoder-switches))) - (if (not (eq status t)) - (error "%s" (cdr status)))) - (setq inputpos start) - (while (< inputpos end) - (setq bits (+ bits (char-int (char-after inputpos)))) - (setq counter (1+ counter)) - (cond ((= counter 3) - (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil - work-buffer) - (base64-insert-char - (aref alphabet (logand (lsh bits -12) 63)) - 1 nil work-buffer) - (base64-insert-char - (aref alphabet (logand (lsh bits -6) 63)) - 1 nil work-buffer) - (base64-insert-char - (aref alphabet (logand bits 63)) - 1 nil work-buffer) - (setq cols (+ cols 4)) - (cond ((and (= cols 72) - (not no-line-break)) - (base64-insert-char ?\n 1 nil work-buffer) - (setq cols 0))) - (setq bits 0 counter 0)) - (t (setq bits (lsh bits 8)))) - (setq inputpos (1+ inputpos))) - ;; write out any remaining bits with appropriate padding - (if (= counter 0) - nil - (setq bits (lsh bits (- 16 (* 8 counter)))) - (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil - work-buffer) - (base64-insert-char (aref alphabet (logand (lsh bits -12) 63)) - 1 nil work-buffer) - (if (= counter 1) - (base64-insert-char ?= 2 nil work-buffer) - (base64-insert-char (aref alphabet (logand (lsh bits -6) 63)) - 1 nil work-buffer) - (base64-insert-char ?= 1 nil work-buffer))) - (if (and (> cols 0) - (not no-line-break)) - (base64-insert-char ?\n 1 nil work-buffer))) - (or (markerp end) (setq end (set-marker (make-marker) end))) - (goto-char start) - (insert-buffer-substring work-buffer) - (delete-region (point) end)) - (and work-buffer (kill-buffer work-buffer)))) - (message "Encoding base64... done")) +(eval-and-compile + (defun base64-autoload-functionp (object) + (if (functionp object) + (let ((def object)) + (while (and (symbolp def) (fboundp def)) + (setq def (symbol-function def))) + (eq (car-safe def) 'autoload)))) -(defun base64-encode (string) - (save-excursion - (set-buffer (get-buffer-create " *base64-encode*")) - (erase-buffer) - (insert string) - (base64-encode-region (point-min) (point-max)) - (skip-chars-backward " \t\r\n") - (delete-region (point-max) (point)) - (prog1 - (buffer-string) - (kill-buffer (current-buffer))))) + (if (base64-autoload-functionp 'base64-decode-string) + (fmakunbound 'base64-decode-string)) + (if (base64-autoload-functionp 'base64-decode-region) + (fmakunbound 'base64-decode-region)) + (if (base64-autoload-functionp 'base64-encode-string) + (fmakunbound 'base64-encode-string)) + (if (base64-autoload-functionp 'base64-encode-region) + (fmakunbound 'base64-encode-region)) -(defun base64-decode (string) - (save-excursion - (set-buffer (get-buffer-create " *base64-decode*")) - (erase-buffer) - (insert string) - (base64-decode-region (point-min) (point-max)) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n") - (delete-region (point-max) (point)) - (prog1 - (buffer-string) - (kill-buffer (current-buffer))))) + (require 'mel) -(fset 'base64-decode-string 'base64-decode) -(fset 'base64-encode-string 'base64-encode) + (mel-find-function 'mime-decode-string "base64") + (mel-find-function 'mime-decode-region "base64") + (mel-find-function 'mime-encode-string "base64") + (mel-find-function 'mime-encode-region "base64")) (provide 'base64) + +;;; base64.el ends here diff --git a/lisp/binhex.el b/lisp/binhex.el index 45c7b60..9215f25 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -1,14 +1,11 @@ ;;; binhex.el -- elisp native binhex decode -;; Copyright (c) 1998 by Shenghuo Zhu +;; Copyright (c) 1998 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 -;; $Revision: 1.1.2.8 $ -;; Time-stamp: -;; Keywords: binhex +;; Keywords: binhex news -;; This file is not part of GNU Emacs, but the same permissions -;; apply. +;; 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 @@ -29,8 +26,13 @@ ;;; Code: -(if (not (fboundp 'char-int)) - (fset 'char-int 'identity)) +(eval-when-compile (require 'cl)) + +(eval-and-compile + (defalias 'binhex-char-int + (if (fboundp 'char-int) + 'char-int + 'identity))) (defvar binhex-decoder-program "hexbin" "*Non-nil value should be a string that names a uu decoder. @@ -68,7 +70,7 @@ input and write the converted data to its standard output.") ((boundp 'temporary-file-directory) temporary-file-directory) ("/tmp/"))) -(if (string-match "XEmacs" emacs-version) +(if (featurep 'xemacs) (defalias 'binhex-insert-char 'insert-char) (defun binhex-insert-char (char &optional count ignored buffer) (if (or (null buffer) (eq buffer (current-buffer))) @@ -133,14 +135,14 @@ input and write the converted data to its standard output.") (defun binhex-string-big-endian (string) (let ((ret 0) (i 0) (len (length string))) (while (< i len) - (setq ret (+ (lsh ret 8) (char-int (aref string i))) + (setq ret (+ (lsh ret 8) (binhex-char-int (aref string i))) i (1+ i))) ret)) (defun binhex-string-little-endian (string) (let ((ret 0) (i 0) (shift 0) (len (length string))) (while (< i len) - (setq ret (+ ret (lsh (char-int (aref string i)) shift)) + (setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift)) i (1+ i) shift (+ shift 8))) ret)) @@ -150,11 +152,11 @@ input and write the converted data to its standard output.") (let ((pos (point-min)) len) (vector (prog1 - (setq len (char-int (char-after pos))) + (setq len (binhex-char-int (char-after pos))) (setq pos (1+ pos))) (buffer-substring pos (setq pos (+ pos len))) (prog1 - (setq len (char-int (char-after pos))) + (setq len (binhex-char-int (char-after pos))) (setq pos (1+ pos))) (buffer-substring pos (setq pos (+ pos 4))) (buffer-substring pos (setq pos (+ pos 4))) @@ -199,15 +201,8 @@ If HEADER-ONLY is non-nil only decode header and return filename." (save-excursion (goto-char start) (when (re-search-forward binhex-begin-line end t) - (if (and (not (string-match "XEmacs\\|Lucid" emacs-version)) - (boundp 'enable-multibyte-characters)) - (let ((multibyte - (default-value 'enable-multibyte-characters))) - (setq-default enable-multibyte-characters nil) - (setq work-buffer (generate-new-buffer " *binhex-work*")) - (setq-default enable-multibyte-characters multibyte)) + (let (default-enable-multibyte-characters) (setq work-buffer (generate-new-buffer " *binhex-work*"))) - (buffer-disable-undo work-buffer) (beginning-of-line) (setq bits 0 counter 0) (while tmp @@ -251,26 +246,26 @@ If HEADER-ONLY is non-nil only decode header and return filename." ((= counter 2) (binhex-push-char (logand (lsh bits -10) 255) 1 nil work-buffer)))) - (if header-only nil - (binhex-verify-crc work-buffer - data-fork-start - (+ data-fork-start (aref header 6) 2)) - (or (markerp end) (setq end (set-marker (make-marker) end))) - (goto-char start) - (insert-buffer-substring work-buffer - data-fork-start (+ data-fork-start - (aref header 6))) - (delete-region (point) end))) + (if header-only nil + (binhex-verify-crc work-buffer + data-fork-start + (+ data-fork-start (aref header 6) 2)) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer + data-fork-start (+ data-fork-start + (aref header 6))) + (delete-region (point) end))) (and work-buffer (kill-buffer work-buffer))) (if header (aref header 1)))) (defun binhex-decode-region-external (start end) - "Binhex decode region between START and END using external decoder" + "Binhex decode region between START and END using external decoder." (interactive "r") (let ((cbuf (current-buffer)) firstline work-buffer status - (file-name (concat binhex-temporary-file-directory - (binhex-decode-region start end t) - ".data"))) + (file-name (expand-file-name + (concat (binhex-decode-region start end t) ".data") + binhex-temporary-file-directory))) (save-excursion (goto-char start) (when (re-search-forward binhex-begin-line nil t) diff --git a/lisp/catchup.pbm b/lisp/catchup.pbm new file mode 100644 index 0000000000000000000000000000000000000000..3fc571bdf8059402f3059eb7f574678c3d0cbdaa GIT binary patch literal 81 zcmWGA;W9E&Ff!p{fC0t>3=9sUObU#lj)4nStqKTrVff`F$l{{J&?Ukc%EYiafKhM; YQ-^D*Lx-XUYY7X}0vQGdd6;en0AX c Gray35", +", c #5b1a5b1a5b1a", +"< c #5fe95fe95fe9", +"1 c #626262626262", +"2 c Gray40", +"3 c #67e767e767e7", +"4 c Gray42", +"5 c #6fff6fff6fff", +"6 c Gray45", +"7 c Gray46", +"8 c #77e977e977e9", +"9 c #7bdb7bdb7bdb", +"0 c #7ccc7ccc7ccc", +"q c Gray50", +"w c #866586658665", +"e c Gray56", +"r c Gray60", +"t c #9bcb9bcb9bcb", +"y c #9fff9fff9fff", +"u c #a7c7a7c7a7c7", +"i c #af0eaf0eaf0e", +"p c Gray70", +"a c Gray75", +"s c Gray81", +"d c #dfffdfffdfff", +"f c #efffefffefff", +"g c Gray100", +/* pixels */ +"aaaaaaaaaaaaaaaaaaaaaaaa", +"aaaaaaaaaaaaaaaaaaaaaaaa", +"aaaaaaaaaaaaaaaaaaaaaaaa", +"aaaaaa7$$*uaaaaaaaaareep", +"aaaaaa$rr6", +"aaaaaa76;aaaareeeee#rw*", +"&aqqagga@<<<7e7qqqqqq=:u", +"33e4qgggsaa%1Oa&&&gggeae7ggyar=aa=r6 er=aa=r6 aggg=wr&g&rrr", +"rrrrr$a<:6 @$$$rri=d5qrr", +"rrrrr<===6$wrrrrrr6&qo6r", +"rrrrrrrrrewrrrrrrr6 oq", +"rrrrrrrrrrrrrrrrrrrrrrrr", +"rrrrrrrrrrrrrrrrrrrrrrrr", +"rrrrrrrrrrrrrrrrrrrrrrrr" +}; diff --git a/lisp/cu-exit.pbm b/lisp/cu-exit.pbm new file mode 100644 index 0000000000000000000000000000000000000000..210869cce7836f3325e4fe48f70d16214dbbcbeb GIT binary patch literal 81 zcmWGA;W9E&Ff!p{Km+m&41o+xi4ClU0W3-iEa47pP7bUt4$KY>jG+z;K|m6u07U+0 PV7$)2@Q;BZ1Y`sNnq~{( literal 0 HcmV?d00001 diff --git a/lisp/cu-exit.xpm b/lisp/cu-exit.xpm new file mode 100644 index 0000000..bc051f8 --- /dev/null +++ b/lisp/cu-exit.xpm @@ -0,0 +1,64 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 34 1", +" c Gray0", +". c #0bfb0bfb0bfb", +"X c Gray6", +"o c Gray9", +"O c Gray11", +"+ c Gray12", +"@ c #23f323f323f3", +"# c Gray15", +"$ c #2ff52ff52ff5", +"% c #3fff3fff3fff", +"& c Gray25", +"* c Gray28", +"= c #4ccc4ccc4ccc", +"- c #53e853e853e8", +"; c #5b1a5b1a5b1a", +": c #5fef5fef5fef", +"> c #67e767e767e7", +", c Gray42", +"< c #6ff76ff76ff7", +"1 c #77dc77dc77dc", +"2 c Gray50", +"3 c #866586658665", +"4 c #88a888a888a8", +"5 c Gray56", +"6 c Gray60", +"7 c #9bcb9bcb9bcb", +"8 c #9fff9fff9fff", +"9 c #a7d7a7d7a7d7", +"0 c Gray70", +"q c #b635b635b635", +"w c Gray75", +"e c Gray78", +"r c #dfffdfffdfff", +"t c Gray100", +/* pixels */ +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwww-$$$-wwwwwwww", +"wwwwwww9-$w$ttt$wwwwwwww", +"wwwwww:wwwwww", +"wwwwww,::X%%%+$w:5wwwwww", +"qqqqqq4*5%t%t255;qqqqqqq", +"6666663#*+2+2%**=6666666", +"6666666=0$w$0*0&36666666", +"6666666=,$9@5*,#66666666", +"6666666= +% 2% #66666666", +"6666666= %e@<2 #66666666", +"6666666:# +666666666", +"666666666=====3666666666", +"666666666666666666666666" +}; diff --git a/lisp/describe-group.pbm b/lisp/describe-group.pbm new file mode 100644 index 0000000000000000000000000000000000000000..de7bf1104317ae6686562b822f04b5feb493f14c GIT binary patch literal 81 zcmWGA;W9E&Ff!o^4Gq;;)D;ryy6=@js0hO(4u;S`7L5fAq5%xMek!;IFf=(pMM47@ f_PkIC4Pl&>$pF-q_oyp0F!cZL^`Rl5pFC6m%K{qn literal 0 HcmV?d00001 diff --git a/lisp/describe-group.xpm b/lisp/describe-group.xpm new file mode 100644 index 0000000..e191277 --- /dev/null +++ b/lisp/describe-group.xpm @@ -0,0 +1,72 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 42 1", +" c Gray0", +". c #099909990999", +"X c #0bfb0bfb0bfb", +"o c #133313331333", +"O c Gray9", +"+ c Gray11", +"@ c #23f323f323f3", +"# c Gray15", +"$ c #2d8d2d8d2d8d", +"% c #399939993999", +"& c #433243324332", +"* c #4ccc4ccc4ccc", +"= c #519151915191", +"- c #53e353e353e3", +"; c #565656565656", +": c Gray36", +"> c #5fdf5fdf5fdf", +", c Gray42", +"< c #6fff6fff6fff", +"1 c Gray45", +"2 c #77f777f777f7", +"3 c #7ccc7ccc7ccc", +"4 c Gray50", +"5 c #865a865a865a", +"6 c Gray58", +"7 c Gray60", +"8 c #9bfb9bfb9bfb", +"9 c Gray62", +"0 c #9fff9fff9fff", +"q c #a0c0a0c0a0c0", +"w c Gray64", +"e c Gray65", +"r c Gray70", +"t c #b635b635b635", +"y c Gray73", +"u c Gray75", +"i c #d332d332d332", +"p c Gray85", +"a c #e665e665e665", +"s c #eccbeccbeccb", +"d c #f998f998f998", +"f c Gray100", +/* pixels */ +"&77&77&77&77&77&77&77&77", +"777777777777777777777777", +"77777777777777777iaaa777", +"&77&77&77&77&77 ;; Katsumi Yamaoka @@ -28,68 +29,34 @@ ;;; Code: ;; Set coding priority of Shift-JIS to the bottom. -(defvar *predefined-category*) -(defvar coding-category-list) (if (featurep 'xemacs) - (fset 'set-coding-priority 'ignore) - (fset 'coding-priority-list 'ignore) - (fset 'set-coding-priority-list 'ignore)) + (defalias 'set-coding-priority 'ignore) + (defalias 'coding-priority-list 'ignore) + (defalias 'set-coding-priority-list 'ignore)) (cond ((and (featurep 'xemacs) (featurep 'mule)) (if (memq 'shift-jis (coding-priority-list)) (set-coding-priority-list - (nconc (delq 'shift-jis (coding-priority-list)) '(shift-jis))))) + (append (delq 'shift-jis (coding-priority-list)) '(shift-jis))))) ((boundp 'MULE) (put '*coding-category-sjis* 'priority (length *predefined-category*))) ((featurep 'mule) (if (memq 'coding-category-sjis coding-category-list) (set-coding-priority - (nconc (delq 'coding-category-sjis coding-category-list) - '(coding-category-sjis)))))) + (append (delq 'coding-category-sjis + (copy-sequence coding-category-list)) + '(coding-category-sjis)))))) -(fset 'facep 'ignore) +(defalias 'facep 'ignore) (require 'cl) -;; cl functions. -(define-compiler-macro mapc (&whole form fn seq &rest rest) - (if (and (fboundp 'mapc) - (subrp (symbol-function 'mapc))) - form - (if rest - `(let* ((fn ,fn) - (seq ,seq) - (args (cons seq ,rest)) - (m (apply (function min) (mapcar (function length) args))) - (n 0)) - (while (< n m) - (apply fn (mapcar (function (lambda (arg) (nth n arg))) args)) - (setq n (1+ n))) - seq) - `(let ((seq ,seq)) - (mapcar ,fn seq) - seq)))) - -(define-compiler-macro last (&whole form x &optional n) - (if (and (fboundp 'last) - (subrp (symbol-function 'last))) - form - (if n - `(let* ((x ,x) - (n ,n) - (m 0) - (p x)) - (while (consp p) - (incf m) - (pop p)) - (if (<= n 0) - p - (if (< n m) - (nthcdr (- m n) x) - x))) - `(let ((x ,x)) - (while (consp (cdr x)) - (pop x)) - x)))) +(defvar srcdir (or (getenv "srcdir") ".")) + +(defvar dgnushack-w3-dir (let ((w3dir (getenv "W3DIR"))) + (unless (zerop (length w3dir)) + (file-name-as-directory w3dir)))) +(when dgnushack-w3-dir + (push dgnushack-w3-dir load-path)) ;; If we are building w3 in a different directory than the source ;; directory, we must read *.el from source directory and write *.elc @@ -111,48 +78,85 @@ (require 'bytecomp) -(defvar srcdir (or (getenv "srcdir") ".")) - -(push srcdir load-path) - -;; Attempt to pickup the additional load-path(s). -(load (expand-file-name "dgnuspath.el" srcdir) nil nil t) -(condition-case err - (load "~/.lpath.el" t nil t) - (error (message "Error in \"~/.lpath.el\" file: %s" err))) +(unless (fboundp 'si:byte-optimize-form-code-walker) + (byte-optimize-form nil);; Load `byte-opt' or `byte-optimize'. + (setq max-specpdl-size 3000) + (defalias 'si:byte-optimize-form-code-walker + (symbol-function 'byte-optimize-form-code-walker)) + (defun byte-optimize-form-code-walker (form for-effect) + (if (and for-effect (memq (car-safe form) '(and or))) + ;; Fix bug in and/or forms. + (let ((fn (car form)) + (backwards (reverse (cdr form)))) + (while (and backwards + (null (setcar backwards + (byte-optimize-form (car backwards) t)))) + (setq backwards (cdr backwards))) + (if (and (cdr form) (null backwards)) + (byte-compile-log + " all subforms of %s called for effect; deleted" form)) + (if backwards + (let ((head backwards)) + (while (setq backwards (cdr backwards)) + (setcar backwards (byte-optimize-form (car backwards) + nil))) + (cons fn (nreverse head))))) + (si:byte-optimize-form-code-walker form for-effect))) + (byte-compile 'byte-optimize-form-code-walker)) + +(load (expand-file-name "gnus-clfns.el" srcdir) nil t t) (condition-case nil (char-after) (wrong-number-of-arguments ;; Optimize byte code for `char-after'. -;;; (put 'char-after 'byte-optimizer 'byte-optimize-char-after) -;;; (defun byte-optimize-char-after (form) -;;; (if (null (cdr form)) -;;; '(char-after (point)) -;;; form)) - (byte-defop-compiler char-after 0-1))) + (put 'char-after 'byte-optimizer 'byte-optimize-char-after) + (defun byte-optimize-char-after (form) + (if (null (cdr form)) + '(char-after (point)) + form)))) (condition-case nil (char-before) (wrong-number-of-arguments - (define-compiler-macro char-before (&whole form &optional pos) - (if (null pos) + ;; Optimize byte code for `char-before'. + (put 'char-before 'byte-optimizer 'byte-optimize-char-before) + (defun byte-optimize-char-before (form) + (if (null (cdr form)) '(char-before (point)) form)))) -;; `char-after' and `char-before' must be well-behaved before lpath.el -;; is loaded. Because it requires `poe' via `path-util'. +(load (expand-file-name "dgnuspath.el" srcdir) nil nil t) + +(condition-case err + (load "~/.lpath.el" t nil t) + (error (message "Error in \"~/.lpath.el\" file: %s" err))) + +;; Don't load path-util until `char-after' and `char-before' have been +;; optimized because it requires `poe' and then modify the functions. +(or (featurep 'path-util) + (load "apel/path-util")) +(add-path "apel") +(add-path "flim") +(unless (module-installed-p 'mel) + ;; FLIM 1.14 may have installed in two "flim" subdirectories. + (push (expand-file-name "flim" + (file-name-directory (get-latest-path "^apel$" t))) + load-path) + (unless (module-installed-p 'mel) + (error " +FLIM package does not found in %s. +Try to re-configure with --with-addpath=FLIM_PATH and run make again. +" + (progn + (add-path "semi") + load-path)))) +(add-path "semi") + +(push srcdir load-path) (load (expand-file-name "lpath.el" srcdir) nil t t) -(unless (fboundp 'byte-compile-file-form-custom-declare-variable) - ;; Bind defcustom'ed variables. - (put 'custom-declare-variable 'byte-hunk-handler - 'byte-compile-file-form-custom-declare-variable) - (defun byte-compile-file-form-custom-declare-variable (form) - (if (memq 'free-vars byte-compile-warnings) - (setq byte-compile-bound-variables - (cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) - form)) +(require 'custom) ;; Bind functions defined by `defun-maybe'. (put 'defun-maybe 'byte-hunk-handler 'byte-compile-file-form-defun-maybe) @@ -169,22 +173,62 @@ :symbol-for-testing-whether-colon-keyword-is-available-or-not (void-variable ;; Bind keywords. - (mapcar (lambda (keyword) (set keyword keyword)) - '(:button-keymap :data :file :mime-handle)))) + (dolist (keyword '(:button-keymap :data :file :mime-handle + :key-type :value-type + :ascent :foreground :help)) + (set keyword keyword)))) + +;; If you are using Mule 2.3 based on Emacs 19.34, you may also put the +;; following lines in your .emacs file, before gnus related modules are +;; loaded. It is not always necessary. However if it is done, you will +;; be able to load or evaluate gnus related *.el (not compiled) files. +;; ------ cut here ------ cut here ------ cut here ------ cut here ------ +(if (boundp 'MULE) + (progn + (setq :version ':version + :set-after ':set-after) + (require 'custom) + (defadvice custom-handle-keyword + (around dont-signal-an-error-even-if-unsupported-keyword-is-given + activate) + "Don't signal an error even if unsupported keyword is given." + (if (not (memq (ad-get-arg 1) '(:version :set-after))) + ad-do-it)))) +;; ------ cut here ------ cut here ------ cut here ------ cut here ------ + +(when (boundp 'MULE) + (put 'custom-declare-face 'byte-optimizer + 'byte-optimize-ignore-unsupported-custom-keywords) + (put 'custom-declare-group 'byte-optimizer + 'byte-optimize-ignore-unsupported-custom-keywords) + (defun byte-optimize-ignore-unsupported-custom-keywords (form) + (let ((args (nthcdr 4 form))) + (if (or (memq ':version args) + (memq ':set-after args)) + (let ((newform (list (car form) (nth 1 form) + (nth 2 form) (nth 3 form)))) + (while args + (or (memq (car args) '(:version :set-after)) + (setq newform (nconc newform (list (car args) + (car (cdr args)))))) + (setq args (cdr (cdr args)))) + newform) + form))) + + (put 'custom-declare-variable 'byte-hunk-handler + 'byte-compile-file-form-custom-declare-variable) + (defun byte-compile-file-form-custom-declare-variable (form) + ;; Bind defcustom'ed variables. + (if (memq 'free-vars byte-compile-warnings) + (setq byte-compile-bound-variables + (cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) + (byte-optimize-ignore-unsupported-custom-keywords form))) ;; Unknown variables and functions. (unless (boundp 'buffer-file-coding-system) (defvar buffer-file-coding-system (symbol-value 'file-coding-system))) -(autoload 'font-lock-set-defaults "font-lock") -(unless (fboundp 'coding-system-get) - (defalias 'coding-system-get 'ignore)) -(when (boundp 'MULE) - (defalias 'find-coding-system 'ignore)) -(unless (fboundp 'get-charset-property) - (defalias 'get-charset-property 'ignore)) (unless (featurep 'xemacs) (defalias 'Custom-make-dependencies 'ignore) - (defalias 'toolbar-gnus 'ignore) (defalias 'update-autoloads-from-directory 'ignore)) (autoload 'texinfo-parse-line-arg "texinfmt") @@ -199,12 +243,49 @@ (defalias 'ange-ftp-re-read-dir 'ignore) (defalias 'define-mail-user-agent 'ignore) -(eval-and-compile - (unless (string-match "XEmacs" emacs-version) - (fset 'get-popup-menu-response 'ignore) - (fset 'event-object 'ignore) - (fset 'x-defined-colors 'ignore) - (fset 'read-color 'ignore))) +(defconst dgnushack-unexporting-files + (append '("dgnushack.el" "dgnuspath.el" "lpath.el" "ptexinfmt.el") + (unless (or (condition-case nil + (require 'w3-forms) + (error nil)) + ;; Maybe mis-configured Makefile is used (e.g. + ;; configured for FSFmacs but XEmacs is running). + (let ((lp (delete dgnushack-w3-dir + (copy-sequence load-path)))) + (when (condition-case nil + (let ((load-path lp)) + (require 'w3-forms)) + (error nil)) + ;; If success, fix `load-path' for compiling. + (setq load-path lp)))) + '("nnweb.el" "nnlistserv.el" "nnultimate.el" + "nnslashdot.el" "nnwarchive.el" "webmail.el" + "nnwfm.el")) + (condition-case nil + (progn (require 'bbdb) nil) + (error '("gnus-bbdb.el"))) + (unless (featurep 'xemacs) + '("gnus-xmas.el" "gnus-picon.el" "messagexmas.el" + "nnheaderxm.el" "smiley.el")) + (when (or (featurep 'xemacs) (<= emacs-major-version 20)) + '("smiley-ems.el")) + (when (and (fboundp 'base64-decode-string) + (subrp (symbol-function 'base64-decode-string))) + '("base64.el")) + (when (and (fboundp 'md5) (subrp (symbol-function 'md5))) + '("md5.el"))) + "Files which will not be installed.") + +(defconst dgnushack-exporting-files + (let ((files (directory-files srcdir nil "^[^=].*\\.el$" t))) + (dolist (file dgnushack-unexporting-files) + (setq files (delete file files))) + (sort files 'string-lessp)) + "Files which will be compiled and installed.") + +(defun dgnushack-exporting-files () + "Print name of files which will be installed." + (princ (mapconcat 'identity dgnushack-exporting-files " "))) (defun dgnushack-compile (&optional warn) ;;(setq byte-compile-dynamic t) @@ -219,188 +300,43 @@ You also then need to add the following to the lisp/dgnushack.el file: (push \"~/lisp/custom\" load-path) Modify to suit your needs.")) - (let ((files (delete "dgnuspath.el" - (directory-files srcdir nil "^[^=].*\\.el$"))) - (xemacs (string-match "XEmacs" emacs-version)) - ;;(byte-compile-generate-call-tree t) + + ;; Show `load-path'. + (message "load-path=(\"%s\")" + (mapconcat 'identity load-path "\"\n \"")) + + (dolist (file dgnushack-exporting-files) + (setq file (expand-file-name file srcdir)) + (when (and (file-exists-p (setq elc (concat file "c"))) + (file-newer-than-file-p file elc)) + (delete-file elc))) + + (let (;;(byte-compile-generate-call-tree t) + (files dgnushack-exporting-files) file elc) - (condition-case () - (require 'w3-forms) - (error - (dolist (file '("nnweb.el" "nnlistserv.el" "nnultimate.el" - "nnslashdot.el" "nnwarchive.el" "webmail.el")) - (setq files (delete file files))))) - (condition-case () - (require 'bbdb) - (error (setq files (delete "gnus-bbdb.el" files)))) (while (setq file (pop files)) - (unless (or (and (not xemacs) - (member file - '("gnus-xmas.el" "gnus-picon.el" - "messagexmas.el" "nnheaderxm.el" - "smiley.el" "x-overlay.el"))) - (and (string-equal file "md5.el") - (not (and (fboundp 'md5) - (subrp (symbol-function 'md5)))))) - (setq file (expand-file-name file srcdir)) - (when (or (not (file-exists-p (setq elc (concat file "c")))) - (file-newer-than-file-p file elc)) - (ignore-errors - (byte-compile-file file))))))) + (setq file (expand-file-name file srcdir)) + (when (or (not (file-exists-p (setq elc (concat file "c")))) + (file-newer-than-file-p file elc)) + (ignore-errors + (byte-compile-file file)))))) (defun dgnushack-recompile () (require 'gnus) (byte-recompile-directory "." 0)) -;; Avoid byte-compile warnings. -(defvar gnus-product-name) -(defvar early-package-load-path) -(defvar early-packages) -(defvar last-package-load-path) -(defvar last-packages) -(defvar late-package-load-path) -(defvar late-packages) - -(defconst dgnushack-info-file-regexp - (concat "^\\(gnus\\|message\\|emacs-mime\\|gnus-ja\\|message-ja\\)" - "\\.info\\(-[0-9]+\\)?$")) - -(defconst dgnushack-texi-file-regexp - "^\\(gnus\\|message\\|emacs-mime\\|gnus-ja\\|message-ja\\)\\.texi$") - -(defun dgnushack-make-package () - (require 'gnus) - (let* ((product-name (downcase gnus-product-name)) - (lisp-dir (concat "lisp/" product-name "/")) - make-backup-files) - - (message "Updating autoloads for directory %s..." default-directory) - (let ((generated-autoload-file "auto-autoloads.el") - noninteractive - (omsg (symbol-function 'message))) - (defun message (fmt &rest args) - (cond ((and (string-equal "Generating autoloads for %s..." fmt) - (file-exists-p (file-name-nondirectory (car args)))) - (funcall omsg fmt (file-name-nondirectory (car args)))) - ((string-equal "No autoloads found in %s" fmt)) - ((string-equal "Generating autoloads for %s...done" fmt)) - (t (apply omsg fmt args)))) - (unwind-protect - (update-autoloads-from-directory default-directory) - (fset 'message omsg))) - (byte-compile-file "auto-autoloads.el") - - (with-temp-buffer - (let ((standard-output (current-buffer))) - (Custom-make-dependencies ".")) - (message (buffer-string))) - (require 'cus-load) - (byte-compile-file "custom-load.el") - - (message "Generating MANIFEST.%s for the package..." product-name) - (with-temp-buffer - (insert "pkginfo/MANIFEST." product-name "\n" - lisp-dir - (mapconcat - 'identity - (sort (delete "dgnuspath.el" - (delete "patchs.elc" - (directory-files "." nil "\\.elc?$"))) - 'string-lessp) - (concat "\n" lisp-dir)) - "\ninfo/" - (mapconcat - 'identity - (sort (directory-files "../texi/" - nil dgnushack-info-file-regexp) - 'string-lessp) - "\ninfo/") - "\n") - (write-file (concat "../MANIFEST." product-name))))) - -(defun dgnushack-install-package () - (let ((package-dir (car command-line-args-left)) - dirs info-dir pkginfo-dir product-name lisp-dir manifest files) - (unless package-dir - (when (boundp 'early-packages) - (setq dirs (delq nil (append (when early-package-load-path - early-packages) - (when late-package-load-path - late-packages) - (when last-package-load-path - last-packages)))) - (while (and dirs (not package-dir)) - (when (file-exists-p (car dirs)) - (setq package-dir (car dirs) - dirs (cdr dirs)))))) - (unless package-dir - (error "%s" " -You must specify the name of the package path as follows: - -% make install-package PACKAGEDIR=/usr/local/lib/xemacs/xemacs-packages -" - )) - (setq info-dir (expand-file-name "info/" package-dir) - pkginfo-dir (expand-file-name "pkginfo/" package-dir)) - (require 'gnus) - (setq product-name (downcase gnus-product-name) - lisp-dir (expand-file-name (concat "lisp/" product-name "/") - package-dir) - manifest (concat "MANIFEST." product-name)) - - (unless (file-directory-p lisp-dir) - (make-directory lisp-dir t)) - (unless (file-directory-p info-dir) - (make-directory info-dir)) - (unless (file-directory-p pkginfo-dir) - (make-directory pkginfo-dir)) - - (setq files - (sort (delete "dgnuspath.el" - (delete "dgnuspath.elc" - (directory-files "." nil "\\.elc?$"))) - 'string-lessp)) - (mapcar - (lambda (file) - (unless (member file files) - (setq file (expand-file-name file lisp-dir)) - (message "Removing %s..." file) - (condition-case nil - (delete-file file) - (error nil)))) - (directory-files lisp-dir nil nil nil t)) - (mapcar - (lambda (file) - (message "Copying %s to %s..." file lisp-dir) - (copy-file file (expand-file-name file lisp-dir) t t)) - files) - - (mapcar - (lambda (file) - (message "Copying ../texi/%s to %s..." file info-dir) - (copy-file (expand-file-name file "../texi/") - (expand-file-name file info-dir) - t t)) - (sort (directory-files "../texi/" nil dgnushack-info-file-regexp) - 'string-lessp)) - - (message "Copying ../%s to %s..." manifest pkginfo-dir) - (copy-file (expand-file-name manifest "../") - (expand-file-name manifest pkginfo-dir) t t) - - (message "Done"))) - (defun dgnushack-texi-add-suffix-and-format () (dgnushack-texi-format t)) (defun dgnushack-texi-format (&optional addsuffix) (if (not noninteractive) (error "batch-texinfo-format may only be used -batch.")) - (require 'texinfmt) + (require 'ptexinfmt) (let ((auto-save-default nil) (find-file-run-dired nil) - coding-system-for-write) + coding-system-for-write + output-coding-system) (let ((error 0) file (files ())) @@ -412,25 +348,36 @@ You must specify the name of the package path as follows: command-line-args-left (cdr command-line-args-left))) ((file-directory-p file) (setq command-line-args-left - (nconc (directory-files file) + (nconc (directory-files file nil nil t) (cdr command-line-args-left)))) (t (setq files (cons file files) command-line-args-left (cdr command-line-args-left))))) - (while files - (setq file (car files) - files (cdr files)) + (while (setq file (pop files)) (condition-case err (progn (if buffer-file-name (kill-buffer (current-buffer))) (find-file file) - (setq coding-system-for-write buffer-file-coding-system) + (buffer-disable-undo (current-buffer)) + (if (boundp 'MULE) + (setq output-coding-system (symbol-value + 'file-coding-system)) + (setq coding-system-for-write buffer-file-coding-system)) + ;; Remove ignored areas first. + (while (re-search-forward "^@ignore[\t\r ]*$" nil t) + (delete-region (match-beginning 0) + (if (re-search-forward + "^@end[\t ]+ignore[\t\r ]*$" nil t) + (1+ (match-end 0)) + (point-max)))) + (goto-char (point-min)) + ;; Add suffix if it is needed. (when (and addsuffix (re-search-forward "^@setfilename[\t ]+\\([^\t\n ]+\\)" nil t) (not (string-match "\\.info$" (match-string 1)))) - (insert ".info")) - (buffer-disable-undo (current-buffer)) + (insert ".info") + (goto-char (point-min))) ;; process @include before updating node ;; This might produce some problem if we use @lowersection or ;; such. @@ -488,4 +435,109 @@ You must specify the name of the package path as follows: (setq error 1)))) (kill-emacs error)))) + +(defconst dgnushack-info-file-regexp-en + (let ((names '("gnus" "message" "emacs-mime")) + regexp name) + (while (setq name (pop names)) + (setq regexp (concat regexp "^" name "\\.info\\(-[0-9]+\\)?$" + (when names "\\|")))) + regexp) + "Regexp matching English info files.") + +(defconst dgnushack-info-file-regexp-ja + (let ((names '("gnus-ja" "message-ja")) + regexp name) + (while (setq name (pop names)) + (setq regexp (concat regexp "^" name "\\.info\\(-[0-9]+\\)?$" + (when names "\\|")))) + regexp) + "Regexp matching Japanese info files.") + +(defun dgnushack-make-autoloads () + "Make auto-autoloads.el, custom-load.el and then compile them." + (let (make-backup-files) + (message "Updating autoloads for directory %s..." default-directory) + (let ((generated-autoload-file "auto-autoloads.el") + (si:message (symbol-function 'message)) + noninteractive) + (defun message (fmt &rest args) + (cond ((and (string-equal "Generating autoloads for %s..." fmt) + (file-exists-p (file-name-nondirectory (car args)))) + (funcall si:message fmt (file-name-nondirectory (car args)))) + ((string-equal "No autoloads found in %s" fmt)) + ((string-equal "Generating autoloads for %s...done" fmt)) + (t (apply si:message fmt args)))) + (unwind-protect + (update-autoloads-from-directory default-directory) + (fset 'message si:message))) + (byte-compile-file "auto-autoloads.el") + (with-temp-buffer + (let ((standard-output (current-buffer))) + (Custom-make-dependencies ".")) + (message "%s" (buffer-string))) + (require 'cus-load) + (byte-compile-file "custom-load.el"))) + +(defun dgnushack-remove-extra-files-in-package () + "Remove extra files in the lisp directory of the XEmacs package." + (let ((lisp-dir (expand-file-name (concat "lisp/" + ;; GNUS_PRODUCT_NAME + (cadr command-line-args-left) + "/") + ;; PACKAGEDIR + (car command-line-args-left)))) + (when (file-directory-p lisp-dir) + (let (files) + (dolist (file dgnushack-exporting-files) + (setq files (nconc files (list file (concat file "c"))))) + (dolist (file (directory-files lisp-dir nil nil t t)) + (unless (member file files) + (setq file (expand-file-name file lisp-dir)) + (message "Removing %s..." file) + (condition-case nil + (delete-file file) + (error nil)))))))) + +(defun dgnushack-install-package-manifest () + "Install MANIFEST file as an XEmacs package." + (let* ((package-dir (car command-line-args-left)) + (product-name (cadr command-line-args-left)) + (name (expand-file-name (concat "pkginfo/MANIFEST." product-name) + package-dir)) + make-backup-files) + (message "Generating %s..." name) + (with-temp-file name + (insert "pkginfo/MANIFEST." product-name "\n") + (let ((lisp-dir (concat "lisp/" product-name "/")) + (files (sort (directory-files "." nil "\\.elc?$" t) 'string-lessp)) + file) + (while (setq file (pop files)) + (unless (member file dgnushack-unexporting-files) + (insert lisp-dir file "\n"))) + (setq files + (sort (directory-files "../texi/" nil + (concat dgnushack-info-file-regexp-en + "\\|" + dgnushack-info-file-regexp-ja) + t) + 'string-lessp)) + (while (setq file (pop files)) + (insert "info/" file "\n")))))) + + +(define-compiler-macro describe-key-briefly (&whole form key &optional insert) + (if (condition-case nil + (progn + (describe-key-briefly '((())) nil) + t) + (wrong-number-of-arguments nil);; Old Emacsen. + (error t)) + form + (if insert + `(if ,insert + (insert (funcall 'describe-key-briefly ,key)) + (funcall 'describe-key-briefly ,key)) + `(funcall 'describe-key-briefly ,key)))) + ;;; dgnushack.el ends here diff --git a/lisp/dgnuspath.el.in b/lisp/dgnuspath.el.in index 36749e6..3ee338f 100644 --- a/lisp/dgnuspath.el.in +++ b/lisp/dgnuspath.el.in @@ -7,8 +7,11 @@ (setq path (file-name-as-directory (expand-file-name (match-string 0 addpath))) addpath (substring addpath (match-end 0))) - (if (string-match "apel/" path) - (setq path (substring path 0 (match-beginning 0)))) + (if (string-match "apel/$" path) + (progn + (if (file-directory-p path) + (setq paths (nconc paths (list path)))) + (setq path (substring path 0 (match-beginning 0))))) (if (file-directory-p path) (setq paths (nconc paths (list path))))) (or (null paths) diff --git a/lisp/dig.el b/lisp/dig.el new file mode 100644 index 0000000..18019e9 --- /dev/null +++ b/lisp/dig.el @@ -0,0 +1,169 @@ +;;; dig.el --- Domain Name System dig interface +;; Copyright (c) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: DNS BIND dig + +;; This file is not a part of GNU Emacs, but the same permissions apply. + +;; 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: + +;; This provide an interface for "dig". +;; +;; For interactive use, try M-x dig and type a hostname. Use `q' to quit +;; dig buffer. +;; +;; For use in elisp programs, call `dig-invoke' and use +;; `dig-extract-rr' to extract resource records. + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defgroup dig nil + "Dig configuration.") + +(defcustom dig-program "dig" + "Name of dig (domain information groper) binary." + :type 'file + :group 'dig) + +(defcustom dig-dns-server nil + "DNS server to query. +If nil, use system defaults." + :type '(choice (const :tag "System defaults") + string) + :group 'dig) + +(defcustom dig-font-lock-keywords + '(("^;; [A-Z]+ SECTION:" 0 font-lock-keyword-face) + ("^;;.*" 0 font-lock-comment-face) + ("^; <<>>.*" 0 font-lock-type-face) + ("^;.*" 0 font-lock-function-name-face)) + "Default expressions to highlight in dig mode." + :type 'sexp + :group 'dig) + +(defun dig-invoke (domain &optional + query-type query-class query-option + dig-option server) + "Call dig with given arguments and return buffer containing output. +DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional string +with a DNS type. QUERY-CLASS is an optional string with a DNS class. +QUERY-OPTION is an optional string with dig \"query options\". +DIG-OPTIONS is an optional string with parameters for the dig program. +SERVER is an optional string with a domain name server to query. + +Dig is an external program found in the BIND name server distribution, +and is a commonly available debugging tool." + (let (buf cmdline) + (setq buf (generate-new-buffer "*dig output*")) + (if dig-option (push dig-option cmdline)) + (if query-option (push query-option cmdline)) + (if query-class (push query-class cmdline)) + (if query-type (push query-type cmdline)) + (push domain cmdline) + (if server (push (concat "@" server) cmdline) + (if dig-dns-server (push (concat "@" dig-dns-server) cmdline))) + (apply 'call-process dig-program nil buf nil cmdline) + buf)) + +(defun dig-extract-rr (domain &optional type class) + "Extract resource records for DOMAIN, TYPE and CLASS from buffer. +Buffer should contain output generated by `dig-invoke'." + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+" + (upcase (or class "IN")) "[\t ]+" (upcase (or type "A"))) + nil t) + (let (b e) + (end-of-line) + (setq e (point)) + (beginning-of-line) + (setq b (point)) + (when (search-forward " (" e t) + (search-forward " )")) + (end-of-line) + (setq e (point)) + (buffer-substring b e)) + (and (re-search-forward (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+" + (upcase (or class "IN")) + "[\t ]+CNAME[\t ]+\\(.*\\)$") nil t) + (dig-extract-rr (match-string 1) type class))))) + +(defun dig-rr-get-pkix-cert (rr) + (let (b e str) + (string-match "[^\t ]+[\t ]+[0-9wWdDhHmMsS]+[\t ]+IN[\t ]+CERT[\t ]+\\(1\\|PKIX\\)[\t ]+[0-9]+[\t ]+[0-9]+[\t ]+(?" rr) + (setq b (match-end 0)) + (string-match ")" rr) + (setq e (match-beginning 0)) + (setq str (substring rr b e)) + (while (string-match "[\t \n\r]" str) + (setq str (replace-match "" nil nil str))) + str)) + +;; XEmacs does it like this. For Emacs, we have to set the +;; `font-lock-defaults' buffer-local variable. +(put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t)) + +(put 'dig-mode 'mode-class 'special) + +(defvar dig-mode-map nil) +(unless dig-mode-map + (setq dig-mode-map (make-sparse-keymap)) + (suppress-keymap dig-mode-map) + + (define-key dig-mode-map "q" 'dig-exit)) + +(defun dig-mode () + "Major mode for displaying dig output." + (interactive) + (kill-all-local-variables) + (setq mode-name "dig") + (setq major-mode 'dig-mode) + (use-local-map dig-mode-map) + (buffer-disable-undo) + (unless (featurep 'xemacs) + (set (make-local-variable 'font-lock-defaults) + '(dig-font-lock-keywords t))) + (when (featurep 'font-lock) + (font-lock-set-defaults))) + +(defun dig-exit () + "Quit dig output buffer." + (interactive) + (kill-buffer (current-buffer))) + +(defun dig (domain &optional + query-type query-class query-option dig-option server) + "Query addresses of a DOMAIN using dig, by calling `dig-invoke'. +Optional arguments are passed to `dig-invoke'." + (interactive "sHost: ") + (switch-to-buffer + (dig-invoke domain query-type query-class query-option dig-option server)) + (goto-char (point-min)) + (and (search-forward ";; ANSWER SECTION:" nil t) + (forward-line)) + (dig-mode) + (setq buffer-read-only t) + (set-buffer-modified-p nil)) + +(provide 'dig) + +;;; dig.el ends here diff --git a/lisp/earcon.el b/lisp/earcon.el index a698479..7c42e8b 100644 --- a/lisp/earcon.el +++ b/lisp/earcon.el @@ -1,7 +1,11 @@ ;;; earcon.el --- Sound effects for messages -;; Copyright (C) 1996 Free Software Foundation + +;; Copyright (C) 1996, 2000 Free Software Foundation ;; Author: Steven L. Baur + +;; 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) @@ -22,9 +26,6 @@ ;;; Code: -(if (null (boundp 'running-xemacs)) - (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) - (eval-when-compile (require 'cl)) (require 'gnus) (require 'gnus-audio) diff --git a/lisp/exit-gnus.pbm b/lisp/exit-gnus.pbm new file mode 100644 index 0000000000000000000000000000000000000000..32ad0e0ebe9673bfbefa86e1d3e9132e2a516521 GIT binary patch literal 81 zcmWGA;W9E&Ff!p{aAaUmZV)JR;FJF$8XCf2$H01(f$!}B!O#GvEex(DA#7?4p`w9W lObjj}j(QCZqN0I33=E;6uK5id<)wo5ySzj1hB7cP008Y?6KDVc literal 0 HcmV?d00001 diff --git a/lisp/exit-gnus.xpm b/lisp/exit-gnus.xpm new file mode 100644 index 0000000..d910b55 --- /dev/null +++ b/lisp/exit-gnus.xpm @@ -0,0 +1,76 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 46 1", +" c Gray0", +". c Gray6", +"X c #133313331333", +"o c Gray11", +"O c Gray12", +"+ c Gray15", +"@ c #2ff82ff82ff8", +"# c Gray20", +"$ c #399939993999", +"% c #3fff3fff3fff", +"& c Gray25", +"* c Gray28", +"= c #4ccc4ccc4ccc", +"- c #53e353e353e3", +"; c #565e565e565e", +": c #5b1a5b1a5b1a", +"> c #5ff55ff55ff5", +", c #626262626262", +"< c Gray40", +"1 c #67e767e767e7", +"2 c Gray42", +"3 c #6ff96ff96ff9", +"4 c Gray45", +"5 c #77d777d777d7", +"6 c #7ccc7ccc7ccc", +"7 c Gray50", +"8 c Gray56", +"9 c #97f797f797f7", +"0 c Gray60", +"q c #9bd19bd19bd1", +"w c #9ff29ff29ff2", +"e c #a7cba7cba7cb", +"r c Gray67", +"t c #afd5afd5afd5", +"y c Gray70", +"u c Gray75", +"i c #c3c3c3c3c3c3", +"p c Gray78", +"a c #cbcbcbcbcbcb", +"s c Gray81", +"d c #d7d8d7d8d7d8", +"f c #dff2dff2dff2", +"g c Gray89", +"h c #e7e7e7e7e7e7", +"j c #eff8eff8eff8", +"k c Gray100", +/* pixels */ +"kkkkkkkkkufkkkku7skkkkkk", +"kkkkkkkkw>%fkkw 7kkkkkkk", +"kk3%wkkksu ukk%u7skkkkkk", +"kww>>@@uu3f@8 @@7.@Owskk", +"kkwf777%>77O> >>%7777wkk", +"kkkkkss7j8O.@ 8jujsfjkkk", +"kkkjuuwO @> @>@@ujkkkkkk", +"kkk>%O77O$ > %f >kkkkkk", +"kkk87sj7<=u>@7s8>@%wkkkk", +"kkkkkkq==u>>u ukk3u7kkkk", +"7uwfuw+=>u u> >fuw7uwwuf", +"8twut#>:8q q8* uprwswwtu", +"ipuge&,5uq5uau-@uuuuuadu", +"psuu>4@uuuuuduu5uuduuuuu", +"uugu>4@uuguuuuuuuuauuuuu", +"uuuy:>-uuuuuuugguaaugguu", +"psu8=+uuuuspuuuuudduuuuu", +"ipu8=+uuujfhguuuuuudauuu", +"ue82=+8euuuuishspujdgguu", +"e@$$+X=;>uu5ttp9sduuuuuu", +"&4$8$ 7=4@@5y>qejdjduuuu", +";$4O4444444O@eye5@uuusfd", +">>>>3<>@*<3>@wp9f7uuufsd", +"uuujfhgedhfjqpswsiuuuuuu" +}; diff --git a/lisp/exit-summ.pbm b/lisp/exit-summ.pbm new file mode 100644 index 0000000000000000000000000000000000000000..d0192310607c6f40033068a55cc5c4c7c244f866 GIT binary patch literal 81 zcmWGA;W9E&Ff!p1aAaWsgNFYPm{|`nF+LD*Ji@^FfRXXQB*q7fKoQ;t!j4CP;tY%j W8W@3U9GHw6L_=L5x+ZZdKo|ff#}ZBe literal 0 HcmV?d00001 diff --git a/lisp/exit-summ.xpm b/lisp/exit-summ.xpm new file mode 100644 index 0000000..00caf53 --- /dev/null +++ b/lisp/exit-summ.xpm @@ -0,0 +1,45 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 15 1", +" c Gray0", +". c #0bfb0bfb0bfb", +"X c Gray9", +"o c #23f323f323f3", +"O c #2fef2fef2fef", +"+ c Gray28", +"@ c #53e353e353e3", +"# c #5fdf5fdf5fdf", +"$ c Gray42", +"% c #77d777d777d7", +"& c Gray56", +"* c #9bcb9bcb9bcb", +"= c #a7c7a7c7a7c7", +"- c Gray70", +"; c Gray75", +/* pixels */ +"@;;@;;@;;@;;@;;@;;@;;@;;", +";;;;;;;;;;;;;;;;;;;;;;;;", +";;;;;;;;;;;;;;;;;;;;;;;;", +"@;;@;;&=@OOOo O;;@;;", +";;;;;;X&;;;;=## O;;;;;", +";;;;;;.%;;;;;;; O;;;;;", +"@;;@;;@;;@;;*;; O;;@;;", +";;;;;;;;;;;;%;; O;;;;;", +";;;;;;O%;;;;;;; O;;;;;", +"@;;@;;o=;@;;-&- O;;@;;", +";;;;;;X&;;;;+ & O;;;;;", +";;;;;;.%;;;;$ & O;;;;;", +"@;;@;;o=;@;;;;; O;;@;;", +";;;;;;X&;;;;;;; O;;;;;", +";;;;;;*;;;;;@;; O;;;;;", +"@;;@;;&=;@;;;;; O;;@;;", +";;;;;; #;;;;;&#XO+O;;;;;", +";;;;;;o=;*OO*#o%#+*;;;;;", +"@;;@;@;%OOOO@%*@%*@;;@;;", +";;;;;;;;;;;;;;;;;;;;;;;;", +";;;;;;;;;;;;;;;;;;;;;;;;", +"@;;@;;@;;@;;@;;@;;@;;@;;", +";;;;;;;;;;;;;;;;;;;;;;;;", +";;;;;;;;;;;;;;;;;;;;;;;;" +}; diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el new file mode 100644 index 0000000..64946f9 --- /dev/null +++ b/lisp/flow-fill.el @@ -0,0 +1,103 @@ +;;; flow-fill.el --- interprete RFC2646 "flowed" text + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: mail + +;; 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: + +;; This implement decoding of RFC2646 formatted text, including the +;; quoted-depth wins rules. + +;; Theory of operation: search for lines ending with SPC, save quote +;; length of line, remove SPC and concatenate line with the following +;; line if quote length of following line matches current line. + +;; When no further concatenations are possible, we've found a +;; 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 +;; implementations differ..) + +;; History: + +;; 2000-02-17 posted on ding mailing list +;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs +;; 2000-03-11 no compile warnings for point-at-bol stuff +;; 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. + +;;; Code: + +(eval-when-compile (require 'cl)) + +(eval-and-compile + (defalias 'fill-flowed-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) + + (defalias 'fill-flowed-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position))) + +(defun fill-flowed (&optional buffer) + (save-excursion + (set-buffer (or (current-buffer) buffer)) + (goto-char (point-min)) + (while (re-search-forward " $" nil t) + (when (save-excursion + (beginning-of-line) + (looking-at "^\\(>*\\)\\( ?\\)")) + (let ((quote (match-string 1)) sig) + (if (string= quote "") + (setq quote nil)) + (when (and quote (string= (match-string 2) "")) + (save-excursion + ;; insert SP after quote for pleasant reading of quoted lines + (beginning-of-line) + (when (> (skip-chars-forward ">") 0) + (insert " ")))) + (while (and (save-excursion + (ignore-errors (backward-char 3)) + (setq sig (looking-at "-- ")) + (looking-at "[^-][^-] ")) + (save-excursion + (unless (eobp) + (forward-char 1) + (looking-at (format "^\\(%s\\)\\([^>]\\)" (or quote " ?")))))) + (save-excursion + (replace-match (if (string= (match-string 2) " ") + "" "\\2"))) + (backward-delete-char -1) + (end-of-line)) + (unless sig + (let ((fill-prefix (when quote (concat quote " ")))) + (fill-region (fill-flowed-point-at-bol) + (fill-flowed-point-at-eol) + 'left 'nosqueeze)))))))) + +(provide 'flow-fill) + +;;; flow-fill.el ends here diff --git a/lisp/followup.pbm b/lisp/followup.pbm new file mode 100644 index 0000000000000000000000000000000000000000..61be114096b3eb182aa962728a44e8bc45bfb176 GIT binary patch literal 81 zcmWGA;W9E&Ff!p1WE5avU}69QK8C*v$E&(A-7Zex;1h_N| h1Y86h8aNzSBovqo0vH_x7#V c #9fff9fff9fff", +", c #a7c7a7c7a7c7", +"< c Gray70", +"1 c Gray75", +"2 c Gray81", +"3 c #dfffdfffdfff", +"4 c #efffefffefff", +"5 c Gray100", +/* pixels */ +"<,1<,1<,1<,1<,1<,1<,1<,1", +",;1,;1,;1,;1,;1,;1,;1,;1", +"111111111111111111111111", +"<,1<,1<,1<,:=+.<,1<,1<,1", +",;1,;1,;1;O*>5+$;1,;1,;1", +"11111111##142+>O11111111", +"<,1<,:=+2555 o2#,1<,1<,1", +",;1;O*>5555>-151$1,;1,;1", +"111<@15555525554*:111111", +"<,1<$:5555555555>=<,1<,1", +",;1,;*>553--55555+,;1,;1", +"111111=>&$1O555552#11111", +"<,111:=+241$+55555#,1<,1", +",;1,$*>55$ 1+555551$1,;1", +"11##14555 $4>>55554*:111", +"<@155555&5551-55555>=<,1", +",O15555555553-355551o,;1", +"1,#55555555553$555+%;111", +"<,#25555555555&1*O<,1<,1", +",;1+55555555555X;1,;1,;1", +"111=>5555555555:*1111111", +"<,1:*45555555552%<<,1<,1", +",;11$15555555555-;,;1,;1", +"1111,#55555555553#111111" +}; diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 8986dc0..6cd39ed 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -1,5 +1,5 @@ ;;; format-spec.el --- functions for formatting arbitrary formatting strings -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: tools diff --git a/lisp/fuwo.pbm b/lisp/fuwo.pbm new file mode 100644 index 0000000000000000000000000000000000000000..b81af10c3997ce1eb584a907505fcac6282cd795 GIT binary patch literal 81 zcmWGA;W9E&Ff!p1WE5afU}6A+Kvn?;76u0%0R|2R1_6+eW2y+l1qRkY0j?cP!X*qk dCJY6k0t#FV4y-H+tPBD`#MBVL7{bBm003Mb2}A$@ literal 0 HcmV?d00001 diff --git a/lisp/fuwo.xpm b/lisp/fuwo.xpm new file mode 100644 index 0000000..e860d95 --- /dev/null +++ b/lisp/fuwo.xpm @@ -0,0 +1,53 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 23 1", +" c Gray0", +". c Gray6", +"X c Gray9", +"o c Gray12", +"O c #2fef2fef2fef", +"+ c #3fff3fff3fff", +"@ c #53ee53ee53ee", +"# c #5fe85fe85fe8", +"$ c #67e767e767e7", +"% c #6fff6fff6fff", +"& c #77ea77ea77ea", +"* c #7bdb7bdb7bdb", +"= c Gray50", +"- c Gray56", +"; c #9bd69bd69bd6", +": c #9fff9fff9fff", +"> c #a7c7a7c7a7c7", +", c Gray70", +"< c Gray75", +"1 c Gray81", +"2 c #dfffdfffdfff", +"3 c #efffefffefff", +"4 c Gray100", +/* pixels */ +",><,><,><,><,><,><,><,><", +">-<>-<>-<>-<>-<>-<>-<>-<", +"<<<<<<<<<<<<<<<<<<<<<<<<", +",><,><,><,><,><,><,><,><", +">-<>-<>-<>-<>-<>-<>-<>-<", +"<<<<<<<<<<<<;O;<<<<<<<<<", +",><,><,><,>< X;,><,><,><", +">-<>-<>-<>-&#-<>-<>-<>-<", +"<<<<<<<<<<<;<<<<<<<<<<<<", +",><,><,><,><,><,><,><,><", +">-<>-<>-<-O>>-<>-<>-<>-<", +"<<<<<<<<@@<@<<<<<<<<<<<<", +",><<<;*+1<<#;<<,><,><,><", +">-<>#&:<==+#&-<>-<>-<>-<", +"<<@@<3+=<1o <#<<<<<<<<<<", +",>O<=+444:+.4=-,><,><,><", +">-O=<4444:4::<$>-<>-<>-<", +"<&;444444444+4+<<<<<<<<<", +",#;444444444<=4O<<,><,><", +">-O4444444442=2&-<>-<>-<", +"<<;%444444444=<<#<<<<<<<", +",><@2444444444+4=-,><,><", +">-<-=444444444::<$>-<>-<", +"<<<,$1444444444+4+<<<<<<" +}; diff --git a/lisp/get-news.pbm b/lisp/get-news.pbm new file mode 100644 index 0000000000000000000000000000000000000000..c0080716c4494d4ea6a56f29a9583152fdadb79a GIT binary patch literal 81 zcmWGA;W9E&Ff!pP6%Aa)#K0)x*wB1}Q8cibQGqcuv~kf1#_+ c #519151915191", +", c #53e753e753e7", +"< c #565a565a565a", +"1 c Gray35", +"2 c #5b1a5b1a5b1a", +"3 c #5fe55fe55fe5", +"4 c Gray45", +"5 c Gray46", +"6 c #77d777d777d7", +"7 c #7ccc7ccc7ccc", +"8 c Gray50", +"9 c #866586658665", +"0 c Gray56", +"q c Gray60", +"w c #9bcb9bcb9bcb", +"e c #9fff9fff9fff", +"r c #a7c7a7c7a7c7", +"t c Gray70", +"y c Gray75", +"u c Gray81", +"i c #dfffdfffdfff", +"p c Gray100", +/* pixels */ +"0000000ryyyyyyyyyyyyyyyy", +"@8888833yyyyyyyyyyyyyyyy", +"*pppppy3yyyyyyyyyyyyyyyy", +"*pppppy3yyyyyr=$$6yyyyyy", +"*ppppp3%3yyyr<9qq36yyyyy", +"*ppppp ;0>yy0:qqqq%yyyyy", +"*pppppy @82tq>0qq8>yyyyy", +"*pppppy%>q42y0>q42yyyyyy", +"*pppppy3q=q8%%.=:#%6yyyy", +"%yyyyy03y0:qqqqqqqq:0yyy", +"33333330yr<9qqqqqqq42yyy", +"yyyyyyyyyyr=qqqqqqqq$yyy", +"yyyyyyyyyyyy$:%***$q$**X", +"yyyyyyyyyyyy$:yppe3q$pp*", +"yyyyyyyyyyyy$:ypp*q3qpp*", +"yyyyyyyyyyyy$:yp8402upp*", +"yyyyyyyyyyyyo$yi*&48ppp*", +"yyyyyyyyyyy>4&u>00:ippp*", +"yyyyyyyyyyy%q:00Oq%yyyy%", +"yyyyyyyyyyy%q4:o<3&%3333", +"yyyyyyyyyyy%qqq$9443yyyy", +"yyyyyyyyyyy%44@0&4<3yyyy", +"yyyyyyyyyyy6o$;r%&O0yyyy", +"yyyyyyyyyyyy$:0y34%yyyyy" +}; diff --git a/lisp/gnntg.pbm b/lisp/gnntg.pbm new file mode 100644 index 0000000000000000000000000000000000000000..2f5e5261a97e722736c03805a8c2b6743901b626 GIT binary patch literal 81 zcmWGA;W9E&Ff!pP6%EX8VsI33WN1F&7#_%|tl)S(lwsEj$NECXP2Hg(u?!q4p`xJ* kY;#;hLp9pY0ND(j9-* c #566656665666", +", c #5fed5fed5fed", +"< c #626262626262", +"1 c Gray42", +"2 c Gray45", +"3 c Gray46", +"4 c #77d777d777d7", +"5 c #7ccc7ccc7ccc", +"6 c Gray50", +"7 c #866586658665", +"8 c Gray56", +"9 c Gray60", +"0 c #9bcb9bcb9bcb", +"q c #a7c7a7c7a7c7", +"w c Gray70", +"e c Gray75", +"r c #dfffdfffdfff", +"t c Gray100", +/* pixels */ +"w8888888weeeeeeeeeeeeeee", +"8&66666&8eeeeeeeeeeeeeee", +"86ttttt68eeeeeeeeeeeeeee", +"86ttttt68eeeee0###0eeeee", +"86ttttr&-4eee8:000:8eeee", +"86tttte 144ee,20002,eeee", +"86ttttt6 =,4e4<000<4eeee", +"86ttttt6-,0,4e4,0,4eeeee", +"86ttttt684,0<$$.,#$$0eee", +"8,eeeee,8e,200000000#eee", +"q,,,,,,,qe8:00000000,4ee", +"eeeeeeeeeee0=000006,0$ee", +"eeeeeeeeeeee8;00002;0$ee", +"eeeeeeeeeeee8;00002;0$ee", +"eeeeeeeeeeee8;00002;0$ee", +"eeeeeeeeeeee8;00002;0$ee", +"eeeeeeeeeeee8#;;;;%#;$ee", +"eeeeeeeeeeee=2222+88@0ee", +"eeeeeeeeeeee#00000.4$eee", +"eeeeeeeeeeee#00720O,,eee", +"eeeeeeeeeeee#002;02%8eee", +"eeeeeeeeeeee+22$,>2%8eee", +"eeeeeeeeeeee-#o48O%$qeee", +"eeeeeeeeeeee8;#ee$2,eeee" +}; diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 889283f..b71c302 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,5 +1,5 @@ ;;; gnus-agent.el --- unplugged support for Semi-gnus -;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Tatsuya Ichikawa @@ -25,11 +25,18 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'gnus) (require 'gnus-cache) (require 'nnvirtual) (require 'gnus-sum) -(eval-when-compile (require 'gnus-score)) +(require 'gnus-score) +(eval-when-compile + (if (featurep 'xemacs) + (require 'itimer) + (require 'timer)) + (require 'gnus-group)) (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") "Where the Gnus agent will store its files." @@ -77,6 +84,12 @@ If nil, only read articles will be expired." :group 'gnus-agent :type 'hook) +(defcustom gnus-agent-confirmation-function 'y-or-n-p + "Function to confirm when error happens." + :version "21.1" + :group 'gnus-agent + :type 'function) + (defcustom gnus-agent-large-newsgroup nil "*The number of articles which indicates a large newsgroup. If the number of unread articles exceeds it, The number of articles to be @@ -85,6 +98,15 @@ fetched will be limited to it. If not a positive integer, never consider it." :type '(choice (const nil) (integer :tag "Number"))) +(defcustom gnus-agent-synchronize-flags 'ask + "Indicate if flags are synchronized 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) @@ -102,10 +124,6 @@ fetched will be limited to it. If not a positive integer, never consider it." (defvar gnus-agent-send-mail-function nil) (defvar gnus-agent-file-coding-system 'raw-text) -(defconst gnus-agent-scoreable-headers - '("subject" "from" "date" "message-id" "references" "chars" "lines" "xref") - "Headers that are considered when scoring articles for download via the Agent.") - ;; Dynamic variables (defvar gnus-headers) (defvar gnus-score) @@ -166,7 +184,9 @@ fetched will be limited to it. If not a positive integer, never consider it." (defun gnus-agent-lib-file (file) "The full path of the Gnus agent library FILE." - (concat (gnus-agent-directory) "agent.lib/" file)) + (expand-file-name file + (file-name-as-directory + (expand-file-name "agent.lib" (gnus-agent-directory))))) ;;; Fetching setup functions. @@ -188,7 +208,7 @@ fetched will be limited to it. If not a positive integer, never consider it." (defmacro gnus-agent-with-fetch (&rest forms) "Do FORMS safely." `(unwind-protect - (progn + (let ((gnus-agent-fetching t)) (gnus-agent-start-fetch) ,@forms) (gnus-agent-stop-fetch))) @@ -235,7 +255,7 @@ fetched will be limited to it. If not a positive integer, never consider it." "Jc" gnus-enter-category-buffer "Jj" gnus-agent-toggle-plugged "Js" gnus-agent-fetch-session - "JY" gnus-agent-synchronize + "JY" gnus-agent-synchronize-flags "JS" gnus-group-send-drafts "Ja" gnus-agent-add-group "Jr" gnus-agent-remove-group) @@ -292,6 +312,7 @@ fetched will be limited to it. If not a positive integer, never consider it." (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) " Plugged")) (gnus-agent-close-connections) @@ -373,6 +394,43 @@ be a select method." (while (search-backward "\n" nil t) (replace-match "\\n" t t)))) +(defun gnus-agent-restore-gcc () + "Restore GCC field from saved header." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t) + (replace-match "Gcc:" 'fixedcase)))) + +(defun gnus-agent-any-covered-gcc () + (save-restriction + (message-narrow-to-headers) + (let* ((gcc (mail-fetch-field "gcc" nil t)) + (methods (and gcc + (mapcar 'gnus-inews-group-method + (message-unquote-tokens + (message-tokenize-header + gcc " ,"))))) + covered) + (while (and (not covered) methods) + (setq covered + (member (car methods) gnus-agent-covered-methods) + methods (cdr methods))) + covered))) + +(defun gnus-agent-possibly-save-gcc () + "Save GCC if Gnus is unplugged." + (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc)) + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward "^gcc:" nil t) + (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase)))))) + +(defun gnus-agent-possibly-do-gcc () + "Do GCC if Gnus is plugged." + (when (or gnus-plugged (not (gnus-agent-any-covered-gcc))) + (gnus-inews-do-gcc))) + ;;; ;;; Group mode commands ;;; @@ -427,26 +485,49 @@ be a select method." (setf (cadddr c) (delete group (cadddr c)))))) (gnus-category-write))) -(defun gnus-agent-synchronize () - "Synchronize local, unplugged, data with backend. -Currently sends flag setting requests, if any." +(defun gnus-agent-synchronize-flags () + "Synchronize unplugged flags with servers." + (interactive) + (save-excursion + (dolist (gnus-command-method gnus-agent-covered-methods) + (when (file-exists-p (gnus-agent-lib-file "flags")) + (gnus-agent-synchronize-flags-server gnus-command-method))))) + +(defun gnus-agent-possibly-synchronize-flags () + "Synchronize flags according to `gnus-agent-synchronize-flags'." (interactive) (save-excursion (dolist (gnus-command-method gnus-agent-covered-methods) (when (file-exists-p (gnus-agent-lib-file "flags")) - (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) - (erase-buffer) - (insert-file-contents (gnus-agent-lib-file "flags")) - (if (null (gnus-check-server gnus-command-method)) - (message "Couldn't open server %s" (nth 1 gnus-command-method)) - (while (not (eobp)) - (if (null (eval (read (current-buffer)))) - (progn (forward-line) - (kill-line -1)) - (write-file (gnus-agent-lib-file "flags")) - (error "Couldn't set flags from file %s" - (gnus-agent-lib-file "flags")))) - (write-file (gnus-agent-lib-file "flags"))))))) + (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) + +(defun gnus-agent-synchronize-flags-server (method) + "Synchronize flags set when unplugged for server." + (let ((gnus-command-method method)) + (when (file-exists-p (gnus-agent-lib-file "flags")) + (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) + (erase-buffer) + (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) + (if (null (gnus-check-server gnus-command-method)) + (message "Couldn't open server %s" (nth 1 gnus-command-method)) + (while (not (eobp)) + (if (null (eval (read (current-buffer)))) + (progn (forward-line) + (kill-line -1)) + (write-file (gnus-agent-lib-file "flags")) + (error "Couldn't set flags from file %s" + (gnus-agent-lib-file "flags")))) + (delete-file (gnus-agent-lib-file "flags"))) + (kill-buffer nil)))) + +(defun gnus-agent-possibly-synchronize-flags-server (method) + "Synchronize flags for server according to `gnus-agent-synchronize-flags'." + (when (or (and gnus-agent-synchronize-flags + (not (eq gnus-agent-synchronize-flags 'ask))) + (and (eq gnus-agent-synchronize-flags 'ask) + (gnus-y-or-n-p (format "Synchronize flags on server `%s'? " + (cadr method))))) + (gnus-agent-synchronize-flags-server method))) ;;; ;;; Server mode commands @@ -486,8 +567,12 @@ Currently sends flag setting requests, if any." (defun gnus-agent-write-servers () "Write the alist of covered servers." (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) - (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods (current-buffer)))) + (let ((coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") + (prin1 gnus-agent-covered-methods (current-buffer))))) ;;; ;;; Summary commands @@ -615,8 +700,9 @@ 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)) - (gnus-write-active-file-as-coding-system gnus-agent-file-coding-system - file orig))) + ;; The hashtable contains real names of groups, no more prefix + ;; removing, so set `full' to `t'. + (gnus-write-active-file file orig t))) (defun gnus-agent-save-groups (method) (gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format)) @@ -624,7 +710,12 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-group-info (method group active) (when (gnus-agent-method-p method) (let* ((gnus-command-method method) - (file (gnus-agent-lib-file "active"))) + (coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) + (file (gnus-agent-lib-file "active")) + oactive) (gnus-make-directory (file-name-directory file)) (with-temp-file file (when (file-exists-p file) @@ -632,9 +723,17 @@ the actual number of articles toggled is returned." (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) + (save-excursion + (save-restriction + (narrow-to-region (match-beginning 0) + (progn + (forward-line 1) + (point))) + (setq oactive (car (nnmail-parse-active))))) (gnus-delete-line)) - (insert (format "%S %d %d y\n" (intern group) (cdr active) - (car active))) + (insert (format "%S %d %d y\n" (intern group) + (cdr active) + (or (car oactive) (car active)))) (goto-char (point-max)) (while (search-backward "\\." nil t) (delete-char 1)))))) @@ -646,7 +745,7 @@ the actual number of articles toggled is returned." (nnheader-translate-file-chars (nnheader-replace-chars-in-string (nnheader-replace-duplicate-chars-in-string - (nnheader-replace-chars-in-string + (nnheader-replace-chars-in-string (gnus-group-real-name group) ?/ ?_) ?. ?_) @@ -682,7 +781,7 @@ the actual number of articles toggled is returned." (insert "\n") (let ((file (gnus-agent-lib-file "history"))) (when (file-exists-p file) - (insert-file file)) + (nnheader-insert-file-contents file)) (set (make-local-variable 'gnus-agent-file-name) file)))) (defun gnus-agent-save-history () @@ -704,11 +803,15 @@ the actual number of articles toggled is returned." (save-excursion (set-buffer gnus-agent-current-history) (goto-char (point-max)) - (insert id "\t" (number-to-string date) "\t") - (while group-arts - (insert (caar group-arts) " " (number-to-string (cdr (pop group-arts))) - " ")) - (insert "\n"))) + (let ((p (point))) + (insert id "\t" (number-to-string date) "\t") + (while group-arts + (insert (format "%S" (intern (caar group-arts))) + " " (number-to-string (cdr (pop group-arts))) + " ")) + (insert "\n") + (while (search-backward "\\." p t) + (delete-char 1))))) (defun gnus-agent-article-in-history-p (id) (save-excursion @@ -737,7 +840,7 @@ the actual number of articles toggled is returned." ;; Prune off articles that we have already fetched. (while (and articles (cdr (assq (car articles) gnus-agent-article-alist))) - (pop articles)) + (pop articles)) (let ((arts articles)) (while (cdr arts) (if (cdr (assq (cadr arts) gnus-agent-article-alist)) @@ -758,7 +861,10 @@ the actual number of articles toggled is returned." (with-temp-buffer (let (article) (while (setq article (pop articles)) - (when (gnus-request-article article group) + (when (or + (gnus-backlog-request-article group article + nntp-server-buffer) + (gnus-request-article article group)) (goto-char (point-max)) (push (cons article (point)) pos) (insert-buffer-substring nntp-server-buffer))) @@ -816,7 +922,7 @@ the actual number of articles toggled is returned." (setcdr alist (cons (cons (cdar crosses) t) (cdr alist))) (save-excursion (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*" - group))) + group))) (when (= (point-max) (point-min)) (push (cons group (current-buffer)) gnus-agent-buffer-alist) (ignore-errors @@ -855,12 +961,12 @@ the actual number of articles toggled is returned." (< 0 gnus-agent-large-newsgroup)) (and (< 0 (setq i (- len gnus-agent-large-newsgroup))) (setq articles (nthcdr i articles)))) - ;; add article with marks to list of article headers we want to fetch + ;; 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-union (gnus-uncompress-sequence (cdr arts)) articles))) (setq articles (sort articles '<)) - ;; remove known articles + ;; Remove known articles. (when (gnus-agent-load-alist group) (setq articles (gnus-sorted-intersection articles @@ -869,7 +975,7 @@ the actual number of articles toggled is returned." (cdr (gnus-active group))))))) ;; Fetch them. (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file))) + (file-name-directory file) t)) (when articles (gnus-message 7 "Fetching headers for %s..." group) (save-excursion @@ -944,31 +1050,36 @@ the actual number of articles toggled is returned." (setq gnus-agent-article-alist (gnus-agent-read-file (if dir - (concat dir ".agentview") + (expand-file-name ".agentview" dir) (gnus-agent-article-name ".agentview" group))))) (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." - (with-temp-file (if dir - (concat dir ".agentview") - (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"))) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (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")))) (defun gnus-agent-article-name (article group) - (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" - (if (stringp article) article (string-to-number article)))) + (expand-file-name (if (stringp article) article (string-to-number article)) + (file-name-as-directory + (expand-file-name (gnus-agent-group-path group) + (gnus-agent-directory))))) ;;;###autoload (defun gnus-agent-batch-fetch () "Start Gnus and fetch session." (interactive) (gnus) - (gnus-agent-fetch-session) + (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation)) + (gnus-agent-fetch-session)) (gnus-group-exit)) (defun gnus-agent-fetch-session () @@ -982,14 +1093,24 @@ the actual number of articles toggled is returned." groups group gnus-command-method) (save-excursion (while methods - (setq gnus-command-method (car methods)) - (when (or (gnus-server-opened gnus-command-method) - (gnus-open-server gnus-command-method)) - (setq groups (gnus-groups-from-server (car methods))) - (gnus-agent-with-fetch - (while (setq group (pop groups)) - (when (<= (gnus-group-level group) gnus-agent-handle-level) - (gnus-agent-fetch-group-1 group gnus-command-method))))) + (condition-case err + (progn + (setq gnus-command-method (car methods)) + (when (or (gnus-server-opened gnus-command-method) + (gnus-open-server gnus-command-method)) + (setq groups (gnus-groups-from-server (car methods))) + (gnus-agent-with-fetch + (while (setq group (pop groups)) + (when (<= (gnus-group-level group) gnus-agent-handle-level) + (gnus-agent-fetch-group-1 group gnus-command-method)))))) + (error + (unless (funcall gnus-agent-confirmation-function + (format "Error (%s). Continue? " err)) + (error "Cannot fetch articles into the Gnus agent."))) + (quit + (unless (funcall gnus-agent-confirmation-function + (format "Quit (%s). Continue? " err)) + (signal 'quit "Cannot fetch articles into the Gnus agent.")))) (pop methods)) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) @@ -1000,70 +1121,51 @@ the actual number of articles toggled is returned." gnus-newsgroup-dependencies gnus-newsgroup-headers gnus-newsgroup-scored gnus-headers gnus-score gnus-use-cache articles arts - category predicate info marks score-param) + category predicate info marks score-param + (gnus-summary-expunge-below gnus-summary-expunge-below) + (gnus-summary-mark-below gnus-summary-mark-below) + (gnus-orphan-score gnus-orphan-score) + ;; Maybe some other gnus-summary local variables should also + ;; be put here. + ) (unless (gnus-check-group group) (error "Can't open server for %s" group)) ;; Fetch headers. (when (and (or (gnus-active group) (gnus-activate-group group)) (setq articles (gnus-agent-fetch-headers group)) - (progn + (let ((nntp-server-buffer gnus-agent-overview-buffer)) ;; Parse them and see which articles we want to fetch. (setq gnus-newsgroup-dependencies (make-vector (length articles) 0)) - ;; No need to call `gnus-get-newsgroup-headers-xover' with - ;; the entire .overview for group as we still have the just - ;; downloaded headers in `gnus-agent-overview-buffer'. - (let ((nntp-server-buffer gnus-agent-overview-buffer)) - (setq gnus-newsgroup-headers - (gnus-get-newsgroup-headers-xover articles nil nil - group))) + (setq gnus-newsgroup-headers + (gnus-get-newsgroup-headers-xover articles nil nil + group)) ;; `gnus-agent-overview-buffer' may be killed for - ;; timeout reason. If so, recreate it. + ;; timeout reason. If so, recreate it. (gnus-agent-create-buffer))) (setq category (gnus-group-category group)) (setq predicate (gnus-get-predicate (or (gnus-group-find-parameter group 'agent-predicate t) (cadr category)))) - ;; Do we want to download everything, or nothing? - (if (or (eq (caaddr predicate) 'gnus-agent-true) - (eq (caaddr predicate) 'gnus-agent-false)) - ;; Yes. - (setq arts (symbol-value - (cadr (assoc (caaddr predicate) - '((gnus-agent-true articles) - (gnus-agent-false nil)))))) - ;; No, we need to decide what we want. + (if (memq (caaddr predicate) '(gnus-agent-true gnus-agent-false)) + ;; Simple implementation + (setq arts + (and (eq (caaddr predicate) 'gnus-agent-true) articles)) + (setq arts nil) (setq score-param - (let ((score-method - (or - (gnus-group-find-parameter group 'agent-score t) - (caddr category)))) - (when score-method - (require 'gnus-score) - (if (eq score-method 'file) - (let ((entries - (gnus-score-load-files - (gnus-all-score-files group))) - list score-file) - (while (setq list (car entries)) - (push (car list) score-file) - (setq list (cdr list)) - (while list - (when (member (caar list) - gnus-agent-scoreable-headers) - (push (car list) score-file)) - (setq list (cdr list))) - (setq score-param - (append score-param (list (nreverse score-file))) - score-file nil entries (cdr entries))) - (list score-param)) - (if (stringp (car score-method)) - score-method - (list (list score-method))))))) + (or (gnus-group-get-parameter group 'agent-score t) + (caddr category))) + ;; Translate score-param into real one + (cond + ((not score-param)) + ((eq score-param 'file) + (setq score-param (gnus-all-score-files group))) + ((stringp (car score-param))) + (t + (setq score-param (list (list score-param))))) (when score-param (gnus-score-headers score-param)) - (setq arts nil) (while (setq gnus-headers (pop gnus-newsgroup-headers)) (setq gnus-score (or (cdr (assq (mail-header-number gnus-headers) @@ -1289,8 +1391,8 @@ The following commands are available: (let ((info (assq category gnus-category-alist)) (buffer-read-only nil)) (gnus-delete-line) - (gnus-category-write) - (setq gnus-category-alist (delq info gnus-category-alist)))) + (setq gnus-category-alist (delq info gnus-category-alist)) + (gnus-category-write))) (defun gnus-category-copy (category to) "Copy the current category." @@ -1445,13 +1547,24 @@ The following commands are available: (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward "^\t") - (if (> (read (current-buffer)) day) + (if (let ((fetch-date (read (current-buffer)))) + (if (numberp fetch-date) + (> fetch-date day) + ;; History file is corrupted. + (gnus-message + 5 + (format "File %s is corrupted!" + (gnus-agent-lib-file "history"))) + (sit-for 1) + ;; Ignore it + t)) ;; New article; we don't expire it. (forward-line 1) ;; Old article. Schedule it for possible nuking. (while (not (eolp)) - (setq sym (let ((obarray expiry-hashtb)) - (read (current-buffer)))) + (setq sym (let ((obarray expiry-hashtb) s) + (setq s (read (current-buffer))) + (if (stringp s) (intern s) s))) (if (boundp sym) (set sym (cons (cons (read (current-buffer)) (point)) (symbol-value sym))) @@ -1583,9 +1696,7 @@ The following commands are available: (gnus-delete-line)) (gnus-agent-save-history) (gnus-agent-close-history) - (gnus-write-active-file-as-coding-system - gnus-agent-file-coding-system - (gnus-agent-lib-file "active") orig)) + (gnus-write-active-file (gnus-agent-lib-file "active") orig)) (gnus-message 4 "Expiry...done"))))))) ;;;###autoload diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index cf5e933..d5780ef 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Semi-gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -31,24 +31,20 @@ (eval-when-compile (require 'static)) (require 'path-util) -(require 'custom) (require 'gnus) (require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) -(require 'browse-url) (require 'alist) (require 'mime-view) +(require 'wid-edit) ;; Avoid byte-compile warnings. -(defvar gnus-article-decoded-p) -(defvar gnus-article-mime-handles) (eval-when-compile (require 'mm-bodies) (require 'mail-parse) (require 'mm-decode) (require 'mm-view) - (require 'wid-edit) (require 'mm-uu) ) @@ -130,7 +126,7 @@ "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:" "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" - "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:" + "^MBOX-Line" "^Priority:" "^X400-[-A-Za-z]+:" "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:" "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:" "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:" @@ -139,7 +135,8 @@ "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:" "^List-[A-Za-z]+:" "^X-Listprocessor-Version:" "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:" - "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:") + "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:" + "^X-Received:" "^Content-length:" "X-precedence:") "*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." @@ -149,7 +146,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." :group 'gnus-article-hiding) (defcustom gnus-visible-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:" + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:" "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." @@ -180,8 +177,8 @@ Possible values in this list are `empty', `newsgroups', `followup-to', (const :tag "Followup-to identical to newsgroups." followup-to) (const :tag "Reply-to identical to from." reply-to) (const :tag "Date less than four days old." date) - (const :tag "Very long To header." long-to) - (const :tag "Multiple To headers." many-to)) + (const :tag "Very long To and/or Cc header." long-to) + (const :tag "Multiple To and/or Cc headers." many-to)) :group 'gnus-article-hiding) (defcustom gnus-signature-separator '("^-- $" "^-- *$") @@ -193,7 +190,7 @@ the end of the buffer." :group 'gnus-article-signature) (defcustom gnus-signature-limit nil - "Provide a limit to what is considered a signature. + "Provide a limit to what is considered a signature. If it is a number, no signature may not be longer (in characters) than that number. If it is a floating point number, no signature may be longer (in lines) than that number. If it is a function, the function @@ -212,16 +209,34 @@ regexp. If it matches, the text in question is not a signature." :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command - (if (and (not gnus-xemacs) - window-system - (module-installed-p 'x-face-mule)) - 'x-face-mule-gnus-article-display-x-face - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -" - ) + (cond + ;; Fixme: This isn't the right thing for mixed graphical and and + ;; non-graphical frames in a session. + ;; gnus-xmas.el overrides this for XEmacs. + ((and (fboundp 'image-type-available-p) + (image-type-available-p 'xbm)) + (if (module-installed-p 'x-face-e21) + 'x-face-decode-message-header + 'gnus-article-display-xface)) + ((and (not (featurep 'xemacs)) + window-system + (module-installed-p 'x-face-mule)) + 'x-face-mule-gnus-article-display-x-face) + (gnus-article-compface-xbm + "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -") + (t + "{ 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 'string ;Leave function case to Lisp. + :type '(choice string + (function-item + :tag "x-face-decode-message-header (x-face-e21)" + x-face-decode-message-header) + (function-item gnus-article-display-xface) + (function-item x-face-mule-gnus-article-display-x-face) + function) :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil @@ -229,6 +244,22 @@ asynchronously. The compressed face will be piped to this command." :type '(choice regexp (const nil)) :group 'gnus-article-washing) +(defcustom gnus-article-banner-alist nil + "Banner alist for stripping. +For example, + ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" + :version "21.1" + :type '(repeat (cons symbol regexp)) + :group 'gnus-article-washing) + +(defcustom gnus-article-banner-alist nil + "Banner alist for stripping. +For example, + ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" + :version "21.1" + :type '(repeat (cons symbol regexp)) + :group 'gnus-article-washing) + (defcustom gnus-emphasis-alist (let ((format "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)") @@ -265,6 +296,15 @@ is the face used for highlighting." face)) :group 'gnus-article-emphasis) +(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n" + "A regexp to describe whitespace which should not be emphasized. +Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\". +The former avoids underlining of leading and trailing whitespace, +and the latter avoids underlining any whitespace at all." + :version "21.1" + :group 'gnus-article-emphasis + :type 'regexp) + (defface gnus-emphasis-bold '((t (:bold t))) "Face used for displaying strong emphasized text (*word*)." :group 'gnus-article-emphasis) @@ -489,7 +529,8 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." :group 'gnus-article-signature) (defface gnus-signature-face - '((t (:italic t))) + '((t + (:italic t))) "Face used for highlighting a signature in the article buffer." :group 'gnus-article-highlight :group 'gnus-article-signature) @@ -598,7 +639,8 @@ displayed by the first non-nil matching CONTENT face." "Function used to decode headers.") (defvar gnus-article-dumbquotes-map - '(("\202" ",") + '(("\200" "EUR") + ("\202" ",") ("\203" "f") ("\204" ",,") ("\205" "...") @@ -609,8 +651,8 @@ displayed by the first non-nil matching CONTENT face." ("\223" "``") ("\224" "\"") ("\225" "*") - ("\226" "---") - ("\227" "-") + ("\226" "-") + ("\227" "--") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -619,11 +661,13 @@ displayed by the first non-nil matching CONTENT face." (defcustom gnus-ignored-mime-types nil "List of MIME types that should be ignored by Gnus." + :version "21.1" :group 'gnus-article-mime :type '(repeat regexp)) (defcustom gnus-unbuttonized-mime-types '(".*/.*") "List of MIME types that should not be given buttons when rendered inline." + :version "21.1" :group 'gnus-article-mime :type '(repeat regexp)) @@ -635,13 +679,17 @@ on parts -- for instance, adding Vcard info to a database." :type 'function) (defcustom gnus-mime-multipart-functions nil - "An alist of MIME types to functions to display them.") + "An alist of MIME types to functions to display them." + :version "21.1" + :group 'gnus-article-mime + :type 'alist) (defcustom gnus-article-date-lapsed-new-header nil "Whether the X-Sent and Date headers can coexist. When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will either replace the old \"Date:\" header (if this variable is nil), or be added below it (otherwise)." + :version "21.1" :group 'gnus-article-headers :type 'boolean) @@ -649,10 +697,11 @@ be added below it (otherwise)." "Function called with a MIME handle as the argument. This is meant for people who want to view first matched part. For `undisplayed-alternative' (default), the first undisplayed -part or alternative part is used. For `undisplayed', the first -undisplayed part is used. For a function, the first part which -the function return `t' is used. For `nil', the first part is +part or alternative part is used. For `undisplayed', the first +undisplayed part is used. For a function, the first part which +the function return `t' is used. For `nil', the first part is used." + :version "21.1" :group 'gnus-article-mime :type '(choice (item :tag "first" :value nil) @@ -661,6 +710,37 @@ used." :value undisplayed-alternative) (function))) +(defcustom gnus-mime-action-alist + '(("save to file" . gnus-mime-save-part) + ("save and strip" . gnus-mime-save-part-and-strip) + ("display as text" . gnus-mime-inline-part) + ("view the part" . gnus-mime-view-part) + ("pipe to command" . gnus-mime-pipe-part) + ("toggle display" . gnus-article-press-button) + ("toggle display" . gnus-article-view-part-as-charset) + ("view as type" . gnus-mime-view-part-as-type) + ("internalize type" . gnus-mime-internalize-part) + ("externalize type" . gnus-mime-externalize-part)) + "An alist of actions that run on the MIME attachment." + :group 'gnus-article-mime + :type '(repeat (cons (string :tag "name") + (function)))) + +(defcustom gnus-mime-action-alist + '(("save to file" . gnus-mime-save-part) + ("display as text" . gnus-mime-inline-part) + ("view the part" . gnus-mime-view-part) + ("pipe to command" . gnus-mime-pipe-part) + ("toggle display" . gnus-article-press-button) + ("view as type" . gnus-mime-view-part-as-type) + ("internalize type" . gnus-mime-internalize-part) + ("externalize type" . gnus-mime-externalize-part)) + "An alist of actions that run on the MIME attachment." + :version "21.1" + :group 'gnus-article-mime + :type '(repeat (cons (string :tag "name") + (function)))) + ;;; ;;; The treatment variables ;;; @@ -762,10 +842,25 @@ See the manual 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." + :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." + :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." + :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -839,6 +934,7 @@ See the manual for details." "Display the date in the ISO8601 format. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." + :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-head-custom) @@ -854,6 +950,7 @@ See the manual for details." "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." + :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -887,11 +984,13 @@ See the manual for details." (put 'gnus-treat-overstrike 'highlight t) (defcustom gnus-treat-display-xface - (if (or (and gnus-xemacs (featurep 'xface)) - (eq 'x-face-mule-gnus-article-display-x-face - gnus-article-x-face-command)) - 'head - nil) + (and (or (and (fboundp 'image-type-available-p) + (image-type-available-p 'xbm) + (string-match "^0x" (shell-command-to-string "uncompface"))) + (and (featurep 'xemacs) (featurep 'xface)) + (eq 'x-face-mule-gnus-article-display-x-face + gnus-article-x-face-command)) + 'head) "Display X-Face headers. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." @@ -900,10 +999,13 @@ See the manual for details." (put 'gnus-treat-display-xface 'highlight t) (defcustom gnus-treat-display-smileys - (if (or (and gnus-xemacs (featurep 'xpm)) - (and (not gnus-xemacs) + (if (or (and (featurep 'xemacs) + (featurep 'xpm)) + (and (fboundp 'image-type-available-p) + (image-type-available-p 'pbm)) + (and (not (featurep 'xemacs)) window-system - (module-installed-p 'smiley-mule))) + (module-installed-p 'gnus-bitmap))) t nil) "Display smileys. @@ -913,7 +1015,7 @@ See the manual for details." :type gnus-article-treat-custom) (put 'gnus-treat-display-smileys 'highlight t) -(defcustom gnus-treat-display-picons (if gnus-xemacs 'head nil) +(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil) "Display picons. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." @@ -925,6 +1027,7 @@ See the manual for details." "Capitalize sentence-starting words. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." + :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -939,6 +1042,7 @@ See the manual for details." "Play sounds. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." + :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -956,9 +1060,30 @@ decode the body, '(or header t) for the whole article, etc." "Translate articles from one language to another. Valid values are nil, t, `head', `last', an integer or a predicate. See the manual for details." + :version "21.1" + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-x-pgp-sig nil + "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." :group 'gnus-article-treat + :group 'mime-security :type gnus-article-treat-custom) +(defvar gnus-article-encrypt-protocol-alist + '(("PGP" . mml2015-self-encrypt))) + +;; Set to nil if more than one protocol added to +;; gnus-article-encrypt-protocol-alist. +(defcustom gnus-article-encrypt-protocol "PGP" + "The protocol used for encrypt articles. +It is a string, such as \"PGP\". If nil, ask user." + :type 'string + :group 'mime-security) + ;;; Internal variables (defvar article-goto-body-goes-to-point-min-p nil) @@ -969,6 +1094,7 @@ See the manual for details." (defvar gnus-treatment-function-alist '((gnus-treat-decode-article-as-default-mime-charset gnus-article-decode-article-as-default-mime-charset) + (gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) (gnus-treat-strip-banner gnus-article-strip-banner) (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) (gnus-treat-buttonize gnus-article-add-buttons) @@ -980,6 +1106,7 @@ See the manual for details." (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) (gnus-treat-hide-signature gnus-article-hide-signature) (gnus-treat-hide-citation gnus-article-hide-citation) + (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers) (gnus-treat-strip-pgp gnus-article-hide-pgp) (gnus-treat-strip-pem gnus-article-hide-pem) @@ -1001,7 +1128,7 @@ See the manual for details." gnus-article-strip-multiple-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) - (gnus-treat-display-smileys gnus-smiley-display) + (gnus-treat-display-smileys gnus-article-smiley-display) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) (gnus-treat-display-picons gnus-article-display-picons) (gnus-treat-play-sounds gnus-earcon-display))) @@ -1012,7 +1139,8 @@ See the manual for details." (defvar gnus-article-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?- "w" table) + ;; This causes the citation match run O(2^n). + ;; (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?> ")" table) (modify-syntax-entry ?< "(" table) table) @@ -1032,11 +1160,12 @@ Initialized from `text-mode-syntax-table.") (defsubst gnus-article-hide-text (b e props) "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (add-text-properties b e props) + (gnus-add-text-properties-when 'article-type nil b e props) (when (memq 'intangible props) (put-text-property (max (1- b) (point-min)) b 'intangible (cddr (memq 'intangible props))))) + (defsubst gnus-article-unhide-text (b e) "Remove hidden text properties from region between B and E." (remove-text-properties b e gnus-hidden-properties) @@ -1232,11 +1361,15 @@ always hide." 4)) (gnus-article-hide-header "date")))) ((eq elem 'long-to) - (let ((to (message-fetch-field "to"))) + (let ((to (message-fetch-field "to")) + (cc (message-fetch-field "cc"))) (when (> (length to) 1024) - (gnus-article-hide-header "to")))) + (gnus-article-hide-header "to")) + (when (> (length cc) 1024) + (gnus-article-hide-header "cc")))) ((eq elem 'many-to) - (let ((to-count 0)) + (let ((to-count 0) + (cc-count 0)) (goto-char (point-min)) (while (re-search-forward "^to:" nil t) (setq to-count (1+ to-count))) @@ -1248,7 +1381,19 @@ always hide." (forward-line -1) (narrow-to-region (point) (point-max)) (gnus-article-hide-header "to")) - (setq to-count (1- to-count))))))))))))) + (setq to-count (1- to-count)))) + (goto-char (point-min)) + (while (re-search-forward "^cc:" nil t) + (setq cc-count (1+ cc-count))) + (when (> cc-count 1) + (while (> cc-count 0) + (goto-char (point-min)) + (save-restriction + (re-search-forward "^cc:" nil nil cc-count) + (forward-line -1) + (narrow-to-region (point) (point-max)) + (gnus-article-hide-header "cc")) + (setq cc-count (1- cc-count))))))))))))) (defun gnus-article-hide-header (header) (save-excursion @@ -1328,7 +1473,7 @@ if given a positive prefix, always hide." (narrow-to-region header-start header-end) (article-hide-headers) ;; Re-display X-Face image under XEmacs. - (when (and gnus-xemacs + (when (and (featurep 'xemacs) (gnus-functionp gnus-article-x-face-command)) (let ((func (cadr (assq 'gnus-treat-display-xface gnus-treatment-function-alist))) @@ -1525,7 +1670,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (not (string-match gnus-article-x-face-too-ugly from)))) ;; Has to be present. - (re-search-forward "^X-Face: " nil t)) + (re-search-forward "^X-Face:[ \t]*" nil t)) ;; This used to try to do multiple faces (`while' instead of ;; `when' above), but (a) sending multiple EOFs to xv doesn't ;; work (b) it can crash some versions of Emacs (c) are @@ -1569,39 +1714,47 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." "Decode charset-encoded text in the article. If PROMPT (the prefix), prompt for a coding system to use." (interactive "P") + (let ((inhibit-point-motion-hooks t) (case-fold-search t) + buffer-read-only + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (save-excursion (condition-case nil + (set-buffer gnus-summary-buffer) + (error)) + gnus-newsgroup-ignored-charsets)) + ct cte ctl charset format) (save-excursion (save-restriction (article-narrow-to-head) - (let* ((inhibit-point-motion-hooks t) - (case-fold-search t) - (ct (message-fetch-field "Content-Type" t)) - (cte (message-fetch-field "Content-Transfer-Encoding" t)) - (ctl (and ct (ignore-errors - (mail-header-parse-content-type ct)))) - (charset (cond - (prompt - (mm-read-coding-system "Charset to decode: ")) - (ctl - (mail-content-type-get ctl 'charset)))) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (condition-case nil - (set-buffer gnus-summary-buffer) - (error)) - gnus-newsgroup-ignored-charsets)) - buffer-read-only) - (if (and ctl (not (string-match "/" (car ctl)))) - (setq ctl nil)) - (goto-char (point-max)) - (widen) - (forward-line 1) - (narrow-to-region (point) (point-max)) - (when (and (or (not ctl) - (equal (car ctl) "text/plain"))) - (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) - (car ctl))))))) + (setq ct (message-fetch-field "Content-Type" t) + cte (message-fetch-field "Content-Transfer-Encoding" t) + ctl (and ct (ignore-errors + (mail-header-parse-content-type ct))) + charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ctl + (mail-content-type-get ctl 'charset))) + format (and ctl (mail-content-type-get ctl 'format))) + (when cte + (setq cte (mail-header-strip cte))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max))) + (forward-line 1) + (save-restriction + (narrow-to-region (point) (point-max)) + (when (and (eq mail-parse-charset 'gnus-decoded) + (eq (mm-body-7-or-8) '8bit)) + ;; The text code could have been decoded. + (setq charset mail-parse-charset)) + (when (and (or (not ctl) + (equal (car ctl) "text/plain")) + (not format)) ;; article with format will decode later. + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -1618,21 +1771,101 @@ If FORCE, decode the article whether it is marked as quoted-printable or not." (interactive (list 'force)) (save-excursion - (let ((buffer-read-only nil) - (type (gnus-fetch-field "content-transfer-encoding")) - (charset gnus-newsgroup-charset)) + (let ((buffer-read-only nil) type charset) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (setq type + (gnus-fetch-field "content-transfer-encoding")) + (let* ((ct (gnus-fetch-field "content-type")) + (ctl (and ct + (ignore-errors + (mail-header-parse-content-type ct))))) + (setq charset (and ctl + (mail-content-type-get ctl 'charset))) + (if (stringp charset) + (setq charset (intern (downcase charset))))))) + (unless charset + (setq charset gnus-newsgroup-charset)) + (when (or force + (and type (let ((case-fold-search t)) + (string-match "quoted-printable" type)))) + (article-goto-body) + (quoted-printable-decode-region + (point) (point-max) (mm-charset-to-coding-system charset)))))) + +(defun article-de-base64-unreadable (&optional force) + "Translate a base64 article. +If FORCE, decode the article whether it is marked as base64 not." + (interactive (list 'force)) + (save-excursion + (let ((buffer-read-only nil) type charset) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (setq type + (gnus-fetch-field "content-transfer-encoding")) + (let* ((ct (gnus-fetch-field "content-type")) + (ctl (and ct + (ignore-errors + (mail-header-parse-content-type ct))))) + (setq charset (and ctl + (mail-content-type-get ctl 'charset))) + (if (stringp charset) + (setq charset (intern (downcase charset))))))) + (unless charset + (setq charset gnus-newsgroup-charset)) (when (or force - (and type (string-match "quoted-printable" (downcase type)))) + (and type (let ((case-fold-search t)) + (string-match "base64" type)))) (article-goto-body) (save-restriction (narrow-to-region (point) (point-max)) - (quoted-printable-decode-region (point-min) (point-max)) - (when charset - (mm-decode-body charset))))))) + (base64-decode-region (point-min) (point-max)) + (mm-decode-coding-region + (point-min) (point-max) (mm-charset-to-coding-system charset))))))) + +(eval-when-compile + (require 'rfc1843)) + +(defun article-decode-HZ () + "Translate a HZ-encoded article." + (interactive) + (require 'rfc1843) + (save-excursion + (let ((buffer-read-only nil)) + (rfc1843-decode-region (point-min) (point-max))))) + +(defun article-wash-html () + "Format an html article." + (interactive) + (save-excursion + (let ((buffer-read-only nil) + charset) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (let* ((ct (gnus-fetch-field "content-type")) + (ctl (and ct + (ignore-errors + (mail-header-parse-content-type ct))))) + (setq charset (and ctl + (mail-content-type-get ctl 'charset))) + (if (stringp charset) + (setq charset (intern (downcase charset))))))) + (unless charset + (setq charset gnus-newsgroup-charset)) + (article-goto-body) + (save-window-excursion + (save-restriction + (narrow-to-region (point) (point-max)) + (mm-setup-w3) + (let ((w3-strict-width (window-width)) + (url-standalone-mode t)) + (condition-case var + (w3-region (point-min) (point-max)) + (error)))))))) (defun article-hide-list-identifiers () - "Remove any list identifiers in `gnus-list-identifiers' from Subject -header in the current article." + "Remove list identifies from the Subject header. +The `gnus-list-identifiers' variable specifies what to do." (interactive) (save-excursion (save-restriction @@ -1644,9 +1877,14 @@ header in the current article." (when regexp (goto-char (point-min)) (when (re-search-forward - (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)") + (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") nil t) - (delete-region (match-beginning 2) (match-end 0))))))))) + (let ((s (or (match-string 3) (match-string 5)))) + (delete-region (match-beginning 1) (match-end 1)) + (when s + (goto-char (match-beginning 1)) + (insert s)))))))))) (defun article-hide-pgp () "Remove any PGP headers and signatures in the current article." @@ -1717,7 +1955,7 @@ always hide." (save-excursion (save-restriction (let ((inhibit-point-motion-hooks t) - (banner (gnus-group-get-parameter gnus-newsgroup-name 'banner)) + (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner)) (gnus-signature-limit nil) buffer-read-only beg end) (when banner @@ -1728,6 +1966,10 @@ always hide." (widen) (forward-line -1) (delete-region (point) (point-max)))) + ((symbolp banner) + (if (setq banner (cdr (assq banner gnus-article-banner-alist))) + (while (re-search-forward banner nil t) + (delete-region (match-beginning 0) (match-end 0))))) ((stringp banner) (while (re-search-forward banner nil t) (delete-region (match-beginning 0) (match-end 0)))))))))) @@ -1955,24 +2197,16 @@ means show, 0 means toggle." 'hidden nil))) -(defun gnus-article-show-hidden-text (type &optional hide) +(defun gnus-article-show-hidden-text (type &optional dummy) "Show all hidden text of type TYPE. -If HIDE, hide the text instead." - (save-excursion - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (end (point-min)) - beg) - (while (setq beg (text-property-any end (point-max) 'article-type type)) - (goto-char beg) - (setq end (or - (text-property-not-all beg (point-max) 'article-type type) - (point-max))) - (if hide - (gnus-article-hide-text beg end gnus-hidden-properties) - (gnus-article-unhide-text beg end)) - (goto-char end)) - t))) +Originally it is hide instead of DUMMY." + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t)) + (gnus-remove-text-properties-when + 'article-type type + (point-min) (point-max) + (cons 'article-type (cons type + gnus-hidden-properties))))) (defconst article-time-units `((year . ,(* 365.25 24 60 60)) @@ -1986,7 +2220,7 @@ If HIDE, hide the text instead." (defun article-date-ut (&optional type highlight header) "Convert DATE date to universal time in the current article. If TYPE is `local', convert to local time; if it is `lapsed', output -how much time has lapsed since DATE. For `lapsed', the value of +how much time has lapsed since DATE. For `lapsed', the value of `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header should replace the \"Date:\" one, or should be added below it." (interactive (list 'ut t)) @@ -2081,9 +2315,9 @@ should replace the \"Date:\" one, or should be added below it." (concat "Date: " (current-time-string (let* ((e (parse-time-string date)) - (tm (apply 'encode-time e)) - (ms (car tm)) - (ls (- (cadr tm) (car (current-time-zone time))))) + (tm (apply 'encode-time e)) + (ms (car tm)) + (ls (- (cadr tm) (car (current-time-zone time))))) (cond ((< ls 0) (list (1- ms) (+ ls 65536))) ((> ls 65535) (list (1+ ms) (- ls 65536))) (t (list ms ls))))) @@ -2328,76 +2562,78 @@ This format is defined by the `gnus-article-time-format' variable." (let ((default-name (funcall function group headers (symbol-value variable))) result) - (setq - result - (cond - ((eq filename 'default) - default-name) - ((eq filename t) - default-name) - (filename filename) - (t - (let* ((split-name (gnus-get-split-value gnus-split-methods)) - (prompt - (format prompt - (if (and gnus-number-of-articles-to-be-saved - (> gnus-number-of-articles-to-be-saved 1)) - (format "these %d articles" - gnus-number-of-articles-to-be-saved) - "this article"))) - (file - ;; Let the split methods have their say. - (cond - ;; No split name was found. - ((null split-name) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name)) - ;; A single group name is returned. - ((stringp split-name) - (setq default-name - (funcall function split-name headers - (symbol-value variable))) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name)) - ;; A single split name was found - ((= 1 (length split-name)) - (let* ((name (expand-file-name - (car split-name) gnus-article-save-directory)) - (dir (cond ((file-directory-p name) - (file-name-as-directory name)) - ((file-exists-p name) name) - (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name ") ") - dir name))) - ;; A list of splits was found. - (t - (setq split-name (nreverse split-name)) - (let (result) - (let ((file-name-history - (nconc split-name file-name-history))) - (setq result - (expand-file-name - (read-file-name - (concat prompt " (`M-p' for defaults) ") - gnus-article-save-directory - (car split-name)) - gnus-article-save-directory))) - (car (push result file-name-history))))))) - ;; Create the directory. - (gnus-make-directory (file-name-directory file)) - ;; If we have read a directory, we append the default file name. - (when (file-directory-p file) - (setq file (concat (file-name-as-directory file) - (file-name-nondirectory default-name)))) - ;; Possibly translate some characters. - (nnheader-translate-file-chars file))))) + (setq result + (expand-file-name + (cond + ((eq filename 'default) + default-name) + ((eq filename t) + default-name) + (filename filename) + (t + (let* ((split-name (gnus-get-split-value gnus-split-methods)) + (prompt + (format prompt + (if (and gnus-number-of-articles-to-be-saved + (> gnus-number-of-articles-to-be-saved 1)) + (format "these %d articles" + gnus-number-of-articles-to-be-saved) + "this article"))) + (file + ;; Let the split methods have their say. + (cond + ;; No split name was found. + ((null split-name) + (read-file-name + (concat prompt " (default " + (file-name-nondirectory default-name) ") ") + (file-name-directory default-name) + default-name)) + ;; A single group name is returned. + ((stringp split-name) + (setq default-name + (funcall function split-name headers + (symbol-value variable))) + (read-file-name + (concat prompt " (default " + (file-name-nondirectory default-name) ") ") + (file-name-directory default-name) + default-name)) + ;; A single split name was found + ((= 1 (length split-name)) + (let* ((name (expand-file-name + (car split-name) + gnus-article-save-directory)) + (dir (cond ((file-directory-p name) + (file-name-as-directory name)) + ((file-exists-p name) name) + (t gnus-article-save-directory)))) + (read-file-name + (concat prompt " (default " name ") ") + dir name))) + ;; A list of splits was found. + (t + (setq split-name (nreverse split-name)) + (let (result) + (let ((file-name-history + (nconc split-name file-name-history))) + (setq result + (expand-file-name + (read-file-name + (concat prompt " (`M-p' for defaults) ") + gnus-article-save-directory + (car split-name)) + gnus-article-save-directory))) + (car (push result file-name-history))))))) + ;; Create the directory. + (gnus-make-directory (file-name-directory file)) + ;; If we have read a directory, we append the default file name. + (when (file-directory-p file) + (setq file (expand-file-name (file-name-nondirectory + default-name) + (file-name-as-directory file)))) + ;; Possibly translate some characters. + (nnheader-translate-file-chars file)))))) (gnus-make-directory (file-name-directory result)) (set variable result))) @@ -2555,17 +2791,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is default (or last-file default)))) -(defun gnus-Plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/News.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - (defun gnus-plain-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is @@ -2574,9 +2799,82 @@ If variable `gnus-use-long-file-name' is non-nil, it is (expand-file-name (if (gnus-use-long-file-name 'not-save) newsgroup - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) + (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))) gnus-article-save-directory))) +(defun article-verify-x-pgp-sig () + "Verify X-PGP-Sig." + (interactive) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (let ((sig (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "X-PGP-Sig"))) + items info headers) + (when (and sig + mml2015-use + (mml2015-clear-verify-function)) + (with-temp-buffer + (insert-buffer gnus-original-article-buffer) + (setq items (split-string sig)) + (message-narrow-to-head) + (let ((inhibit-point-motion-hooks t) + (case-fold-search t)) + ;; Don't verify multiple headers. + (setq headers (mapconcat (lambda (header) + (concat header ": " + (mail-fetch-field header) "\n")) + (split-string (nth 1 items) ",") ""))) + (delete-region (point-min) (point-max)) + (insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n") + (insert "X-Signed-Headers: " (nth 1 items) "\n") + (insert headers) + (widen) + (forward-line) + (while (not (eobp)) + (if (looking-at "^-") + (insert "- ")) + (forward-line)) + (insert "\n-----BEGIN PGP SIGNATURE-----\n") + (insert "Version: " (car items) "\n\n") + (insert (mapconcat 'identity (cddr items) "\n")) + (insert "\n-----END PGP SIGNATURE-----\n") + (let ((mm-security-handle (list (format "multipart/signed")))) + (mml2015-clean-buffer) + (let ((coding-system-for-write (or gnus-newsgroup-charset + 'iso-8859-1))) + (funcall (mml2015-clear-verify-function))) + (setq info + (or (mm-handle-multipart-ctl-parameter + mm-security-handle 'gnus-details) + (mm-handle-multipart-ctl-parameter + mm-security-handle 'gnus-info))))) + (when info + (let (buffer-read-only bface eface) + (save-restriction + (message-narrow-to-head) + (goto-char (point-max)) + (forward-line -1) + (setq bface (get-text-property (gnus-point-at-bol) 'face) + eface (get-text-property (1- (gnus-point-at-eol)) 'face)) + (message-remove-header "X-Gnus-PGP-Verify") + (if (re-search-forward "^X-PGP-Sig:" nil t) + (forward-line) + (goto-char (point-max))) + (narrow-to-region (point) (point)) + (insert "X-Gnus-PGP-Verify: " info "\n") + (goto-char (point-min)) + (forward-line) + (while (not (eobp)) + (if (not (looking-at "^[ \t]")) + (insert " ")) + (forward-line)) + ;; Do highlighting. + (goto-char (point-min)) + (when (looking-at "\\([^:]+\\): *") + (put-text-property (match-beginning 1) (1+ (match-end 1)) + 'face bface) + (put-text-property (match-end 0) (point-max) + 'face eface))))))))) + (eval-and-compile (mapcar (lambda (func) @@ -2586,18 +2884,18 @@ If variable `gnus-use-long-file-name' is non-nil, it is gfunc (cdr func)) (setq afunc func gfunc (intern (format "gnus-%s" func)))) - (fset gfunc - (if (not (fboundp afunc)) - nil - `(lambda (&optional interactive &rest args) - ,(documentation afunc t) - (interactive (list t)) - (save-excursion - (set-buffer gnus-article-buffer) - (if interactive - (call-interactively ',afunc) - (apply ',afunc args)))))))) + (defalias gfunc + (if (fboundp afunc) + `(lambda (&optional interactive &rest args) + ,(documentation afunc t) + (interactive (list t)) + (save-excursion + (set-buffer gnus-article-buffer) + (if interactive + (call-interactively ',afunc) + (apply ',afunc args)))))))) '(article-hide-headers + article-verify-x-pgp-sig article-hide-boring-headers article-toggle-headers article-treat-overstrike @@ -2606,6 +2904,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-remove-cr article-display-x-face article-de-quoted-unreadable + article-de-base64-unreadable + article-decode-HZ + article-wash-html article-hide-list-identifiers article-hide-pgp article-strip-banner @@ -2651,11 +2952,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is "s" gnus-article-show-summary "\C-c\C-m" gnus-article-mail "?" gnus-article-describe-briefly - "e" gnus-summary-article-edit + "e" gnus-summary-edit-article "<" beginning-of-buffer ">" end-of-buffer "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug + "\C-hk" gnus-article-describe-key + "\C-hc" gnus-article-describe-key-briefly "\C-d" gnus-article-read-summary-keys "\M-*" gnus-article-read-summary-keys @@ -2686,6 +2989,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is (decf c)) keys)))) +(eval-when-compile + (defvar gnus-article-commands-menu)) + (defun gnus-article-make-menu-bar () (gnus-turn-off-edit-menu 'article) (unless (boundp 'gnus-article-article-menu) @@ -2701,12 +3007,14 @@ If variable `gnus-use-long-file-name' is non-nil, it is (easy-menu-define gnus-article-treatment-menu gnus-article-mode-map "" + ;; Fixme: this should use :active (and maybe :visible). '("Treatment" ["Hide headers" gnus-article-toggle-headers t] ["Hide signature" gnus-article-hide-signature t] ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] - ["Remove carriage return" gnus-article-remove-cr t])) + ["Remove carriage return" gnus-article-remove-cr t] + ["Decode HZ" gnus-article-decode-HZ t])) ;; Note "Commands" menu is defined in gnus-sum.el for consistency @@ -2714,7 +3022,15 @@ If variable `gnus-use-long-file-name' is non-nil, it is (define-key gnus-article-mode-map [menu-bar post] (cons "Post" gnus-summary-post-menu))) - (gnus-run-hooks 'gnus-article-menu-hook))) + (gnus-run-hooks 'gnus-article-menu-hook)) + ;; Add the menu. + (when (boundp 'gnus-article-commands-menu) + (easy-menu-add gnus-article-commands-menu gnus-article-mode-map)) + (when (boundp 'gnus-summary-post-menu) + (easy-menu-add gnus-summary-post-menu gnus-article-mode-map))) + +;; Fixme: do something for the Emacs tool bar in Article mode a la +;; Summary. (defun gnus-article-mode () "Major mode for displaying an article. @@ -2749,7 +3065,9 @@ commands: (make-local-variable 'gnus-article-mime-handles) (make-local-variable 'gnus-article-decoded-p) (make-local-variable 'gnus-article-mime-handle-alist) - (make-local-variable 'gnus-article-washed-types) + (make-local-variable 'gnus-article-wash-types) + (make-local-variable 'gnus-article-charset) + (make-local-variable 'gnus-article-ignored-charsets) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t) @@ -2778,12 +3096,12 @@ commands: ;; Init original article buffer. (save-excursion (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) + (set-buffer-multibyte nil) (setq major-mode 'gnus-original-article-mode) (make-local-variable 'gnus-original-article)) (if (get-buffer name) (save-excursion (set-buffer name) - (kill-all-local-variables) (buffer-disable-undo) (setq buffer-read-only t) (unless (eq major-mode 'gnus-article-mode) @@ -2829,12 +3147,7 @@ commands: (mime-display-message mime-message-structure gnus-article-buffer nil gnus-article-mode-map) (when all-headers - (gnus-article-hide-headers nil -1)) - ) - ;; `mime-display-message' changes current buffer to `gnus-article-buffer'. - (make-local-variable 'mime-button-mother-dispatcher) - (setq mime-button-mother-dispatcher - (function gnus-article-push-button)) + (gnus-article-hide-headers nil -1))) (run-hooks 'gnus-mime-article-prepare-hook)) (defun gnus-article-display-traditional-message () @@ -2915,8 +3228,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (message "Message marked for downloading")) (gnus-summary-mark-article article gnus-canceled-mark) (unless (memq article gnus-newsgroup-sparse) - (gnus-error 1 - "No such article (may have expired or been canceled)"))))) + (gnus-error 1 "No such article (may have expired or been canceled)"))))) (if (or (eq result 'pseudo) (eq result 'nneething)) (progn @@ -2967,6 +3279,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-set-global-variables) (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)))) + (save-excursion + (gnus-configure-windows 'article)) (when (or (numberp article) (stringp article)) (gnus-article-prepare-display) @@ -3048,8 +3362,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if (eq entity last-entity) 1 2) type) - (setq entity (get-text-property next 'mime-view-entity)) - (goto-char (point-max))))))) + (goto-char (point-max))) + (setq entity (get-text-property next 'mime-view-entity)))))) ;;;###autoload (defun gnus-article-prepare-display () @@ -3131,12 +3445,15 @@ value of the variable `gnus-show-mime' is non-nil." '((gnus-article-press-button "\r" "Toggle Display") (gnus-mime-view-part "v" "View Interactively...") (gnus-mime-view-part-as-type "t" "View As Type...") + (gnus-mime-view-part-as-charset "C" "View As charset...") (gnus-mime-save-part "o" "Save...") + (gnus-mime-save-part-and-strip "\C-o" "Save and Strip") (gnus-mime-copy-part "c" "View As Text, In Other Buffer") (gnus-mime-inline-part "i" "View As Text, In This Buffer") (gnus-mime-internalize-part "E" "View Internally") (gnus-mime-externalize-part "e" "View Externally") - (gnus-mime-pipe-part "|" "Pipe To Command..."))) + (gnus-mime-pipe-part "|" "Pipe To Command...") + (gnus-mime-action-on-part "." "Take action on the part"))) (defun gnus-article-mime-part-status () (with-current-buffer gnus-article-buffer @@ -3145,22 +3462,22 @@ value of the variable `gnus-show-mime' is non-nil." (format " (%d parts)" (length (mime-entity-children entity))) "")))) -(defvar gnus-mime-button-map nil) -(unless gnus-mime-button-map - (setq gnus-mime-button-map (make-sparse-keymap)) - (set-keymap-parent gnus-mime-button-map gnus-article-mode-map) - (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) - (define-key gnus-mime-button-map gnus-down-mouse-3 'gnus-mime-button-menu) - (mapcar (lambda (c) - (define-key gnus-mime-button-map (cadr c) (car c))) - gnus-mime-button-commands)) +(defvar gnus-mime-button-map + (let ((map (make-sparse-keymap))) + ;; Not for Emacs 21: fixme better. + ;; (set-keymap-parent map gnus-article-mode-map) + (define-key map gnus-mouse-2 'gnus-article-push-button) + (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) + (dolist (c gnus-mime-button-commands) + (define-key map (cadr c) (car c))) + map)) (defun gnus-mime-button-menu (event) "Construct a context-sensitive menu of MIME commands." (interactive "e") - (save-excursion + (save-window-excursion (let ((pos (event-start event))) - (set-buffer (window-buffer (posn-window pos))) + (select-window (posn-window pos)) (goto-char (posn-point pos)) (gnus-article-check-buffer) (let ((response (x-popup-menu @@ -3169,7 +3486,7 @@ value of the variable `gnus-show-mime' is non-nil." (cons (caddr c) (car c))) gnus-mime-button-commands)))))) (if response - (funcall response)))))) + (call-interactively response)))))) (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." @@ -3179,11 +3496,73 @@ value of the variable `gnus-show-mime' is non-nil." (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) - (if (stringp (car handles)) - (gnus-mime-view-all-parts (cdr handles)) - (mapcar 'mm-display-part handles))))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) + (mm-remove-parts handles) + (goto-char (point-min)) + (or (search-forward "\n\n") (goto-char (point-max))) + (let (buffer-read-only) + (delete-region (point) (point-max))) + (mm-display-parts handles)))) + +(defun gnus-mime-save-part-and-strip () + "Save the MIME part under point then replace it with an external body." + (interactive) + (gnus-article-check-buffer) + (let* ((data (get-text-property (point) 'gnus-data)) + (file (mm-save-part data)) + param) + (when file + (with-current-buffer (mm-handle-buffer data) + (erase-buffer) + (insert "Content-Type: " (mm-handle-media-type data)) + (mml-insert-parameter-string (cdr (mm-handle-type data)) + '(charset)) + (insert "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: binary\n") + (insert "\n")) + (setcdr data + (cdr (mm-make-handle nil + `("message/external-body" + (access-type . "LOCAL-FILE") + (name . ,file))))) + (set-buffer gnus-summary-buffer) + (gnus-article-edit-article + `(lambda () + (erase-buffer) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + (mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (insert-buffer gnus-original-article-buffer) + (mime-to-mml gnus-article-mime-handles) + (setq gnus-article-mime-handles nil) + (make-local-hook 'kill-buffer-hook) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) + `(lambda (no-highlight) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets))) + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + 'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) + ,gnus-summary-buffer no-highlight)))))) (defun gnus-mime-save-part () "Save the MIME part under point." @@ -3206,13 +3585,33 @@ value of the variable `gnus-show-mime' is non-nil." (let ((data (get-text-property (point) 'gnus-data))) (mm-interactively-view-part data))) -(defun gnus-mime-view-part-as-type () +(defun gnus-mime-view-part-as-type-internal () + (gnus-article-check-buffer) + (let* ((name (mail-content-type-get + (mm-handle-type (get-text-property (point) 'gnus-data)) + 'name)) + (def-type (and name (mm-default-file-encoding name)))) + (and def-type (cons def-type 0)))) + +(defun gnus-mime-view-part-as-type (mime-type) "Choose a MIME media type, and view the part as such." (interactive - (list (completing-read "View as MIME type: " mailcap-mime-types))) + (list (completing-read + "View as MIME type: " + (mapcar #'list (mailcap-mime-types)) + nil nil + (gnus-mime-view-part-as-type-internal)))) (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) - (gnus-mm-display-part handle))) + (gnus-mm-display-part + (mm-make-handle (mm-handle-buffer handle) + (cons mime-type (cdr (mm-handle-type handle))) + (mm-handle-encoding handle) + (mm-handle-undisplayer handle) + (mm-handle-disposition handle) + (mm-handle-description handle) + (mm-handle-cache handle) + (mm-handle-id handle))))) (defun gnus-mime-copy-part (&optional handle) "Put the the MIME part under point into a new buffer." @@ -3237,28 +3636,63 @@ value of the variable `gnus-show-mime' is non-nil." (setq buffer-file-name nil)) (goto-char (point-min)))) -(defun gnus-mime-inline-part (&optional handle) +(defun gnus-mime-inline-part (&optional handle arg) "Insert the MIME part under point into the current buffer." - (interactive) + (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - contents + contents charset (b (point)) buffer-read-only) - (if (mm-handle-undisplayer handle) + (if (and (not arg) (mm-handle-undisplayer handle)) (mm-remove-part handle) (setq contents (mm-get-part handle)) + (cond + ((not arg) + (setq charset (or (mail-content-type-get + (mm-handle-type handle) 'charset) + gnus-newsgroup-charset))) + ((numberp arg) + (if (mm-handle-undisplayer handle) + (mm-remove-part handle)) + (setq charset + (or (cdr (assq arg + gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: "))))) (forward-line 2) - (mm-insert-inline handle contents) + (mm-insert-inline handle + (if (and charset + (setq charset (mm-charset-to-coding-system + charset)) + (not (eq charset 'ascii))) + (mm-decode-coding-string contents charset) + contents)) (goto-char b)))) +(defun gnus-mime-view-part-as-charset (&optional handle arg) + "Insert the MIME part under point into the current buffer." + (interactive (list nil current-prefix-arg)) + (gnus-article-check-buffer) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + contents charset + (b (point)) + buffer-read-only) + (if (mm-handle-undisplayer handle) + (mm-remove-part handle)) + (let ((gnus-newsgroup-charset + (or (cdr (assq arg + gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: "))) + (gnus-newsgroup-ignored-charsets 'gnus-all)) + (gnus-article-press-button)))) + (defun gnus-mime-externalize-part (&optional handle) "View the MIME part under point with an external viewer." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (mm-user-display-methods nil) - (mm-inline-large-images nil) + (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) @@ -3283,6 +3717,15 @@ In no internal viewer is available, use an external viewer." (mm-remove-part handle) (mm-display-part handle)))) +(defun gnus-mime-action-on-part (&optional action) + "Do something with the MIME attachment at \(point\)." + (interactive + (list (completing-read "Action: " gnus-mime-action-alist))) + (gnus-article-check-buffer) + (let ((action-pair (assoc action gnus-mime-action-alist))) + (if action-pair + (funcall (cdr action-pair))))) + (defun gnus-article-part-wrapper (n function) (save-current-buffer (set-buffer gnus-article-buffer) @@ -3312,6 +3755,11 @@ In no internal viewer is available, use an external viewer." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-copy-part)) +(defun gnus-article-view-part-as-charset (n) + "Copy MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) + (defun gnus-article-externalize-part (n) "View MIME part N externally, which is the numerical prefix." (interactive "p") @@ -3332,7 +3780,7 @@ In no internal viewer is available, use an external viewer." ((eq condition 'undisplayed) (not (or (mm-handle-undisplayer (cdr ihandle)) (equal (mm-handle-media-type (cdr ihandle)) - "multipart/alternative")))) + "multipart/alternative")))) ((eq condition 'undisplayed-alternative) (not (mm-handle-undisplayer (cdr ihandle)))) (t t)) @@ -3358,6 +3806,11 @@ In no internal viewer is available, use an external viewer." (when (eq (gnus-mm-display-part handle) 'internal) (gnus-set-window-start))))))) +(defsubst gnus-article-mime-total-parts () + (if (bufferp (car gnus-article-mime-handles)) + 1 ;; single part + (1- (length gnus-article-mime-handles)))) + (defun gnus-mm-display-part (handle) "Display HANDLE and fix MIME button." (let ((id (get-text-property (point) 'gnus-part)) @@ -3391,7 +3844,7 @@ In no internal viewer is available, use an external viewer." (narrow-to-region (point) (point-max)) (gnus-treat-article nil id - (1- (length gnus-article-mime-handles)) + (gnus-article-mime-total-parts) (mm-handle-media-type handle))))) (select-window window)))) (goto-char point) @@ -3412,6 +3865,8 @@ In no internal viewer is available, use an external viewer." 'name) (mail-content-type-get (mm-handle-disposition handle) 'filename) + (mail-content-type-get (mm-handle-type handle) + 'url) "")) (gnus-tmp-type (mm-handle-media-type handle)) (gnus-tmp-description @@ -3436,28 +3891,39 @@ In 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 - `(local-map ,gnus-mime-button-map - keymap ,gnus-mime-button-map - gnus-callback gnus-mm-display-part - gnus-part ,gnus-tmp-id - article-type annotation - gnus-data ,handle)) + `(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)) (setq e (point)) - (widget-convert-button 'link b e - :mime-handle handle - :action 'gnus-widget-press-button - :button-keymap gnus-mime-button-map - :help-echo - (lambda (widget) - ;; Needed to properly clear the message - ;; due to a bug in wid-edit - (setq help-echo-owns-message t) - (format - "Click to %s the MIME part; %s for more options" - (if (mm-handle-displayed-p - (widget-get widget :mime-handle)) - "hide" "show") - (if gnus-xemacs "button3" "mouse-3")))))) + (widget-convert-button + 'link b e + :mime-handle handle + :action 'gnus-widget-press-button + :button-keymap gnus-mime-button-map + :help-echo + (lambda (widget/window &optional overlay pos) + ;; Needed to properly clear the message due to a bug in + ;; wid-edit (XEmacs only). + (if (boundp 'help-echo-owns-message) + (setq help-echo-owns-message t)) + (format + "%S: %s the MIME part; %S: more options" + (aref gnus-mouse-2 0) + ;; XEmacs will get a single widget arg; Emacs 21 will get + ;; window, overlay, position. + (if (mm-handle-displayed-p + (if overlay + (with-current-buffer (gnus-overlay-buffer overlay) + (widget-get (widget-at (gnus-overlay-start overlay)) + :mime-handle)) + (widget-get widget/window :mime-handle))) + "hide" "show") + (aref gnus-down-mouse-3 0)))))) (defun gnus-widget-press-button (elems el) (goto-char (widget-get elems :from)) @@ -3483,7 +3949,7 @@ In no internal viewer is available, use an external viewer." ;; Top-level call; we clean up. (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) - (setq gnus-article-mime-handle-alist nil)) ;; A trick. + (setq gnus-article-mime-handle-alist nil));; A trick. (setq gnus-article-mime-handles handles) ;; We allow users to glean info from the handles. (when gnus-article-mime-part-function @@ -3504,13 +3970,13 @@ In no internal viewer is available, use an external viewer." (narrow-to-region (point) (point-max)) (gnus-treat-article nil 1 1) (widen))) - (if (not ihandles) - ;; Highlight the headers. - (save-excursion - (save-restriction - (article-goto-body) - (narrow-to-region (point-min) (point)) - (gnus-treat-article 'head)))))))) + (unless ihandles + ;; Highlight the headers. + (save-excursion + (save-restriction + (article-goto-body) + (narrow-to-region (point-min) (point)) + (gnus-treat-article 'head)))))))) (defvar gnus-mime-display-multipart-as-mixed nil) @@ -3534,7 +4000,19 @@ In no internal viewer is available, use an external viewer." (not gnus-mime-display-multipart-as-mixed)) ;;;!!!We should find the start part, but we just default ;;;!!!to the first part. - (gnus-mime-display-part (cadr handle))) + ;;(gnus-mime-display-part (cadr handle)) + ;;;!!! Most multipart/related is an HTML message plus images. + ;;;!!! Unfortunately we are unable to let W3 display those + ;;;!!! included images, so we just display it as a mixed multipart. + (gnus-mime-display-mixed (cdr handle))) + ((equal (car handle) "multipart/signed") + (or (memq 'signed gnus-article-wash-types) + (push 'signed gnus-article-wash-types)) + (gnus-mime-display-security handle)) + ((equal (car handle) "multipart/encrypted") + (or (memq 'encrypted gnus-article-wash-types) + (push 'encrypted gnus-article-wash-types)) + (gnus-mime-display-security handle)) ;; Other multiparts are handled like multipart/mixed. (t (gnus-mime-display-mixed (cdr handle))))) @@ -3570,21 +4048,23 @@ In no internal viewer is available, use an external viewer." (setq display t) (when (equal (mm-handle-media-supertype handle) "text") (setq text t))) - (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (let ((id (1+ (length gnus-article-mime-handle-alist))) + beg) (push (cons id handle) gnus-article-mime-handle-alist) (when (or (not display) (not (gnus-unbuttonized-mime-type-p type))) - (gnus-article-insert-newline) + ;(gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display (and not-attachment text)))) - (gnus-article-insert-newline) - (gnus-article-insert-newline) - (setq move t))) - (let ((beg (point))) + (gnus-article-insert-newline) + ;(gnus-article-insert-newline) + ;; Remember modify the number of forward lines. + (setq move t)) + (setq beg (point)) (cond (display (when move - (forward-line -2) + (forward-line -1) (setq beg (point))) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets @@ -3596,7 +4076,7 @@ In no internal viewer is available, use an external viewer." (goto-char (point-max))) ((and text not-attachment) (when move - (forward-line -2) + (forward-line -1) (setq beg (point))) (gnus-article-insert-newline) (mm-insert-inline handle (mm-get-part handle)) @@ -3606,8 +4086,8 @@ In no internal viewer is available, use an external viewer." (save-restriction (narrow-to-region beg (point)) (gnus-treat-article - nil (length gnus-article-mime-handle-alist) - (1- (length gnus-article-mime-handles)) + nil id + (gnus-article-mime-total-parts) (mm-handle-media-type handle))))))))) (defun gnus-unbuttonized-mime-type-p (type) @@ -3645,6 +4125,7 @@ In no internal viewer is available, use an external viewer." (unless (setq not-pref (cadr (member preferred ihandles))) (setq not-pref (car ihandles))) (when (or ibegend + (not preferred) (not (gnus-unbuttonized-mime-type-p "multipart/alternative"))) (gnus-add-text-properties @@ -3659,7 +4140,9 @@ In no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',not-pref ',begend ,id)) - local-map ,gnus-mime-button-map + ,@(if (>= (string-to-number emacs-version) 21) + nil ;; XEmacs doesn't care + (list 'local-map gnus-mime-button-map)) ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face keymap ,gnus-mime-button-map @@ -3684,7 +4167,9 @@ In no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) - local-map ,gnus-mime-button-map + ,@(if (>= (string-to-number emacs-version) 21) + nil ;; XEmacs doesn't care + (list 'local-map gnus-mime-button-map)) ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face keymap ,gnus-mime-button-map @@ -3709,7 +4194,7 @@ In no internal viewer is available, use an external viewer." (narrow-to-region (car begend) (point-max)) (gnus-treat-article nil (length gnus-article-mime-handle-alist) - (1- (length gnus-article-mime-handles)) + (gnus-article-mime-total-parts) (mm-handle-media-type handle)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) @@ -3725,19 +4210,21 @@ In no internal viewer is available, use an external viewer." (boring (memq 'boring-headers gnus-article-wash-types)) (pgp (memq 'pgp gnus-article-wash-types)) (pem (memq 'pem gnus-article-wash-types)) + (signed (memq 'signed gnus-article-wash-types)) + (encrypted (memq 'encrypted gnus-article-wash-types)) (signature (memq 'signature gnus-article-wash-types)) (overstrike (memq 'overstrike gnus-article-wash-types)) (emphasis (memq 'emphasis gnus-article-wash-types))) (format "%c%c%c%c%c%c%c" (if cite ?c ? ) (if (or headers boring) ?h ? ) - (if (or pgp pem) ?p ? ) + (if (or pgp pem signed encrypted) ?p ? ) (if signature ?s ? ) (if overstrike ?o ? ) (if gnus-show-mime ?m ? ) (if emphasis ?e ? ))))) -(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) +(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) (defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. @@ -3829,7 +4316,8 @@ Argument LINES specifies lines to be scrolled up." (forward-line 1) (setq start nil)) (unless (or (cond ((eq (1+ (buffer-size)) (point)) - (setq end-of-buffer t)) + (and (pos-visible-in-window-p) + (setq end-of-buffer t))) ((eobp) (setq end-of-page t))) (not lines)) @@ -3843,7 +4331,8 @@ Argument LINES specifies lines to be scrolled up." (t (if start (set-window-start (selected-window) start) - (scroll-up lines)) + (let (window-pixel-scroll-increment) + (scroll-up lines))) nil)))) (defun gnus-article-prev-page (&optional lines) @@ -3862,7 +4351,8 @@ Argument LINES specifies lines to be scrolled down." (gnus-narrow-to-page -1)) (t (condition-case nil - (scroll-down lines) + (let (window-pixel-scroll-increment) + (scroll-down lines)) (beginning-of-buffer (goto-char (point-min)))))))) @@ -3953,7 +4443,8 @@ Argument LINES specifies lines to be scrolled down." ;; We disable the pick minor mode commands. (let (gnus-pick-mode) (setq func (lookup-key (current-local-map) keys)))) - (if (not func) + (if (or (not func) + (numberp func)) (ding) (unless (member keys nosave-in-article) (set-buffer gnus-article-current-summary)) @@ -3972,26 +4463,58 @@ Argument LINES specifies lines to be scrolled down." (switch-to-buffer summary 'norecord)) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. - (if (setq func (let (gnus-pick-mode) - (lookup-key (current-local-map) keys))) + (if (and (setq func (let (gnus-pick-mode) + (lookup-key (current-local-map) keys))) + (functionp func)) (progn (call-interactively func) - (setq new-sum-point (point))) - (ding)) - (when (eq in-buffer (current-buffer)) - (setq selected (gnus-summary-select-article)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (when (eq selected 'old) - (article-goto-body) - (set-window-start (get-buffer-window (current-buffer)) - 1) - (set-window-point (get-buffer-window (current-buffer)) - (point))) - (let ((win (get-buffer-window gnus-article-current-summary))) - (when win - (set-window-point win new-sum-point)))))))) + (setq new-sum-point (point)) + (when (eq in-buffer (current-buffer)) + (setq selected (gnus-summary-select-article)) + (set-buffer obuf) + (unless not-restore-window + (set-window-configuration owin)) + (when (eq selected 'old) + (article-goto-body) + (set-window-start (get-buffer-window (current-buffer)) + 1) + (set-window-point (get-buffer-window (current-buffer)) + (point))) + (let ((win (get-buffer-window gnus-article-current-summary))) + (when win + (set-window-point win new-sum-point)))) ) + (switch-to-buffer gnus-article-buffer) + (ding)))))) + +(defun gnus-article-describe-key (key) + "Display documentation of the function invoked by KEY. KEY is a string." + (interactive "kDescribe key: ") + (gnus-article-check-buffer) + (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (save-excursion + (set-buffer gnus-article-current-summary) + (let (gnus-pick-mode) + (push (elt key 0) unread-command-events) + (setq key (if (featurep 'xemacs) + (events-to-keys (read-key-sequence "Describe key: ")) + (read-key-sequence "Describe key: ")))) + (describe-key key)) + (describe-key key))) + +(defun gnus-article-describe-key-briefly (key &optional insert) + "Display documentation of the function invoked by KEY. KEY is a string." + (interactive "kDescribe key: \nP") + (gnus-article-check-buffer) + (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (save-excursion + (set-buffer gnus-article-current-summary) + (let (gnus-pick-mode) + (push (elt key 0) unread-command-events) + (setq key (if (featurep 'xemacs) + (events-to-keys (read-key-sequence "Describe key: ")) + (read-key-sequence "Describe key: ")))) + (describe-key-briefly key insert)) + (describe-key-briefly key insert))) (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. @@ -4033,8 +4556,7 @@ If given a prefix, show the hidden text instead." ;; We only request an article by message-id when we do not have the ;; headers for it, so we'll have to get those. (when (stringp article) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article))) + (gnus-read-header article)) ;; If the article number is negative, that means that this article ;; doesn't belong in this newsgroup (possibly), so we find its @@ -4052,8 +4574,7 @@ If given a prefix, show the hidden text instead." ;; This is a sparse gap article. (setq do-update-line article) (setq article (mail-header-id header)) - (let ((gnus-override-method gnus-refer-article-method)) - (setq sparse-header (gnus-read-header article))) + (setq sparse-header (gnus-read-header article)) (setq gnus-newsgroup-sparse (delq article gnus-newsgroup-sparse))) ((vectorp header) @@ -4068,11 +4589,11 @@ If given a prefix, show the hidden text instead." gnus-newsgroup-name))) (when (and (eq (car method) 'nneething) (vectorp header)) - (let ((dir (concat + (let ((dir (expand-file-name + (mail-header-subject header) (file-name-as-directory (or (cadr (assq 'nneething-address method)) - (nth 1 method))) - (mail-header-subject header)))) + (nth 1 method)))))) (when (file-directory-p dir) (setq article 'nneething) (gnus-group-enter-directory dir)))))))) @@ -4104,21 +4625,40 @@ If given a prefix, show the hidden text instead." (gnus-cache-request-article article group)) 'article) ;; Get the article and put into the article buffer. - ((or (stringp article) (numberp article)) - (let ((gnus-override-method - (and (stringp article) gnus-refer-article-method)) + ((or (stringp article) + (numberp article)) + (let ((gnus-override-method gnus-override-method) + (methods (and (stringp article) + gnus-refer-article-method)) + result (buffer-read-only nil)) - (erase-buffer) - (gnus-kill-all-overlays) - (let ((gnus-newsgroup-name group)) - (gnus-check-group-server)) - (when (gnus-request-article article group (current-buffer)) - (when (numberp article) - (gnus-async-prefetch-next group article gnus-summary-buffer) - (when gnus-keep-backlog - (gnus-backlog-enter-article - group article (current-buffer)))) - 'article))) + (if (or (not (listp methods)) + (and (symbolp (car methods)) + (assq (car methods) nnoo-definition-alist))) + (setq methods (list methods))) + (when (and (null gnus-override-method) + methods) + (setq gnus-override-method (pop methods))) + (while (not result) + (when (eq gnus-override-method 'current) + (setq gnus-override-method gnus-current-select-method)) + (erase-buffer) + (gnus-kill-all-overlays) + (let ((gnus-newsgroup-name group)) + (gnus-check-group-server)) + (when (gnus-request-article article group (current-buffer)) + (when (numberp article) + (gnus-async-prefetch-next group article + gnus-summary-buffer) + (when gnus-keep-backlog + (gnus-backlog-enter-article + group article (current-buffer)))) + (setq result 'article)) + (if (not result) + (if methods + (setq gnus-override-method (pop methods)) + (setq result 'done)))) + (and (eq result 'article) 'article))) ;; It was a pseudo. (t article))) @@ -4134,6 +4674,7 @@ If given a prefix, show the hidden text instead." (if (get-buffer gnus-original-article-buffer) (set-buffer gnus-original-article-buffer) (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) + (set-buffer-multibyte nil) (buffer-disable-undo) (setq major-mode 'gnus-original-article-mode) (setq buffer-read-only t)) @@ -4241,27 +4782,6 @@ groups." (defun gnus-article-edit-done (&optional arg) "Update the article edits and exit." (interactive "P") - (save-excursion - (save-restriction - (widen) - (when (article-goto-body) - (let ((lines (count-lines (point) (point-max))) - (length (- (point-max) (point))) - (case-fold-search t) - (body (copy-marker (point)))) - (goto-char (point-min)) - (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string length))) - (goto-char (point-min)) - (when (re-search-forward - "^x-content-length:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string length))) - (goto-char (point-min)) - (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string lines))))))) (let ((func gnus-article-edit-done-function) (buf (current-buffer)) (start (window-start))) @@ -4292,7 +4812,7 @@ groups." "Exit the article editing without updating." (interactive) ;; We remove all text props from the article buffer. - (let ((buf (format "%s" (buffer-string))) + (let ((buf (buffer-substring-no-properties (point-min) (point-max))) (curbuf (current-buffer)) (p (point)) (window-start (window-start))) @@ -4406,7 +4926,7 @@ after replacing with the original article." ;;; Internal Variables: -(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)" +(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)" "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) @@ -4425,7 +4945,7 @@ after replacing with the original article." ("mailto:\\([-a-zA-Z.@_+0-9%]+\\)" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 0 t gnus-button-embedded-url 1) + ("]*\\)>" 0 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. @@ -4736,7 +5256,11 @@ specified by `gnus-button-alist'." (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) + (and data (list 'gnus-data data)))) + (widget-convert-button 'link from to :action 'gnus-widget-press-button + ;; Quote `:button-keymap' for Mule 2.3 + ;; but it won't work. + ':button-keymap gnus-widget-button-keymap)) ;;; Internal functions: @@ -4752,9 +5276,15 @@ specified by `gnus-button-alist'." (inhibit-point-motion-hooks t) (limit (next-single-property-change end 'mime-view-entity nil (point-max)))) - (if (get-text-property end 'invisible) - (gnus-article-unhide-text end limit) - (gnus-article-hide-text end limit gnus-hidden-properties))))) + (if (text-property-any end limit 'article-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end limit + (cons 'article-type (cons 'signature + gnus-hidden-properties))) + (gnus-add-text-properties-when + 'article-type nil end limit + (cons 'article-type (cons 'signature + gnus-hidden-properties))))))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. @@ -4888,22 +5418,19 @@ forbidden in URL encoding." (message-goto-subject))))) (defun gnus-button-mailto (address) - ;; Mail to ADDRESS. + "Mail to ADDRESS." (set-buffer (gnus-copy-article-buffer)) - (gnus-setup-message 'reply - (message-reply address))) + (message-reply address)) -(defun gnus-button-reply (address) - ;; Reply to ADDRESS. - (gnus-setup-message 'reply - (message-reply address))) +(defalias 'gnus-button-reply 'message-reply) (defun gnus-button-embedded-url (address) - "Browse ADDRESS." - ;; In Emacs 20, `browse-url-browser-function' may be an alist. - (if (listp browse-url-browser-function) - (browse-url (gnus-strip-whitespace address)) - (funcall browse-url-browser-function (gnus-strip-whitespace address)))) + "Activate ADDRESS with `browse-url'." + (browse-url (gnus-strip-whitespace address))) + +(defun gnus-article-smiley-display () + "Display \"smileys\" as small graphical icons." + (smiley-toggle-buffer 1 (current-buffer) (point-min) (point-max))) ;;; Next/prev buttons in the article buffer. @@ -4998,8 +5525,8 @@ forbidden in URL encoding." '(mail-decode-encoded-word-region) "List of methods used to decode headers. -This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is -FUNCTION, FUNCTION will be apply to all newsgroups. If item is a +This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item +is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a (REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups whose names match REGEXP. @@ -5017,13 +5544,13 @@ For example: (eq gnus-newsgroup-name (car gnus-decode-header-methods-cache))) (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name)) - (mapc '(lambda (x) - (if (symbolp x) - (nconc gnus-decode-header-methods-cache (list x)) - (if (and gnus-newsgroup-name - (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-header-methods-cache - (list (cdr x)))))) + (mapcar (lambda (x) + (if (symbolp x) + (nconc gnus-decode-header-methods-cache (list x)) + (if (and gnus-newsgroup-name + (string-match (car x) gnus-newsgroup-name)) + (nconc gnus-decode-header-methods-cache + (list (cdr x)))))) gnus-decode-header-methods)) (let ((xlist gnus-decode-header-methods-cache)) (pop xlist) @@ -5055,7 +5582,11 @@ For example: (gnus-run-hooks 'gnus-part-display-hook) (unless gnus-inhibit-treatment (while (setq elem (pop alist)) - (setq val (symbol-value (car elem))) + (setq val + (save-excursion + (if (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-summary-buffer)) + (symbol-value (car elem)))) (when (and (or (consp val) treated-type) (gnus-treat-predicate val) @@ -5077,11 +5608,13 @@ For example: 'mime-view-entity entity)))))) ;; Dynamic variables. -(defvar part-number) -(defvar total-parts) -(defvar type) -(defvar condition) -(defvar length) +(eval-when-compile + (defvar part-number) + (defvar total-parts) + (defvar type) + (defvar condition) + (defvar length)) + (defun gnus-treat-predicate (val) (cond ((null val) @@ -5119,6 +5652,238 @@ For example: (t (error "%S is not a valid value" val)))) +(defun gnus-article-encrypt-body (protocol &optional n) + "Encrypt the article body." + (interactive + (list + (or gnus-article-encrypt-protocol + (completing-read "Encrypt protocol: " + gnus-article-encrypt-protocol-alist + nil t)) + current-prefix-arg)) + (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) + (unless func + (error (format "Can't find the encrypt protocol %s" protocol))) + (if (equal gnus-newsgroup-name "nndraft:drafts") + (error "Can't encrypt the article in group nndraft:drafts.")) + (if (equal gnus-newsgroup-name "nndraft:queue") + (error "Don't encrypt the article in group nndraft:queue.")) + (gnus-summary-iterate n + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) + (summary-buffer gnus-summary-buffer) + references point) + (gnus-set-global-variables) + (when (gnus-group-read-only-p) + (error "The current newsgroup does not support article encrypt")) + (gnus-summary-show-article t) + (setq references + (or (mail-header-references gnus-current-headers) "")) + (set-buffer gnus-article-buffer) + (let* ((buffer-read-only nil) + (headers + (mapcar (lambda (field) + (and (save-restriction + (message-narrow-to-head) + (goto-char (point-min)) + (search-forward field nil t)) + (prog2 + (message-narrow-to-field) + (buffer-substring (point-min) (point-max)) + (delete-region (point-min) (point-max)) + (widen)))) + '("Content-Type:" "Content-Transfer-Encoding:" + "Content-Disposition:")))) + (message-narrow-to-head) + (message-remove-header "MIME-Version") + (goto-char (point-max)) + (setq point (point)) + (insert (apply 'concat headers)) + (widen) + (narrow-to-region point (point-max)) + (let ((message-options message-options)) + (message-options-set 'message-sender user-mail-address) + (message-options-set 'message-recipients user-mail-address) + (message-options-set 'message-sign-encrypt 'not) + (funcall func)) + (goto-char (point-min)) + (insert "MIME-Version: 1.0\n") + (widen) + (gnus-summary-edit-article-done + references nil summary-buffer t)) + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (save-excursion + (when (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq gnus-original-article nil))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current)))))))) + +(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n" + "The following specs can be used: +%t The security MIME type +%i Additional info +%d Details +%D Details if button is pressed") + +(defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n" + "The following specs can be used: +%t The security MIME type +%i Additional info +%d Details +%D Details if button is pressed") + +(defvar gnus-mime-security-button-line-format-alist + '((?t gnus-tmp-type ?s) + (?i gnus-tmp-info ?s) + (?d gnus-tmp-details ?s) + (?D gnus-tmp-pressed-details ?s))) + +(defvar gnus-mime-security-button-map + (let ((map (make-sparse-keymap))) + ;; Not for Emacs 21: fixme better. + ;;(set-keymap-parent map gnus-article-mode-map) + (define-key map gnus-mouse-2 'gnus-article-push-button) + (define-key map "\r" 'gnus-article-press-button) + map)) + +(defvar gnus-mime-security-details-buffer nil) + +(defvar gnus-mime-security-button-pressed nil) + +(defvar gnus-mime-security-show-details-inline t + "If non-nil, show details in the article buffer.") + +(defun gnus-mime-security-verify-or-decrypt (handle) + (mm-remove-parts (cdr handle)) + (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) + buffer-read-only) + (when region + (delete-region (car region) (cdr region)) + (set-marker (car region) nil) + (set-marker (cdr region) nil))) + (with-current-buffer (mm-handle-multipart-original-buffer handle) + (let* ((mm-verify-option 'known) + (mm-decrypt-option 'known) + (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) + (unless (eq nparts (cdr handle)) + (mm-destroy-parts (cdr handle)) + (setcdr handle nparts)))) + (let ((point (point)) + buffer-read-only) + (gnus-mime-display-security handle) + (goto-char point))) + +(defun gnus-mime-security-show-details (handle) + (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) + (if details + (if gnus-mime-security-show-details-inline + (let ((gnus-mime-security-button-pressed t) + (gnus-mime-security-button-line-format + (get-text-property (point) 'gnus-line-format)) + buffer-read-only) + (forward-char -1) + (while (eq (get-text-property (point) 'gnus-line-format) + gnus-mime-security-button-line-format) + (forward-char -1)) + (forward-char) + (delete-region (point) + (or (text-property-not-all + (point) (point-max) + 'gnus-line-format + gnus-mime-security-button-line-format) + (point-max))) + (gnus-insert-mime-security-button handle)) + (if (gnus-buffer-live-p gnus-mime-security-details-buffer) + (with-current-buffer gnus-mime-security-details-buffer + (erase-buffer) + t) + (setq gnus-mime-security-details-buffer + (gnus-get-buffer-create "*MIME Security Details*"))) + (with-current-buffer gnus-mime-security-details-buffer + (insert details) + (goto-char (point-min))) + (pop-to-buffer gnus-mime-security-details-buffer)) + (gnus-message 5 "No details.")))) + +(defun gnus-mime-security-press-button (handle) + (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) + (gnus-mime-security-show-details handle) + (gnus-mime-security-verify-or-decrypt handle))) + +(defun gnus-insert-mime-security-button (handle &optional displayed) + (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) + (gnus-tmp-type + (concat + (or (nth 2 (assoc protocol mm-verify-function-alist)) + (nth 2 (assoc protocol mm-decrypt-function-alist)) + "Unknown") + (if (equal (car handle) "multipart/signed") + " Signed" " Encrypted") + " Part")) + (gnus-tmp-info + (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) + "Undecided")) + (gnus-tmp-details + (mm-handle-multipart-ctl-parameter handle 'gnus-details)) + gnus-tmp-pressed-details + b e) + (setq gnus-tmp-details + (if gnus-tmp-details + (concat "\n" gnus-tmp-details) "")) + (setq gnus-tmp-pressed-details + (if gnus-mime-security-button-pressed gnus-tmp-details "")) + (unless (bolp) + (insert "\n")) + (setq b (point)) + (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)) + (setq e (point)) + (widget-convert-button + 'link b e + :mime-handle handle + :action 'gnus-widget-press-button + :button-keymap gnus-mime-security-button-map + :help-echo + (lambda (widget/window &optional overlay pos) + ;; Needed to properly clear the message due to a bug in + ;; wid-edit (XEmacs only). + (if (boundp 'help-echo-owns-message) + (setq help-echo-owns-message t)) + (format + "%S: show detail" + (aref gnus-mouse-2 0)))))) + +(defun gnus-mime-display-security (handle) + (save-restriction + (narrow-to-region (point) (point)) + (gnus-insert-mime-security-button handle) + (gnus-mime-display-mixed (cdr handle)) + (unless (bolp) + (insert "\n")) + (let ((gnus-mime-security-button-line-format + gnus-mime-security-button-end-line-format)) + (gnus-insert-mime-security-button handle)) + (mm-set-handle-multipart-parameter handle 'gnus-region + (cons (set-marker (make-marker) + (point-min)) + (set-marker (make-marker) + (point-max)))))) + ;;; @ for mime-view ;;; diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 0009e85..e661658 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -1,5 +1,5 @@ ;;; gnus-async.el --- asynchronous support for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,6 +26,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-sum) (require 'nntp) @@ -34,7 +35,7 @@ "Support for asynchronous operations." :group 'gnus) -(defcustom gnus-asynchronous t +(defcustom gnus-asynchronous nil "*If nil, inhibit all Gnus asynchronicity. If non-nil, let the other asynch variables be heeded." :group 'gnus-asynchronous @@ -158,42 +159,42 @@ It should return non-nil if the article is to be prefetched." "Possibly prefetch several articles starting with ARTICLE." (if (not (gnus-buffer-live-p summary)) (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) + (setq gnus-async-fetch-list nil)) (when (and gnus-asynchronous (gnus-alive-p)) (when next (gnus-async-with-semaphore - (pop gnus-async-fetch-list))) + (pop gnus-async-fetch-list))) (let ((do-fetch next) - (do-message t)) ;(eq major-mode 'gnus-summary-mode))) + (do-message t)) ;(eq major-mode 'gnus-summary-mode))) (when (and (gnus-group-asynchronous-p group) (gnus-buffer-live-p summary) (or (not next) gnus-async-fetch-list)) (gnus-async-with-semaphore - (unless next - (setq do-fetch (not gnus-async-fetch-list)) - ;; Nix out any outstanding requests. - (setq gnus-async-fetch-list nil) - ;; Fill in the new list. - (let ((n gnus-use-article-prefetch) - (data (gnus-data-find-list article)) - d) - (while (and (setq d (pop data)) - (if (numberp n) - (natnump (decf n)) - n)) - (unless (or (gnus-async-prefetched-article-entry - group (setq article (gnus-data-number d))) - (not (natnump article)) - (not (funcall gnus-async-prefetch-article-p d))) - ;; Not already fetched -- so we add it to the list. - (push article gnus-async-fetch-list))) - (setq gnus-async-fetch-list - (nreverse gnus-async-fetch-list)))) - - (when do-fetch - (setq article (car gnus-async-fetch-list)))) + (unless next + (setq do-fetch (not gnus-async-fetch-list)) + ;; Nix out any outstanding requests. + (setq gnus-async-fetch-list nil) + ;; Fill in the new list. + (let ((n gnus-use-article-prefetch) + (data (gnus-data-find-list article)) + d) + (while (and (setq d (pop data)) + (if (numberp n) + (natnump (decf n)) + n)) + (unless (or (gnus-async-prefetched-article-entry + group (setq article (gnus-data-number d))) + (not (natnump article)) + (not (funcall gnus-async-prefetch-article-p d))) + ;; Not already fetched -- so we add it to the list. + (push article gnus-async-fetch-list))) + (setq gnus-async-fetch-list + (nreverse gnus-async-fetch-list)))) + + (when do-fetch + (setq article (car gnus-async-fetch-list)))) (when (and do-fetch article) ;; We want to fetch some more articles. @@ -227,16 +228,16 @@ It should return non-nil if the article is to be prefetched." (when arg (gnus-async-set-buffer) (gnus-async-with-semaphore - (setq - gnus-async-article-alist - (cons (list (intern (format "%s-%d" group article) - gnus-async-hashtb) - mark (set-marker (make-marker) (point-max)) - group article) - gnus-async-article-alist)))) + (setq + gnus-async-article-alist + (cons (list (intern (format "%s-%d" group article) + gnus-async-hashtb) + mark (set-marker (make-marker) (point-max)) + group article) + gnus-async-article-alist)))) (if (not (gnus-buffer-live-p summary)) (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) + (setq gnus-async-fetch-list nil)) (gnus-async-prefetch-article group next summary t)))) (defun gnus-async-unread-p (data) @@ -296,8 +297,8 @@ It should return non-nil if the article is to be prefetched." (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) (gnus-async-with-semaphore - (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)))) + (setq gnus-async-article-alist + (delq entry gnus-async-article-alist)))) (defun gnus-async-prefetch-remove-group (group) "Remove all articles belonging to GROUP from the prefetch buffer." diff --git a/lisp/gnus-audio.el b/lisp/gnus-audio.el index f3bb686..8906745 100644 --- a/lisp/gnus-audio.el +++ b/lisp/gnus-audio.el @@ -1,7 +1,8 @@ ;;; gnus-audio.el --- Sound effects for Gnus -;; Copyright (C) 1996 Free Software Foundation +;; Copyright (C) 1996, 2000 Free Software Foundation ;; Author: Steven L. Baur +;; Keywords: news, mail, multimedia ;; This file is part of GNU Emacs. @@ -21,99 +22,116 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: + ;; This file provides access to sound effects in Gnus. -;; Prerelease: This file is partially stripped to support earcons.el -;; You can safely ignore most of it until Red Gnus. **Evil Laugh** -;;; Code: +;; This file is partially stripped to support earcons.el. -(when (null (boundp 'running-xemacs)) - (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) +;;; Code: (require 'nnheader) -(eval-when-compile (require 'cl)) -(defvar gnus-audio-inline-sound - (and (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)) - "When t, we will not spawn a subprocess to play sounds.") +(defgroup gnus-audio nil + "Playing sound in Gnus." + :version "21.1" + :group 'gnus-visual + :group 'multimedia) -(defvar gnus-audio-directory (nnheader-find-etc-directory "sounds") - "The directory containing the Sound Files.") - -(defvar gnus-audio-au-player "/usr/bin/showaudio" - "Executable program for playing sun AU format sound files.") - -(defvar gnus-audio-wav-player "/usr/local/bin/play" - "Executable program for playing WAV files.") +(defvar gnus-audio-inline-sound + (or (if (fboundp 'device-sound-enabled-p) + (device-sound-enabled-p)) ; XEmacs + (fboundp 'play-sound)) ; Emacs 21 + "Non-nil means try to play sounds without using an external program.") + +(defcustom gnus-audio-directory (nnheader-find-etc-directory "sounds") + "The directory containing the Sound Files." + :type '(choice directory (const nil)) + :group 'gnus-audio) + +(defcustom gnus-audio-au-player "/usr/bin/showaudio" + "Executable program for playing sun AU format sound files." + :group 'gnus-audio + :type 'string) + +(defcustom gnus-audio-wav-player "/usr/local/bin/play" + "Executable program for playing WAV files." + :group 'gnus-audio + :type 'string) ;;; The following isn't implemented yet. Wait for Millennium Gnus. -;(defvar gnus-audio-effects-enabled t -; "When t, Gnus will use sound effects.") -;(defvar gnus-audio-enable-hooks nil -; "Functions run when enabling sound effects.") -;(defvar gnus-audio-disable-hooks nil -; "Functions run when disabling sound effects.") -;(defvar gnus-audio-theme-song nil -; "Theme song for Gnus.") -;(defvar gnus-audio-enter-group nil -; "Sound effect played when selecting a group.") -;(defvar gnus-audio-exit-group nil -; "Sound effect played when exiting a group.") -;(defvar gnus-audio-score-group nil -; "Sound effect played when scoring a group.") -;(defvar gnus-audio-busy-sound nil -; "Sound effect played when going into a ... sequence.") +;;(defvar gnus-audio-effects-enabled t +;; "When t, Gnus will use sound effects.") +;;(defvar gnus-audio-enable-hooks nil +;; "Functions run when enabling sound effects.") +;;(defvar gnus-audio-disable-hooks nil +;; "Functions run when disabling sound effects.") +;;(defvar gnus-audio-theme-song nil +;; "Theme song for Gnus.") +;;(defvar gnus-audio-enter-group nil +;; "Sound effect played when selecting a group.") +;;(defvar gnus-audio-exit-group nil +;; "Sound effect played when exiting a group.") +;;(defvar gnus-audio-score-group nil +;; "Sound effect played when scoring a group.") +;;(defvar gnus-audio-busy-sound nil +;; "Sound effect played when going into a ... sequence.") ;;;###autoload - ;(defun gnus-audio-enable-sound () -; "Enable Sound Effects for Gnus." -; (interactive) -; (setq gnus-audio-effects-enabled t) -; (gnus-run-hooks gnus-audio-enable-hooks)) +;;(defun gnus-audio-enable-sound () +;; "Enable Sound Effects for Gnus." +;; (interactive) +;; (setq gnus-audio-effects-enabled t) +;; (gnus-run-hooks gnus-audio-enable-hooks)) ;;;###autoload ;(defun gnus-audio-disable-sound () -; "Disable Sound Effects for Gnus." -; (interactive) -; (setq gnus-audio-effects-enabled nil) -; (gnus-run-hooks gnus-audio-disable-hooks)) +;; "Disable Sound Effects for Gnus." +;; (interactive) +;; (setq gnus-audio-effects-enabled nil) +;; (gnus-run-hooks gnus-audio-disable-hooks)) ;;;###autoload (defun gnus-audio-play (file) - "Play a sound through the speaker." + "Play a sound FILE through the speaker." (interactive) (let ((sound-file (if (file-exists-p file) file - (concat gnus-audio-directory file)))) + (expand-file-name file gnus-audio-directory)))) (when (file-exists-p sound-file) - (if gnus-audio-inline-sound - (play-sound-file sound-file) - (cond ((string-match "\\.wav$" sound-file) - (call-process gnus-audio-wav-player - sound-file - 0 - nil - sound-file)) - ((string-match "\\.au$" sound-file) - (call-process gnus-audio-au-player - sound-file - 0 - nil - sound-file))))))) + (cond ((and gnus-audio-inline-sound + (condition-case nil + ;; Even if we have audio, we may fail with the + ;; wrong sort of sound file. + (progn (play-sound-file sound-file) + t) + (error nil)))) + ;; If we don't have built-in sound, or playing it failed, + ;; try with external program. + ((equal "wav" (file-name-extension sound-file)) + (call-process gnus-audio-wav-player + sound-file + 0 + nil + sound-file)) + ((equal "au" (file-name-extension sound-file)) + (call-process gnus-audio-au-player + sound-file + 0 + nil + sound-file)))))) ;;; The following isn't implemented yet, wait for Red Gnus - ;(defun gnus-audio-startrek-sounds () -; "Enable sounds from Star Trek the original series." -; (interactive) -; (setq gnus-audio-busy-sound "working.au") -; (setq gnus-audio-enter-group "bulkhead_door.au") -; (setq gnus-audio-exit-group "bulkhead_door.au") -; (setq gnus-audio-score-group "ST_laser.au") -; (setq gnus-audio-theme-song "startrek.au") -; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group) -; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group)) +;;(defun gnus-audio-startrek-sounds () +;; "Enable sounds from Star Trek the original series." +;; (interactive) +;; (setq gnus-audio-busy-sound "working.au") +;; (setq gnus-audio-enter-group "bulkhead_door.au") +;; (setq gnus-audio-exit-group "bulkhead_door.au") +;; (setq gnus-audio-score-group "ST_laser.au") +;; (setq gnus-audio-theme-song "startrek.au") +;; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group) +;; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group)) ;;;*** (defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au" diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el index 6caef29..e39ba6b 100644 --- a/lisp/gnus-bbdb.el +++ b/lisp/gnus-bbdb.el @@ -1,15 +1,15 @@ -;; gnus-bbdb.el --- Interface to Semi-gnus +;; gnus-bbdb.el --- Interface to T-gnus ;; Copyright (c) 1991,1992,1993 Jamie Zawinski . ;; Copyright (C) 1995,1996,1997 Shuhei KOBAYASHI ;; Copyright (C) 1997,1998 MORIOKA Tomohiko -;; Copyright (C) 1998 Keiichi Suzuki +;; Copyright (C) 1998,1999 Keiichi Suzuki -;; Author: Keiichi Suzuki +;; Author: Keiichi Suzuki ;; Author: Shuhei KOBAYASHI ;; Keywords: BBDB, MIME, multimedia, multilingual, mail, news -;; This file is part of Semi-gnus. +;; This file is part of T-gnus. ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -29,10 +29,13 @@ ;;; Code: (require 'bbdb) +(require 'bbdb-com) (require 'gnus) (require 'std11) (eval-when-compile - (require 'gnus-win)) + (defvar bbdb-pop-up-elided-display) ; default unbound. + (require 'gnus-win) + (require 'cl)) (defvar gnus-bbdb/decode-field-body-function 'nnheader-decode-field-body "*Field body decoder.") @@ -51,34 +54,25 @@ bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and the user confirms the creation." (if bbdb-use-pop-up (gnus-bbdb/pop-up-bbdb-buffer offer-to-create) - (save-excursion - (save-restriction - (let (from) - (set-buffer gnus-original-article-buffer) - (widen) - (narrow-to-region (point-min) - (progn (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (error "message unexists")) - (- (point) 2))) - (when (setq from (mail-fetch-field "from")) - (setq from (gnus-bbdb/extract-address-components - (gnus-bbdb/decode-field-body from 'From)))) - (when (and (car (cdr from)) - (string-match (bbdb-user-mail-names) - (car (cdr from)))) - ;; if logged-in user sent this, use recipients. - (let ((to (mail-fetch-field "to"))) - (when to - (setq from - (gnus-bbdb/extract-address-components - (gnus-bbdb/decode-field-body to 'To)))))) - (when from - (bbdb-annotate-message-sender from t - (or (bbdb-invoke-hook-for-value - bbdb/news-auto-create-p) - offer-to-create) - offer-to-create))))))) + (let ((from (mime-entity-fetch-field gnus-current-headers "from"))) + (when from + (setq from (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body from 'From)))) + (when (and (car (cdr from)) + (string-match (bbdb-user-mail-names) + (car (cdr from)))) + ;; if logged-in user sent this, use recipients. + (let ((to (mime-entity-fetch-field gnus-current-headers "to"))) + (when to + (setq from + (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body to 'To)))))) + (when from + (bbdb-annotate-message-sender from t + (or (bbdb-invoke-hook-for-value + bbdb/news-auto-create-p) + offer-to-create) + offer-to-create))))) ;;;###autoload (defun gnus-bbdb/annotate-sender (string &optional replace) @@ -87,7 +81,7 @@ corresponding to the sender of this message. If REPLACE is non-nil, replace the existing notes entry (if any)." (interactive (list (if bbdb-readonly-p (error "The Insidious Big Brother Database is read-only.") - (read-string "Comments: ")))) + (read-string "Comments: ")))) (bbdb-annotate-notes (gnus-bbdb/update-record t) string 'notes replace)) (defun gnus-bbdb/edit-notes (&optional arg) @@ -110,41 +104,119 @@ This buffer will be in bbdb-mode, with associated keybindings." (bbdb-display-records (list record)) (error "unperson")))) -;; Avoid byte-compile warning. -(defvar bbdb-pop-up-elided-display) (defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create) "Make the *BBDB* buffer be displayed along with the GNUS windows, displaying the record corresponding to the sender of the current message." - (let ((bbdb-gag-messages t) - (bbdb-use-pop-up nil) - (bbdb-electric-p nil)) - (let ((record (gnus-bbdb/update-record offer-to-create)) - (bbdb-elided-display (bbdb-pop-up-elided-display)) - (b (current-buffer))) + (let* ((bbdb-gag-messages t) + (bbdb-electric-p nil) + (record + (let (bbdb-use-pop-up) + (gnus-bbdb/update-record offer-to-create))) + (bbdb-elided-display (bbdb-pop-up-elided-display))) + (save-current-buffer ;; display the bbdb buffer iff there is a record for this article. - (cond (record - (bbdb-pop-up-bbdb-buffer - (function (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (or (eq major-mode 'mime-veiw-mode) - (eq major-mode 'gnus-article-mode)) - (set-buffer b)))))) - (bbdb-display-records (list record))) - (t - (or bbdb-inside-electric-display - (not (get-buffer-window bbdb-buffer-name)) - (let (w) - (delete-other-windows) - (if (assq 'article gnus-buffer-configuration) - (gnus-configure-windows 'article) - (gnus-configure-windows 'SelectArticle)) - (if (setq w (get-buffer-window gnus-summary-buffer)) - (select-window w)) - )))) - (set-buffer b) - record))) + (cond + (record + (bbdb-pop-up-bbdb-buffer + (lambda (w) + (with-current-buffer (window-buffer w) + (memq major-mode + '(mime-view-mode gnus-article-mode))))) + (bbdb-display-records (list record))) + ((and (not bbdb-inside-electric-display) + (get-buffer-window bbdb-buffer-name)) + (delete-other-windows) + (if (assq 'article gnus-buffer-configuration) + (gnus-configure-windows 'article) + (gnus-configure-windows 'SelectArticle)) + (let ((w (get-buffer-window gnus-summary-buffer))) + (if w (select-window w)))))) + record)) + +;;;###autoload +(defun gnus-bbdb/split-mail (header-field bbdb-field + &optional regexp group) + "Mail split method for `nnmail-split-fancy'. +HEADER-FIELD is a regexp or list of regexps as mail header field name +for gathering mail addresses. If HEADER-FIELD is a string, then it's +used for just matching pattern. If HEADER-FIELD is a list of strings, +then these strings have priorities in the order. + +BBDB-FIELD is field name of BBDB. +Optional argument REGEXP is regexp string for matching BBDB-FIELD value. +If REGEXP is nil or not specified, then all BBDB-FIELD value is matched. + +If GROUP is nil or not specified, then BBDB-FIELD value is returned as +group name. If GROUP is a symbol `&', then list of all matching group's +BBDB-FIELD values is returned. Otherwise, GROUP is returned." + (if (listp header-field) + (if (eq group '&) + (gnus-bbdb/split-mail (mapconcat 'identity header-field "\\|") + bbdb-field regexp group) + (let (rest) + (while (and header-field + (null (setq rest (gnus-bbdb/split-mail + (car header-field) bbdb-field + regexp group)))) + (setq header-field (cdr header-field))) + rest)) + (let ((pat (concat "^\\(" header-field "\\):[ \t]")) + header-values) + (goto-char (point-min)) + (while (re-search-forward pat nil t) + (setq header-values (cons (buffer-substring (point) + (std11-field-end)) + header-values))) + (let ((address-regexp + (with-temp-buffer + (let (lal) + (while header-values + (setq lal (std11-parse-addresses-string + (pop header-values))) + (while lal + (gnus-bbdb/insert-address-regexp (pop lal))))) + (buffer-string)))) + (unless (zerop (length address-regexp)) + (gnus-bbdb/split-mail-1 address-regexp bbdb-field regexp group)))))) + +(defun gnus-bbdb/insert-address-regexp (address) + "Insert string of address part from parsed ADDRESS of RFC 822." + (cond ((eq (car address) 'group) + (setq address (cdr address)) + (while address + (gnus-bbdb/insert-address-regexp (pop address)))) + ((eq (car address) 'mailbox) + (unless (eq (point) (point-min)) + (insert "\\|")) + (let ((addr (nth 1 address))) + (insert (std11-addr-to-string + (if (eq (car addr) 'phrase-route-addr) + (nth 2 addr) + (cdr addr)))))))) + +(defun gnus-bbdb/split-mail-1 (address-regexp bbdb-field regexp group) + (let ((records (bbdb-search (bbdb-records) nil nil address-regexp)) + prop rest) + (or regexp (setq regexp "")) + (catch 'done + (cond + ((eq group '&) + (while records + (when (and (setq prop (bbdb-record-getprop (car records) bbdb-field)) + (string-match regexp prop) + (not (member prop rest))) + (setq rest (cons prop rest))) + (setq records (cdr records))) + (throw 'done (when rest (cons '& rest)))) + (t + (while records + (when (or (null bbdb-field) + (and (setq prop (bbdb-record-getprop (car records) + bbdb-field)) + (string-match regexp prop))) + (throw 'done (or group prop))) + (setq records (cdr records)))))))) ;; ;; Announcing BBDB entries in the summary buffer @@ -167,8 +239,10 @@ This variable has no effect on the marking controlled by :group 'bbdb-mua-specific-gnus :type '(choice (const :tag "Mark known posters" t) (const :tag "Do not mark known posters" nil))) -(defvaralias 'gnus-bbdb/mark-known-posters - 'gnus-bbdb/summary-mark-known-posters) +(static-when (and (fboundp 'defvaralias) + (subrp (symbol-function 'defvaralias))) + (defvaralias 'gnus-bbdb/mark-known-posters + 'gnus-bbdb/summary-mark-known-posters)) (defcustom gnus-bbdb/summary-known-poster-mark "+" "This is the default character to prefix author names with if @@ -187,8 +261,10 @@ people who aren't in the database, of course. (`gnus-optional-headers' must be `gnus-bbdb/lines-and-from' for GNUS users.)" :group 'bbdb-mua-specific-gnus :type 'boolean) -(defvaralias 'gnus-bbdb/header-show-bbdb-names - 'gnus-bbdb/summary-show-bbdb-names) +(static-when (and (fboundp 'defvaralias) + (subrp (symbol-function 'defvaralias))) + (defvaralias 'gnus-bbdb/header-show-bbdb-names + 'gnus-bbdb/summary-show-bbdb-names)) (defcustom gnus-bbdb/summary-prefer-bbdb-data t "If t, then for posters who are in our BBDB, replace the information @@ -207,8 +283,10 @@ See `gnus-bbdb/lines-and-from' for GNUS users, or :group 'bbdb-mua-specific-gnus :type '(choice (const :tag "Prefer real names" t) (const :tag "Prefer network addresses" nil))) -(defvaralias 'gnus-bbdb/header-prefer-real-names - 'gnus-bbdb/summary-prefer-real-names) +(static-when (and (fboundp 'defvaralias) + (subrp (symbol-function 'defvaralias))) + (defvaralias 'gnus-bbdb/header-prefer-real-names + 'gnus-bbdb/summary-prefer-real-names)) (defcustom gnus-bbdb/summary-user-format-letter "B" "This is the gnus-user-format-function- that will be used to insert @@ -442,17 +520,7 @@ addresses better than the traditionally static global scorefile." gnus-bbdb/score-alist) (defun gnus-bbdb/extract-field-value-init () - (when (or (and (eq (current-buffer) (get-buffer gnus-article-buffer)) - (buffer-live-p gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer)) - (eq (current-buffer) (get-buffer gnus-original-article-buffer))) - (widen) - (narrow-to-region (point-min) - (progn (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (error "message unexists")) - (- (point) 2))) - 'gnus-bbdb/extract-field-value)) + (function gnus-bbdb/extract-field-value)) (defun gnus-bbdb/extract-field-value (field-name) "Given the name of a field (like \"Subject\") this returns the value of @@ -465,7 +533,8 @@ beginning of the message headers." ;; divided real-names from addresses; the actual From: and Subject: fields ;; exist only in the message. (let (value) - (when (setq value (mail-fetch-field field-name)) + (when (setq value (mime-entity-fetch-field + gnus-current-headers field-name)) (gnus-bbdb/decode-field-body value field-name)))) ;;; @ mail-extr @@ -486,8 +555,7 @@ beginning of the message headers." (if (string= address "") (setq address nil)) (if (string= phrase "") (setq phrase nil)) (when (or phrase address) - (list phrase address)) - )) + (list phrase address)))) ;;; @ full-name canonicalization methods ;;; @@ -496,25 +564,21 @@ beginning of the message headers." (let (dest) (while (string-match "\\s +" str) (setq dest (cons (substring str 0 (match-beginning 0)) dest)) - (setq str (substring str (match-end 0))) - ) + (setq str (substring str (match-end 0)))) (or (string= str "") (setq dest (cons str dest))) (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) + (mapconcat 'identity dest " "))) (defun gnus-bbdb/canonicalize-dots (str) (let (dest) (while (string-match "\\." str) (setq dest (cons (substring str 0 (match-end 0)) dest)) - (setq str (substring str (match-end 0))) - ) + (setq str (substring str (match-end 0)))) (or (string= str "") (setq dest (cons str dest))) (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) + (mapconcat 'identity dest " "))) ;; ;; Insinuation @@ -527,7 +591,7 @@ beginning of the message headers." (when (boundp 'bbdb-extract-field-value-function-list) (add-to-list 'bbdb-extract-field-value-function-list 'gnus-bbdb/extract-field-value-init)) - (add-hook 'gnus-article-prepare-hook 'gnus-bbdb/update-record) + (add-hook 'gnus-article-display-hook 'gnus-bbdb/update-record) (add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save) (define-key gnus-summary-mode-map ":" 'gnus-bbdb/show-sender) (define-key gnus-summary-mode-map ";" 'gnus-bbdb/edit-notes) diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index a47a199..3fca805 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -1,5 +1,5 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -61,30 +61,32 @@ gnus-backlog-articles nil)) (defun gnus-backlog-enter-article (group number buffer) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - b) - (if (memq ident gnus-backlog-articles) - () ; It's already kept. + (when (and (numberp number) + (not (string-match "^nnvirtual" group))) + (gnus-backlog-setup) + (let ((ident (intern (concat group ":" (int-to-string number)) + gnus-backlog-hashtb)) + b) + (if (memq ident gnus-backlog-articles) + () ; It's already kept. ;; Remove the oldest article, if necessary. - (and (numberp gnus-keep-backlog) - (>= (length gnus-backlog-articles) gnus-keep-backlog) + (and (numberp gnus-keep-backlog) + (>= (length gnus-backlog-articles) gnus-keep-backlog) (gnus-backlog-remove-oldest-article)) - (push ident gnus-backlog-articles) - ;; Insert the new article. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (setq b (point)) - (insert-buffer-substring buffer) - ;; Tag the beginning of the article with the ident. - (if (> (point-max) b) + (push ident gnus-backlog-articles) + ;; Insert the new article. + (save-excursion + (set-buffer (gnus-backlog-buffer)) + (let (buffer-read-only) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (setq b (point)) + (insert-buffer-substring buffer) + ;; Tag the beginning of the article with the ident. + (if (> (point-max) b) (gnus-put-text-property b (1+ b) 'gnus-backlog ident) - (gnus-error 3 "Article %d is blank" number))))))) + (gnus-error 3 "Article %d is blank" number)))))))) (defun gnus-backlog-remove-oldest-article () (save-excursion @@ -126,8 +128,9 @@ t)) (setq gnus-backlog-articles (delq ident gnus-backlog-articles))))))) -(defun gnus-backlog-request-article (group number buffer) - (when (numberp number) +(defun gnus-backlog-request-article (group number &optional buffer) + (when (and (numberp number) + (not (string-match "^nnvirtual" group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) @@ -146,10 +149,12 @@ (setq end (next-single-property-change (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring gnus-backlog-buffer beg end) - t))))) + (save-excursion + (and buffer (set-buffer buffer)) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert-buffer-substring gnus-backlog-buffer beg end))) + t)))) (provide 'gnus-bcklg) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 12b491a..5f255b6 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,5 +1,6 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Tatsuya Ichikawa @@ -28,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-int) @@ -37,7 +39,7 @@ (require 'gnus-sum)) (defcustom gnus-cache-active-file - (concat (file-name-as-directory gnus-cache-directory) "active") + (expand-file-name "active" gnus-cache-directory) "*The cache active file." :group 'gnus-cache :type 'file) @@ -62,7 +64,7 @@ If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups it's not cached." :group 'gnus-cache :type '(choice (const :tag "off" nil) - regexp)) + regexp)) (defcustom gnus-uncacheable-groups nil "*Groups that match this regexp will not be cached. @@ -178,6 +180,7 @@ it's not cached." t ; The article already is saved. (save-excursion (set-buffer nntp-server-buffer) + (require 'gnus-art) (let ((gnus-use-cache nil) (gnus-article-decode-hook nil)) (gnus-request-article-this-buffer number group)) @@ -428,7 +431,7 @@ Returns the list of articles removed." (defun gnus-summary-insert-cached-articles () "Insert all the articles cached for this group into the current buffer." (interactive) - (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '<)) + (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>)) (gnus-verbose (max 6 gnus-verbose))) (unless cached (gnus-message 3 "No cached articles for this group")) @@ -471,20 +474,22 @@ Returns the list of articles removed." (and (not unread) (not ticked) (not dormant) (memq 'read class)))) (defun gnus-cache-file-name (group article) - (concat (file-name-as-directory gnus-cache-directory) - (file-name-as-directory - (nnheader-translate-file-chars - (if (gnus-use-long-file-name 'not-cache) - group - (let ((group (nnheader-replace-duplicate-chars-in-string - (nnheader-replace-chars-in-string group ?/ ?_) - ?. ?_))) - ;; Translate the first colon into a slash. - (when (string-match ":" group) - (aset group (match-beginning 0) ?/)) - (nnheader-replace-chars-in-string group ?. ?/))) - t)) - (if (stringp article) article (int-to-string article)))) + (expand-file-name + (if (stringp article) article (int-to-string article)) + (file-name-as-directory + (expand-file-name + (nnheader-translate-file-chars + (if (gnus-use-long-file-name 'not-cache) + group + (let ((group (nnheader-replace-duplicate-chars-in-string + (nnheader-replace-chars-in-string group ?/ ?_) + ?. ?_))) + ;; Translate the first colon into a slash. + (when (string-match ":" group) + (aset group (match-beginning 0) ?/)) + (nnheader-replace-chars-in-string group ?. ?/))) + t) + gnus-cache-directory)))) (defun gnus-cache-update-article (group article) "If ARTICLE is in the cache, remove it and re-enter it." @@ -647,6 +652,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" (let ((gnus-mark-article-hook nil) (gnus-expert-user t) (nnmail-spool-file nil) + (mail-sources nil) (gnus-use-dribble-file nil) (gnus-novice-user nil) (gnus-large-newsgroup nil)) @@ -687,9 +693,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" (when (or force (and gnus-cache-active-hashtb gnus-cache-active-altered)) - (gnus-write-active-file-as-coding-system - gnus-cache-write-file-coding-system - gnus-cache-active-file gnus-cache-active-hashtb t) + (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t) ;; Mark the active hashtb as unaltered. (setq gnus-cache-active-altered nil))) @@ -759,7 +763,8 @@ If LOW, update the lower bound instead." (interactive (list gnus-cache-directory)) (gnus-cache-close) (let ((nnml-generate-active-function 'identity)) - (nnml-generate-nov-databases-1 dir))) + (nnml-generate-nov-databases-1 dir)) + (gnus-cache-open)) (defun gnus-cache-move-cache (dir) "Move the cache tree to somewhere else." diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 33ff4fd..681745c 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,7 +1,13 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;;; gnus-cite.el --- parse citations in articles for Gnus -*- coding: iso-latin-1 -*- -;; Author: Per Abhiddenware; you can redistribute it and/or modify +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. + +;; Author: Per Abhiddenware + +;; 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. @@ -21,11 +27,12 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'static)) + (require 'gnus) (require 'gnus-art) (require 'gnus-range) - -(eval-when-compile (require 'static)) +(require 'message) ; for message-cite-prefix-regexp ;;; Customization: @@ -43,10 +50,10 @@ article has citations." :type 'string) (defcustom gnus-cite-always-check nil - "Check article always for citations. Set it t to check all articles." + "Check article always for citations. Set it t to check all articles." :group 'gnus-cite :type '(choice (const :tag "no" nil) - (const :tag "yes" t))) + (const :tag "yes" t))) (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" "Format of opened cited text buttons." @@ -74,19 +81,13 @@ Set it to nil to parse all articles." :type '(choice (const :tag "all" nil) integer)) -(defcustom gnus-cite-prefix-regexp - "^[]>»|:}+ ]*[]>»|:}+]\\(.*>»\\)?\\|^.*>" - "*Regexp matching the longest possible citation prefix on a line." - :group 'gnus-cite - :type 'regexp) - (defcustom gnus-cite-max-prefix 20 "Maximum possible length for a citation prefix." :group 'gnus-cite :type 'integer) (defcustom gnus-supercite-regexp - (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" + (concat "^\\(" message-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") "*Regexp matching normal Supercite attribution lines. The first grouping must match prefixes added by other packages." @@ -239,8 +240,8 @@ It is merged with the face for the cited text belonging to the attribution." (defcustom gnus-cite-face-list '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 - gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 - gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) + gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 + gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) "*List of faces used for highlighting citations. When there are citations from multiple articles in the same message, @@ -306,7 +307,7 @@ Attribution lines are highlighted with the same face as the corresponding citation merged with `gnus-cite-attribution-face'. Text is considered cited if at least `gnus-cite-minimum-match-count' -lines matches `gnus-cite-prefix-regexp' with the same prefix. +lines matches `message-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." @@ -462,57 +463,63 @@ always hide." (gnus-set-format 'cited-closed-text-button t) (save-excursion (set-buffer gnus-article-buffer) - (cond - ((gnus-article-check-hidden-text 'cite arg) - t) - ((gnus-article-text-type-exists-p 'cite) - (let ((buffer-read-only nil)) - (gnus-article-hide-text-of-type 'cite))) - (t (let ((buffer-read-only nil) - (marks (gnus-dissect-cited-text)) + marks (inhibit-point-motion-hooks t) (props (nconc (list 'article-type 'cite) gnus-hidden-properties)) - beg end start) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks + (point (point-min)) + found beg end start) + (while (setq point + (text-property-any point (point-max) + 'gnus-callback + 'gnus-article-toggle-cited-text)) + (setq found t) + (goto-char point) + (gnus-article-toggle-cited-text + (get-text-property point 'gnus-data) arg) + (forward-line 1) + (setq point (point))) + (unless found + (setq marks (gnus-dissect-cited-text)) + (while marks + (setq beg nil + end nil) + (while (and marks (string= (cdar marks) "")) + (setq marks (cdr marks))) + (when marks + (setq beg (caar marks))) + (while (and marks (not (string= (cdar marks) ""))) + (setq marks (cdr marks))) + (when marks (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (forward-line (if (consp gnus-cited-lines-visible) - (car gnus-cited-lines-visible) - gnus-cited-lines-visible)) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)) - (when (consp gnus-cited-lines-visible) - (goto-char end) - (forward-line (- (cdr gnus-cited-lines-visible))) - (if (<= (point) beg) - (setq beg nil) + ;; Skip past lines we want to leave visible. + (when (and beg end gnus-cited-lines-visible) + (goto-char beg) + (forward-line (if (consp gnus-cited-lines-visible) + (car gnus-cited-lines-visible) + gnus-cited-lines-visible)) + (if (>= (point) end) + (setq beg nil) + (setq beg (point-marker)) + (when (consp gnus-cited-lines-visible) + (goto-char end) + (forward-line (- (cdr gnus-cited-lines-visible))) + (if (<= (point) beg) + (setq beg nil) (setq end (point-marker)))))) - (when (and beg end) - ;; We use markers for the end-points to facilitate later - ;; wrapping and mangling of text. - (setq beg (set-marker (make-marker) beg) - end (set-marker (make-marker) end)) - (gnus-add-text-properties beg end props) - (goto-char beg) - (unless (save-excursion (search-backward "\n\n" nil t)) - (insert "\n")) - (put-text-property - (setq start (point-marker)) - (progn + (when (and beg end) + ;; We use markers for the end-points to facilitate later + ;; wrapping and mangling of text. + (setq beg (set-marker (make-marker) beg) + end (set-marker (make-marker) end)) + (gnus-add-text-properties-when 'article-type nil beg end props) + (goto-char beg) + (unless (save-excursion (search-backward "\n\n" nil t)) + (insert "\n")) + (put-text-property + (setq start (point-marker)) + (progn (gnus-article-add-button (point) (progn (eval gnus-cited-closed-text-button-line-format-spec) @@ -520,40 +527,51 @@ always hide." `gnus-article-toggle-cited-text (list (cons beg end) start)) (point)) - 'article-type 'annotation) - (set-marker beg (point))))))))) + 'article-type 'annotation) + (set-marker beg (point)))))))) -(defun gnus-article-toggle-cited-text (args) - "Toggle hiding the text in REGION." +(defun gnus-article-toggle-cited-text (args &optional arg) + "Toggle hiding the text in REGION. +ARG can be nil or a number. Positive means hide, negative +means show, nil means toggle." (let* ((region (car args)) + (beg (car region)) + (end (cdr region)) (start (cadr args)) (hidden - (text-property-any - (car region) (1- (cdr region)) - (car gnus-hidden-properties) (cadr gnus-hidden-properties))) + (text-property-any beg (1- end) 'article-type 'cite)) (inhibit-point-motion-hooks t) buffer-read-only) - (funcall - (if hidden - 'remove-text-properties 'gnus-add-text-properties) - (car region) (cdr region) gnus-hidden-properties) - (save-excursion - (goto-char start) - (gnus-delete-line) - (put-text-property - (point) - (progn - (gnus-article-add-button - (point) - (progn (eval - (if hidden - gnus-cited-opened-text-button-line-format-spec - gnus-cited-closed-text-button-line-format-spec)) - (point)) - `gnus-article-toggle-cited-text - args) - (point)) - 'article-type 'annotation)))) + (when (or (null arg) + (zerop arg) + (and (> arg 0) (not hidden)) + (and (< arg 0) hidden)) + (if hidden + (gnus-remove-text-properties-when + 'article-type 'cite beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties))) + (gnus-add-text-properties-when + 'article-type nil beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties)))) + (save-excursion + (goto-char start) + (gnus-delete-line) + (put-text-property + (point) + (progn + (gnus-article-add-button + (point) + (progn (eval + (if hidden + gnus-cited-opened-text-button-line-format-spec + gnus-cited-closed-text-button-line-format-spec)) + (point)) + `gnus-article-toggle-cited-text + args) + (point)) + 'article-type 'annotation))))) (defun gnus-article-hide-citation-maybe (&optional arg force) "Toggle hiding of cited text that has an attribution line. @@ -661,23 +679,26 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char (point-max)) (gnus-article-search-signature) (point))) - alist entry start begin end numbers prefix mc-flag) + (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)")) + alist entry start begin end numbers prefix guess-limit mc-flag) ;; Get all potential prefixes in `alist'. (while (< (point) max) ;; Each line. (setq begin (point) + guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) end (progn (beginning-of-line 2) (point)) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. - (when (looking-at gnus-supercite-regexp) + (when (and (< guess-limit (+ begin gnus-cite-max-prefix)) + (looking-at gnus-supercite-regexp)) (if (match-end 1) (setq end (1+ (match-end 1))) (setq end (1+ begin)))) ;; Ignore very long prefixes. - (when (> end (+ (point) gnus-cite-max-prefix)) - (setq end (+ (point) gnus-cite-max-prefix))) - (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) + (when (> end (+ begin gnus-cite-max-prefix)) + (setq end (+ begin gnus-cite-max-prefix))) + (while (re-search-forward prefix-regexp (1- end) t) ;; Each prefix. (setq end (match-end 0) prefix (buffer-substring begin end)) @@ -909,7 +930,7 @@ See also the documentation for `gnus-article-highlight-citation'." (static-if (or (featurep 'xemacs) (and (eq emacs-major-version 20) (>= emacs-minor-version 3)) - (> emacs-major-version 20));-) + (>= emacs-major-version 21)) (forward-char (length prefix)) (move-to-column (string-width prefix))) (skip-chars-forward " \t") @@ -970,4 +991,8 @@ See also the documentation for `gnus-article-highlight-citation'." (provide 'gnus-cite) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; gnus-cite.el ends here diff --git a/lisp/gnus-clfns.el b/lisp/gnus-clfns.el new file mode 100644 index 0000000..6fed527 --- /dev/null +++ b/lisp/gnus-clfns.el @@ -0,0 +1,77 @@ +;;; gnus-clfns.el --- compiler macros for emulating cl functions +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Kastsumi Yamaoka +;; Keywords: cl, compile + +;; 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: + +;; Avoid cl runtime functions for FSF Emacsen. + +;;; Code: + +(if (featurep 'xemacs) + nil + (require 'cl) + + (define-compiler-macro last (&whole form x &optional n) + (if (and (fboundp 'last) + (subrp (symbol-function 'last))) + form + (if n + `(let* ((x ,x) + (n ,n) + (m 0) + (p x)) + (while (consp p) + (incf m) + (pop p)) + (if (<= n 0) + p + (if (< n m) + (nthcdr (- m n) x) + x))) + `(let ((x ,x)) + (while (consp (cdr x)) + (pop x)) + x)))) + + (define-compiler-macro mapc (&whole form fn seq &rest rest) + (if (and (fboundp 'mapc) + (subrp (symbol-function 'mapc))) + form + (if rest + `(let* ((fn ,fn) + (seq ,seq) + (args (list seq ,@rest)) + (m (apply (function min) (mapcar (function length) args))) + (n 0)) + (while (< n m) + (apply fn (mapcar (function (lambda (arg) (nth n arg))) args)) + (setq n (1+ n))) + seq) + `(let ((seq ,seq)) + (mapcar ,fn seq) + seq)))) + ) + +(provide 'gnus-clfns) + +;;; gnus-clfns.el ends here diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 995d6b4..87987e5 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -1,6 +1,6 @@ ;;; gnus-cus.el --- customization commands for Gnus ;; -;; Copyright (C) 1996,1999 Free Software Foundation, Inc. +;; Copyright (C) 1996,1999, 2000 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: news @@ -52,6 +52,21 @@ if that value is non-nil." (setq major-mode 'gnus-custom-mode mode-name "Gnus Customize") (use-local-map widget-keymap) + ;; Emacs 21 stuff: + (when (and (facep 'custom-button-face) + (facep 'custom-button-pressed-face)) + (set (make-local-variable 'widget-button-face) + 'custom-button-face) + (set (make-local-variable 'widget-button-pressed-face) + 'custom-button-pressed-face) + (set (make-local-variable 'widget-mouse-face) + 'custom-button-pressed-face)) + (when (and (boundp 'custom-raised-buttons) + (symbol-value 'custom-raised-buttons)) + (set (make-local-variable 'widget-push-button-prefix) "") + (set (make-local-variable 'widget-push-button-suffix) "") + (set (make-local-variable 'widget-link-prefix) "") + (set (make-local-variable 'widget-link-suffix) "")) (gnus-run-hooks 'gnus-custom-mode-hook)) ;;; Group Customization: @@ -137,26 +152,35 @@ listserv has inserted `Reply-To' headers that point back to the listserv itself. This is broken behavior. So there!") (to-group (string :tag "To Group") "\ -All posts will be send to the specified group.") +All posts will be sent to the specified group.") (gcc-self (choice :tag "GCC" :value t - (const t) + (const :tag "To current group" t) (const none) (string :format "%v" :hide-front-space t)) "\ Specify default value for GCC header. If this symbol is present in the group parameter list and set to `t', -new composed messages will be `Gcc''d to the current group. If it is +new composed messages will be `Gcc''d to the current group. If it is present and set to `none', no `Gcc:' header will be generated, if it is present and a string, this string will be inserted literally as a `gcc' header (this symbol takes precedence over any default `Gcc' rules as described later).") (banner (choice :tag "Banner" - (const signature) - string ) "\ -Banner to be removed from articles.") + :value nil + (const :tag "Remove signature" signature) + (symbol :tag "Item in `gnus-article-banner-alist'" none) + regexp + (const :tag "None" nil)) "\ +If non-nil, specify how to remove `banners' from articles. + +Symbol `signature' means to remove signatures delimited by +`gnus-signature-separator'. Any other symbol is used to look up a +regular expression to match the banner in `gnus-article-banner-alist'. +A string is used as a regular expression to match the banner +directly.") (auto-expire (const :tag "Automatic Expire" t) "\ All articles that are read will be marked as expirable.") @@ -176,10 +200,19 @@ Use with caution.") When to expire. Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' -when expiring expirable messages. The value can either be a number of +when expiring expirable messages. The value can either be a number of days (not necessarily an integer) or the symbols `never' or `immediate'.") + (expiry-target (choice :tag "Expiry Target" + :value delete + (const delete) + (function :format "%v" nnmail-) + string) "\ +Where expired messages end up. + +Overrides `nnmail-expiry-target', which see.") + (score-file (file :tag "Score File") "\ Make the specified file into the current score file. This means that all score commands you issue will end up in this file.") @@ -236,8 +269,24 @@ default charset will be used instead.") (number :tag "Group for displayed part" 0) (symbol :tag "Face" gnus-emphasis-highlight-words)))) - "highlight regexps. -See gnus-emphasis-alist.")) + "highlight regexps. +See gnus-emphasis-alist.") + + (posting-style + (choice :tag "Posting style" + :value nil + (repeat (list + (choice :tag "Type" + :value nil + (const signature) + (const signature-file) + (const organization) + (const address) + (const name) + (const body)) + (string :format "%v")))) + "post style. +See gnus-posting-styles.")) "Alist of valid group or topic parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter @@ -255,7 +304,9 @@ Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a documentation string for the parameter.") -(defconst gnus-extra-group-parameters nil +(defconst gnus-extra-group-parameters + '((uidvalidity (string :tag "IMAP uidvalidity") "\ +Server-assigned value attached to IMAP groups, used to maintain consistency.")) "Alist of group parameters that are not also topic parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter @@ -293,6 +344,7 @@ DOC is a documentation string for the parameter.") (setq gnus-custom-group group) (make-local-variable 'gnus-custom-topic) (setq gnus-custom-topic topic) + (buffer-disable-undo) (widget-insert "Customize the ") (if group (widget-create 'info-link @@ -304,7 +356,7 @@ DOC is a documentation string for the parameter.") :tag "topic parameters" "(gnus)Topic Parameters")) (widget-insert " for <") - (widget-insert (or group topic)) + (widget-insert (gnus-group-decoded-name (or group topic))) (widget-insert "> and press ") (widget-create 'push-button :tag "done" @@ -322,7 +374,7 @@ DOC is a documentation string for the parameter.") :tag "Parameters" :format "%t:\n%h%v" :doc "\ -These special paramerters are recognized by Gnus. +These special parameters are recognized by Gnus. Check the [ ] for the parameters you want to apply to this group or to the groups in this topic, then edit the value to suit your taste." ,@types) @@ -342,10 +394,10 @@ like. If you want to hear a beep when you enter a group, you could put something like `(dummy-variable (ding))' in the parameters of that group. `dummy-variable' will be set to the result of the `(ding)' form, but who cares?" - (cons :format "%v" :value (nil . nil) - (symbol :tag "Variable") - (sexp :tag - "Value"))) + (list :format "%v" :value (nil nil) + (symbol :tag "Variable") + (sexp :tag + "Value"))) '(repeat :inline t :tag "Unknown entries" @@ -363,6 +415,7 @@ form, but who cares?" :value (gnus-info-method info)))) (use-local-map widget-keymap) (widget-setup) + (buffer-enable-undo) (goto-char (point-min)))) (defun gnus-group-customize-done (&rest ignore) @@ -490,9 +543,9 @@ documentation string for the parameter.") (item `(const :format "" :value ,(downcase tag))) (match '(string :tag "Match")) (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) + (const :tag "default" nil) + (integer :format "%v" + :hide-front-space t))) (expire '(choice :tag "Expire" (const :tag "off" nil) (integer :format "%v" @@ -563,9 +616,9 @@ each score entry has four elements: (item `(const :format "" :value ,(downcase tag))) (match '(integer :tag "Match")) (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) + (const :tag "default" nil) + (integer :format "%v" + :hide-front-space t))) (expire '(choice :tag "Expire" (const :tag "off" nil) (integer :format "%v" @@ -600,9 +653,9 @@ each score entry has four elements: (item `(const :format "" :value ,(downcase tag))) (match '(string :tag "Match")) (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) + (const :tag "default" nil) + (integer :format "%v" + :hide-front-space t))) (expire '(choice :tag "Expire" (const :tag "off" nil) (integer :format "%v" @@ -652,11 +705,11 @@ eh?"))) (interactive (list gnus-current-score-file)) (let ((scores (gnus-score-load file)) (types (mapcar (lambda (entry) - `(group :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) - gnus-score-parameters))) + `(group :format "%v%h\n" + :doc ,(nth 2 entry) + (const :format "" ,(nth 0 entry)) + ,(nth 1 entry))) + gnus-score-parameters))) ;; Ready. (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index 7c1fa49..6a77b8e 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -34,7 +34,7 @@ (require 'nnmail) (require 'gnus-util) (eval-and-compile - (if (string-match "XEmacs" (emacs-version)) + (if (featurep 'xemacs) (require 'itimer) (require 'timer))) @@ -152,14 +152,14 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (nowParts (decode-time now)) ;; obtain THEN as discrete components (thenParts (parse-time-string time)) - (thenHour (elt thenParts 0)) + (thenHour (elt thenParts 2)) (thenMin (elt thenParts 1)) ;; convert time as elements into number of seconds since EPOCH. (then (encode-time 0 thenMin thenHour ;; If THEN is earlier than NOW, make it - ;; same time tomorrow. Doc for encode-time + ;; same time tomorrow. Doc for encode-time ;; says that this is OK. (+ (elt nowParts 3) (if (or (< thenHour (elt nowParts 2)) @@ -191,6 +191,10 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." ;; sufficiently ripe. (let ((handlers gnus-demon-handler-state) (gnus-inhibit-demon t) + ;; Try to avoid dialog boxes, e.g. by Mailcrypt. + ;; Unfortunately, Emacs 20's `message-or-box...' doesn't + ;; obey `use-dialog-box'. + use-dialog-box (last-nonmenu-event 10) handler time idle) (while handlers (setq handler (pop handlers)) @@ -258,7 +262,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." "Add daemonic nntp server disconnection to Gnus. If no commands have gone out via nntp during the last five minutes, the connection is closed." - (gnus-demon-add-handler 'gnus-demon-close-connections 5 nil)) + (gnus-demon-add-handler 'gnus-demon-nntp-close-connections 5 nil)) (defun gnus-demon-nntp-close-connection () (save-window-excursion @@ -272,7 +276,8 @@ minutes, the connection is closed." (defun gnus-demon-scan-mail () (save-window-excursion (let ((servers gnus-opened-servers) - server) + server + (nnmail-fetched-sources (list t))) (while (setq server (car (pop servers))) (and (gnus-check-backend-function 'request-scan (car server)) (or (gnus-server-opened server) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index b0df871..849dc9b 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,5 +1,6 @@ ;;; gnus-draft.el --- draft message support for Semi-gnus -;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -69,8 +70,8 @@ (interactive "P") (when (eq major-mode 'gnus-summary-mode) (when (set (make-local-variable 'gnus-draft-mode) - (if (null arg) (not gnus-draft-mode) - (> (prefix-numeric-value arg) 0))) + (if (null arg) (not gnus-draft-mode) + (> (prefix-numeric-value arg) 0))) ;; Set up the menu. (when (gnus-visual-p 'draft-menu 'menu) (gnus-draft-make-menu-bar)) @@ -111,17 +112,20 @@ (defun gnus-draft-send-message (&optional n) "Send the current draft." (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article) + (let* ((articles (gnus-summary-work-articles n)) + (total (length articles)) + article) (while (setq article (pop articles)) (gnus-summary-remove-process-mark article) (unless (memq article gnus-newsgroup-unsendable) - (gnus-draft-send article gnus-newsgroup-name t) + (let ((message-sending-message + (format "Sending message %d of %d..." + (- total (length articles)) total))) + (gnus-draft-send article gnus-newsgroup-name t)) (gnus-summary-mark-article article gnus-canceled-mark))))) (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (gnus-draft-setup-for-sending article (or group "nndraft:queue")) (let ((message-syntax-checks (if interactive nil 'dont-check-for-anything-just-trust-me)) (message-inhibit-body-encoding (or (not group) @@ -129,7 +133,10 @@ message-inhibit-body-encoding)) (message-send-hook (and group (not (equal group "nndraft:queue")) message-send-hook)) + (message-setup-hook (and group (not (equal group "nndraft:queue")) + message-setup-hook)) type method) + (gnus-draft-setup-for-sending article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction @@ -140,6 +147,8 @@ (setq type (ignore-errors (read (current-buffer))) method (ignore-errors (read (current-buffer)))) (message-remove-header gnus-agent-meta-information-header))) + ;; Let Agent restore any GCC lines and have message.el perform them. + (gnus-agent-restore-gcc) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. (when (let ((mail-header-separator "")) @@ -181,14 +190,14 @@ (cdr (assq 'unsend (gnus-info-marks (gnus-get-info "nndraft:queue")))))) - (n (length articles)) - article i) + (total (length articles)) + article) (while (setq article (pop articles)) - (setq i (- n (length articles))) - (message "Sending message %d of %d." i n) - (if (memq article unsendable) - (message "Message %d of %d is unsendable." i n) - (gnus-draft-send article)))))) + (unless (memq article unsendable) + (let ((message-sending-message + (format "Sending message %d of %d..." + (- total (length articles)) total))) + (gnus-draft-send article))))))) ;;; Utility functions @@ -210,8 +219,8 @@ (erase-buffer) (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") - ;; Insert the separator. (funcall gnus-draft-decoding-function) + ;; Insert the separator. (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) diff --git a/lisp/gnus-dup.el b/lisp/gnus-dup.el index 691381f..e148f45 100644 --- a/lisp/gnus-dup.el +++ b/lisp/gnus-dup.el @@ -1,5 +1,6 @@ ;;; gnus-dup.el --- suppression of duplicate articles in Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -136,6 +137,8 @@ seen in the same session." (gnus-dup-open)) (gnus-message 6 "Suppressing duplicates...") (let ((headers gnus-newsgroup-headers) + (auto (and gnus-newsgroup-auto-expire + (memq gnus-duplicate-mark gnus-auto-expirable-marks))) number header) (while (setq header (pop headers)) (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) @@ -143,8 +146,10 @@ seen in the same session." (setq gnus-newsgroup-unreads (delq (setq number (mail-header-number header)) gnus-newsgroup-unreads)) - (push (cons number gnus-duplicate-mark) - gnus-newsgroup-reads)))) + (if (not auto) + (push (cons number gnus-duplicate-mark) gnus-newsgroup-reads) + (push number gnus-newsgroup-expirable) + (push (cons number gnus-expirable-mark) gnus-newsgroup-reads))))) (gnus-message 6 "Suppressing duplicates...done")) (defun gnus-dup-unsuppress-article (article) diff --git a/lisp/gnus-eform.el b/lisp/gnus-eform.el index 09f2bb5..9fe7242 100644 --- a/lisp/gnus-eform.el +++ b/lisp/gnus-eform.el @@ -1,5 +1,6 @@ ;;; gnus-eform.el --- a mode for editing forms for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 84dff68..fae3844 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,5 +1,6 @@ ;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Tatsuya Ichikawa @@ -26,19 +27,18 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'ring)) ;;; Function aliases later to be redefined for XEmacs usage. -(defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version) - "Non-nil if running under XEmacs.") - (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-3 [down-mouse-3]) (defvar gnus-down-mouse-2 [down-mouse-2]) (defvar gnus-widget-button-keymap nil) (defvar gnus-mode-line-modified - (if (or gnus-xemacs + (if (or (featurep 'xemacs) (< emacs-major-version 20)) '("--**-" . "-----") '("**" "--"))) @@ -48,49 +48,25 @@ (autoload 'gnus-xmas-redefine "gnus-xmas") (autoload 'appt-select-lowest-window "appt")) -(or (fboundp 'mail-file-babyl-p) - (fset 'mail-file-babyl-p 'rmail-file-p)) +(if (featurep 'xemacs) + (autoload 'gnus-smiley-display "smiley") + (autoload 'gnus-smiley-display "smiley-ems")) ; override XEmacs version + +(defun gnus-kill-all-overlays () + "Delete all overlays in the current buffer." + (let* ((overlayss (overlay-lists)) + (buffer-read-only nil) + (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) + (while overlays + (delete-overlay (pop overlays))))) ;;; Mule functions. (eval-and-compile - (if (string-match "XEmacs\\|Lucid" emacs-version) - nil - + (if (featurep 'xemacs) + (gnus-xmas-define) (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions.")) - - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-define)) - - ((or (not (boundp 'emacs-minor-version)) - (and (< emacs-major-version 20) - (< emacs-minor-version 30))) - ;; Remove the `intangible' prop. - (let ((props (and (boundp 'gnus-hidden-properties) - gnus-hidden-properties))) - (while (and props (not (eq (car (cdr props)) 'intangible))) - (setq props (cdr props))) - (when props - (setcdr props (cdr (cdr (cdr props)))))) - (unless (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - (format "%s" (buffer-substring beg end))))) - - ((boundp 'MULE) - (provide 'gnusutil)))) - -(eval-and-compile - (cond - ((not window-system) - (defun gnus-dummy-func (&rest args)) - (let ((funcs '(mouse-set-point set-face-foreground - set-face-background x-popup-menu))) - (while funcs - (unless (fboundp (car funcs)) - (fset (car funcs) 'gnus-dummy-func)) - (setq funcs (cdr funcs))))))) + "Property used for highlighting mouse regions."))) (eval-and-compile (let ((case-fold-search t)) @@ -99,8 +75,9 @@ (symbol-name system-type)) (setq nnheader-file-name-translation-alist (append nnheader-file-name-translation-alist - '((?: . ?_) - (?+ . ?-)))))))) + (mapcar (lambda (c) (cons c ?_)) + '(?: ?* ?\" ?< ?> ??)) + '((?+ . ?-)))))))) (defvar gnus-tmp-unread) (defvar gnus-tmp-replied) @@ -111,85 +88,75 @@ (defvar gnus-tmp-name) (defvar gnus-tmp-closing-bracket) (defvar gnus-tmp-subject-or-nil) +(defvar gnus-check-before-posting) (defun gnus-ems-redefine () (cond - ((string-match "XEmacs\\|Lucid" emacs-version) + ((featurep 'xemacs) (gnus-xmas-redefine)) ((featurep 'mule) ;; Mule and new Emacs definitions ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and beta version of Emacs including - ;; some mule features. Unfortunately these API are different. In + ;; original MULE, XEmacs/mule and Emacs 20+ including + ;; MULE features. Unfortunately these API are different. In ;; particular, Emacs (including original MULE) and XEmacs are - ;; quite different. + ;; quite different. However, this version of Gnus doesn't support + ;; anything other than XEmacs 20+ and Emacs 20.3+. + ;; Predicates to check are following: ;; (boundp 'MULE) is t only if MULE (original; anything older than ;; Mule 2.3) is running. ;; (featurep 'mule) is t when every mule variants are running. - ;; These implementations may be able to share between original - ;; MULE and beta version of new Emacs. In addition, it is able to - ;; detect XEmacs/mule by (featurep 'mule) and to check variable - ;; `emacs-version'. In this case, implementation for XEmacs/mule - ;; may be able to share between XEmacs and XEmacs/mule. + ;; It is possible to detect XEmacs/mule by (featurep 'mule) and + ;; checking `emacs-version'. In this case, the implementation for + ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") - (fset 'gnus-summary-set-display-table (lambda ())) + + (defalias 'gnus-summary-set-display-table (lambda ())) (if (fboundp 'truncate-string-to-width) (fset 'gnus-truncate-string 'truncate-string-to-width) (fset 'gnus-truncate-string 'truncate-string)) + (when (boundp 'gnus-check-before-posting) + (setq gnus-check-before-posting + (delq 'long-lines + (delq 'control-chars gnus-check-before-posting)))) + )) + (when (featurep 'mule) (defun gnus-tilde-max-form (el max-width) "Return a form that limits EL to MAX-WIDTH." (let ((max (abs max-width))) (if (symbolp el) - `(if (> (string-width ,el) ,max) - ,(if (< max-width 0) - `(gnus-truncate-string - ,el (string-width ,el) - (- (string-width ,el) ,max)) - `(gnus-truncate-string ,el ,max)) - ,el) - `(let ((val (eval ,el))) - (if (> (string-width val) ,max) - ,(if (< max-width 0) - `(gnus-truncate-string - val (string-width val) - (- (string-width val) ,max)) - `(gnus-truncate-string val ,max)) - val))))) + (if (< max-width 0) + `(let ((width (string-width ,el))) + (gnus-truncate-string ,el width (- width ,max))) + `(gnus-truncate-string ,el ,max)) + (if (< max-width 0) + `(let* ((val (eval ,el)) + (width (string-width val))) + (gnus-truncate-string val width (- width ,max))) + `(let ((val (eval ,el))) + (gnus-truncate-string val ,max)))))) (defun gnus-tilde-cut-form (el cut-width) "Return a form that cuts CUT-WIDTH off of EL." (let ((cut (abs cut-width))) (if (symbolp el) - `(if (> (string-width ,el) ,cut) - ,(if (< cut-width 0) - `(gnus-truncate-string - ,el (- (string-width ,el) ,cut)) - `(gnus-truncate-string - ,el (- (string-width ,el) ,cut) ,cut)) - ,el) - `(let ((val (eval ,el))) - (if (> (string-width val) ,cut) - ,(if (< cut-width 0) - `(gnus-truncate-string - val (- (string-width val) ,cut)) - `(gnus-truncate-string - val (- (string-width val) ,cut) ,cut)) - val))))) - - (when (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - ))) + (if (< cut-width 0) + `(gnus-truncate-string ,el (- (string-width ,el) ,cut)) + `(gnus-truncate-string ,el (string-width ,el) ,cut)) + (if (< cut-width 0) + `(let ((val (eval ,el))) + (gnus-truncate-string val (- (string-width val) ,cut))) + `(let ((val (eval ,el))) + (gnus-truncate-string val (string-width val) ,cut)))))) + )) (defun gnus-region-active-p () "Say whether the region is active." @@ -198,9 +165,9 @@ (boundp 'mark-active) mark-active)) -(defun gnus-add-minor-mode (mode name map) - (if (fboundp 'add-minor-mode) - (add-minor-mode mode name map) +(if (fboundp 'add-minor-mode) + (defalias 'gnus-add-minor-mode 'add-minor-mode) + (defun gnus-add-minor-mode (mode name map &rest rest) (set (make-local-variable mode) t) (unless (assq mode minor-mode-alist) (push `(,mode ,name) minor-mode-alist)) @@ -214,18 +181,19 @@ pixmap file height beg i) (save-excursion (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) - (let ((buffer-read-only nil)) + (let ((buffer-read-only nil) + width height) (erase-buffer) (when (and dir - (file-exists-p (setq file (concat dir "x-splash")))) + (file-exists-p (setq file + (expand-file-name "x-splash" dir)))) (with-temp-buffer (insert-file-contents-as-binary file) (goto-char (point-min)) (ignore-errors (setq pixmap (read (current-buffer)))))) (when pixmap - (unless (facep 'gnus-splash) - (make-face 'gnus-splash)) + (make-face 'gnus-splash) (setq height (/ (car pixmap) (frame-char-height)) width (/ (cadr pixmap) (frame-char-width))) (set-face-foreground 'gnus-splash "Brown") @@ -233,15 +201,92 @@ (insert-char ?\n (* (/ (window-height) 2 height) height)) (setq i height) (while (> i 0) - (insert-char ? (* (/ (window-width) 2 width) width)) + (insert-char ?\ (* (/ (window-width) 2 width) width)) (setq beg (point)) - (insert-char ? width) + (insert-char ?\ width) (set-text-properties beg (point) '(face gnus-splash)) - (insert "\n") + (insert ?\n) (decf i)) (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 (beg end) + "Display an XFace header from between BEG and END in the current article. +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)) + (data (buffer-substring beg end)) + (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) + (insert-image image)))))) + (defun-maybe assoc-ignore-case (key alist) "Like `assoc', but assumes KEY is a string and ignores case when comparing." (setq key (downcase key)) @@ -287,8 +332,4 @@ (provide 'gnus-ems) -;; Local Variables: -;; byte-compile-warnings: '(redefine callargs) -;; End: - ;;; gnus-ems.el ends here diff --git a/lisp/gnus-gl.el b/lisp/gnus-gl.el index 3263e60..f3d08b3 100644 --- a/lisp/gnus-gl.el +++ b/lisp/gnus-gl.el @@ -1,5 +1,7 @@ ;;; gnus-gl.el --- an interface to GroupLens for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Brad Miller ;; Keywords: news, score @@ -137,10 +139,10 @@ This pseudonym is obtained during the registration process") (defvar grouplens-bbb-host "grouplens.cs.umn.edu" - "Host where the bbbd is running" ) + "Host where the bbbd is running.") (defvar grouplens-bbb-port 9000 - "Port where the bbbd is listening" ) + "Port where the bbbd is listening.") (defvar grouplens-newsgroups '("comp.groupware" "comp.human-factors" "comp.lang.c++" @@ -194,19 +196,19 @@ GroupLens scores can be combined with gnus scores in one of three ways. ;;;; Program global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar grouplens-bbb-token nil - "Current session token number") + "Current session token number.") (defvar grouplens-bbb-process nil - "Process Id of current bbbd network stream process") + "Process Id of current bbbd network stream process.") (defvar grouplens-bbb-buffer nil - "Buffer associated with the BBBD process") + "Buffer associated with the BBBD process.") (defvar grouplens-rating-alist nil - "Current set of message-id rating pairs") + "Current set of message-id rating pairs.") (defvar grouplens-current-hashtable nil - "A hashtable to hold predictions from the BBB") + "A hashtable to hold predictions from the BBB.") (defvar grouplens-current-group nil) @@ -313,7 +315,7 @@ If this times out we give up and assume that something has died..." ) (concat "login " grouplens-pseudonym)) (if (bbb-read-response bbb-process) (setq grouplens-bbb-token (bbb-extract-token-number)) - (gnus-message 3 "Error: GroupLens login failed"))))) + (gnus-message 3 "Error: GroupLens login failed"))))) (gnus-message 3 "Error: you must set a pseudonym")) grouplens-bbb-token) @@ -407,7 +409,7 @@ recommend using both scores and grouplens predictions together." pred (bbb-get-pred)) (push `(,mid ,pred nil s) resp) (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh)) - grouplens-current-hashtable) + grouplens-current-hashtable) (forward-line 1) t) ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") @@ -780,12 +782,12 @@ If prefix argument ALL is non-nil, all articles are marked as read." (unless gnus-grouplens-mode-map (setq gnus-grouplens-mode-map (make-keymap)) (gnus-define-keys - gnus-grouplens-mode-map - "n" grouplens-next-unread-article - "r" bbb-summary-rate-article - "k" grouplens-score-thread - "c" grouplens-summary-catchup-and-exit - "," grouplens-best-unread-article)) + gnus-grouplens-mode-map + "n" grouplens-next-unread-article + "r" bbb-summary-rate-article + "k" grouplens-score-thread + "c" grouplens-summary-catchup-and-exit + "," grouplens-best-unread-article)) (defun gnus-grouplens-make-menu-bar () (unless (boundp 'gnus-grouplens-menu) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 17b58fe..8376f13 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,5 +1,6 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-start) (require 'nnmail) @@ -161,6 +163,7 @@ with some simple extensions. %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used %d The date the group was last entered. +%E Icon as defined by `gnus-group-icon-list'. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the @@ -331,7 +334,7 @@ variable." ((= unread 0) . gnus-group-mail-low-empty-face) (t . - gnus-group-mail-low-face)) + gnus-group-mail-low-face)) "*Controls the highlighting of group buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a a @@ -360,6 +363,66 @@ ticked: The number of ticked articles." :group 'gnus-group-visual :type 'character) +(defgroup gnus-group-icons nil + "Add Icons to your group buffer. " + :group 'gnus-group-visual) + +(defcustom gnus-group-icon-list + nil + "*Controls the insertion of icons into group buffer lines. + +Below is a list of `Form'/`File' pairs. When deciding how a +particular group line should be displayed, each form is evaluated. +The icon from the file field after the first true form is used. You +can change how those group lines are displayed by editing the file +field. The File will either be found in the +`gnus-group-glyph-directory' or by designating absolute path to the +file. + +It is also possible to change and add form fields, but currently that +requires an understanding of Lisp expressions. Hopefully this will +change in a future release. For now, you can use the following +variables in the Lisp expression: + +group: The name of the group. +unread: The number of unread articles in the group. +method: The select method used. +mailp: Whether it's a mail group or not. +newsp: Whether it's a news group or not +level: The level of the group. +score: The score of the group. +ticked: The number of ticked articles." + :group 'gnus-group-icons + :type '(repeat (cons (sexp :tag "Form") file))) + +(defcustom gnus-group-name-charset-method-alist nil + "*Alist of method and the charset for group names. + +For example: + (((nntp \"news.com.cn\") . cn-gb-2312)) +" + :version "21.1" + :group 'gnus-charset + :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) + +(defcustom gnus-group-name-charset-group-alist nil + "*Alist of group regexp and the charset for group names. + +For example: + ((\"\\.com\\.cn:\" . cn-gb-2312)) +" + :group 'gnus-charset + :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) + +(defcustom gnus-group-jump-to-group-prompt nil + "Default prompt for `gnus-group-jump-to-group'. +If non-nil, the value should be a string, e.g. \"nnml:\", +in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" +in the minibuffer prompt." + :group 'gnus-group-various + :type '(choice (string :tag "Prompt string") + (const :tag "Empty" nil))) + ;;; Internal variables (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat @@ -404,6 +467,7 @@ ticked: The number of ticked articles." (?s gnus-tmp-news-server ?s) (?n gnus-tmp-news-method ?s) (?P gnus-group-indentation ?s) + (?E gnus-tmp-group-icon ?s) (?l gnus-tmp-grouplens ?s) (?z gnus-tmp-news-method-string ?s) (?m (gnus-group-new-mail gnus-tmp-group) ?c) @@ -433,6 +497,12 @@ ticked: The number of ticked articles." (defvar gnus-group-list-mode nil) + +(defvar gnus-group-icon-cache nil) + +(defvar gnus-group-listed-groups nil) +(defvar gnus-group-list-option nil) + ;;; ;;; Gnus group mode ;;; @@ -445,6 +515,7 @@ ticked: The number of ticked articles." "=" gnus-group-select-group "\r" gnus-group-select-group "\M-\r" gnus-group-quick-select-group + "\M- " gnus-group-visible-select-group [(meta control return)] gnus-group-select-group-ephemerally "j" gnus-group-jump-to-group "n" gnus-group-next-unread-group @@ -572,7 +643,45 @@ ticked: The number of ticked articles." "d" gnus-group-description-apropos "m" gnus-group-list-matching "M" gnus-group-list-all-matching - "l" gnus-group-list-level) + "l" gnus-group-list-level + "c" gnus-group-list-cached + "?" gnus-group-list-dormant) + + (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) + "k" gnus-group-list-limit + "z" gnus-group-list-limit + "s" gnus-group-list-limit + "u" gnus-group-list-limit + "A" gnus-group-list-limit + "m" gnus-group-list-limit + "M" gnus-group-list-limit + "l" gnus-group-list-limit + "c" gnus-group-list-limit + "?" gnus-group-list-limit) + + (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) + "k" gnus-group-list-flush + "z" gnus-group-list-flush + "s" gnus-group-list-flush + "u" gnus-group-list-flush + "A" gnus-group-list-flush + "m" gnus-group-list-flush + "M" gnus-group-list-flush + "l" gnus-group-list-flush + "c" gnus-group-list-flush + "?" gnus-group-list-flush) + + (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) + "k" gnus-group-list-plus + "z" gnus-group-list-plus + "s" gnus-group-list-plus + "u" gnus-group-list-plus + "A" gnus-group-list-plus + "m" gnus-group-list-plus + "M" gnus-group-list-plus + "l" gnus-group-list-plus + "c" gnus-group-list-plus + "?" gnus-group-list-plus) (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) "f" gnus-score-flush-cache) @@ -598,21 +707,29 @@ ticked: The number of ticked articles." (easy-menu-define gnus-group-reading-menu gnus-group-mode-map "" - '("Group" + `("Group" ["Read" gnus-group-read-group (gnus-group-group-name)] ["Select" gnus-group-select-group (gnus-group-group-name)] ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC" :active (gnus-group-group-name)] - ["Catch up" gnus-group-catchup-current (gnus-group-group-name)] + ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Mark unread articles in the current group as read"))] ["Catch up all articles" gnus-group-catchup-current-all (gnus-group-group-name)] ["Check for new articles" gnus-group-get-new-news-this-group - (gnus-group-group-name)] + :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Check for new messages in current group"))] ["Toggle subscription" gnus-group-unsubscribe-current-group (gnus-group-group-name)] - ["Kill" gnus-group-kill-group (gnus-group-group-name)] + ["Kill" gnus-group-kill-group :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Kill (remove) current group"))] ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] - ["Describe" gnus-group-describe-group (gnus-group-group-name)] + ["Describe" gnus-group-describe-group :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display description of the current group"))] ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) @@ -648,7 +765,9 @@ ticked: The number of ticked articles." ["Group and description apropos..." gnus-group-description-apropos t] ["List groups matching..." gnus-group-list-matching t] ["List all groups matching..." gnus-group-list-all-matching t] - ["List active file" gnus-group-list-active t]) + ["List active file" gnus-group-list-active t] + ["List groups with cached" gnus-group-list-cached t] + ["List groups with dormant" gnus-group-list-dormant t]) ("Sort" ["Default sort" gnus-group-sort-groups t] ["Sort by method" gnus-group-sort-groups-by-method t] @@ -726,7 +845,7 @@ ticked: The number of ticked articles." (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" - '("Misc" + `("Misc" ("SOUP" ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] ["Send replies" gnus-soup-send-replies @@ -736,7 +855,10 @@ ticked: The number of ticked articles." ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) ["Send a mail" gnus-group-mail t] ["Post an article..." gnus-group-post-news t] - ["Check for new news" gnus-group-get-new-news t] + ["Check for new news" gnus-group-get-new-news + ,@(if (featurep 'xemacs) nil + '(:help "Get newly arrived articles")) + ] ["Activate all groups" gnus-activate-all-groups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] @@ -752,11 +874,41 @@ ticked: The number of ticked articles." ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] ["Send a bug report" gnus-bug t] - ["Exit from Gnus" gnus-group-exit t] + ["Exit from Gnus" gnus-group-exit + ,@(if (featurep 'xemacs) nil + '(:help "Quit reading news"))] ["Exit without saving" gnus-group-quit t])) (gnus-run-hooks 'gnus-group-menu-hook))) +(defvar gnus-group-toolbar-map nil) + +;; Emacs 21 tool bar. Should be no-op otherwise. +(defun gnus-group-make-tool-bar () + (if (and (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-group-toolbar-map)) + (setq gnus-group-toolbar-map + (let ((tool-bar-map (make-sparse-keymap))) + (tool-bar-add-item-from-menu + 'gnus-group-get-new-news "get-news" gnus-group-mode-map) + (tool-bar-add-item-from-menu + 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map) + (tool-bar-add-item-from-menu + 'gnus-group-catchup-current "catchup" gnus-group-mode-map) + (tool-bar-add-item-from-menu + 'gnus-group-describe-group "describe-group" gnus-group-mode-map) + (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe + :help "Subscribe to the current group") + (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe + 'unsubscribe + :help "Unsubscribe from the current group") + (tool-bar-add-item-from-menu + 'gnus-group-exit "exit-gnus" gnus-group-mode-map) + tool-bar-map))) + (if gnus-group-toolbar-map + (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map))) + (defun gnus-group-mode () "Major mode for reading news. @@ -775,9 +927,10 @@ The following commands are available: \\{gnus-group-mode-map}" (interactive) - (when (gnus-visual-p 'group-menu 'menu) - (gnus-group-make-menu-bar)) (kill-all-local-variables) + (when (gnus-visual-p 'group-menu 'menu) + (gnus-group-make-menu-bar) + (gnus-group-make-tool-bar)) (gnus-simplify-mode-line) (setq major-mode 'gnus-group-mode) (setq mode-name "Group") @@ -840,6 +993,29 @@ The following commands are available: (when gnus-carpal (gnus-carpal-setup-buffer 'group)))) +(defsubst gnus-group-name-charset (method group) + (if (null method) + (setq method (gnus-find-method-for-group group))) + (let ((item (assoc method gnus-group-name-charset-method-alist)) + (alist gnus-group-name-charset-group-alist) + result) + (if item + (cdr item) + (while (setq item (pop alist)) + (if (string-match (car item) group) + (setq alist nil + result (cdr item)))) + result))) + +(defsubst gnus-group-name-decode (string charset) + (if (and string charset (featurep 'mule)) + (decode-coding-string string charset) + string)) + +(defun gnus-group-decoded-name (string) + (let ((charset (gnus-group-name-charset nil string))) + (gnus-group-name-decode string charset))) + (defun gnus-group-list-groups (&optional level unread lowest) "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. @@ -913,18 +1089,35 @@ If ALL (the prefix), also list groups that have no unread articles." (interactive "nList groups on level: \nP") (gnus-group-list-groups level all level)) -(defun gnus-group-prepare-flat (level &optional all lowest regexp) +(defun gnus-group-prepare-logic (group test) + (or (and gnus-group-listed-groups + (null gnus-group-list-option) + (member group gnus-group-listed-groups)) + (cond + ((null gnus-group-listed-groups) test) + ((null gnus-group-list-option) test) + (t (and (member group gnus-group-listed-groups) + (if (eq gnus-group-list-option 'flush) + (not test) + test)))))) + +(defun gnus-group-prepare-flat (level &optional predicate lowest regexp) "List all newsgroups with unread articles of level LEVEL or lower. -If ALL is non-nil, list groups that have no unread articles. +If PREDICATE is a function, list groups that the function returns non-nil; +if it is t, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. -If REGEXP, only list groups matching REGEXP." +If REGEXP is a function, list dead groups that the function returns non-nil; +if it is a string, only list groups matching REGEXP." (set-buffer gnus-group-buffer) (let ((buffer-read-only nil) (newsrc (cdr gnus-newsrc-alist)) (lowest (or lowest 1)) + (not-in-list (and gnus-group-listed-groups + (copy-sequence gnus-group-listed-groups))) info clevel unread group params) (erase-buffer) - (when (< lowest gnus-level-zombie) + (when (or (< lowest gnus-level-zombie) + gnus-group-listed-groups) ;; List living groups. (while newsrc (setq info (car newsrc) @@ -932,41 +1125,60 @@ If REGEXP, only list groups matching REGEXP." params (gnus-info-params info) newsrc (cdr newsrc) unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (and unread ; This group might be bogus - (or (not regexp) - (string-match regexp group)) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (or all ; We list all groups? - (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) ; We list groups with unread articles - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) + (if not-in-list + (setq not-in-list (delete group not-in-list))) + (and + (gnus-group-prepare-logic + group + (and unread ; This group might be unchecked + (or (not (stringp regexp)) + (string-match regexp group)) + (<= (setq clevel (gnus-info-level info)) level) + (>= clevel lowest) + (cond + ((functionp predicate) + (funcall predicate info)) + (predicate t) ; We list all groups? + (t + (or + (if (eq unread t) ; Unactivated? + gnus-group-list-inactive-groups + ; We list unactivated + (> unread 0)) + ; We list groups with unread articles + (and gnus-list-groups-with-ticked-articles + (cdr (assq 'tick (gnus-info-marks info)))) ; And groups with tickeds - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups - group)) - (memq 'visible params) - (cdr (assq 'visible params))) - (gnus-group-insert-group-line - group (gnus-info-level info) - (gnus-info-marks info) unread (gnus-info-method info))))) - + ;; Check for permanent visibility. + (and gnus-permanently-visible-groups + (string-match gnus-permanently-visible-groups group)) + (memq 'visible params) + (cdr (assq 'visible params))))))) + (gnus-group-insert-group-line + group (gnus-info-level info) + (gnus-info-marks info) unread (gnus-info-method info))))) + ;; List dead groups. - (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) - (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - regexp)) - (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) - (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K regexp)) + (if (or gnus-group-listed-groups + (and (>= level gnus-level-zombie) + (<= lowest gnus-level-zombie))) + (gnus-group-prepare-flat-list-dead + (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) + gnus-level-zombie ?Z + regexp)) + (if not-in-list + (dolist (group gnus-zombie-list) + (setq not-in-list (delete group not-in-list)))) + (if (or gnus-group-listed-groups + (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) + (gnus-group-prepare-flat-list-dead + (gnus-union + not-in-list + (setq gnus-killed-list (sort gnus-killed-list 'string<))) + gnus-level-killed ?K regexp)) (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) + (setq gnus-group-list-mode (cons level predicate)) (gnus-run-hooks 'gnus-group-prepare-hook) t)) @@ -975,27 +1187,32 @@ If REGEXP, only list groups matching REGEXP." ;; suggested by Jack Vinson . It does ;; this by ignoring the group format specification altogether. (let (group) - (if regexp - ;; This loop is used when listing groups that match some - ;; regexp. - (while groups - (setq group (pop groups)) - (when (string-match regexp group) - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " group "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))) - ;; This loop is used when listing all groups. - (while groups - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " - (setq group (pop groups)) "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))))) + (while groups + (setq group (pop groups)) + (when (gnus-group-prepare-logic + group + (or (not regexp) + (and (stringp regexp) (string-match regexp group)) + (and (functionp regexp) (funcall regexp group)))) +;;; (gnus-add-text-properties +;;; (point) (prog1 (1+ (point)) +;;; (insert " " mark " *: " +;;; (gnus-group-name-decode group +;;; (gnus-group-name-charset +;;; nil group)) +;;; "\n")) +;;; (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) +;;; 'gnus-unread t +;;; 'gnus-level level)) + (gnus-group-insert-group-line + group level nil + (let ((active (gnus-active group))) + (if active + (if (zerop (cdr active)) + 0 + (- (1+ (cdr active)) (car active))) + nil)) + (gnus-method-simplify (gnus-find-method-for-group group))))))) (defun gnus-group-update-group-line () "Update the current line in the group buffer." @@ -1038,13 +1255,17 @@ If REGEXP, only list groups matching REGEXP." 0 (- (1+ (cdr active)) (car active))) nil) - nil)))) + (gnus-method-simplify (gnus-find-method-for-group group)))))) (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." - (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) + (let* ((gnus-tmp-method + (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) + (group-name-charset (gnus-group-name-charset gnus-tmp-method + gnus-tmp-group)) + (gnus-tmp-active (gnus-active gnus-tmp-group)) (gnus-tmp-number-total (if gnus-tmp-active (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) @@ -1061,10 +1282,14 @@ If REGEXP, only list groups matching REGEXP." ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) ((= gnus-tmp-level gnus-level-zombie) ?Z) (t ?K))) - (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) + (gnus-tmp-qualified-group + (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) + group-name-charset)) (gnus-tmp-newsgroup-description (if gnus-description-hashtb - (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") + (or (gnus-group-name-decode + (gnus-gethash gnus-tmp-group gnus-description-hashtb) + group-name-charset) "") "")) (gnus-tmp-moderated (if (and gnus-moderated-hashtb @@ -1072,8 +1297,7 @@ If REGEXP, only list groups matching REGEXP." ?m ? )) (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) - (gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ; + (gnus-tmp-group-icon "==&&==") (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) (gnus-tmp-news-method-string @@ -1107,10 +1331,10 @@ If REGEXP, only list groups matching REGEXP." gnus-marked ,gnus-tmp-marked-mark gnus-indentation ,gnus-group-indentation gnus-level ,gnus-tmp-level)) + (forward-line -1) (when (inline (gnus-visual-p 'group-highlight 'highlight)) - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-hook) - (forward-line)) + (gnus-run-hooks 'gnus-group-update-hook)) + (forward-line) ;; Allow XEmacs to remove front-sticky text properties. (gnus-group-remove-excess-properties))) @@ -1329,6 +1553,12 @@ If FIRST-TOO, the current line is also eligible as a target." ;; Group marking. +(defun gnus-group-mark-line-p () + (save-excursion + (beginning-of-line) + (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) + (eq (char-after) gnus-process-mark))) + (defun gnus-group-mark-group (n &optional unmark no-advance) "Mark the current group." (interactive "p") @@ -1395,10 +1625,10 @@ If UNMARK, remove the mark instead." (gnus-group-set-mark group)))) (gnus-group-position-point)) -(defun gnus-group-remove-mark (group) +(defun gnus-group-remove-mark (group &optional test-marked) "Remove the process mark from GROUP and move point there. Return nil if the group isn't displayed." - (if (gnus-group-goto-group group) + (if (gnus-group-goto-group group nil test-marked) (save-excursion (gnus-group-mark-group 1 'unmark t) t) @@ -1477,7 +1707,7 @@ Take into consideration N (the prefix) and the list of marked groups." (eval `(defun gnus-group-iterate (arg ,function) "Iterate FUNCTION over all process/prefixed groups. -FUNCTION will be called with the group name as the paremeter +FUNCTION will be called with the group name as the parameter and with point over the group in question." (let ((,groups (gnus-group-process-prefix arg)) (,window (selected-window)) @@ -1579,7 +1809,7 @@ be permanent." (defun gnus-fetch-group (group) "Start Gnus if necessary and enter GROUP. Returns whether the fetching was successful or not." - (interactive "sGroup name: ") + (interactive (list (completing-read "Group name: " gnus-active-hashtb))) (unless (get-buffer gnus-group-buffer) (gnus-no-server)) (gnus-group-read-group nil nil group)) @@ -1645,7 +1875,9 @@ Return the name of the group if selection was successful." (when (gnus-group-read-group t t group select-articles) group) ;;(error nil) - (quit nil))))) + (quit + (message "Quit reading the ephemeral group") + nil))))) (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." @@ -1653,7 +1885,7 @@ Return the name of the group if selection was successful." (list (completing-read "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) - nil + gnus-group-jump-to-group-prompt 'gnus-group-history))) (when (equal group "") @@ -1668,41 +1900,56 @@ Return the name of the group if selection was successful." ;; Adjust cursor point. (gnus-group-position-point)) -(defun gnus-group-goto-group (group &optional far) +(defun gnus-group-goto-group (group &optional far test-marked) "Goto to newsgroup GROUP. -If FAR, it is likely that the group is not on the current line." +If FAR, it is likely that the group is not on the current line. +If TEST-MARKED, the line must be marked." (when group - (if far - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) - (beginning-of-line) - (cond - ;; It's quite likely that we are on the right line, so - ;; we check the current line first. - ((eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (point)) - ;; Previous and next line are also likely, so we check them as well. - ((save-excursion - (forward-line -1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line -1) - (point)) - ((save-excursion - (forward-line 1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line 1) - (point)) - (t - ;; Search through the entire buffer. - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) + (beginning-of-line) + (cond + ;; It's quite likely that we are on the right line, so + ;; we check the current line first. + ((and (not far) + (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))) + (point)) + ;; Previous and next line are also likely, so we check them as well. + ((and (not far) + (save-excursion + (forward-line -1) + (and (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))))) + (forward-line -1) + (point)) + ((and (not far) + (save-excursion + (forward-line 1) + (and (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))))) + (forward-line 1) + (point)) + (test-marked + (goto-char (point-min)) + (let (found) + (while (and (not found) + (gnus-goto-char + (text-property-any + (point) (point-max) + 'gnus-group + (gnus-intern-safe group gnus-active-hashtb)))) + (if (gnus-group-mark-line-p) + (setq found t) + (forward-line 1))) + found)) + (t + ;; Search through the entire buffer. + (gnus-goto-char + (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))) (defun gnus-group-next-group (n &optional silent) "Go to next N'th newsgroup. @@ -1858,8 +2105,20 @@ ADDRESS." (gnus-request-create-group nname nil args)) t)) -(defun gnus-group-delete-group (group &optional force) - "Delete the current group. Only meaningful with mail groups. +(defun gnus-group-delete-groups (&optional arg) + "Delete the current group. Only meaningful with editable groups." + (interactive "P") + (let ((n (length (gnus-group-process-prefix arg)))) + (when (gnus-yes-or-no-p + (if (= n 1) + "Delete this 1 group? " + (format "Delete these %d groups? " n))) + (gnus-group-iterate arg + (lambda (group) + (gnus-group-delete-group group nil t)))))) + +(defun gnus-group-delete-group (group &optional force no-prompt) + "Delete the current group. Only meaningful with editable groups. If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face of the Earth\". There is no undo. The user will be prompted before @@ -1872,10 +2131,11 @@ doing the deletion." (unless (gnus-check-backend-function 'request-delete-group group) (error "This backend does not support group deletion")) (prog1 - (if (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group (if force " and all its contents" "")))) + (if (and (not no-prompt) + (not (gnus-yes-or-no-p + (format + "Do you really want to delete %s%s? " + group (if force " and all its contents" ""))))) () ; Whew! (gnus-message 6 "Deleting group %s..." group) (if (not (gnus-request-delete-group group force)) @@ -1920,10 +2180,12 @@ and NEW-NAME will be prompted for." (gnus-message 6 "Renaming group %s to %s..." group new-name) (prog1 - (if (not (gnus-request-rename-group group new-name)) + (if (progn + (gnus-group-goto-group group) + (not (when (< (gnus-group-group-level) gnus-level-zombie) + (gnus-request-rename-group group new-name)))) (gnus-error 3 "Couldn't rename group %s to %s" group new-name) ;; We rename the group internally by killing it... - (gnus-group-goto-group group) (gnus-group-kill-group) ;; ... changing its name ... (setcar (cdar gnus-list-of-killed-groups) new-name) @@ -1962,7 +2224,7 @@ and NEW-NAME will be prompted for." ((eq part 'method) "select method") ((eq part 'params) "group parameters") (t "group info")) - group) + (gnus-group-decoded-name group)) `(lambda (form) (gnus-group-edit-group-done ',part ,group form))))) @@ -2145,6 +2407,32 @@ If SOLID (the prefix), create a solid group." (nnwarchive-login ,login)))) (gnus-group-make-group group method))) +(defvar nnshimbun-type-definition) +(defvar gnus-group-shimbun-server-history nil) + +(defun gnus-group-make-shimbun-group () + "Create a nnshimbun group." + (interactive) + (require 'nnshimbun) + (let* ((minibuffer-setup-hook (append minibuffer-setup-hook + '(beginning-of-line))) + (server (completing-read + "Shimbun address: " + (mapcar (lambda (elem) (list (car elem))) + nnshimbun-type-definition) + nil t + (or (car gnus-group-shimbun-server-history) + (caar nnshimbun-type-definition)) + 'gnus-group-shimbun-server-history)) + (group (completing-read + "Group name: " + (mapcar (lambda (elem) (list elem)) + (cdr (assq 'groups + (cdr (assoc server nnshimbun-type-definition))))) + nil t nil)) + (nnshimbun-pre-fetch-article nil)) + (gnus-group-make-group group `(nnshimbun ,server)))) + (defun gnus-group-make-archive-group (&optional all) "Create the (ding) Gnus archive group of the most recent articles. Given a prefix, create a full group." @@ -2178,14 +2466,14 @@ mail messages or news articles in files that have numeric names." (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) (setq group (gnus-group-prefixed-name - (concat (file-name-as-directory (directory-file-name dir)) - ext) + (expand-file-name ext dir) '(nndir ""))) (setq ext (format "<%d>" (setq i (1+ i))))) (gnus-group-make-group (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) +(eval-when-compile (defvar nnkiboze-score-file)) (defun gnus-group-make-kiboze-group (group address scores) "Create an nnkiboze group. The user will be prompted for a name, a regexp to match groups, and @@ -2203,15 +2491,20 @@ score file entries for articles to include in the group." "Match on header: " headers nil t)))) (setq regexps nil) (while (not (equal "" (setq regexp (read-string - (format "Match on %s (string): " + (format "Match on %s (regexp): " header))))) (push (list regexp nil nil 'r) regexps)) (push (cons header regexps) scores)) scores))) (gnus-group-make-group group "nnkiboze" address) - (with-temp-file (gnus-score-file-name (concat "nnkiboze:" group)) - (let (emacs-lisp-mode-hook) - (pp scores (current-buffer))))) + (let* ((nnkiboze-current-group group) + (score-file (car (nnkiboze-score-file ""))) + (score-dir (file-name-directory score-file))) + (unless (file-exists-p score-dir) + (make-directory score-dir)) + (with-temp-file score-file + (let (emacs-lisp-mode-hook) + (pp scores (current-buffer)))))) (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." @@ -2290,30 +2583,31 @@ score file entries for articles to include in the group." (error "Killed group; can't be edited")) (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap) (error "%s is not an nnimap group" group)) - (gnus-edit-form (setq acl (nnimap-acl-get mailbox (cadr method))) - (format "Editing the access control list for `%s'. + (unless (setq acl (nnimap-acl-get mailbox (cadr method))) + (error "Server does not support ACL's")) + (gnus-edit-form acl (format "Editing the access control list for `%s'. An access control list is a list of (identifier . rights) elements. - The identifier string specifies the corresponding user. The + The identifier string specifies the corresponding user. The identifier \"anyone\" is reserved to refer to the universal identity. Rights is a string listing a (possibly empty) set of alphanumeric characters, each character listing a set of operations which is being - controlled. Letters are reserved for ``standard'' rights, listed + controlled. Letters are reserved for ``standard'' rights, listed below. Digits are reserved for implementation or site defined rights. l - lookup (mailbox is visible to LIST/LSUB commands) r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL, SEARCH, COPY from mailbox) - s - keep seen/unseen information across sessions (STORE SEEN flag) - w - write (STORE flags other than SEEN and DELETED) + s - keep seen/unseen information across sessions (STORE \\SEEN flag) + w - write (STORE flags other than \\SEEN and \\DELETED) i - insert (perform APPEND, COPY into mailbox) p - post (send mail to submission address for mailbox, not enforced by IMAP4 itself) - c - create (CREATE new sub-mailboxes in any implementation-defined - hierarchy) - d - delete (STORE DELETED flag, perform EXPUNGE) + c - create and delete mailbox (CREATE new sub-mailboxes in any + implementation-defined hierarchy, RENAME or DELETE mailbox) + d - delete messages (STORE \\DELETED flag, perform EXPUNGE) a - administer (perform SETACL)" group) `(lambda (form) (nnimap-acl-edit @@ -2542,7 +2836,7 @@ sort in reverse order." ;; Group catching up. (defun gnus-group-catchup-current (&optional n all) - "Mark all articles not marked as unread in current newsgroup as read. + "Mark all unread articles in the current newsgroup as read. If prefix argument N is numeric, the next N newsgroups will be caught up. If ALL is non-nil, marked articles will also be marked as read. Cross references (Xref: header) of articles are ignored. @@ -2572,8 +2866,7 @@ up is returned." (when (eq 'nnvirtual (car method)) (nnvirtual-catchup-group (gnus-group-real-name group) (nth 1 method) all))) - (if (>= (gnus-info-level (gnus-get-info group)) - gnus-level-zombie) + (if (>= (gnus-group-level group) gnus-level-zombie) (gnus-message 2 "Dead groups can't be caught up") (if (prog1 (gnus-group-goto-group group) @@ -2596,6 +2889,8 @@ The return value is the number of articles that were marked as read, or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (num (car entry))) + ;; Remove entries for this group. + (nnmail-purge-split-history (gnus-group-real-name group)) ;; Do the updating only if the newsgroup isn't killed. (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up %s; non-active group" group) @@ -2639,8 +2934,12 @@ or nil if no action could be taken." (expirable (if (gnus-group-total-expirable-p group) (cons nil (gnus-list-of-read-articles group)) (assq 'expire (gnus-info-marks info)))) - (expiry-wait (gnus-group-find-parameter group 'expiry-wait))) + (expiry-wait (gnus-group-find-parameter group 'expiry-wait)) + (nnmail-expiry-target + (or (gnus-group-find-parameter group 'expiry-target) + nnmail-expiry-target))) (when expirable + (gnus-check-group group) (setcdr expirable (gnus-compress-sequence @@ -2655,7 +2954,9 @@ or nil if no action could be taken." (gnus-request-expire-articles (gnus-uncompress-sequence (cdr expirable)) group)))) (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" group)))) + (gnus-message 6 "Expiring articles in %s...done" group) + ;; Return the list of un-expired articles. + (cdr expirable)))) (defun gnus-group-expire-all-groups () "Expire all expirable articles in all newsgroups." @@ -2972,7 +3273,7 @@ entail asking the server for the groups." ;; First we make sure that we have really read the active file. (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t) - (gnus-agent nil)) ; Trick the agent into ignoring the active file. + (gnus-agent nil)) ; Trick the agent into ignoring the active file. (gnus-read-active-file))) ;; Find all groups and sort them. (let ((groups @@ -2990,10 +3291,14 @@ entail asking the server for the groups." group) (erase-buffer) (while groups + (setq group (pop groups)) (gnus-add-text-properties (point) (prog1 (1+ (point)) (insert " *: " - (setq group (pop groups)) "\n")) + (gnus-group-name-decode group + (gnus-group-name-charset + nil group)) + "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t 'gnus-level (inline (gnus-group-level group))))) @@ -3046,7 +3351,10 @@ re-scanning. If ARG is non-nil and not a number, this will force (gnus-get-unread-articles arg))) (gnus-run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups (and (numberp arg) - (max (car gnus-group-list-mode) arg))))) + (max (car gnus-group-list-mode) arg)))) + ;; Update modeline. + (when (and gnus-agent (not (interactive-p))) + (gnus-agent-toggle-plugged gnus-plugged))) (defun gnus-group-get-new-news-this-group (&optional n dont-scan) "Check for newly arrived news in the current group (and the N-1 next groups). @@ -3057,7 +3365,12 @@ If N is negative, this group and the N-1 previous groups will be checked." (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n (point))) - group method) + group method + (gnus-inhibit-demon t) + ;; Binding this variable will inhibit multiple fetchings + ;; of the same mail source. + (nnmail-fetched-sources (list t))) + (gnus-run-hooks 'gnus-get-new-news-hook) (while (setq group (pop groups)) (gnus-group-remove-mark group) ;; Bypass any previous denials from the server. @@ -3093,7 +3406,7 @@ to use." (when current-prefix-arg (completing-read "Faq dir: " (and (listp gnus-group-faq-directory) - (mapcar (lambda (file) (list file)) + (mapcar #'list gnus-group-faq-directory)))))) (unless group (error "No group name given")) @@ -3104,7 +3417,7 @@ to use." (while (and (not found) (setq dir (pop dirs))) (let ((name (gnus-group-real-name group))) - (setq file (concat (file-name-as-directory dir) name))) + (setq file (expand-file-name name dir))) (if (not (file-exists-p file)) (gnus-message 1 "No such file: %s" file) (let ((enable-local-variables nil)) @@ -3147,8 +3460,12 @@ to use." (mapatoms (lambda (group) (setq b (point)) - (insert (format " *: %-20s %s\n" (symbol-name group) - (symbol-value group))) + (let ((charset (gnus-group-name-charset nil (symbol-name group)))) + (insert (format " *: %-20s %s\n" + (gnus-group-name-decode + (symbol-name group) charset) + (gnus-group-name-decode + (symbol-value group) charset)))) (gnus-add-text-properties b (1+ b) (list 'gnus-group group 'gnus-unread t 'gnus-marked nil @@ -3190,11 +3507,13 @@ to use." (while groups ;; Groups may be entered twice into the list of groups. (when (not (string= (car groups) prev)) - (insert (setq prev (car groups)) "\n") - (when (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " des "\n"))) + (setq prev (car groups)) + (let ((charset (gnus-group-name-charset nil prev))) + (insert (gnus-group-name-decode prev charset) "\n") + (when (and gnus-description-hashtb + (setq des (gnus-gethash (car groups) + gnus-description-hashtb))) + (insert " " (gnus-group-name-decode des charset) "\n")))) (setq groups (cdr groups))) (goto-char (point-min)))) (pop-to-buffer obuf))) @@ -3221,8 +3540,8 @@ This command may read the active file." (when (and level (> (prefix-numeric-value level) gnus-level-killed)) (gnus-get-killed-groups)) - (gnus-group-prepare-flat - (or level gnus-level-subscribed) all (or lowest 1) regexp) + (funcall gnus-group-prepare-function + (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp) (goto-char (point-min)) (gnus-group-position-point)) @@ -3457,26 +3776,26 @@ and the second element is the address." (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. - ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't + ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) (or (null articles) - (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) + (setcdr (nthcdr 2 info) + (list (list (cons type (gnus-compress-sequence + articles t))))))) (and (not (setq m (assq type (car marked)))) (or (null articles) - (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) - (car marked))))) + (setcar marked + (cons (cons type (gnus-compress-sequence articles t) ) + (car marked))))) (if force (if (null articles) - (setcar (nthcdr 3 info) - (gnus-delete-alist type (car marked))) - (setcdr m (gnus-compress-sequence articles t))) + (setcar (nthcdr 3 info) + (gnus-delete-alist type (car marked))) + (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) @@ -3501,7 +3820,7 @@ or `gnus-group-catchup-group-hook'." (defun gnus-group-timestamp-delta (group) "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." (let* ((time (or (gnus-group-timestamp group) - (list 0 0))) + (list 0 0))) (delta (subtract-time (current-time) time))) (+ (* (nth 0 delta) 65536.0) (nth 1 delta)))) @@ -3513,6 +3832,102 @@ or `gnus-group-catchup-group-hook'." "" (gnus-time-iso8601 time)))) +(defun gnus-group-list-cached (level &optional lowest) + "List all groups with cached articles. +If the prefix LEVEL is non-nil, it should be a number that says which +level to cut off listing groups. +If LOWEST, don't list groups with level lower than LOWEST. + +This command may read the active file." + (interactive "P") + (when level + (setq level (prefix-numeric-value level))) + (when (or (not level) (>= level gnus-level-zombie)) + (gnus-cache-open)) + (funcall gnus-group-prepare-function + (or level gnus-level-subscribed) + #'(lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'cache marks))) + lowest + #'(lambda (group) + (or (gnus-gethash group + gnus-cache-active-hashtb) + ;; Cache active file might use "." + ;; instead of ":". + (gnus-gethash + (mapconcat 'identity + (split-string group ":") + ".") + gnus-cache-active-hashtb)))) + (goto-char (point-min)) + (gnus-group-position-point)) + +(defun gnus-group-list-dormant (level &optional lowest) + "List all groups with dormant articles. +If the prefix LEVEL is non-nil, it should be a number that says which +level to cut off listing groups. +If LOWEST, don't list groups with level lower than LOWEST. + +This command may read the active file." + (interactive "P") + (when level + (setq level (prefix-numeric-value level))) + (when (or (not level) (>= level gnus-level-zombie)) + (gnus-cache-open)) + (funcall gnus-group-prepare-function + (or level gnus-level-subscribed) + #'(lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'dormant marks))) + lowest + 'ignore) + (goto-char (point-min)) + (gnus-group-position-point)) + +(defun gnus-group-listed-groups () + "Return a list of listed groups." + (let (point groups) + (goto-char (point-min)) + (while (setq point (text-property-not-all (point) (point-max) + 'gnus-group nil)) + (goto-char point) + (push (symbol-name (get-text-property point 'gnus-group)) groups) + (forward-char 1)) + groups)) + +(defun gnus-group-list-plus (&optional args) + "List groups plus the current selection." + (interactive "P") + (let ((gnus-group-listed-groups (gnus-group-listed-groups)) + (gnus-group-list-mode gnus-group-list-mode) ;; Save it. + func) + (push last-command-event unread-command-events) + (if (featurep 'xemacs) + (push (make-event 'key-press '(key ?A)) unread-command-events) + (push ?A unread-command-events)) + (let (gnus-pick-mode keys) + (setq keys (if (featurep 'xemacs) + (events-to-keys (read-key-sequence nil)) + (read-key-sequence nil))) + (setq func (lookup-key (current-local-map) keys))) + (if (or (not func) + (numberp func)) + (ding) + (call-interactively func)))) + +(defun gnus-group-list-flush (&optional args) + "Flush groups from the current selection." + (interactive "P") + (let ((gnus-group-list-option 'flush)) + (gnus-group-list-plus args))) + +(defun gnus-group-list-limit (&optional args) + "List groups limited within the current selection." + (interactive "P") + (let ((gnus-group-list-option 'limit)) + (gnus-group-list-plus args))) + (provide 'gnus-group) ;;; gnus-group.el ends here diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index df5fdc8..abd5737 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,5 +1,6 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -70,8 +71,7 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." (list 'nnmh-directory (file-name-as-directory (expand-file-name - (concat "~/" (substring - gnus-nntp-server 1))))) + (substring gnus-nntp-server 1) "~/"))) (list 'nnmh-get-new-mail nil))) (t (list 'nntp gnus-nntp-server))))) @@ -451,13 +451,14 @@ If BUFFER, insert the article in that group." (defun gnus-request-scan (group gnus-command-method) "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." - (when gnus-plugged - (let ((gnus-command-method - (if group (gnus-find-method-for-group group) gnus-command-method)) - (gnus-inhibit-demon t)) - (funcall (gnus-get-function gnus-command-method 'request-scan) - (and group (gnus-group-real-name group)) - (nth 1 gnus-command-method))))) + (let ((gnus-command-method + (if group (gnus-find-method-for-group group) gnus-command-method)) + (gnus-inhibit-demon t) + (mail-source-plugged gnus-plugged)) + (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-scan) + (and group (gnus-group-real-name group)) + (nth 1 gnus-command-method))))) (defsubst gnus-request-update-info (info gnus-command-method) "Request that GNUS-COMMAND-METHOD update INFO." diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index 1d04718..dfed289 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -1,5 +1,6 @@ ;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -27,6 +28,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-art) (require 'gnus-range) @@ -48,7 +50,8 @@ :type 'boolean) (defcustom gnus-winconf-kill-file nil - "What does this do, Lars?" + "What does this do, Lars? +I don't know, Per." :group 'gnus-score-kill :type 'sexp) @@ -520,7 +523,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (if (listp kill-list) ;; It is a list. (if (not (consp (cdr kill-list))) - ;; It's on the form (regexp . date). + ;; It's of the form (regexp . date). (if (zerop (gnus-execute field (car kill-list) command nil (not all))) (when (> (days-between date (cdr kill-list)) @@ -682,6 +685,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" (mapconcat 'identity command-line-args-left " ")))) (gnus-expert-user t) (nnmail-spool-file nil) + (mail-sources nil) (gnus-use-dribble-file nil) (gnus-batch-mode t) info group newsrc entry diff --git a/lisp/gnus-load.el b/lisp/gnus-load.el index f89f95e..53784fb 100644 --- a/lisp/gnus-load.el +++ b/lisp/gnus-load.el @@ -37,7 +37,7 @@ (put 'gnus-cite 'custom-loads '("gnus-cite")) (put 'gnus-demon 'custom-loads '("gnus-demon")) (put 'gnus-message 'custom-loads '("message")) -(put 'gnus-score-default 'custom-loads '("gnus-sum" "gnus-score")) +(put 'gnus-score-delta-default 'custom-loads '("gnus-sum" "gnus-score")) (put 'nnmail-duplicate 'custom-loads '("nnmail")) (put 'message-interface 'custom-loads '("message")) (put 'nnmail-files 'custom-loads '("nnmail")) diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index c40f49e..03b1c1c 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -1,5 +1,6 @@ ;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-score) (require 'gnus-util) @@ -143,7 +145,7 @@ (let* ((type (or type 's)) (case-fold-search (not (eq (downcase (symbol-name type)) (symbol-name type)))) - (header (aref gnus-advanced-headers index))) + (header (or (aref gnus-advanced-headers index) ""))) (cond ((memq type '(r R regexp Regexp)) (string-match match header)) diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index dd2b499..209d69d 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -1,9 +1,9 @@ -;;; mailcap.el --- Functions for displaying MIME parts -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;;; mailcap.el --- MIME media types configuration +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen -;; Keywords: news, mail +;; Keywords: news, mail, multimedia ;; This file is part of GNU Emacs. @@ -24,10 +24,20 @@ ;;; Commentary: +;; Provides configuration of MIME media types from directly from Lisp +;; and via the usual mailcap mechanism (RFC 1524). Deals with +;; mime.types similarly. + ;;; Code: (eval-when-compile (require 'cl)) (require 'mail-parse) +(require 'mm-util) + +(defgroup mailcap nil + "Definition of viewers for MIME types." + :version "21.1" + :group 'mime) (defvar mailcap-parse-args-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) @@ -38,6 +48,10 @@ table) "A syntax table for parsing sgml attributes.") +;; Postpone using defcustom for this as it's so big and we essentially +;; have to have two copies of the data around then. Perhaps just +;; customize the Lisp viewers and rely on the normal configuration +;; files for the rest? -- fx (defvar mailcap-mime-data '(("application" ("x-x509-ca-cert" @@ -51,11 +65,12 @@ ("octet-stream" (viewer . mailcap-save-binary-file) (non-viewer . t) - (type ."application/octet-stream")) - ("dvi" - (viewer . "open %s") - (type . "application/dvi") - (test . (eq (mm-device-type) 'ns))) + (type . "application/octet-stream")) +;;; XEmacs says `ns' device-type not implemented. +;; ("dvi" +;; (viewer . "open %s") +;; (type . "application/dvi") +;; (test . (eq (mm-device-type) 'ns))) ("dvi" (viewer . "xdvi %s") (test . (eq (mm-device-type) 'x)) @@ -97,13 +112,28 @@ (non-viewer . t) (type . "application/zip") ("copiousoutput")) + ;; Prefer free viewers. + ("pdf" + (viewer . "gv %s") + (type . "application/pdf") + (test . window-system)) + ("pdf" + (viewer . "xpdf %s") + (type . "application/pdf") + (test . (eq (mm-device-type) 'x))) ("pdf" (viewer . "acroread %s") (type . "application/pdf")) +;;; XEmacs says `ns' device-type not implemented. +;; ("postscript" +;; (viewer . "open %s") +;; (type . "application/postscript") +;; (test . (eq (mm-device-type) 'ns))) ("postscript" - (viewer . "open %s") - (type . "application/postscript") - (test . (eq (mm-device-type) 'ns))) + (viewer . "gv -safer %s") + (type . "application/postscript") + (test . window-system) + ("needsx11")) ("postscript" (viewer . "ghostview -dSAFER %s") (type . "application/postscript") @@ -119,12 +149,6 @@ (viewer . "maplay %s") (type . "audio/x-mpeg")) (".*" - (viewer . mailcap-save-binary-file) - (non-viewer . t) - (test . (or (featurep 'nas-sound) - (featurep 'native-sound))) - (type . "audio/*")) - (".*" (viewer . "showaudio") (type . "audio/*"))) ("message" @@ -143,10 +167,6 @@ (type . "message/rfc822")) ("rfc-*822" (viewer . view-mode) - (test . (fboundp 'view-mode)) - (type . "message/rfc822")) - ("rfc-*822" - (viewer . fundamental-mode) (type . "message/rfc822"))) ("image" ("x-xwd" @@ -167,10 +187,11 @@ ("compose" . "xwd -frame > %s") (test . (eq (mm-device-type) 'x)) ("needsx11")) - (".*" - (viewer . "aopen %s") - (type . "image/*") - (test . (eq (mm-device-type) 'ns))) +;;; XEmacs says `ns' device-type not implemented. +;; (".*" +;; (viewer . "aopen %s") +;; (type . "image/*") +;; (test . (eq (mm-device-type) 'ns))) (".*" (viewer . "display %s") (type . "image/*") @@ -218,7 +239,7 @@ (viewer . tar-mode) (type . "archive/tar") (test . (fboundp 'tar-mode))))) - "The mailcap structure is an assoc list of assoc lists. + "The mailcap structure is an assoc list of assoc lists. 1st assoc list is keyed on the major content-type 2nd assoc list is keyed on the minor content-type (which can be a regexp) @@ -230,57 +251,38 @@ Which looks like: (\"plain\" . ))) Where is another assoc list of the various information -related to the mailcap RFC. This is keyed on the lowercase +related to the mailcap RFC 1524. This is keyed on the lowercase attribute name (viewer, test, etc). This looks like: - ((viewer . viewerinfo) - (test . testinfo) - (xxxx . \"string\")) + ((viewer . VIEWERINFO) + (test . TESTINFO) + (xxxx . \"STRING\") + FLAG) -Where viewerinfo specifies how the content-type is viewed. Can be +Where VIEWERINFO specifies how the content-type is viewed. Can be a string, in which case it is run through a shell, with appropriate parameters, or a symbol, in which case the symbol is -funcall'd, with the buffer as an argument. - -testinfo is a list of strings, or nil. If nil, it means the -viewer specified is always valid. If it is a list of strings, -these are used to determine whether a viewer passes the 'test' or -not.") - -(defvar mailcap-download-directory nil - "*Where downloaded files should go by default.") - -(defvar mailcap-temporary-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/")) - "*Where temporary files go.") +`funcall'ed, with the buffer as an argument. + +TESTINFO is a test for the viewer's applicability, or nil. If nil, it +means the viewer is always valid. If it is a Lisp function, it is +called with a list of items from any extra fields from the +Content-Type header as argument to return a boolean value for the +validity. Otherwise, if it is a non-function Lisp symbol or list +whose car is a symbol, it is `eval'led to yield the validity. If it +is a string or list of strings, it represents a shell command to run +to return a true or false shell value for the validity.") + +(defcustom mailcap-download-directory nil + "*Directory to which `mailcap-save-binary-file' downloads files by default. +Nil means your home directory." + :type '(choice (const :tag "Home directory" nil) + directory) + :group 'mailcap) ;;; ;;; Utility functions ;;; -(defun mailcap-generate-unique-filename (&optional fmt) - "Generate a unique filename in mailcap-temporary-directory" - (if (not fmt) - (let ((base (format "mailcap-tmp.%d" (user-real-uid))) - (fname "") - (x 0)) - (setq fname (format "%s%d" base x)) - (while (file-exists-p - (expand-file-name fname mailcap-temporary-directory)) - (setq x (1+ x) - fname (concat base (int-to-string x)))) - (expand-file-name fname mailcap-temporary-directory)) - (let ((base (concat "mm" (int-to-string (user-real-uid)))) - (fname "") - (x 0)) - (setq fname (format fmt (concat base (int-to-string x)))) - (while (file-exists-p - (expand-file-name fname mailcap-temporary-directory)) - (setq x (1+ x) - fname (format fmt (concat base (int-to-string x))))) - (expand-file-name fname mailcap-temporary-directory)))) - (defun mailcap-save-binary-file () (goto-char (point-min)) (unwind-protect @@ -291,11 +293,42 @@ not.") (write-region (point-min) (point-max) file)) (kill-buffer (current-buffer)))) +(defvar mailcap-maybe-eval-warning + "*** WARNING *** + +This MIME part contains untrusted and possibly harmful content. +If you evaluate the Emacs Lisp code contained in it, a lot of nasty +things can happen. Please examine the code very carefully before you +instruct Emacs to evaluate it. You can browse the buffer containing +the code using \\[scroll-other-window]. + +If you are unsure what to do, please answer \"no\"." + "Text of warning message displayed by `mailcap-maybe-eval'. +Make sure that this text consists only of few text lines. Otherwise, +Gnus might fail to display all of it.") + (defun mailcap-maybe-eval () - "Maybe evaluate a buffer of emacs lisp code" - (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ") - (eval-buffer (current-buffer)) - (emacs-lisp-mode))) + "Maybe evaluate a buffer of Emacs Lisp code." + (let ((lisp-buffer (current-buffer))) + (goto-char (point-min)) + (when + (save-window-excursion + (delete-other-windows) + (let ((buffer (get-buffer-create (generate-new-buffer-name + "*Warning*")))) + (unwind-protect + (with-current-buffer buffer + (insert (substitute-command-keys + mailcap-maybe-eval-warning)) + (goto-char (point-min)) + (display-buffer buffer) + (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? ")) + (kill-buffer buffer)))) + (eval-buffer (current-buffer))) + (when (buffer-live-p lisp-buffer) + (with-current-buffer lisp-buffer + (emacs-lisp-mode))))) + ;;; ;;; The mailcap parser @@ -310,8 +343,12 @@ not.") (defvar mailcap-parsed-p nil) (defun mailcap-parse-mailcaps (&optional path force) - "Parse out all the mailcaps specified in a unix-style path string PATH. -If FORCE, re-parse even if already parsed." + "Parse out all the mailcaps specified in a path string PATH. +Components of PATH are separated by the `path-separator' character +appropriate for this system. If FORCE, re-parse even if already +parsed. If PATH is omitted, use the value of environment variable +MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus +/usr/local/etc/mailcap." (interactive (list nil t)) (when (or (not mailcap-parsed-p) force) @@ -319,30 +356,27 @@ If FORCE, re-parse even if already parsed." (path nil) ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) ((memq system-type '(ms-dos ms-windows windows-nt)) - (setq path (mapconcat 'expand-file-name - '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap") - ";"))) - (t (setq path (mapconcat 'expand-file-name - '("~/.mailcap" - "/etc/mailcap:/usr/etc/mailcap" - "/usr/local/etc/mailcap") ":")))) + (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) + (t (setq path + ;; This is per RFC 1524, specifically + ;; with /usr before /usr/local. + '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" + "/usr/local/etc/mailcap")))) (let ((fnames (reverse - (split-string - path (if (memq system-type - '(ms-dos ms-windows windows-nt)) - ";" - ":")))) + (if (stringp path) + (delete "" (split-string path path-separator)) + path))) fname) (while fnames (setq fname (car fnames)) - (if (and (file-exists-p fname) (file-readable-p fname) - (file-regular-p fname)) - (mailcap-parse-mailcap (car fnames))) + (if (and (file-readable-p fname) + (file-regular-p fname)) + (mailcap-parse-mailcap fname)) (setq fnames (cdr fnames)))) - (setq mailcap-parsed-p t))) + (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) - ;; Parse out the mailcap file specified by FNAME + "Parse out the mailcap file specified by FNAME." (let (major ; The major mime type (image/audio/etc) minor ; The minor mime type (gif, basic, etc) save-pos ; Misc saved positions used in parsing @@ -353,25 +387,24 @@ If FORCE, re-parse even if already parsed." (insert-file-contents fname) (set-syntax-table mailcap-parse-args-syntax-table) (mailcap-replace-regexp "#.*" "") ; Remove all comments + (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces (mailcap-replace-regexp "\n+" "\n") ; And blank lines - (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces - (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "") (goto-char (point-max)) (skip-chars-backward " \t\n") (delete-region (point) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n") + (while (not (bobp)) + (skip-chars-backward " \t\n") + (beginning-of-line) (setq save-pos (point) info nil) (skip-chars-forward "^/; \t\n") (downcase-region save-pos (point)) (setq major (buffer-substring save-pos (point))) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") (setq minor "") (when (eq (char-after) ?/) (forward-char) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^; \t\n") (downcase-region save-pos (point)) @@ -380,14 +413,14 @@ If FORCE, re-parse even if already parsed." ((eq ?* (or (char-after save-pos) 0)) ".*") ((= (point) save-pos) ".*") (t (regexp-quote (buffer-substring save-pos (point))))))) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") ;;; Got the major/minor chunks, now for the viewers/etc ;;; The first item _must_ be a viewer, according to the - ;;; RFC for mailcap files (#1343) + ;;; RFC for mailcap files (#1524) (setq viewer "") - (when (eq (char-after) ?\;) + (when (eq (char-after) ?\;) (forward-char) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^;\n") ;; skip \; @@ -406,17 +439,18 @@ If FORCE, re-parse even if already parsed." (setq viewer (buffer-substring save-pos (point))))) (setq save-pos (point)) (end-of-line) - (unless (equal viewer "") + (unless (equal viewer "") (setq info (nconc (list (cons 'viewer viewer) (cons 'type (concat major "/" (if (string= minor ".*") "*" minor)))) (mailcap-parse-mailcap-extras save-pos (point)))) (mailcap-mailcap-entry-passes-test info) - (mailcap-add-mailcap-entry major minor info)))))) + (mailcap-add-mailcap-entry major minor info)) + (beginning-of-line))))) (defun mailcap-parse-mailcap-extras (st nd) - ;; Grab all the extra stuff from a mailcap entry + "Grab all the extra stuff from a mailcap entry." (let ( name ; From name= value ; its value @@ -461,11 +495,10 @@ If FORCE, re-parse even if already parsed." results))) (defun mailcap-mailcap-entry-passes-test (info) - ;; Return t iff a mailcap entry passes its test clause or no test - ;; clause is present. - (let (status ; Call-process-regions return value - (test (assq 'test info)) ; The test clause - ) + "Return non-nil iff mailcap entry INFO passes its test clause. +Also return non-nil if no test clause is present." + (let ((test (assq 'test info)) ; The test clause + status) (setq status (and test (split-string (cdr test) " "))) (if (and (or (assoc "needsterm" info) (assoc "needsterminal" info) @@ -492,17 +525,17 @@ If FORCE, re-parse even if already parsed." ;;; (defun mailcap-possible-viewers (major minor) - ;; Return a list of possible viewers from MAJOR for minor type MINOR + "Return a list of possible viewers from MAJOR for minor type MINOR." (let ((exact '()) (wildcard '())) (while major (cond ((equal (car (car major)) minor) (setq exact (cons (cdr (car major)) exact))) - ((and minor (string-match (car (car major)) minor)) + ((and minor (string-match (concat "^" (car (car major)) "$") minor)) (setq wildcard (cons (cdr (car major)) wildcard)))) (setq major (cdr major))) - (nconc (nreverse exact) (nreverse wildcard)))) + (nconc exact wildcard))) (defun mailcap-unescape-mime-test (test type-info) (let (save-pos save-chr subst) @@ -527,18 +560,18 @@ If FORCE, re-parse even if already parsed." (setq save-pos (point)) (skip-chars-forward "%") (setq save-chr (char-after (point))) + ;; Escapes: + ;; %s: name of a file for the body data + ;; %t: content-type + ;; %{ ;; Lars Magne Ingebrigtsen @@ -39,6 +40,9 @@ (require 'gnus-msg) (require 'gnus-sum) +(eval-when-compile + (defvar mh-lib-progs)) + (defun gnus-summary-save-article-folder (&optional arg) "Append the current article to an mh folder. If N is a positive number, save the N next articles. @@ -66,8 +70,12 @@ Optional argument FOLDER specifies folder name." t)))) (errbuf (gnus-get-buffer-create " *Gnus rcvstore*")) ;; Find the rcvstore program. - (exec-path (if mh-lib (cons mh-lib exec-path) exec-path))) - (gnus-eval-in-buffer-window gnus-original-article-buffer + (exec-path (cond + ((and (boundp 'mh-lib-progs) mh-lib-progs) + (cons mh-lib-progs exec-path)) + (mh-lib (cons mh-lib exec-path)) + (t exec-path)))) + (with-current-buffer gnus-original-article-buffer (save-restriction (widen) (unwind-protect diff --git a/lisp/gnus-ml.el b/lisp/gnus-ml.el new file mode 100644 index 0000000..5eb0fd0 --- /dev/null +++ b/lisp/gnus-ml.el @@ -0,0 +1,205 @@ +;;; gnus-ml.el --- Mailing list minor mode for Gnus + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Julien Gilles +;; 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: + +;; implement (small subset of) RFC 2369 + +;;; Usage: + +;; (add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode) + +;;; Code: + +(require 'gnus) +(require 'gnus-msg) +(eval-when-compile (require 'cl)) + +;;; Mailing list minor mode + +(defvar gnus-mailing-list-mode nil + "Minor mode for providing mailing-list commands.") + +(defvar gnus-mailing-list-mode-map nil) + +(defvar gnus-mailing-list-menu) + +(unless gnus-mailing-list-mode-map + (setq gnus-mailing-list-mode-map (make-sparse-keymap)) + + (gnus-define-keys gnus-mailing-list-mode-map + "\C-nh" gnus-mailing-list-help + "\C-ns" gnus-mailing-list-subscribe + "\C-nu" gnus-mailing-list-unsubscribe + "\C-np" gnus-mailing-list-post + "\C-no" gnus-mailing-list-owner + "\C-na" gnus-mailing-list-archive + )) + +(defun gnus-mailing-list-make-menu-bar () + (unless (boundp 'gnus-mailing-list-menu) + (easy-menu-define + gnus-mailing-list-menu gnus-mailing-list-mode-map "" + '("Mailing-Lists" + ["Get help" gnus-mailing-list-help t] + ["Subscribe" gnus-mailing-list-subscribe t] + ["Unsubscribe" gnus-mailing-list-unsubscribe t] + ["Post a message" gnus-mailing-list-post t] + ["Mail to owner" gnus-mailing-list-owner t] + ["Browse archive" gnus-mailing-list-archive t])))) + +;;;###autoload +(defun turn-on-gnus-mailing-list-mode () + (when (gnus-group-get-parameter gnus-newsgroup-name 'to-list) + (gnus-mailing-list-mode 1))) + +;;;###autoload +(defun gnus-mailing-list-insinuate (&optional force) + "Setup group parameters from List-Post header. +If FORCE is non-nil, replace the old ones." + (interactive "P") + (let ((list-post + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "list-post")))) + (if list-post + (if (and (not force) + (gnus-group-get-parameter gnus-newsgroup-name 'to-list)) + (gnus-message 1 "to-list is non-nil.") + (if (string-match "]*\\)>" list-post) + (setq list-post (match-string 1 list-post))) + (gnus-group-add-parameter gnus-newsgroup-name + (cons 'to-list list-post)) + (gnus-mailing-list-mode 1)) + (gnus-message 1 "no list-post in this message.")))) + +;;;###autoload +(defun gnus-mailing-list-mode (&optional arg) + "Minor mode for providing mailing-list commands. + +\\{gnus-mailing-list-mode-map}" + (interactive "P") + (when (eq major-mode 'gnus-summary-mode) + (when (set (make-local-variable 'gnus-mailing-list-mode) + (if (null arg) (not gnus-mailing-list-mode) + (> (prefix-numeric-value arg) 0))) + ;; Set up the menu. + (when (gnus-visual-p 'mailing-list-menu 'menu) + (gnus-mailing-list-make-menu-bar)) + (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map) + (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) + +;;; Commands + +(defun gnus-mailing-list-help () + "Get help from mailing list server." + (interactive) + (let ((list-help + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "list-help")))) + (cond (list-help (gnus-mailing-list-message list-help)) + (t (gnus-message 1 "no list-help in this group"))))) + +(defun gnus-mailing-list-subscribe () + "Subscribe" + (interactive) + (let ((list-subscribe + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "list-subscribe")))) + (cond (list-subscribe (gnus-mailing-list-message list-subscribe)) + (t (gnus-message 1 "no list-subscribe in this group"))))) + +(defun gnus-mailing-list-unsubscribe () + "Unsubscribe" + (interactive) + (let ((list-unsubscribe + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "list-unsubscribe")))) + (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe)) + (t (gnus-message 1 "no list-unsubscribe in this group"))))) + +(defun gnus-mailing-list-post () + "Post message (really useful ?)" + (interactive) + (let ((list-post + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "list-post")))) + (cond (list-post (gnus-mailing-list-message list-post)) + (t (gnus-message 1 "no list-post in this group"))))) + +(defun gnus-mailing-list-owner () + "Mail to the owner" + (interactive) + (let ((list-owner + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "list-owner")))) + (cond (list-owner (gnus-mailing-list-message list-owner)) + (t (gnus-message 1 "no list-owner in this group"))))) + +(defun gnus-mailing-list-archive () + "Browse archive" + (interactive) + (require 'browse-url) + (let ((list-archive + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "list-archive")))) + (cond (list-archive + (if (string-match "<\\(http:[^>]*\\)>" list-archive) + (browse-url (match-string 1 list-archive)) + (browse-url list-archive))) + (t (gnus-message 1 "no list-archive in this group"))))) + +;;; Utility functions + +(defun gnus-mailing-list-message (address) + "" + (let ((mailto "") + (to ()) + (subject "None") + (body "") + ) + (cond + ((string-match "]*\\)>" address) + (let ((args (match-string 1 address))) + (cond ; with param + ((string-match "\\(.*\\)\\?\\(.*\\)" args) + (setq mailto (match-string 1 args)) + (let ((param (match-string 2 args))) + (if (string-match "subject=\\([^&]*\\)" param) + (setq subject (match-string 1 param))) + (if (string-match "body=\\([^&]*\\)" param) + (setq body (match-string 1 param))) + (if (string-match "to=\\([^&]*\\)" param) + (push (match-string 1 param) to)) + )) + (t (setq mailto args))))) ; without param + + ; other case +;; Author: Alexandre Oliva ;; Keywords: news, mail ;; This program is free software; you can redistribute it and/or modify @@ -27,22 +28,35 @@ (defvar gnus-group-split-updated-hook nil "Hook called just after nnmail-split-fancy is updated by -gnus-group-split-update") +gnus-group-split-update.") (defvar gnus-group-split-default-catch-all-group "mail.misc" - "Group used by gnus-group-split and gnus-group-split-update as -default catch-all group") + "Group name (or arbitrary fancy split) with default splitting rules. +Used by gnus-group-split and gnus-group-split-update as a fallback +split, in case none of the group-based splits matches.") ;;;###autoload (defun gnus-group-split-setup (&optional auto-update catch-all) - "Sets things up so that nnmail-split-fancy is used for mail + "Set up the split for nnmail-split-fancy. +Sets things up so that nnmail-split-fancy is used for mail splitting, and defines the variable nnmail-split-fancy according with group parameters. If AUTO-UPDATE is non-nil (prefix argument accepted, if called interactively), it makes sure nnmail-split-fancy is re-computed before getting new mail, by adding gnus-group-split-update to -nnmail-pre-get-new-mail-hook." +nnmail-pre-get-new-mail-hook. + +A non-nil CATCH-ALL replaces the current value of +gnus-group-split-default-catch-all-group. This variable is only used +by gnus-group-split-update, and only when its CATCH-ALL argument is +nil. This argument may contain any fancy split, that will be added as +the last split in a `|' split produced by gnus-group-split-fancy, +unless overridden by any group marked as a catch-all group. Typical +uses are as simple as the name of a default mail group, but more +elaborate fancy splits may also be useful to split mail that doesn't +match any of the group-specified splitting rules. See +gnus-group-split-fancy for details." (interactive "P") (setq nnmail-split-methods 'nnmail-split-fancy) (when catch-all @@ -53,27 +67,26 @@ nnmail-pre-get-new-mail-hook." ;;;###autoload (defun gnus-group-split-update (&optional catch-all) - "Computes nnmail-split-fancy from group params, by calling -\(gnus-group-split-fancy nil nil DEFAULTGROUP)" + "Computes nnmail-split-fancy from group params and CATCH-ALL, by +calling (gnus-group-split-fancy nil nil CATCH-ALL). + +If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used +instead. This variable is set by gnus-group-split-setup." (interactive) (setq nnmail-split-fancy (gnus-group-split-fancy - nil nil (or catch-all gnus-group-split-default-catch-all-group))) - (run-hooks 'gnus-group-split-updated-hook) - ) + nil (null nnmail-crosspost) + (or catch-all gnus-group-split-default-catch-all-group))) + (run-hooks 'gnus-group-split-updated-hook)) ;;;###autoload (defun gnus-group-split () - "Uses information from group parameters in order to split mail. See -gnus-group-split-fancy for more information. - -If no group is defined as catch-all, the value of -gnus-group-split-default-catch-all-group is used. + "Uses information from group parameters in order to split mail. +See gnus-group-split-fancy for more information. gnus-group-split is a valid value for nnmail-split-methods." (let (nnmail-split-fancy) - (gnus-group-split-update - gnus-group-split-default-catch-all-group) + (gnus-group-split-update) (nnmail-split-fancy))) ;;;###autoload @@ -92,11 +105,6 @@ if NO-CROSSPOST is ommitted or nil, a & split will be returned, otherwise, a | split, that does not allow crossposting, will be returned. -if CATCH-ALL is not nil, and there is no selected group whose -SPLIT-REGEXP matches the empty string, nor is there a selected group -whose SPLIT-SPEC is 'catch-all, this group name will be appended to -the returned SPLIT list, as the last element in a '| SPLIT. - For each selected group, a SPLIT is composed like this: if SPLIT-SPEC is specified, this split is returned as-is (unless it is nil: in this case, the group is ignored). Otherwise, if TO-ADDRESS, TO-LIST and/or @@ -106,6 +114,13 @@ SPLIT-REGEXP is specified, the regexp will be extended so that it matches this regexp too, and if SPLIT-EXCLUDE is specified, RESTRICT clauses will be generated. +If CATCH-ALL is nil, no catch-all handling is performed, regardless of +catch-all marks in group parameters. Otherwise, if there is no +selected group whose SPLIT-REGEXP matches the empty string, nor is +there a selected group whose SPLIT-SPEC is 'catch-all, this fancy +split (say, a group name) will be appended to the returned SPLIT list, +as the last element of a '| SPLIT. + For example, given the following group parameters: nnml:mail.bar: @@ -137,7 +152,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: (memq group groups)) (and (stringp groups) (string-match groups group))) - (let ((split-spec (cdr (assoc 'split-spec params))) group-clean) + (let ((split-spec (assoc 'split-spec params)) group-clean) ;; Remove backend from group name (setq group-clean (string-match ":" group)) (setq group-clean @@ -145,12 +160,13 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: (substring group (1+ group-clean)) group)) (if split-spec - (if (eq split-spec 'catch-all) - ;; Emit catch-all only when requested - (when catch-all - (setq catch-all group-clean)) - ;; Append split-spec to the main split - (push split-spec split)) + (when (setq split-spec (cdr split-spec)) + (if (eq split-spec 'catch-all) + ;; Emit catch-all only when requested + (when catch-all + (setq catch-all group-clean)) + ;; Append split-spec to the main split + (push split-spec split))) ;; Let's deduce split-spec from other params (let ((to-address (cdr (assoc 'to-address params))) (to-list (cdr (assoc 'to-list params))) @@ -180,8 +196,12 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: (list 'any split-regexp) ;; Generate RESTRICTs for SPLIT-EXCLUDEs. (if (listp split-exclude) - (mapcon (lambda (arg) (cons '- arg)) - split-exclude) + (let ((seq split-exclude) + res) + (while seq + (push (cons '- (pop seq)) + res)) + (apply #'nconc (nreverse res))) (list '- split-exclude)) (list group-clean)) split) @@ -190,7 +210,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: (setq catch-all nil))))))))) ;; Add catch-all if not crossposting (if (and catch-all no-crosspost) - (push split catch-all)) + (push catch-all split)) ;; Move it to the tail, while arranging that SPLITs appear in the ;; same order as groups. (setq split (reverse split)) diff --git a/lisp/gnus-move.el b/lisp/gnus-move.el index 38de4d5..36839c8 100644 --- a/lisp/gnus-move.el +++ b/lisp/gnus-move.el @@ -1,5 +1,6 @@ ;;; gnus-move.el --- commands for moving Gnus from one server to another -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -45,6 +46,7 @@ Update the .newsrc.eld file to reflect the change of nntp server." ;; First start Gnus. (let ((gnus-activate-level 0) + (mail-sources nil) (nnmail-spool-file nil)) (gnus)) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index b6a61c8..719e7a4 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,6 @@ ;;; gnus-msg.el --- mail and post interface for Semi-gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -49,8 +50,8 @@ This method will not be used in mail groups and the like, only in \"real\" newsgroups. If not nil nor `native', the value must be a valid method as discussed -in the documentation of `gnus-select-method'. It can also be a list of -methods. If that is the case, the user will be queried for what select +in the documentation of `gnus-select-method'. It can also be a list of +methods. If that is the case, the user will be queried for what select method to use when posting." :group 'gnus-group-foreign :type `(choice (const nil) @@ -105,15 +106,39 @@ the second with the current group name.") (defvar gnus-posting-styles nil "*Alist of styles to use when posting.") +(defvar gnus-inews-mark-gcc-as-read nil + "If non-nil, automatically mark Gcc articles as read.") + (defcustom gnus-group-posting-charset-alist - '(("^no\\." iso-8859-1) - (message-this-is-mail nil) - ("^de\\." nil) - (".*" iso-8859-1) - (message-this-is-news iso-8859-1)) - "Alist of regexps (to match group names) and default charsets to be unencoded when posting." - :type '(repeat (list (regexp :tag "Group") - (symbol :tag "Charset"))) + '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) + ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) + (message-this-is-mail nil nil) + (message-this-is-news nil t)) + "Alist of regexps and permitted unencoded charsets for posting. +Each element of the alist has the form (TEST HEADER BODY-LIST), where +TEST is either a regular expression matching the newsgroup header or a +variable to query, +HEADER is the charset which may be left unencoded in the header (nil +means encode all charsets), +BODY-LIST is a list of charsets which may be encoded using 8bit +content-transfer encoding in the body, or one of the special values +nil (always encode using quoted-printable) or t (always use 8bit). + +Note that any value other than nil for HEADER infringes some RFCs, so +use this option with care." + :type '(repeat (list :tag "Permitted unencoded charsets" + (choice :tag "Where" + (regexp :tag "Group") + (const :tag "Mail message" :value message-this-is-mail) + (const :tag "News article" :value message-this-is-news)) + (choice :tag "Header" + (const :tag "None" nil) + (symbol :tag "Charset")) + (choice :tag "Body" + (const :tag "Any" :value t) + (const :tag "None" :value nil) + (repeat :tag "Charsets" + (symbol :tag "Charset"))))) :group 'gnus-charset) ;;; Internal variables. @@ -123,6 +148,7 @@ the second with the current group name.") (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) +(defvar gnus-check-before-posting nil) (defvar gnus-last-posting-server nil) (defvar gnus-message-group-art nil) @@ -187,8 +213,8 @@ Thank you for your help in stamping out bugs. "\M-c" gnus-summary-mail-crosspost-complaint "om" gnus-summary-mail-forward "op" gnus-summary-post-forward - "Om" gnus-summary-mail-digest - "Op" gnus-summary-post-digest) + "Om" gnus-uu-digest-mail-forward + "Op" gnus-uu-digest-post-forward) (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) "b" gnus-summary-resend-bounced-mail @@ -225,13 +251,27 @@ Thank you for your help in stamping out bugs. (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) (set (make-local-variable 'gnus-newsgroup-name) ,group) - (set (make-local-variable 'message-posting-charset) - (gnus-setup-posting-charset ,group)) (gnus-run-hooks 'gnus-message-setup-hook)) (gnus-add-buffer) (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) +;;;###autoload +(defun gnus-msg-mail (&rest args) + "Start editing a mail message to be sent. +Like `message-mail', but with Gnus paraphernalia, particularly the +Gcc: header for archiving purposes." + (interactive) + (gnus-setup-message 'message + (apply 'message-mail args)) + ;; COMPOSEFUNC should return t if succeed. Undocumented ??? + t) + +;;;###autoload +(define-mail-user-agent 'gnus-user-agent + 'gnus-msg-mail 'message-send-and-exit + 'message-kill-buffer 'message-send-hook) + (defun gnus-setup-posting-charset (group) (let ((alist gnus-group-posting-charset-alist) (group (or group "")) @@ -245,11 +285,15 @@ Thank you for your help in stamping out bugs. (funcall (car elem) group)) (and (symbolp (car elem)) (symbol-value (car elem)))) - (throw 'found (cadr elem)))))))) + (throw 'found (cons (cadr elem) (caddr elem))))))))) (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) - (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) + (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc + 'gnus-inews-do-gcc) nil t) + (when gnus-agent + (make-local-hook 'message-header-hook) + (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) @@ -455,40 +499,45 @@ header line with the old Message-ID." (error "Can't find any article buffer") (save-excursion (set-buffer article-buffer) - (save-restriction - ;; Copy over the (displayed) article buffer, delete - ;; hidden text and remove text properties. - (widen) - (let ((inhibit-read-only t)) - (copy-to-buffer gnus-article-copy (point-min) (point-max)) + (let ((gnus-newsgroup-charset (or gnus-article-charset + gnus-newsgroup-charset)) + (gnus-newsgroup-ignored-charsets + (or gnus-article-ignored-charsets + gnus-newsgroup-ignored-charsets))) + (save-restriction + ;; Copy over the (displayed) article buffer, delete + ;; hidden text and remove text properties. + (widen) + (let ((inhibit-read-only t)) + (copy-to-buffer gnus-article-copy (point-min) (point-max)) + (set-buffer gnus-article-copy) + ;; Encode bitmap smileys to ordinary text. + ;; Possibly, the original text might be restored. + (static-unless (featurep 'xemacs) + (when (featurep 'smiley-mule) + (smiley-encode-buffer))) + (gnus-article-delete-text-of-type 'annotation) + (gnus-remove-text-with-property 'gnus-prev) + (gnus-remove-text-with-property 'gnus-next) + (gnus-remove-text-with-property 'x-face-mule-bitmap-image) + (insert + (prog1 + (buffer-substring-no-properties (point-min) (point-max)) + (erase-buffer)))) + ;; Find the original headers. + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (while (looking-at message-unix-mail-delimiter) + (forward-line 1)) + (setq beg (point)) + (setq end (or (search-forward "\n\n" nil t) (point))) + ;; Delete the headers from the displayed articles. (set-buffer gnus-article-copy) - (gnus-article-delete-text-of-type 'annotation) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next) - (gnus-remove-text-with-property 'x-face-mule-bitmap-image) - (insert - (prog1 - (format "%s" (buffer-string)) - (erase-buffer))) - ) - ;; Find the original headers. - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (while (looking-at message-unix-mail-delimiter) - (forward-line 1)) - (setq beg (point)) - (setq end (or (search-forward "\n\n" nil t) (point))) - ;; Delete the headers from the displayed articles. - (set-buffer gnus-article-copy) - (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - ;; Encode bitmap smileys to ordinary text. - (static-unless (featurep 'xemacs) - (when (featurep 'smiley-mule) - (smiley-encode-buffer))) - ;; Insert the original article headers. - (insert-buffer-substring gnus-original-article-buffer beg end) - (article-decode-encoded-words))) + (delete-region (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-max))) + ;; Insert the original article headers. + (insert-buffer-substring gnus-original-article-buffer beg end) + (article-decode-encoded-words)))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject @@ -501,6 +550,7 @@ header line with the old Message-ID." (article-buffer 'reply) (t 'message)) (let* ((group (or group gnus-newsgroup-name)) + (charset (gnus-group-name-charset nil group)) (pgroup group) to-address to-group mailing-list to-list newsgroup-p) @@ -511,7 +561,8 @@ header line with the old Message-ID." newsgroup-p (gnus-group-find-parameter group 'newsgroup) mailing-list (when gnus-mailing-list-groups (string-match gnus-mailing-list-groups group)) - group (gnus-group-real-name group))) + group (gnus-group-name-decode (gnus-group-real-name group) + charset))) (if (or (and to-group (gnus-news-group-p to-group)) newsgroup-p @@ -563,7 +614,7 @@ If SILENT, don't prompt the user." ;; the default method. ((null group-method) (or (and (null (eq gnus-post-method 'active)) gnus-post-method) - gnus-select-method message-post-method)) + gnus-select-method message-post-method)) ;; We want the inverse of the default ((and arg (not (eq arg 0))) (if (eq gnus-post-method 'active) @@ -599,7 +650,9 @@ If SILENT, don't prompt the user." (setq method-alist (mapcar (lambda (m) - (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) + (if (equal (cadr m) "") + (list (symbol-name (car m)) m) + (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))) post-methods)) ;; Query the user. (cadr @@ -627,16 +680,6 @@ If SILENT, don't prompt the user." -(defun gnus-extended-version () - "Stringified gnus version." - (concat gnus-product-name "/" gnus-version-number - " (based on " - gnus-original-product-name " v" gnus-original-version-number ")" - (if (zerop (string-to-number gnus-revision-number)) - "" - (concat " (revision " gnus-revision-number ")")) - )) - (defun gnus-message-make-user-agent (&optional include-mime-info max-column) "Return user-agent info. INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable @@ -734,42 +777,41 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (let ((charset default-mime-charset)) (set-buffer gnus-original-article-buffer) (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - ) + (setq default-mime-charset charset)) (let ((message-included-forward-headers (if full-headers "" message-included-forward-headers))) (message-forward post)))) -;;; XXX: generate Subject and ``Topics''? -(defun gnus-summary-mail-digest (&optional n post) - "Digests and forwards all articles in this series." - (interactive "P") - (let ((subject "Digested Articles") - (articles (gnus-summary-work-articles n)) - article frame) - (gnus-setup-message 'forward - (gnus-summary-select-article) - (if post (message-news nil subject) (message-mail nil subject)) - (when (and message-use-multi-frames (cdr articles)) - (setq frame (window-frame (get-buffer-window (current-buffer))))) - (message-goto-body) - (while (setq article (pop articles)) - (save-window-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-select-article nil nil nil article) - (gnus-summary-remove-process-mark article)) - (when frame - (select-frame frame)) - (insert (mime-make-tag "message" "rfc822") "\n") - (insert-buffer-substring gnus-original-article-buffer)) - (push-mark) - (message-goto-body) - (mime-edit-enclose-digest-region (point)(mark t))))) - -(defun gnus-summary-post-digest (&optional n) - "Digest and forwards all articles in this series to a newsgroup." - (interactive "P") - (gnus-summary-mail-digest n t)) +;;;;; XXX: generate Subject and ``Topics''? +;;(defun gnus-summary-mail-digest (&optional n post) +;; "Digests and forwards all articles in this series." +;; (interactive "P") +;; (let ((subject "Digested Articles") +;; (articles (gnus-summary-work-articles n)) +;; article frame) +;; (gnus-setup-message 'forward +;; (gnus-summary-select-article) +;; (if post (message-news nil subject) (message-mail nil subject)) +;; (when (and message-use-multi-frames (cdr articles)) +;; (setq frame (window-frame (get-buffer-window (current-buffer))))) +;; (message-goto-body) +;; (while (setq article (pop articles)) +;; (save-window-excursion +;; (set-buffer gnus-summary-buffer) +;; (gnus-summary-select-article nil nil nil article) +;; (gnus-summary-remove-process-mark article)) +;; (when frame +;; (select-frame frame)) +;; (insert (mime-make-tag "message" "rfc822") "\n") +;; (insert-buffer-substring gnus-original-article-buffer)) +;; (push-mark) +;; (message-goto-body) +;; (mime-edit-enclose-digest-region (point)(mark t))))) +;; +;;(defun gnus-summary-post-digest (&optional n) +;; "Digest and forwards all articles in this series to a newsgroup." +;; (interactive "P") +;; (gnus-summary-mail-digest n t)) (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." @@ -939,15 +981,17 @@ If YANK is non-nil, include the original article." (interactive) (unless (gnus-alive-p) (error "Gnus has been shut down")) - (gnus-setup-message 'bug - (delete-other-windows) - (when gnus-bug-create-help-buffer - (switch-to-buffer "*Gnus Help Bug*") - (erase-buffer) - (insert gnus-bug-message) - (goto-char (point-min))) - (message-pop-to-buffer "*Gnus Bug*") - (message-setup `((To . ,gnus-maintainer) (Subject . ""))) + (gnus-setup-message (if (message-mail-user-agent) 'message 'bug) + (unless (message-mail-user-agent) + (delete-other-windows) + (when gnus-bug-create-help-buffer + (switch-to-buffer "*Gnus Help Bug*") + (erase-buffer) + (insert gnus-bug-message) + (goto-char (point-min))) + (message-pop-to-buffer "*Gnus Bug*")) + (let ((message-this-is-mail t)) + (message-setup `((To . ,gnus-maintainer) (Subject . "")))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) @@ -967,6 +1011,8 @@ If YANK is non-nil, include the original article." (insert (with-temp-buffer (gnus-debug) (buffer-string))) + (let (mime-content-types) + (mime-edit-insert-tag "text" "plain")) (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) @@ -980,13 +1026,33 @@ If YANK is non-nil, include the original article." (interactive (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) current-prefix-arg)) - (gnus-summary-iterate n - (let ((gnus-display-mime-function nil) - (gnus-inhibit-treatment t)) - (gnus-summary-select-article)) - (save-excursion - (set-buffer buffer) - (message-yank-buffer gnus-article-buffer)))) + (when (gnus-buffer-live-p buffer) + (let ((summary-frame (selected-frame)) + (message-frame (when (static-if (featurep 'xemacs) + (device-on-window-system-p) + window-system) + (let ((window (get-buffer-window buffer t))) + (when window + (window-frame window))))) + (separator (concat "^" (regexp-quote mail-header-separator) + "\n"))) + (gnus-summary-iterate n + (gnus-summary-select-article) + (gnus-copy-article-buffer) + (when (frame-live-p message-frame) + (raise-frame message-frame) + (select-frame message-frame)) + (with-current-buffer buffer + (when (save-excursion + (beginning-of-line) + (let (case-fold-search) + (and (not (re-search-backward separator nil t)) + (re-search-forward separator nil t)))) + (goto-char (match-end 0))) + (message-yank-buffer gnus-article-copy)) + (select-frame summary-frame)) + (when (frame-live-p message-frame) + (select-frame message-frame))))) (defun gnus-debug () "Attempts to go through the Gnus source file and report what variables have been changed. @@ -995,7 +1061,7 @@ The source file has to be in the Emacs load path." (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el" "gnus-art.el" "gnus-start.el" "gnus-async.el" "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" - "nnmail.el" "message.el")) + "nnmail.el" "nntp.el" "message.el")) (point (point)) file expr olist sym) (gnus-message 4 "Please wait while we snoop your variables...") @@ -1015,8 +1081,7 @@ The source file has to be in the Emacs load path." (goto-char (point-min)) (while (setq expr (ignore-errors (read (current-buffer)))) (ignore-errors - (and (or (eq (car expr) 'defvar) - (eq (car expr) 'defcustom)) + (and (memq (car expr) '(defvar defcustom defvoo)) (stringp (nth 3 expr)) (or (not (boundp (nth 1 expr))) (not (equal (eval (nth 2 expr)) @@ -1024,7 +1089,7 @@ The source file has to be in the Emacs load path." (push (nth 1 expr) olist))))))) (kill-buffer (current-buffer))) (when (setq olist (nreverse olist)) - (insert "------------------ Environment follows ------------------\n\n")) + (insert ";----------------- Environment follows ------------------\n\n")) (while olist (if (boundp (car olist)) (condition-case () @@ -1040,13 +1105,17 @@ The source file has to be in the Emacs load path." (format "(setq %s 'whatever)\n" (car olist)))) (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) - (insert "\n\n") ;; Remove any control chars - they seem to cause trouble for some ;; mailers. (Byte-compiled output from the stuff above.) (goto-char point) (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t) (replace-match (format "\\%03o" (string-to-char (match-string 0))) - t t)))) + t t)) + ;; Break MIME tags purposely. + (goto-char point) + (while (re-search-forward mime-edit-tag-regexp nil t) + (goto-char (1+ (match-beginning 0))) + (insert "X")))) ;;; Treatment of rejected articles. ;;; Bounced mail. @@ -1073,6 +1142,21 @@ this is a reply." ;;; Gcc handling. +(defun gnus-inews-group-method (group) + (cond ((and (null (gnus-get-info group)) + (eq (car gnus-message-archive-method) + (car + (gnus-server-to-method + (gnus-group-method group))))) + ;; If the group doesn't exist, we assume + ;; it's an archive group... + gnus-message-archive-method) + ;; Use the method. + ((gnus-info-method (gnus-get-info group)) + (gnus-info-method (gnus-get-info group))) + ;; Find the method. + (t (gnus-group-method group)))) + ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) (interactive) @@ -1083,29 +1167,16 @@ this is a reply." (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) (coding-system-for-write 'raw-text) (output-coding-system 'raw-text) - groups group method) + groups group method group-art) (when gcc (message-remove-header "gcc") (widen) - (setq groups (message-tokenize-header gcc " ,")) + (setq groups (message-unquote-tokens + (message-tokenize-header gcc " ,"))) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (gnus-check-server - (setq method - (cond ((and (null (gnus-get-info group)) - (eq (car gnus-message-archive-method) - (car - (gnus-server-to-method - (gnus-group-method group))))) - ;; If the group doesn't exist, we assume - ;; it's an archive group... - gnus-message-archive-method) - ;; Use the method. - ((gnus-info-method (gnus-get-info group)) - (gnus-info-method (gnus-get-info group))) - ;; Find the method. - (t (gnus-group-method group))))) - (gnus-check-server method) + (setq method (gnus-inews-group-method group))) (unless (gnus-request-group group t method) (gnus-request-create-group group method)) (save-excursion @@ -1117,10 +1188,39 @@ this is a reply." (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - (unless (gnus-request-accept-article group method t t) + (unless (setq group-art + (gnus-request-accept-article group method t t)) (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) + (let ((active (gnus-active group))) + (if active + (if (< (cdr active) (cdr group-art)) + (gnus-set-active group (cons (car active) + (cdr group-art)))) + (gnus-activate-group group))) + (let ((buffer (concat "*Summary " group "*")) + (mark gnus-read-mark) + (article (cdr group-art))) + (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))) + (gnus-group-make-articles-read group + (list article)) + (when (gnus-group-auto-expirable-p group) + (gnus-add-marked-articles + group 'expire (list article)))))) (kill-buffer (current-buffer)))))))))) (defun gnus-inews-insert-gcc () @@ -1146,6 +1246,7 @@ this is a reply." (group (or group gnus-newsgroup-name "")) (gcc-self-val (and gnus-newsgroup-name + (not (equal gnus-newsgroup-name "")) (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) result @@ -1298,37 +1399,42 @@ this is a reply." (setq results (delq name (delq address results))) (make-local-variable 'message-setup-hook) (dolist (result results) - (when (cdr result) - (add-hook 'message-setup-hook - (cond - ((eq 'eval (car result)) - 'ignore) - ((eq 'body (car result)) - `(lambda () - (save-excursion - (message-goto-body) - (insert ,(cdr result))))) - ((eq 'signature (car result)) - (set (make-local-variable 'message-signature) nil) - (set (make-local-variable 'message-signature-file) nil) + (add-hook 'message-setup-hook + (cond + ((eq 'eval (car result)) + 'ignore) + ((eq 'body (car result)) + `(lambda () + (save-excursion + (message-goto-body) + (insert ,(cdr result))))) + ((eq 'signature (car result)) + (set (make-local-variable 'message-signature) nil) + (set (make-local-variable 'message-signature-file) nil) + (if (not (cdr result)) + 'ignore `(lambda () (save-excursion (let ((message-signature ,(cdr result))) (when message-signature - (message-insert-signature)))))) - (t - (let ((header - (if (symbolp (car result)) - (capitalize (symbol-name (car result))) - (car result)))) - `(lambda () - (save-excursion - (message-remove-header ,header) - (message-goto-eoh) - (insert ,header ": " ,(cdr result) "\n"))))))))) + (message-insert-signature))))))) + (t + (let ((header + (if (symbolp (car result)) + (capitalize (symbol-name (car result))) + (car result)))) + `(lambda () + (save-excursion + (message-remove-header ,header) + (let ((value ,(cdr result))) + (when value + (message-goto-eoh) + (insert ,header ": " value "\n")))))))))) (when (or name address) (add-hook 'message-setup-hook `(lambda () + (set (make-local-variable 'user-mail-address) + ,(or (cdr address) user-mail-address)) (let ((user-full-name ,(or (cdr name) (user-full-name))) (user-mail-address ,(or (cdr address) user-mail-address))) diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 7e8a862..d682451 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -1,5 +1,6 @@ ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -45,16 +46,17 @@ :type '(repeat (string :tag "Group"))) (defcustom gnus-nocem-issuers - '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] - "rbraver@ohww.norman.ok.us" ; Robert Braver - "clewis@ferret.ocunix.on.ca" ; Chris Lewis - "jem@xpat.com" ; Despammer from Korea - "snowhare@xmission.com" ; Benjamin "Snowhare" Franz - "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM! - ) + '("AutoMoose-1" ; CancelMoose[tm] + "clewis@ferret.ocunix" ; Chris Lewis + "cosmo.roadkill" + "SpamHippo" + "hweede@snafu.de") "*List of NoCeM issuers to pay attention to. -This can also be a list of `(ISSUER CONDITIONS)' elements." +This can also be a list of `(ISSUER CONDITION ...)' elements. + +See for an +issuer registry." :group 'gnus-nocem :type '(repeat (choice string sexp))) @@ -84,6 +86,21 @@ matches an previously scanned and verified nocem message." :group 'gnus-nocem :type 'boolean) +(defcustom gnus-nocem-check-article-limit 500 + "*If non-nil, the maximum number of articles to check in any NoCeM group." + :group 'gnus-nocem + :version "21.1" + :type '(choice (const :tag "unlimited" nil) + (integer 1000))) + +(defcustom gnus-nocem-check-from t + "Non-nil means check for valid issuers in message bodies. +Otherwise don't bother fetching articles unless their author matches a +valid issuer, which is much faster if you are selective about the issuers." + :group 'gnus-nocem + :version "21.1" + :type 'boolean) + ;;; Internal variables (defvar gnus-nocem-active nil) @@ -167,6 +184,18 @@ matches an previously scanned and verified nocem message." ;; are not allowed to have references, so we can ;; ignore scanning followups. (and (string-match "@@NCM" (mail-header-subject header)) + (and gnus-nocem-check-from + (let ((case-fold-search t)) + (catch 'ok + (mapcar + (lambda (author) + (if (consp author) + (setq author (car author))) + (if (string-match + author (mail-header-from header)) + (throw 'ok t))) + gnus-nocem-issuers) + nil))) (or gnus-nocem-liberal-fetch (and (or (string= "" (mail-header-references header)) @@ -174,8 +203,10 @@ matches an previously scanned and verified nocem message." (not (member (mail-header-message-id header) gnus-nocem-seen-message-ids)))) (push header check-headers))) - (let ((i 0) - (len (length check-headers))) + (let* ((i 0) + (check-headers + (last check-headers gnus-nocem-check-article-limit)) + (len (length check-headers))) (dolist (h check-headers) (gnus-message 7 "Checking article %d in %s for NoCeM (%d of %d)..." @@ -193,6 +224,7 @@ matches an previously scanned and verified nocem message." "Check whether the current article is an NCM article and that we want it." ;; Get the article. (let ((date (mail-header-date header)) + (gnus-newsgroup-name group) issuer b e type) (when (or (not date) (time-less-p diff --git a/lisp/gnus-offline.el b/lisp/gnus-offline.el index 0510161..63e6c74 100644 --- a/lisp/gnus-offline.el +++ b/lisp/gnus-offline.el @@ -77,14 +77,17 @@ (eval '(run-hooks 'gnus-offline-load-hook)) -(eval-when-compile (require 'cl) (require 'static)) +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + +(eval-when-compile + (require 'static) + (require 'gnus-agent) + (require 'gnus-group)) (require 'custom) (require 'easymenu) (provide 'gnus-offline) -(eval-after-load "eword-decode" - '(mime-set-field-decoder 'X-Gnus-Offline-Backend nil nil)) - (defgroup gnus-offline nil "Offline backend utility for Gnus." :prefix "gnus-offline-" @@ -119,7 +122,7 @@ miee-popup-menu gnus-group-toolbar))) -(static-if (eq system-type 'windows-nt) +(if (featurep 'meadow) (define-process-argument-editing "/hang\\.exe\\'" (lambda (x) (general-process-argument-editing-function @@ -189,7 +192,7 @@ If mail , gnus-offline only fetch mail articles. :group 'gnus-offline :type 'function) -(defcustom gnus-offline-agent-automatic-expire t +(defcustom gnus-offline-auto-expire t "*Non-nil means expire articles on every session." :group 'gnus-offline :type 'boolean) @@ -340,29 +343,118 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;;; Functions -(defun gnus-offline-get-message (symbol &optional lang) +;; Inline functions. +(defsubst gnus-offline-gettext (symbol &optional lang) (setq lang (or lang gnus-offline-lang)) (or (cdr (assq symbol (symbol-value (intern (format "gnus-offline-resource-%s" lang))))) (cdr (assq symbol gnus-offline-resource-en)))) +(defsubst gnus-offline-set-online-sendmail-function () + "*Initialize sendmail-function when plugged status." + (if (eq gnus-offline-MTA-type 'smtp) + (setq message-send-mail-function 'message-send-mail-with-smtp) + (setq message-send-mail-function 'message-send-mail-with-sendmail))) + +(defsubst gnus-offline-set-offline-sendmail-function () + "*Initialize sendmail-function when unplugged status." + (cond ((eq gnus-offline-drafts-queue-type 'miee) + (if (eq gnus-offline-news-fetch-method 'nnagent) + (setq gnus-agent-send-mail-function + 'sendmail-to-spool-in-gnspool-format)) + (setq message-send-mail-function 'sendmail-to-spool-in-gnspool-format)) + (t + (setq gnus-agent-send-mail-function + (gnus-offline-set-online-sendmail-function) + message-send-mail-function 'gnus-agent-send-mail)))) + +(defsubst gnus-offline-set-offline-post-news-function () + "*Initialize sendnews-function when unplugged status." + (if (eq gnus-offline-drafts-queue-type 'miee) + (setq message-send-news-function 'gnspool-request-post))) + +(defsubst gnus-offline-set-online-post-news-function () + "*Initialize sendnews-function when plugged status." + (setq message-send-news-function 'message-send-news-with-gnus)) + +(defsubst gnus-offline-disable-fetch-mail () + "*Set do not fetch mail." + (setq mail-sources nil + nnmail-spool-file nil)) + +(defsubst gnus-offline-enable-fetch-mail () + "*Set to fetch mail." + (setq gnus-offline-mail-fetch-method 'nnmail) + (setq mail-sources gnus-offline-mail-source)) + +(defsubst gnus-offline-enable-fetch-news () + "*Set to fetch news." + (if (eq gnus-offline-news-fetch-method 'nnagent) + (progn + (setq gnus-agent-handle-level gnus-level-subscribed) + (gnus-agent-toggle-plugged t)))) + +(when (featurep 'gnus-ofsetup) + ;; Advice to Gnus functions. + (defadvice gnus-group-get-new-news (before gnus-offline-advice + activate preactivate) + "When called interactively, dial up and get online automatically." + (when (interactive-p) + (run-hooks 'gnus-offline-before-online-hook) + (if (and (memq 'connect gnus-offline-auto-ppp) + (functionp gnus-offline-dialup-function)) + (funcall gnus-offline-dialup-function)) + (gnus-offline-get-new-news-function))) + + (defadvice gnus-agent-toggle-plugged (around gnus-offline-advice + activate preactivate) + "Also toggle gnus-offline `connected--disconnected' status." + (interactive (list (not gnus-offline-connected))) + (cond ((ad-get-arg 0) + (setq gnus-offline-connected (ad-get-arg 0)) + ad-do-it + ;; Set send mail/news function to offline functions. + (gnus-offline-set-online-sendmail-function) + (gnus-offline-set-online-post-news-function)) + (t + ;; Set to offline status + (gnus-offline-set-unplugged-state)))) + + (defadvice gnus-agent-expire (around gnus-offline-advice activate preactivate) + "Advice not to delete new articles." + (cond ((eq 0 gnus-agent-expire-days) + (let (gnus-agent-expire-all) + ad-do-it)) + (t + ad-do-it))) + + (defadvice gnus-agent-mode (around gnus-offline-advice activate preactivate) + "Advice not to close PPP connection." + (let (gnus-offline-hangup-function) + ad-do-it))) + ;; ;; Setting up... ;; (defun gnus-offline-setup () "*Initialize gnus-offline function" - ;; Menu and keymap - (gnus-offline-define-menu-and-key) + (when (eq gnus-offline-drafts-queue-type 'agent) + (setq gnus-offline-connected gnus-plugged)) + + (gnus-offline-processed-by-timer) + (gnus-offline-error-check) ;; To transfer Mail/News function. - (cond ((eq gnus-offline-mail-treat-environ 'offline) + (cond ((or (and (eq 'gnus-offline-drafts-queue-type 'agent) + gnus-offline-connected) + (eq gnus-offline-mail-treat-environ 'online)) ;; send mail under offline environ. - (gnus-offline-set-offline-sendmail-function)) - ((eq gnus-offline-mail-treat-environ 'online) + (gnus-offline-set-online-sendmail-function)) + (t ;; send mail under offline environ. - (gnus-offline-set-online-sendmail-function)))) + (gnus-offline-set-offline-sendmail-function)))) ;; ;; Setting Error check. @@ -375,57 +467,17 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (featurep 'nnagent)) (set-buffer (gnus-get-buffer-create buffer)) (erase-buffer) - (insert (gnus-offline-get-message 'error-check-1)) + (insert (gnus-offline-gettext 'error-check-1)) (pop-to-buffer buffer))) ((eq gnus-offline-news-fetch-method 'nnspool) (unless (featurep 'nnspool) (set-buffer (gnus-get-buffer-create buffer)) (erase-buffer) - (insert (gnus-offline-get-message 'error-check-2)) + (insert (gnus-offline-gettext 'error-check-2)) (pop-to-buffer buffer))) (t nil)))) -;; -;; -(defun gnus-offline-set-offline-sendmail-function () - "*Initialize sendmail-function when unplugged status." - (cond ((eq gnus-offline-drafts-queue-type 'miee) - (if (eq gnus-offline-news-fetch-method 'nnagent) - (setq gnus-agent-send-mail-function - 'sendmail-to-spool-in-gnspool-format)) - (setq message-send-mail-function 'sendmail-to-spool-in-gnspool-format)) - (t - (setq gnus-agent-send-mail-function - (gnus-offline-set-online-sendmail-function) - message-send-mail-function 'gnus-agent-send-mail)))) -;; -(defun gnus-offline-set-online-sendmail-function () - "*Initialize sendmail-function when plugged status." - (if (eq gnus-offline-MTA-type 'smtp) - (setq message-send-mail-function 'message-send-mail-with-smtp) - (setq message-send-mail-function 'message-send-mail-with-sendmail))) -;; -(defun gnus-offline-set-offline-post-news-function () - "*Initialize sendnews-function when unplugged status." - (if (eq gnus-offline-drafts-queue-type 'miee) - (setq message-send-news-function 'gnspool-request-post))) -;; -(defun gnus-offline-set-online-post-news-function () - "*Initialize sendnews-function when plugged status." - (setq message-send-news-function 'message-send-news-with-gnus)) -;; -;; Get new news jobs. (gnus-agent and nnspool) -;; -(defun gnus-offline-gnus-get-new-news (&optional arg) - "*Override function \"gnus-group-get-new-news\"." - (interactive "P") - (run-hooks 'gnus-offline-before-online-hook) - (if (and (memq 'connect gnus-offline-auto-ppp) - (functionp gnus-offline-dialup-function)) - (funcall gnus-offline-dialup-function)) - (gnus-offline-get-new-news-function) - (gnus-group-get-new-news arg)) ;; ;; dialup... @@ -435,11 +487,11 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; Dialup if gnus-offline-dialup-program is specified (if (stringp gnus-offline-dialup-program) (progn - (message (gnus-offline-get-message 'connect-server-1)) + (message "%s" (gnus-offline-gettext 'connect-server-1)) (apply 'call-process gnus-offline-dialup-program nil nil nil gnus-offline-dialup-program-arguments) (sleep-for 1) - (message (gnus-offline-get-message 'connect-server-2))))) + (message "%s" (gnus-offline-gettext 'connect-server-2))))) ;; ;; Jobs before get new news , send mail and post news. @@ -456,7 +508,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; Set send mail/news functions to online functions. (gnus-offline-set-online-sendmail-function) (gnus-offline-set-online-post-news-function) - (message (gnus-offline-get-message 'get-new-news-function-1)) + (message "%s" (gnus-offline-gettext 'get-new-news-function-1)) ;; fetch only news (if (eq gnus-offline-articles-to-fetch 'news) @@ -513,63 +565,35 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; (defun gnus-offline-after-get-new-news () "*After getting news and mail jobs." - (if (memq gnus-offline-articles-to-fetch '(both mail)) - (progn - ;; Mail/both - ;; send mail/news in spool - (gnus-offline-empting-spool) - (if (eq gnus-offline-articles-to-fetch 'mail) - (progn - ;; Send only mail and hang up... - (if gnus-offline-connected - (gnus-offline-set-unplugged-state)) - ;; Disable fetch mail. - (gnus-offline-disable-fetch-mail) - (gnus-offline-after-jobs-done))))) - - ;; News/Both - (if (memq gnus-offline-articles-to-fetch '(both news)) - (progn - (if gnus-offline-connected - (cond ((eq gnus-offline-news-fetch-method 'nnagent) - ;; Get New News (gnus-agent) - (gnus-agent-toggle-plugged t) - - ;; fetch articles - (gnus-agent-fetch-session) - - ;; Hang Up line. then set to offline status. - (gnus-offline-set-unplugged-state) - - ;; All online jobs has done. - (gnus-offline-after-jobs-done)) - (t - (if (eq gnus-offline-news-fetch-method 'nnspool) - ;; Get New News (nnspool) - (gnspool-get-news)))))))) -;; -;; Disable fetch mail -;; -(defun gnus-offline-disable-fetch-mail () - "*Set do not fetch mail." - (setq mail-sources nil - nnmail-spool-file nil)) -;; -;; Enable fetch mail -;; -(defun gnus-offline-enable-fetch-mail () - "*Set to fetch mail." - (setq gnus-offline-mail-fetch-method 'nnmail) - (setq mail-sources gnus-offline-mail-source)) -;; -;; Enable fetch news -;; -(defun gnus-offline-enable-fetch-news () - "*Set to fetch news." - (if (eq gnus-offline-news-fetch-method 'nnagent) - (progn - (setq gnus-agent-handle-level gnus-level-subscribed) - (gnus-agent-toggle-plugged t)))) + (cond (gnus-offline-connected + (when (memq gnus-offline-articles-to-fetch '(both mail)) + ;; Mail/both + ;; send mail/news in spool + (gnus-offline-empting-spool) + (when (eq gnus-offline-articles-to-fetch 'mail) + ;; Send only mail and hang up... + (if gnus-offline-connected + (gnus-offline-set-unplugged-state)) + ;; Disable fetch mail. + (gnus-offline-disable-fetch-mail) + (gnus-offline-after-jobs-done))) + (when (memq gnus-offline-articles-to-fetch '(both news)) + ;; News/Both + (cond ((eq gnus-offline-news-fetch-method 'nnagent) + ;; Get New News (gnus-agent) + (gnus-agent-toggle-plugged t) + ;; fetch articles + (gnus-agent-fetch-session) + ;; Hang Up line. then set to offline status. + (gnus-offline-set-unplugged-state) + ;; All online jobs has done. + (gnus-offline-after-jobs-done)) + (t + (if (eq gnus-offline-news-fetch-method 'nnspool) + ;; Get New News (nnspool) + (gnspool-get-news)))))) + (t + nil))) ;; ;; Add your custom header. @@ -606,21 +630,6 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; -;; Toggle plugged/unplugged -;; -(defun gnus-offline-toggle-plugged (plugged) - "*Override function \"Jj\" - gnus-agent-toggle-plugged." - (interactive (list (not gnus-offline-connected))) - (if plugged - (progn - (setq gnus-offline-connected plugged) - (gnus-agent-toggle-plugged plugged) - ;; Set send mail/news function to offline functions. - (gnus-offline-set-online-sendmail-function) - (gnus-offline-set-online-post-news-function)) - ;; Set to offline status - (gnus-offline-set-unplugged-state))) -;; ;; Function of hang up line. ;; (defun gnus-offline-set-unplugged-state () @@ -632,7 +641,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (funcall gnus-offline-hangup-function)) (setq gnus-offline-connected nil) (if (eq gnus-offline-news-fetch-method 'nnagent) - (gnus-agent-toggle-plugged nil)) + (ad-Orig-gnus-agent-toggle-plugged nil)) ;; Set send mail/news function to offline functions. (gnus-offline-set-offline-sendmail-function) @@ -644,11 +653,11 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; (defun gnus-offline-hangup-line () "*Hangup line function." - (message (gnus-offline-get-message 'hangup-line-1)) + (message "%s" (gnus-offline-gettext 'hangup-line-1)) (if (stringp gnus-offline-hangup-program) (apply 'start-process "hup" nil gnus-offline-hangup-program gnus-offline-hangup-program-arguments)) - (message (gnus-offline-get-message 'hangup-line-2))) + (message "%s" (gnus-offline-gettext 'hangup-line-2))) ;; ;; Hang Up line routine whe using nnspool ;; @@ -664,14 +673,16 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (run-hooks 'gnus-offline-after-online-hook) (if (eq gnus-offline-articles-to-fetch 'mail) (gnus-offline-restore-mail-group-level)) - (if (eq gnus-offline-news-fetch-method 'nnagent) - (gnus-offline-agent-expire)) - (if (and (featurep 'xemacs) - (fboundp 'play-sound-file)) - (ding nil 'drum) + (if (and (eq gnus-offline-news-fetch-method 'nnagent) + gnus-offline-auto-expire) + (gnus-agent-expire)) + (static-if (featurep 'xemacs) + (if (fboundp 'play-sound-file) + (ding nil 'drum) + (ding)) (ding)) (gnus-group-save-newsrc) - (message (gnus-offline-get-message 'after-jobs-done-1))) + (message "%s" (gnus-offline-gettext 'after-jobs-done-1))) ;; @@ -683,43 +694,46 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (let ((keys (key-description (this-command-keys))) menu title str) (cond ((or (string= "misc-user" keys) + (string= "S-mouse-2" keys) (string-match "^menu-bar" keys) (string-match "^mouse" keys)) - (setq title (gnus-offline-get-message 'menu-3)) + (setq title (gnus-offline-gettext 'menu-3)) (setq menu - (cons - title - (gnus-offline-get-menu-items - '((set-auto-ppp-menu-1 - (progn - (setq gnus-offline-auto-ppp '(connect disconnect)) - (message (gnus-offline-get-message 'set-auto-ppp-1))) - t) - (set-auto-ppp-menu-2 - (progn - (setq gnus-offline-auto-ppp '(connect)) - (message (gnus-offline-get-message 'set-auto-ppp-2))) - t) - (set-auto-ppp-menu-3 - (progn - (setq gnus-offline-auto-ppp nil) - (message (gnus-offline-get-message 'set-auto-ppp-3))) - t))))) + (cons title + (gnus-offline-get-menu-items + '((set-auto-ppp-menu-1 + (progn + (setq gnus-offline-auto-ppp '(connect disconnect)) + (message "%s" + (gnus-offline-gettext 'set-auto-ppp-1))) + t) + (set-auto-ppp-menu-2 + (progn + (setq gnus-offline-auto-ppp '(connect)) + (message "%s" + (gnus-offline-gettext 'set-auto-ppp-2))) + t) + (set-auto-ppp-menu-3 + (progn + (setq gnus-offline-auto-ppp nil) + (message "%s" + (gnus-offline-gettext 'set-auto-ppp-3))) + t))))) (gnus-offline-popup menu title)) (t (cond ((eq gnus-offline-auto-ppp nil) (setq gnus-offline-auto-ppp '(connect disconnect)) - (setq str (gnus-offline-get-message 'set-auto-ppp-1))) + (setq str (gnus-offline-gettext 'set-auto-ppp-1))) ((memq 'connect gnus-offline-auto-ppp) (cond ((memq 'disconnect gnus-offline-auto-ppp) (setq gnus-offline-auto-ppp '(connect)) (setq str - (gnus-offline-get-message 'set-auto-ppp-2))) + (gnus-offline-gettext 'set-auto-ppp-2))) (t (setq gnus-offline-auto-ppp nil) (setq str - (gnus-offline-get-message 'set-auto-ppp-3)))))) - (message str))))) + (gnus-offline-gettext 'set-auto-ppp-3)))))) + (message "%s" str))))) ;; ;; Toggle offline/online to send mail. ;; @@ -731,29 +745,29 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; Sending mail under online environ. (gnus-offline-set-online-sendmail-function) (setq gnus-offline-mail-treat-environ 'online) - (message (gnus-offline-get-message 'toggle-on/off-send-mail-1))) + (message "%s" (gnus-offline-gettext 'toggle-on/off-send-mail-1))) ;; Sending mail under offline environ. (gnus-offline-set-offline-sendmail-function) (setq gnus-offline-mail-treat-environ 'offline) - (message (gnus-offline-get-message 'toggle-on/off-send-mail-2)))) + (message "%s" (gnus-offline-gettext 'toggle-on/off-send-mail-2)))) ;; ;; Toggle articles to fetch ... both -> mail -> news -> both ;; (defun gnus-offline-toggle-articles-to-fetch () "*Set articles to fetch... both(Mail/News) -> mail only -> News only -> both" (interactive) - (let ((string (gnus-offline-get-message 'toggle-articles-to-fetch-1)) + (let ((string (gnus-offline-gettext 'toggle-articles-to-fetch-1)) str) (cond ((eq gnus-offline-articles-to-fetch 'both) (setq gnus-offline-articles-to-fetch 'mail - str (gnus-offline-get-message 'toggle-articles-to-fetch-2))) + str (gnus-offline-gettext 'toggle-articles-to-fetch-2))) ((eq gnus-offline-articles-to-fetch 'mail) (setq gnus-offline-articles-to-fetch 'news - str (gnus-offline-get-message 'toggle-articles-to-fetch-3))) + str (gnus-offline-gettext 'toggle-articles-to-fetch-3))) (t (setq gnus-offline-articles-to-fetch 'both - str (gnus-offline-get-message 'toggle-articles-to-fetch-4)))) - (message (format "%s %s" string str)))) + str (gnus-offline-gettext 'toggle-articles-to-fetch-4)))) + (message "%s %s" string str))) ;; ;; Send mail and Post news using Miee or gnus-agent. ;; @@ -765,11 +779,11 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (progn (if (eq gnus-offline-mail-treat-environ 'offline) (progn - (message (gnus-offline-get-message 'empting-spool-1)) + (message "%s" (gnus-offline-gettext 'empting-spool-1)) ;; Using miee to send mail. (mail-spool-send) - (message (gnus-offline-get-message 'empting-spool-2)))) - (message (gnus-offline-get-message 'empting-spool-3)) + (message "%s" (gnus-offline-gettext 'empting-spool-2)))) + (message "%s" (gnus-offline-gettext 'empting-spool-3)) ;; Using miee to post news. (if (and (not (stringp msspool-news-server)) (not msspool-news-service)) @@ -777,11 +791,11 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (setq msspool-news-server (nth 1 gnus-select-method)) (setq msspool-news-service 119))) (news-spool-post) - (message (gnus-offline-get-message 'empting-spool-4))) + (message "%s" (gnus-offline-gettext 'empting-spool-4))) ;; Send queued message by gnus-agent - (message (gnus-offline-get-message 'empting-spool-5)) + (message "%s" (gnus-offline-gettext 'empting-spool-5)) (gnus-group-send-drafts) - (message (gnus-offline-get-message 'empting-spool-6))) + (message "%s" (gnus-offline-gettext 'empting-spool-6))) ;; (run-hooks 'gnus-offline-after-empting-spool-hook)) ;; @@ -792,78 +806,46 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (interactive) (setq gnus-offline-interval-time (string-to-int (read-from-minibuffer - (format (gnus-offline-get-message 'interval-time-1) + (format (gnus-offline-gettext 'interval-time-1) gnus-offline-interval-time) nil))) (if (< gnus-offline-interval-time 2) (progn - (message (gnus-offline-get-message 'interval-time-2)) + (message "%s" (gnus-offline-gettext 'interval-time-2)) (setq gnus-offline-interval-time 0)) (message - (format (gnus-offline-get-message 'interval-time-3) + (format (gnus-offline-gettext 'interval-time-3) gnus-offline-interval-time))) (gnus-offline-processed-by-timer)) -;; -;; Expire articles using gnus-agent. -;; -(defun gnus-offline-agent-expire () - "*Expire expirable article on News group." - (interactive) - (and gnus-offline-agent-automatic-expire - (if (eq 0 gnus-agent-expire-days) - (let (gnus-agent-expire-all) - (gnus-agent-expire)) - (gnus-agent-expire)))) + ;; ;; Menu. ;; (defun gnus-offline-define-menu-and-key () "*Set key and menu." - (if (eq gnus-offline-drafts-queue-type 'miee) - (static-if (featurep 'xemacs) - (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-miee) - (gnus-offline-define-menu-on-miee)) - (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-agent)) + (cond ((eq gnus-offline-drafts-queue-type 'miee) + (static-cond + ((featurep 'xemacs) + (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-miee)) + (t + (gnus-offline-define-menu-on-miee)))) + (t + (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-agent))) + ;; (add-hook 'gnus-group-mode-hook - '(lambda () - (local-set-key "\C-coh" 'gnus-offline-set-unplugged-state) - (local-set-key "\C-cof" 'gnus-offline-toggle-articles-to-fetch) - (local-set-key "\C-coo" 'gnus-offline-toggle-on/off-send-mail) - (local-set-key "\C-cox" 'gnus-offline-set-auto-ppp) - (local-set-key "\C-cos" 'gnus-offline-set-interval-time) - (substitute-key-definition - 'gnus-group-get-new-news 'gnus-offline-gnus-get-new-news - gnus-group-mode-map) - (if (eq gnus-offline-news-fetch-method 'nnagent) - (progn - (substitute-key-definition - 'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged - gnus-agent-group-mode-map) - (local-set-key "\C-coe" 'gnus-offline-agent-expire))))) - (if (eq gnus-offline-news-fetch-method 'nnagent) - (add-hook 'gnus-summary-mode-hook - '(lambda () - (substitute-key-definition - 'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged - gnus-agent-summary-mode-map)))) - (static-cond - ((featurep 'xemacs) - ;; Overwrite the toolbar spec for gnus-group-mode. - (add-hook 'gnus-startup-hook - #'(lambda () - (catch 'tag - (mapc (lambda (but) - (when (eq 'gnus-group-get-new-news (aref but 1)) - (aset but 1 'gnus-offline-gnus-get-new-news) - (throw 'tag nil))) - gnus-group-toolbar))))) - (t - (add-hook - 'gnus-group-mode-hook - `(lambda () - (define-key gnus-group-mode-map - ,(static-if (eq system-type 'windows-nt) [S-mouse-2] [mouse-3]) - 'gnus-offline-popup-menu)))))) + #'(lambda () + (local-set-key "\C-coh" 'gnus-offline-set-unplugged-state) + (local-set-key "\C-cof" 'gnus-offline-toggle-articles-to-fetch) + (local-set-key "\C-coo" 'gnus-offline-toggle-on/off-send-mail) + (local-set-key "\C-cox" 'gnus-offline-set-auto-ppp) + (local-set-key "\C-cos" 'gnus-offline-set-interval-time) + (if (eq gnus-offline-news-fetch-method 'nnagent) + (local-set-key "\C-coe" 'gnus-agent-expire)) + (static-unless (featurep 'xemacs) + (local-set-key + (if (eq system-type 'windows-nt) [S-mouse-2] [mouse-3]) + 'gnus-offline-popup-menu))))) + ;; ;; (defun gnus-offline-popup (menu &optional title) @@ -911,7 +893,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") #'(lambda (el) (if (listp el) (apply 'vector - (cons (gnus-offline-get-message (car el)) (cdr el))) + (cons (gnus-offline-gettext (car el)) (cdr el))) el)) list)) @@ -921,7 +903,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (menu-2 gnus-offline-toggle-on/off-send-mail t) (menu-3 gnus-offline-set-auto-ppp t) "----" - (menu-4 gnus-offline-agent-expire + (menu-4 gnus-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)) (menu-5 gnus-offline-set-interval-time t) "----" @@ -977,14 +959,24 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; Timer Function (defun gnus-offline-processed-by-timer () "*Set timer interval." - (if (and (> gnus-offline-interval-time 0) - (not gnus-offline-connected)) - ;; Timer call - (gnus-demon-add-handler 'gnus-offline-gnus-get-new-news - gnus-offline-interval-time - gnus-offline-interval-time)) - (if (= gnus-offline-interval-time 0) - (gnus-demon-remove-handler 'gnus-offline-gnus-get-new-news t))) + (let ((func (lambda () (call-interactively 'gnus-group-get-new-news))) + (time gnus-offline-interval-time)) + (cond ((and (> time 0) (not gnus-offline-connected)) + ;; Timer call + (gnus-demon-add-handler func time time)) + ((= gnus-offline-interval-time 0) + (gnus-demon-remove-handler func t))))) +;; +;; Code for making Gnus and Gnus Offline cooperate with each other. +;; + +;; Display `X-Gnus-Offline-Backend' message header aesthetically. +(eval-after-load "eword-decode" + '(mime-set-field-decoder 'X-Gnus-Offline-Backend nil nil)) + +;; Enable key and menu definitions here. +(eval '(funcall 'gnus-offline-define-menu-and-key)) + ;; ;; ;;; gnus-offline.el ends here diff --git a/lisp/gnus-ofsetup.el b/lisp/gnus-ofsetup.el index e6d05a1..a10a275 100644 --- a/lisp/gnus-ofsetup.el +++ b/lisp/gnus-ofsetup.el @@ -1,36 +1,42 @@ ;;; gnus-ofsetup.el --- Setup advisor for Offline reading for Mail/News. -;;; -;;; Copyright (C) 1998 Tatsuya Ichikawa -;;; Author: Tatsuya Ichikawa -;;; Tsukamoto Tetsuo -;;; -;;; This file is part of Semi-gnus. -;;; -;;; 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: -;;; How to use. -;;; -;;; M-x load[RET]gnus-ofsetup -;;; M-x gnus-setup-for-offline -;;; + +;; Copyright (C) 1998 Tatsuya Ichikawa + +;; Author: Tatsuya Ichikawa +;; Tsukamoto Tetsuo +;; +;; This file is part of Semi-gnus. + +;; 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: + +;; How to use. +;; +;; M-x load[RET]gnus-ofsetup +;; M-x gnus-setup-for-offline +;; ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + +(require 'read-passwd) (eval-and-compile (defvar gnus-offline-lang @@ -45,6 +51,7 @@ "This variable decides which language will be used for display.")) (eval-when-compile + (require 'gnus) (require 'gnus-offline)) (defvar gnus-offline-setting-file @@ -74,7 +81,7 @@ (if (not (file-exists-p news-spool)) (make-directory news-spool t))) (error - (error (gnus-ofsetup-get-message 'prepare-miee-1)))))) + (error (gnus-ofsetup-gettext 'prepare-miee-1)))))) (defvar gnus-ofsetup-update-setting-file '((save-excursion @@ -129,23 +136,7 @@ (insert "(setq gnus-offline-MTA-type '" (prin1-to-string MTA-type) ")\n") - ;; Offline setting for gnus-nntp-* - (insert "(setq gnus-nntp-service nil)\n") - (insert "(setq gnus-nntp-server nil)\n") - ;; Write setting about hooks. - (insert (format "%s %s %s\n" - "(add-hook" - "'gnus-group-mode-hook" - "'gnus-offline-processed-by-timer t)")) - (insert (format "%s %s %s\n" - "(add-hook" - "'gnus-group-mode-hook" - "'gnus-offline-error-check t)")) - (insert (format "%s %s %s\n" - "(add-hook" - "'gnus-after-getting-new-news-hook" - "'gnus-offline-after-get-new-news)")) (when (eq news-method 'nnspool) (insert (format "%s %s %s\n" "(add-hook" @@ -156,23 +147,11 @@ "'gnus-before-startup-hook" "(lambda () (setq nnmail-spool-file nil) (setq mail-sources nil)))"))) - (insert (format "%s %s %s\n" - "(add-hook" - "'message-send-hook" - "'gnus-offline-message-add-header)")) - (insert "(autoload 'gnus-offline-setup \"gnus-offline\")\n") - (insert "(add-hook 'gnus-load-hook 'gnus-offline-setup)\n") ;; Write stting about mail-source.el (insert "(setq gnus-offline-mail-source '" (prin1-to-string mail-source) ")\n") (insert "(setq mail-sources gnus-offline-mail-source)\n") - (insert "(require 'read-passwd)\n") - (insert "(setq mail-source-read-passwd 'read-pw-read-passwd)\n") - (insert (format "%s %s %s\n" - "(add-hook" - "'gnus-setup-news-hook" - "'read-pw-set-mail-source-passwd-cache)")) (if save-passwd (insert "(add-hook 'gnus-setup-news-hook (lambda () @@ -200,14 +179,19 @@ (setup-8 . "Use MIEE post/send message ") (setup-9 . "News spool directory for sending: ") (setup-10 . "Mail spool directory for sending: ") - (setup-11 . "How many e-mail address do you have: ") - (setup-12 . "Mail Account name : ") - (setup-13 . "Mail server : ") - (setup-14 . "Authentification Method (TAB to completion): ") - (setup-15 . "Do you use pop3.el to fetch mail? ") - (setup-16 . "movemail program name: ") - (setup-17 . "movemail options: ") - (setup-18 . "Do you save password information to newsrc file? ") + (setup-11 . "How many mail sources will get mails from? : ") + (setup-12 . "What type of the mail source? ") + (setup-13 . "Mail Account name : ") + (setup-14 . "Mail server : ") + (setup-15 . "Authentification Method ") + (setup-16 . "Do you use pop3.el to fetch mail? ") + (setup-17 . "movemail program name: ") + (setup-18 . "movemail options: ") + (setup-19 . "What network stream? ") + (setup-20 . "File: ") + (setup-21 . "Directory: ") + (setup-22 . "Do you save password information to newsrc file? ") + (param-news-method-1 . "News Method") (param-news-method-2 . "Gnus Agent") (param-news-method-3 . "nnspool") @@ -302,14 +286,18 @@ restarted.") (setup-8 . "$B%a%C%;!<%8$NAw?.$K(B MIEE $B$r;H$$$^$9$+(B? ") (setup-9 . "$B%K%e!<%9$N%9%W!<%k%G%#%l%/%H%j(B: ") (setup-10 . "$B%a!<%k$N%9%W!<%k%G%#%l%/%H%j(B: ") - (setup-11 . "$B%a!<%k%"%+%&%s%H$N?t$rEz$($F$/$@$5$$(B: ") - (setup-12 . "$B%a!<%k$N%"%+%&%s%HL>(B: ") - (setup-13 . "$B$=$N%"%+%&%s%H$N$"$k%a!<%k%5!<%PL>(B: ") - (setup-14 . "$B$=$N%5!<%P$G$NG'>ZJ}<0$O(B? (TAB $B$GJd40$7$^$9(B): ") - (setup-15 . "$B%a!<%k$NA0(B: ") - (setup-17 . "movemail $B%W%m%0%i%`$KEO$90z?t(B: ") - (setup-18 . "newsrc $B%U%!%$%k$K(B POP $B%Q%9%o!<%I$rJ]B8$7$^$9$+(B? ") + (setup-11 . "$B@_Dj$9$k%a!<%k(B: ") + (setup-14 . "$B$=$N%"%+%&%s%H$N$"$k%a!<%k%5!<%PL>(B: ") + (setup-15 . "$BG'>ZJ}<0$O(B? ") + (setup-16 . "$B%a!<%k$NA0(B: ") + (setup-18 . "movemail $B%W%m%0%i%`$KEO$90z?t(B: ") + (setup-19 . "$B@\B3J}<0$O(B? ") + (setup-20 . "$B%U%!%$%k(B: ") + (setup-21 . "$B%G%#%l%/%H%j(B: ") + (setup-22 . "newsrc $B%U%!%$%k$K(B POP $B%Q%9%o!<%I$rJ]B8$7$^$9$+(B? ") (param-news-method-4 . "\ $B%K%e!<%95-;v$re5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (param-save-passwd-3 . "$B4m81$@$+$i$d$a$H$/(B") (param-mail-source-1 . "$B%a!<%kpJs(B")))) -(defun gnus-ofsetup-get-message (symbol &optional lang) +(defsubst gnus-ofsetup-gettext (symbol &optional lang) (setq lang (or lang gnus-offline-lang)) (or (cdr (assq symbol (symbol-value @@ -411,119 +399,153 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (intern (completing-read (concat msg - (gnus-ofsetup-get-message 'completing-read-symbol-1)) + (gnus-ofsetup-gettext 'completing-read-symbol-1)) (mapcar - (lambda (sym) - (list (symbol-name sym))) + #'(lambda (sym) + (list (symbol-name sym))) syms) nil t nil))) -(defun gnus-setup-for-offline () +(defun gnus-setup-for-offline (&optional force) "*Set up Gnus for offline environment." - (interactive) - (unless (file-exists-p gnus-offline-setting-file) + (interactive "P") + (unless (and (file-exists-p gnus-offline-setting-file) (not force)) (let (news-method mail-method agent-directory drafts-queue-type news-spool mail-spool use-miee MTA-type dialup-program dialup-program-arguments hangup-program hangup-program-arguments interval - num-of-address i mail-source save-passwd) + num-of-address i n mail-source save-passwd) (setq news-method (gnus-ofsetup-completing-read-symbol - (gnus-ofsetup-get-message 'setup-1) + (gnus-ofsetup-gettext 'setup-1) 'nnagent 'nnspool)) ;; Setting for gnus-agent. (if (eq news-method 'nnagent) (setq agent-directory (read-from-minibuffer - (gnus-ofsetup-get-message 'setup-2) "~/News/agent"))) + (gnus-ofsetup-gettext 'setup-2) "~/News/agent"))) (setq mail-method 'nnmail) (setq dialup-program (read-file-name - (gnus-ofsetup-get-message 'setup-3) + (gnus-ofsetup-gettext 'setup-3) nil nil t)) (if (string-match "^[ \t]*$" dialup-program) (setq dialup-program nil) (setq dialup-program-arguments (delete "" (split-string (read-from-minibuffer - (gnus-ofsetup-get-message 'setup-4)) + (gnus-ofsetup-gettext 'setup-4)) "[\t ]+")))) (setq hangup-program (read-file-name - (gnus-ofsetup-get-message 'setup-5) + (gnus-ofsetup-gettext 'setup-5) nil nil t)) (if (string-match "^[ \t]*$" hangup-program) (setq hangup-program nil) (setq hangup-program-arguments (delete "" (split-string (read-from-minibuffer - (gnus-ofsetup-get-message 'setup-6)) + (gnus-ofsetup-gettext 'setup-6)) "[\t ]+")))) (setq MTA-type (gnus-ofsetup-completing-read-symbol - (gnus-ofsetup-get-message 'setup-7) + (gnus-ofsetup-gettext 'setup-7) 'smtp 'sendmail)) (if (eq news-method 'nnspool) (setq use-miee t) - (setq use-miee (y-or-n-p (gnus-ofsetup-get-message 'setup-8)))) + (setq use-miee (y-or-n-p (gnus-ofsetup-gettext 'setup-8)))) (if use-miee (progn ;; Setting for MIEE. (setq news-spool (read-from-minibuffer - (gnus-ofsetup-get-message 'setup-9) + (gnus-ofsetup-gettext 'setup-9) "/usr/spool/news.out")) (setq mail-spool (read-from-minibuffer - (gnus-ofsetup-get-message 'setup-10) + (gnus-ofsetup-gettext 'setup-10) "/usr/spool/mail.out")) (setq drafts-queue-type 'miee) (gnus-ofsetup-prepare gnus-ofsetup-prepare-for-miee)) ;; Set drafts type gnus-agent. (setq drafts-queue-type 'agent)) - ;; Set E-Mail Address and pop3 movemail type. + ;; Create a list of mail source specifiers. (setq num-of-address - (read-from-minibuffer (gnus-ofsetup-get-message 'setup-11))) - (setq i (string-to-int num-of-address)) + (read-from-minibuffer (gnus-ofsetup-gettext 'setup-11))) + (setq i (setq n (string-to-int num-of-address))) + ;; (while (> i 0) - (let ((user (read-from-minibuffer (gnus-ofsetup-get-message 'setup-12))) - (server (read-from-minibuffer - (gnus-ofsetup-get-message 'setup-13))) - (auth (completing-read - (gnus-ofsetup-get-message 'setup-14) - '(("password") ("apop")) nil t nil)) - (islisp (y-or-n-p (gnus-ofsetup-get-message 'setup-15))) - source) - (if (not islisp) - (let ((prog (read-file-name (gnus-ofsetup-get-message 'setup-16) - exec-directory "movemail")) - (args (read-from-minibuffer - (gnus-ofsetup-get-message 'setup-17) - "-pf"))) - (setq source `(pop - :user ,user - :server ,server - :program ,(format "%s %s %s %s %s" - prog - args - "po:%u" - "%t" - "%p")))) - (setq source `(pop - :user ,user - :server ,server))) - (setq mail-source - (nconc mail-source - (list - (if (string-equal "apop" auth) - (nconc source '(:authentication apop)) - source))))) + (let* ((j (- n (1- i))) + (type (gnus-ofsetup-completing-read-symbol + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-12)) + 'pop 'imap 'file 'directory 'maildir)) + user server authentication stream islisp source + prog args program path) + ;; Prepare. + (when (or (string= type "pop") (string= type "imap")) + (setq user (read-from-minibuffer + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-13)))) + (setq server (read-from-minibuffer + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-14))))) + (when (string= type "pop") + (setq authentication (gnus-ofsetup-completing-read-symbol + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-15)) + 'password 'apop)) + (setq islisp (y-or-n-p + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-16)))) + (unless islisp + (setq prog (read-file-name + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-17)) + exec-directory "movemail")) + (setq args (read-from-minibuffer + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-18) "-pf"))) + (setq program (format "%s %s %s %s %s" + prog args "po:%u" "%t" "%p")))) + (when (string= type "imap") + (setq stream (gnus-ofsetup-completing-read-symbol + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-19)) + 'kerberos4 'starttls 'ssl 'network)) + (setq authentication (gnus-ofsetup-completing-read-symbol + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-14)) + 'kerberos4 'digest-md5 'cram-md5 'login + 'anonymous))) + (when (string= type "file") + (setq path (read-file-name + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-20))))) + (when (or (string= type "directory") (string= type "maildir")) + (setq path (read-file-name + (format "<%d of %d> %s" j n + (gnus-ofsetup-gettext 'setup-21))))) + ;; Now set a mail source specifier. + (setq source `(,type)) + (mapc + #'(lambda (sym) + (when (symbol-value sym) + (setq source + (nconc source + (list + (make-symbol + (format ":%s" sym)) + (symbol-value sym)))))) + '(path user server authentication stream program)) + (setq mail-source (nconc mail-source (list source)))) (setq i (1- i))) (setq save-passwd - (y-or-n-p (gnus-ofsetup-get-message 'setup-18))) + (y-or-n-p (gnus-ofsetup-gettext 'setup-22))) ;; (gnus-ofsetup-prepare gnus-ofsetup-update-setting-file))) (load gnus-offline-setting-file)) + ;; Suppport for customizing gnus-ofsetup parameters. (defvar sendmail-to-spool-directory) @@ -532,60 +554,60 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (defun gnus-ofsetup-find-parameters () "Return the each current value of gnus-offline parameters." `((news-method - (choice :tag ,(gnus-ofsetup-get-message 'param-news-method-1) + (choice :tag ,(gnus-ofsetup-gettext 'param-news-method-1) :value ,gnus-offline-news-fetch-method - (const :tag ,(gnus-ofsetup-get-message 'param-news-method-2) + (const :tag ,(gnus-ofsetup-gettext 'param-news-method-2) nnagent) - (const :tag ,(gnus-ofsetup-get-message 'param-news-method-3) + (const :tag ,(gnus-ofsetup-gettext 'param-news-method-3) nnspool)) - ,(gnus-ofsetup-get-message 'param-news-method-4)) + ,(gnus-ofsetup-gettext 'param-news-method-4)) (dialup-program - (choice :tag ,(gnus-ofsetup-get-message 'param-dialup-program-1) + (choice :tag ,(gnus-ofsetup-gettext 'param-dialup-program-1) :value ,gnus-offline-dialup-program - (string :tag ,(gnus-ofsetup-get-message 'param-dialup-program-2)) - (const :tag ,(gnus-ofsetup-get-message + (string :tag ,(gnus-ofsetup-gettext 'param-dialup-program-2)) + (const :tag ,(gnus-ofsetup-gettext 'param-dialup-program-3) nil)) - ,(gnus-ofsetup-get-message 'param-dialup-program-4)) + ,(gnus-ofsetup-gettext 'param-dialup-program-4)) (dialup-program-arguments - (repeat :tag ,(gnus-ofsetup-get-message 'param-dialup-program-arg-1) + (repeat :tag ,(gnus-ofsetup-gettext 'param-dialup-program-arg-1) :value ,gnus-offline-dialup-program-arguments - (string :tag ,(gnus-ofsetup-get-message + (string :tag ,(gnus-ofsetup-gettext 'param-dialup-program-arg-2))) - ,(gnus-ofsetup-get-message 'param-dialup-program-arg-3)) + ,(gnus-ofsetup-gettext 'param-dialup-program-arg-3)) (hangup-program - (choice :tag ,(gnus-ofsetup-get-message 'param-hangup-program-1) + (choice :tag ,(gnus-ofsetup-gettext 'param-hangup-program-1) :value ,gnus-offline-hangup-program - (string :tag ,(gnus-ofsetup-get-message 'param-hangup-program-2)) - (const :tag ,(gnus-ofsetup-get-message 'param-hangup-program-3) + (string :tag ,(gnus-ofsetup-gettext 'param-hangup-program-2)) + (const :tag ,(gnus-ofsetup-gettext 'param-hangup-program-3) nil)) - ,(gnus-ofsetup-get-message 'param-hangup-program-4)) + ,(gnus-ofsetup-gettext 'param-hangup-program-4)) (hangup-program-arguments - (repeat :tag ,(gnus-ofsetup-get-message 'param-hangup-program-arg-1) + (repeat :tag ,(gnus-ofsetup-gettext 'param-hangup-program-arg-1) :value ,gnus-offline-hangup-program-arguments - (string :tag ,(gnus-ofsetup-get-message + (string :tag ,(gnus-ofsetup-gettext 'param-hangup-program-arg-2))) - ,(gnus-ofsetup-get-message 'param-hangup-program-arg-3)) + ,(gnus-ofsetup-gettext 'param-hangup-program-arg-3)) (interval - (integer :tag ,(gnus-ofsetup-get-message 'param-interval-1) + (integer :tag ,(gnus-ofsetup-gettext 'param-interval-1) :value ,gnus-offline-interval-time) - ,(gnus-ofsetup-get-message 'param-interval-2)) + ,(gnus-ofsetup-gettext 'param-interval-2)) (drafts-queue-type - (choice :tag ,(gnus-ofsetup-get-message 'param-drafts-queue-type-1) + (choice :tag ,(gnus-ofsetup-gettext 'param-drafts-queue-type-1) :value ,gnus-offline-drafts-queue-type - (const :tag ,(gnus-ofsetup-get-message 'param-drafts-queue-type-2) + (const :tag ,(gnus-ofsetup-gettext 'param-drafts-queue-type-2) agent) - (const :tag ,(gnus-ofsetup-get-message 'param-drafts-queue-type-3) + (const :tag ,(gnus-ofsetup-gettext 'param-drafts-queue-type-3) miee)) - ,(gnus-ofsetup-get-message 'param-drafts-queue-type-4)) + ,(gnus-ofsetup-gettext 'param-drafts-queue-type-4)) (mail-spool - (directory :tag ,(gnus-ofsetup-get-message 'param-mail-spool-1) + (directory :tag ,(gnus-ofsetup-gettext 'param-mail-spool-1) :value ,(cond ((and (boundp 'sendmail-to-spool-directory) sendmail-to-spool-directory) sendmail-to-spool-directory) @@ -593,7 +615,7 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B "/usr/spool/mail.out")))) (news-spool - (directory :tag ,(gnus-ofsetup-get-message 'param-news-spool-1) + (directory :tag ,(gnus-ofsetup-gettext 'param-news-spool-1) :value ,(cond ((and (boundp 'news-spool-request-post-directory) news-spool-request-post-directory) news-spool-request-post-directory) @@ -601,26 +623,26 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B "/usr/spool/news.out")))) (MTA-type - (choice :tag ,(gnus-ofsetup-get-message 'param-MTA-type-1) + (choice :tag ,(gnus-ofsetup-gettext 'param-MTA-type-1) :value ,gnus-offline-MTA-type - (const :tag ,(gnus-ofsetup-get-message 'param-MTA-type-2) smtp) - (const :tag ,(gnus-ofsetup-get-message 'param-MTA-type-3) + (const :tag ,(gnus-ofsetup-gettext 'param-MTA-type-2) smtp) + (const :tag ,(gnus-ofsetup-gettext 'param-MTA-type-3) sendmail)) - ,(gnus-ofsetup-get-message 'param-MTA-type-4)) + ,(gnus-ofsetup-gettext 'param-MTA-type-4)) (save-passwd - (choice :tag ,(gnus-ofsetup-get-message 'param-save-passwd-1) + (choice :tag ,(gnus-ofsetup-gettext 'param-save-passwd-1) :value ,(if (memq 'mail-source-password-cache gnus-variable-list) t nil) - (const :tag ,(gnus-ofsetup-get-message 'param-save-passwd-2) t) - (const :tag ,(gnus-ofsetup-get-message 'param-save-passwd-3) nil)) - ,(gnus-ofsetup-get-message 'param-save-passwd-4)) + (const :tag ,(gnus-ofsetup-gettext 'param-save-passwd-2) t) + (const :tag ,(gnus-ofsetup-gettext 'param-save-passwd-3) nil)) + ,(gnus-ofsetup-gettext 'param-save-passwd-4)) (mail-source - (sexp :tag ,(gnus-ofsetup-get-message 'param-mail-source-1) + (sexp :tag ,(gnus-ofsetup-gettext 'param-mail-source-1) :value ,gnus-offline-mail-source) - ,(gnus-ofsetup-get-message 'param-mail-source-2)))) + ,(gnus-ofsetup-gettext 'param-mail-source-2)))) (defvar gnus-ofsetup-params) @@ -628,19 +650,19 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B "Edit the gnus-offline parameters." (interactive) (let* ((params (gnus-ofsetup-find-parameters)) - (types (mapcar (lambda (entry) - `(cons :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) + (types (mapcar #'(lambda (entry) + `(cons :format "%v%h\n" + :doc ,(nth 2 entry) + (const :format "" ,(nth 0 entry)) + ,(nth 1 entry))) params))) (kill-buffer (gnus-get-buffer-create "*Gnus Offline Customize*")) (switch-to-buffer (gnus-get-buffer-create "*Gnus Offline Customize*")) (gnus-custom-mode) - (widget-insert (gnus-ofsetup-get-message 'customize-1)) + (widget-insert (gnus-ofsetup-gettext 'customize-1)) (widget-create 'push-button - :tag (gnus-ofsetup-get-message 'customize-2) - :help-echo (gnus-ofsetup-get-message 'customize-3) + :tag (gnus-ofsetup-gettext 'customize-2) + :help-echo (gnus-ofsetup-gettext 'customize-3) :action 'gnus-ofsetup-customize-done) (widget-insert "\n\n") (make-local-variable 'gnus-ofsetup-params) @@ -648,13 +670,13 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (widget-create 'group `(set :inline t :greedy t - :tag ,(gnus-ofsetup-get-message 'customize-4) + :tag ,(gnus-ofsetup-gettext 'customize-4) :format "%t:\n%h%v" - :doc ,(gnus-ofsetup-get-message 'customize-5) + :doc ,(gnus-ofsetup-gettext 'customize-5) ,@types))) (widget-create 'info-link - :help-echo (gnus-ofsetup-get-message 'customize-6) + :help-echo (gnus-ofsetup-gettext 'customize-6) :tag " mail sources" (if (string-match "^ja" gnus-offline-lang) "(gnus-ja)Mail Sources" @@ -692,7 +714,7 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (save-passwd (and (memq 'mail-source-password-cache gnus-variable-list) t))) (if (null params) - (gnus-message 4 (gnus-ofsetup-get-message 'customize-done-1)) + (gnus-message 4 (gnus-ofsetup-gettext 'customize-done-1)) (mapc #'(lambda (el) (let ((sym (car el)) (val (cdr el))) @@ -713,7 +735,7 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B params) (if (and (eq news-method 'nnspool) (not (eq drafts-queue-type 'miee))) - (error (gnus-ofsetup-get-message 'customize-done-2))) + (error (gnus-ofsetup-gettext 'customize-done-2))) (if use-miee (gnus-ofsetup-prepare gnus-ofsetup-prepare-for-miee)) (gnus-ofsetup-prepare gnus-ofsetup-update-setting-file) @@ -721,4 +743,25 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (bury-buffer) (switch-to-buffer gnus-group-buffer)) -;; gnus-ofsetup.el Ends here. + +;;; Code for making Gnus and Gnus Offline cooperate with each other. + +;; Advice. +(defadvice gnus (around gnus-ofsetup-advice activate preactivate) + "Setup offline environment when Gnus is invoked." + (require 'gnus-offline) ad-do-it (gnus-offline-setup)) + +;; Miscellaneous settings. + +(setq gnus-nntp-service nil) +(setq gnus-nntp-server nil) +(eval-after-load "gnus-start" + '(add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news)) +(eval-after-load "message" + '(add-hook 'message-send-hook 'gnus-offline-message-add-header)) +(setq mail-source-read-passwd 'read-pw-read-passwd) +(add-hook 'gnus-setup-news-hook 'read-pw-set-mail-source-passwd-cache) + +(provide 'gnus-ofsetup) + +;;; gnus-ofsetup.el ends here diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 867d004..e527523 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -26,6 +26,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) ;; (require 'xpm) (require 'annotations) @@ -524,8 +525,8 @@ none, and whose CDR is the corresponding element of DOMAINS." (defun gnus-picons-parse-value (name) (goto-char (point-min)) (if (re-search-forward (concat "" - (regexp-quote name) - " *= * *\\([^ <][^<]*\\) *") + (regexp-quote name) + " *= * *\\([^ <][^<]*\\) *") nil t) (buffer-substring (match-beginning 1) (match-end 1)))) @@ -696,8 +697,8 @@ none, and whose CDR is the corresponding element of DOMAINS." (defun gnus-picons-network-search (user addrs dbs sym-ann right-p marker) (let* ((host (mapconcat 'identity addrs ".")) (key (list (or user "unknown") host (if user - gnus-picons-user-directories - dbs))) + gnus-picons-user-directories + dbs))) (cache (assoc key gnus-picons-url-alist))) (if (null cache) (gnus-picons-url-retrieve diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 1964880..223a32e 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -1,5 +1,6 @@ ;;; gnus-range.el --- range and sequence functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -225,19 +226,19 @@ Note: LIST has to be sorted over `<'." out))) (defun gnus-remove-from-range (range1 range2) - "Return a range that has all articles from RANGE2 removed from -RANGE1. The returned range is always a list. RANGE2 can also be a -unsorted list of articles. RANGE1 is modified by side effects, RANGE2 -is not modified." + "Return a range that has all articles from RANGE2 removed from RANGE1. +The returned range is always a list. RANGE2 can also be a unsorted +list of articles. RANGE1 is modified by side effects, RANGE2 is not +modified." (if (or (null range1) (null range2)) range1 (let (out r1 r2 r1_min r1_max r2_min r2_max - (range2 (gnus-copy-sequence range2))) + (range2 (gnus-copy-sequence range2))) (setq range1 (if (listp (cdr range1)) range1 (list range1)) - range2 (sort (if (listp (cdr range2)) range2 (list range2)) - (lambda (e1 e2) - (< (if (consp e1) (car e1) e1) - (if (consp e2) (car e2) e2)))) + range2 (sort (if (listp (cdr range2)) range2 (list range2)) + (lambda (e1 e2) + (< (if (consp e1) (car e1) e1) + (if (consp e2) (car e2) e2)))) r1 (car range1) r2 (car range2) r1_min (if (consp r1) (car r1) r1) @@ -245,7 +246,7 @@ is not modified." r2_min (if (consp r2) (car r2) r2) r2_max (if (consp r2) (cdr r2) r2)) (while (and range1 range2) - (cond ((< r2_max r1_min) ; r2 < r1 + (cond ((< r2_max r1_min) ; r2 < r1 (pop range2) (setq r2 (car range2) r2_min (if (consp r2) (car r2) r2) @@ -266,7 +267,7 @@ is not modified." (push r1_min out) (push (cons r1_min (1- r2_min)) out)) (pop range2) - (if (< r2_max r1_max) ; finished with r1? + (if (< r2_max r1_max) ; finished with r1? (setq r1_min (1+ r2_max)) (pop range1) (setq r1 (car range1) @@ -283,7 +284,7 @@ is not modified." (setq r1 (car range1) r1_min (if (consp r1) (car r1) r1) r1_max (if (consp r1) (cdr r1) r1))) - ((< r1_max r2_min) ; r2 > r1 + ((< r1_max r2_min) ; r2 > r1 (pop range1) (if (eq r1_min r1_max) (push r1_min out) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 3d5e80f..dd2aa1f 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -1,5 +1,6 @@ ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-sum) @@ -52,7 +54,7 @@ :group 'gnus-summary-pick) (defcustom gnus-pick-elegant-flow t - "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked." + "If non-nil, `gnus-pick-start-reading' runs `gnus-summary-next-group' when no articles have been picked." :type 'boolean :group 'gnus-summary-pick) @@ -119,7 +121,8 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;; Set up the menu. (when (gnus-visual-p 'pick-menu 'menu) (gnus-pick-make-menu-bar)) - (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) + (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map + nil 'gnus-pick-mode) (gnus-run-hooks 'gnus-pick-mode-hook)))) (defun gnus-pick-setup-message () @@ -161,8 +164,8 @@ If given a prefix, mark all unpicked articles as read." (error "No articles have been picked")))) (defun gnus-pick-goto-article (arg) - "Go to the article number indicated by ARG. If ARG is an invalid -article number, then stay on current line." + "Go to the article number indicated by ARG. +If ARG is an invalid article number, then stay on current line." (let (pos) (save-excursion (goto-char (point-min)) @@ -173,7 +176,7 @@ article number, then stay on current line." (goto-char pos)))) (defun gnus-pick-article (&optional arg) - "Pick the article on the current line. + "Pick the article on the current line. If ARG, pick the article on that line instead." (interactive "P") (when arg @@ -181,7 +184,7 @@ If ARG, pick the article on that line instead." (gnus-summary-mark-as-processable 1)) (defun gnus-pick-article-or-thread (&optional arg) - "If gnus-thread-hide-subtree is t, then pick the thread on the current line. + "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line. Otherwise pick the article on the current line. If ARG, pick the article/thread on that line instead." (interactive "P") @@ -195,7 +198,7 @@ If ARG, pick the article/thread on that line instead." (gnus-summary-mark-as-processable 1))) (defun gnus-pick-unmark-article-or-thread (&optional arg) - "If gnus-thread-hide-subtree is t, then unmark the thread on current line. + "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line. Otherwise unmark the article on current line. If ARG, unmark thread/article on that line instead." (interactive "P") @@ -243,46 +246,46 @@ This must be bound to a button-down mouse event." ;; (but not outside the window where the drag started). (let (event end end-point (end-of-range (point))) (track-mouse - (while (progn - (setq event (cdr (gnus-read-event-char))) - (or (mouse-movement-p event) - (eq (car-safe event) 'switch-frame))) - (if (eq (car-safe event) 'switch-frame) - nil - (setq end (event-end event) - end-point (posn-point end)) - - (cond - ;; Are we moving within the original window? - ((and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (gnus-pick-article) - ;; In case the user moved his mouse really fast, pick - ;; articles on the line between this one and the last one. - (let* ((this-line (1+ (count-lines 1 end-point))) - (min-line (min this-line start-line)) - (max-line (max this-line start-line))) - (while (< min-line max-line) - (goto-line min-line) - (gnus-pick-article) - (setq min-line (1+ min-line))) - (setq start-line this-line)) - (when (zerop (% click-count 3)) - (setq end-of-range (point)))) - (t - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top))) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window - (1+ (- mouse-row bottom))))))))))) + (while (progn + (setq event (cdr (gnus-read-event-char))) + (or (mouse-movement-p event) + (eq (car-safe event) 'switch-frame))) + (if (eq (car-safe event) 'switch-frame) + nil + (setq end (event-end event) + end-point (posn-point end)) + + (cond + ;; Are we moving within the original window? + ((and (eq (posn-window end) start-window) + (integer-or-marker-p end-point)) + ;; Go to START-POINT first, so that when we move to END-POINT, + ;; if it's in the middle of intangible text, + ;; point jumps in the direction away from START-POINT. + (goto-char start-point) + (goto-char end-point) + (gnus-pick-article) + ;; In case the user moved his mouse really fast, pick + ;; articles on the line between this one and the last one. + (let* ((this-line (1+ (count-lines 1 end-point))) + (min-line (min this-line start-line)) + (max-line (max this-line start-line))) + (while (< min-line max-line) + (goto-line min-line) + (gnus-pick-article) + (setq min-line (1+ min-line))) + (setq start-line this-line)) + (when (zerop (% click-count 3)) + (setq end-of-range (point)))) + (t + (let ((mouse-row (cdr (cdr (mouse-position))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top))) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window + (1+ (- mouse-row bottom))))))))))) (when (consp event) (let ((fun (key-binding (vector (car event))))) ;; Run the binding of the terminating up-event, if possible. @@ -324,8 +327,8 @@ This must be bound to a button-down mouse event." (setq gnus-binary-mode-map (make-sparse-keymap)) (gnus-define-keys - gnus-binary-mode-map - "g" gnus-binary-show-article)) + gnus-binary-mode-map + "g" gnus-binary-show-article)) (defun gnus-binary-make-menu-bar () (unless (boundp 'gnus-binary-menu) @@ -351,7 +354,8 @@ This must be bound to a button-down mouse event." ;; Set up the menu. (when (gnus-visual-p 'binary-menu 'menu) (gnus-binary-make-menu-bar)) - (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) + (gnus-add-minor-mode 'gnus-binary-mode " Binary" + gnus-binary-mode-map nil 'gnus-binary-mode) (gnus-run-hooks 'gnus-binary-mode-hook)))) (defun gnus-binary-display-article (article &optional all-header) @@ -442,13 +446,13 @@ Two predefined functions are available: (setq gnus-tree-mode-map (make-keymap)) (suppress-keymap gnus-tree-mode-map) (gnus-define-keys - gnus-tree-mode-map - "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary + gnus-tree-mode-map + "\r" gnus-tree-select-article + gnus-mouse-2 gnus-tree-pick-article + "\C-?" gnus-tree-read-summary-keys + "h" gnus-tree-show-summary - "\C-c\C-i" gnus-info-find-node) + "\C-c\C-i" gnus-info-find-node) (substitute-key-definition 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 50583bf..56d9ef7 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,6 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -27,6 +28,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-sum) (require 'gnus-range) @@ -106,8 +108,8 @@ gnus-score-find-bnews: Apply score files whose names matches. See the documentation to these functions for more information. This variable can also be a list of functions to be called. Each -function should either return a list of score files, or a list of -score alists. +function is given the group name as argument and should either return +a list of score files, or a list of score alists. If functions other than these pre-defined functions are used, the `a' symbolic prefix to the score commands will always use @@ -116,7 +118,12 @@ the `a' symbolic prefix to the score commands will always use :type '(radio (function-item gnus-score-find-single) (function-item gnus-score-find-hierarchical) (function-item gnus-score-find-bnews) - (function :tag "Other"))) + (repeat :tag "List of functions" + (choice (function :tag "Other" :value 'ignore) + (function-item gnus-score-find-single) + (function-item gnus-score-find-hierarchical) + (function-item gnus-score-find-bnews))) + (function :tag "Other" :value 'ignore))) (defcustom gnus-score-interactive-default-score 1000 "*Scoring commands will raise/lower the score with this number as the default." @@ -137,12 +144,6 @@ will be expired along with non-matching score entries." :group 'gnus-score-expire :type 'boolean) -(defcustom gnus-orphan-score nil - "*All orphans get this score added. Set in the score file." - :group 'gnus-score-default - :type '(choice (const nil) - integer)) - (defcustom gnus-decay-scores nil "*If non-nil, decay non-permanent scores." :group 'gnus-score-decay @@ -200,6 +201,8 @@ It can be: (repeat (choice string (cons regexp (repeat file)) (function :value fun))) + (function-item gnus-hierarchial-home-score-file) + (function-item gnus-current-home-score-file) (function :value fun))) (defcustom gnus-home-adapt-file nil @@ -220,14 +223,14 @@ This variable allows the same syntax as `gnus-home-score-file'." (gnus-catchup-mark (subject -10)) (gnus-killed-mark (from -1) (subject -20)) (gnus-del-mark (from -2) (subject -15))) -"*Alist of marks and scores." -:group 'gnus-score-adapt -:type '(repeat (cons (symbol :tag "Mark") - (repeat (list (choice :tag "Header" - (const from) - (const subject) - (symbol :tag "other")) - (integer :tag "Score")))))) + "*Alist of marks and scores." + :group 'gnus-score-adapt + :type '(repeat (cons (symbol :tag "Mark") + (repeat (list (choice :tag "Header" + (const from) + (const subject) + (symbol :tag "other")) + (integer :tag "Score")))))) (defcustom gnus-ignored-adaptive-words nil "List of words to be ignored when doing adaptive word scoring." @@ -258,10 +261,10 @@ This variable allows the same syntax as `gnus-home-score-file'." (,gnus-catchup-mark . -10) (,gnus-killed-mark . -20) (,gnus-del-mark . -15)) -"*Alist of marks and scores." -:group 'gnus-score-adapt -:type '(repeat (cons (character :tag "Mark") - (integer :tag "Score")))) + "*Alist of marks and scores." + :group 'gnus-score-adapt + :type '(repeat (cons (character :tag "Mark") + (integer :tag "Score")))) (defcustom gnus-adaptive-word-minimum nil "If a number, this is the minimum score value that can be assigned to a word." @@ -392,6 +395,9 @@ If nil, the user will be asked for a duration." ;; Internal variables. +(defvar gnus-score-use-all-scores t + "If nil, only `gnus-score-find-score-files-function' is used.") + (defvar gnus-adaptive-word-syntax-table (let ((table (copy-syntax-table (standard-syntax-table))) (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))) @@ -513,7 +519,7 @@ The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be used as score." (interactive (gnus-interactive "P\ny")) - (gnus-summary-increase-score (- (gnus-score-default score)) symp)) + (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp)) (defun gnus-score-kill-help-buffer () (when (get-buffer "*Score Help*") @@ -527,7 +533,7 @@ The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be used as score." (interactive (gnus-interactive "P\ny")) - (let* ((nscore (gnus-score-default score)) + (let* ((nscore (gnus-score-delta-default score)) (prefix (if (< nscore 0) ?L ?I)) (increase (> nscore 0)) (char-to-header @@ -650,7 +656,7 @@ used as score." ;; Deal with der(r)ided superannuated paradigms. (when (and (eq (1+ prefix) 77) (eq (+ hchar 12) 109) - (eq tchar 114) + (eq (1- tchar) 113) (eq (- pchar 4) 111)) (error "You rang?")) (if mimic @@ -763,7 +769,7 @@ used as score." (pop-to-buffer "*Score Help*") (let ((window-min-height 1)) (shrink-window-if-larger-than-buffer)) - (select-window (get-buffer-window gnus-summary-buffer)))) + (select-window (get-buffer-window gnus-summary-buffer t)))) (defun gnus-summary-header (header &optional no-err extra) ;; Return HEADER for current articles, or error. @@ -818,9 +824,10 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (setq match (if match (gnus-simplify-subject-re match) ""))) ((eq type 'f) (setq match (gnus-simplify-subject-fuzzy match)))) - (let ((score (gnus-score-default score)) - (header (format "%s" (downcase header))) + (let ((score (gnus-score-delta-default score)) + (header (downcase header)) new) + (set-text-properties 0 (length header) nil header) (when prompt (setq match (read-string (format "Match %s on %s, %s: " @@ -835,8 +842,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (int-to-string match) match)))) - ;; Get rid of string props. - (setq match (format "%s" match)) + (set-text-properties 0 (length match) nil match) ;; If this is an integer comparison, we transform from string to int. (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) @@ -1001,7 +1007,7 @@ EXTRA is the possible non-standard header." (defun gnus-score-followup-article (&optional score) "Add SCORE to all followups to the article in the current buffer." (interactive "P") - (setq score (gnus-score-default score)) + (setq score (gnus-score-delta-default score)) (when (gnus-buffer-live-p gnus-summary-buffer) (save-excursion (save-restriction @@ -1016,7 +1022,7 @@ EXTRA is the possible non-standard header." (defun gnus-score-followup-thread (&optional score) "Add SCORE to all later articles in the thread the current buffer is part of." (interactive "P") - (setq score (gnus-score-default score)) + (setq score (gnus-score-delta-default score)) (when (gnus-buffer-live-p gnus-summary-buffer) (save-excursion (save-restriction @@ -1061,7 +1067,7 @@ EXTRA is the possible non-standard header." (let ((buffer-read-only nil)) ;; Set score. (gnus-summary-update-mark - (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace + (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace (if (< n (or gnus-summary-default-score 0)) gnus-score-below-mark gnus-score-over-mark)) 'score)) @@ -1130,8 +1136,7 @@ EXTRA is the possible non-standard header." gnus-kill-files-directory))) (expand-file-name file)) file) - (concat (file-name-as-directory gnus-kill-files-directory) - file)))) + (expand-file-name file gnus-kill-files-directory)))) (cached (assoc file gnus-score-cache)) (global (member file gnus-internal-global-score-files)) lists alist) @@ -1494,6 +1499,10 @@ EXTRA is the possible non-standard header." (when (setq new (funcall (nth 2 entry) scores header now expire trace)) (push new news)))) + (when (gnus-buffer-live-p gnus-summary-buffer) + (let ((scored gnus-newsgroup-scored)) + (with-current-buffer gnus-summary-buffer + (setq gnus-newsgroup-scored scored)))) ;; Remove the buffer. (kill-buffer (current-buffer))) @@ -1516,79 +1525,50 @@ EXTRA is the possible non-standard header." (gnus-message 5 "Scoring...done")))))) +(defun gnus-score-lower-thread (thread score-adjust) + "Lower the socre on THREAD with SCORE-ADJUST. +THREAD is expected to contain a list of the form `(PARENT [CHILD1 +CHILD2 ...])' where PARENT is a header array and each CHILD is a list +of the same form as THREAD. The empty list `nil' is valid. For each +article in the tree, the score of the corresponding entry in +GNUS-NEWSGROUP-SCORED is adjusted by SCORE-ADJUST." + (while thread + (let ((head (car thread))) + (if (listp head) + ;; handle a child and its descendants + (gnus-score-lower-thread head score-adjust) + ;; handle the parent + (let* ((article (mail-header-number head)) + (score (assq article gnus-newsgroup-scored))) + (if score (setcdr score (+ (cdr score) score-adjust)) + (push (cons article score-adjust) gnus-newsgroup-scored))))) + (setq thread (cdr thread)))) -(defun gnus-get-new-thread-ids (articles) - (let ((index (nth 1 (assoc "message-id" gnus-header-index))) - (refind gnus-score-index) - id-list art this tref) - (while articles - (setq art (car articles) - this (aref (car art) index) - tref (aref (car art) refind) - articles (cdr articles)) - (when (string-equal tref "") ;no references line - (push this id-list))) - id-list)) - -;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers). (defun gnus-score-orphans (score) - (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) - alike articles art arts this last this-id) - - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - ;;more or less the same as in gnus-score-string - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - ;;completely skip if this is empty (not a child, so not an orphan) - (when (not (string= this "")) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (push art alike) - (when last - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this)))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; PLM: now delete those lines that contain an entry from new-thread-ids - (while new-thread-ids - (setq this-id (car new-thread-ids) - new-thread-ids (cdr new-thread-ids)) - (goto-char (point-min)) - (while (search-forward this-id nil t) - ;; found a match. remove this line - (beginning-of-line) - (kill-line 1))) - - ;; now for each line: update its articles with score by moving to - ;; every end-of-line in the buffer and read the articles property - (goto-char (point-min)) - (while (eq 0 (progn - (end-of-line) - (setq arts (get-text-property (point) 'articles)) - (while arts - (setq art (car arts) - arts (cdr arts)) - (setcdr art (+ score (cdr art)))) - (forward-line)))))) - + "Score orphans. +A root is an article with no references. An orphan is an article +which has references, but is not connected via its references to a +root article. This function finds all the orphans, and adjusts their +score in GNUS-NEWSGROUP-SCORED by SCORE." + (let ((threads (gnus-make-threads))) + ;; gnus-make-threads produces a list, where each entry is a "thread" + ;; as described in the gnus-score-lower-thread docs. This function + ;; will be called again (after limiting has been done) if the display + ;; is threaded. It would be nice to somehow save this info and use + ;; it later. + (while threads + (let* ((thread (car threads)) + (id (aref (car thread) gnus-score-index))) + ;; If the parent of the thread is not a root, lower the score of + ;; it and its descendants. Note that some roots seem to satisfy + ;; (eq id nil) and some (eq id ""); not sure why. + (if (and id (not (string= id ""))) + (gnus-score-lower-thread thread score))) + (setq threads (cdr threads))))) (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) entries alist) - ;; Find matches. (while scores (setq alist (car scores) @@ -1637,7 +1617,6 @@ EXTRA is the possible non-standard header." (defun gnus-score-date (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) entries alist match match-func article) - ;; Find matches. (while scores (setq alist (car scores) @@ -1693,204 +1672,211 @@ EXTRA is the possible non-standard header." nil) (defun gnus-score-body (scores header now expire &optional trace) - (save-excursion - (setq gnus-scores-articles - (sort gnus-scores-articles - (lambda (a1 a2) - (< (mail-header-number (car a1)) - (mail-header-number (car a2)))))) - (set-buffer nntp-server-buffer) - (save-restriction - (let* ((buffer-read-only nil) - (articles gnus-scores-articles) - (all-scores scores) - (request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - entries alist ofunc article last) - (when articles - (setq last (mail-header-number (caar (last articles)))) + (if gnus-agent-fetching + nil + (save-excursion + (setq gnus-scores-articles + (sort gnus-scores-articles + (lambda (a1 a2) + (< (mail-header-number (car a1)) + (mail-header-number (car a2)))))) + (set-buffer nntp-server-buffer) + (save-restriction + (let* ((buffer-read-only nil) + (articles gnus-scores-articles) + (all-scores scores) + (request-func (cond ((string= "head" header) + 'gnus-request-head) + ((string= "body" header) + 'gnus-request-body) + (t 'gnus-request-article))) + entries alist ofunc article last) + (when articles + (setq last (mail-header-number (caar (last articles)))) ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (while articles - (setq article (mail-header-number (caar articles))) - (gnus-message 7 "Scoring article %s of %s..." article last) - (when (funcall request-func article gnus-newsgroup-name) + ;; we just fetch the entire article. + (unless (gnus-check-backend-function + (and (string-match "^gnus-" (symbol-name request-func)) + (intern (substring (symbol-name request-func) + (match-end 0)))) + gnus-newsgroup-name) + (setq ofunc request-func) + (setq request-func 'gnus-request-article)) + (while articles + (setq article (mail-header-number (caar articles))) + (gnus-message 7 "Scoring article %s of %s..." article last) (widen) - (goto-char (point-min)) - ;; If just parts of the article is to be searched, but the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) + (when (funcall request-func article gnus-newsgroup-name) + (goto-char (point-min)) + ;; If just parts of the article is to be searched, but the + ;; backend didn't support partial fetching, we just narrow + ;; to the relevant parts. + (when ofunc + (if (eq ofunc 'gnus-request-head) + (narrow-to-region + (point) + (or (search-forward "\n\n" nil t) (point-max))) (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (setq scores all-scores) - ;; Find matches. - (while scores - (setq alist (pop scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) - gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (case-fold-search - (not (or (eq type 'R) (eq type 'S) - (eq type 'Regexp) (eq type 'String)))) - (search-func - (cond ((or (eq type 'r) (eq type 'R) - (eq type 'regexp) (eq type 'Regexp)) - 're-search-forward) - ((or (eq type 's) (eq type 'S) - (eq type 'string) (eq type 'String)) - 'search-forward) - (t - (error "Invalid match type: %s" type))))) - (goto-char (point-min)) - (when (funcall search-func match nil t) - ;; Found a match, update scores. - (setcdr (car articles) (+ score (cdar articles))) - (setq found t) - (when trace - (push - (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace))) - ;; Update expire date - (unless trace - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) - ;; Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries)))) - (setq entries rest))))) - (setq articles (cdr articles))))))) - nil) + (or (search-forward "\n\n" nil t) (point)) + (point-max)))) + (setq scores all-scores) + ;; Find matches. + (while scores + (setq alist (pop scores) + entries (assoc header alist)) + (while (cdr entries) ;First entry is the header index. + (let* ((rest (cdr entries)) + (kill (car rest)) + (match (nth 0 kill)) + (type (or (nth 3 kill) 's)) + (score (or (nth 1 kill) + gnus-score-interactive-default-score)) + (date (nth 2 kill)) + (found nil) + (case-fold-search + (not (or (eq type 'R) (eq type 'S) + (eq type 'Regexp) (eq type 'String)))) + (search-func + (cond ((or (eq type 'r) (eq type 'R) + (eq type 'regexp) (eq type 'Regexp)) + 're-search-forward) + ((or (eq type 's) (eq type 'S) + (eq type 'string) (eq type 'String)) + 'search-forward) + (t + (error "Invalid match type: %s" type))))) + (goto-char (point-min)) + (when (funcall search-func match nil t) + ;; Found a match, update scores. + (setcdr (car articles) (+ score (cdar articles))) + (setq found t) + (when trace + (push + (cons (car-safe (rassq alist gnus-score-cache)) kill) + gnus-score-trace))) + ;; Update expire date + (unless trace + (cond + ((null date)) ;Permanent entry. + ((and found gnus-update-score-entry-dates) + ;; Match, update date. + (gnus-score-set 'touched '(t) alist) + (setcar (nthcdr 2 kill) now)) + ((and expire (< date expire)) ;Old entry, remove. + (gnus-score-set 'touched '(t) alist) + (setcdr entries (cdr rest)) + (setq rest entries)))) + (setq entries rest))))) + (setq articles (cdr articles))))))) + nil)) (defun gnus-score-thread (scores header now expire &optional trace) (gnus-score-followup scores header now expire trace t)) (defun gnus-score-followup (scores header now expire &optional trace thread) - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - (current-score-file gnus-current-score-file) - (all-scores scores) - ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles - new news) - - ;; Change score file to the adaptive score file. All entries that - ;; this function makes will be put into this file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) + (if gnus-agent-fetching + ;; FIXME: It seems doable in fetching mode. + nil + ;; Insert the unique article headers in the buffer. + (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) + (current-score-file gnus-current-score-file) + (all-scores scores) + ;; gnus-score-index is used as a free variable. + alike last this art entries alist articles + new news) + + ;; Change score file to the adaptive score file. All entries that + ;; this function makes will be put into this file. + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-score-load-file + (or gnus-newsgroup-adaptive-score-file + (gnus-score-file-name + gnus-newsgroup-name gnus-adaptive-file-suffix)))) - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) + (setq gnus-scores-articles (sort gnus-scores-articles + 'gnus-score-string<) + articles gnus-scores-articles) - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - (if (equal last this) - (push art alike) - (when last - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search - (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) - (dmt (downcase mt)) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - (t (error "Invalid match type: %s" type)))) - arts art) - (goto-char (point-min)) - (if (= dmt ?e) + (erase-buffer) + (while articles + (setq art (car articles) + this (aref (car art) gnus-score-index) + articles (cdr articles)) + (if (equal last this) + (push art alike) + (when last + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike)) + (setq alike (list art) + last this))) + (when last ; Bwadr, duplicate code. + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike)) + + ;; Find matches. + (while scores + (setq alist (car scores) + scores (cdr scores) + entries (assoc header alist)) + (while (cdr entries) ;First entry is the header index. + (let* ((rest (cdr entries)) + (kill (car rest)) + (match (nth 0 kill)) + (type (or (nth 3 kill) 's)) + (score (or (nth 1 kill) gnus-score-interactive-default-score)) + (date (nth 2 kill)) + (found nil) + (mt (aref (symbol-name type) 0)) + (case-fold-search + (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) + (dmt (downcase mt)) + (search-func + (cond ((= dmt ?r) 're-search-forward) + ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) + (t (error "Invalid match type: %s" type)))) + arts art) + (goto-char (point-min)) + (if (= dmt ?e) + (while (funcall search-func match nil t) + (and (= (progn (beginning-of-line) (point)) + (match-beginning 0)) + (= (progn (end-of-line) (point)) + (match-end 0)) + (progn + (setq found (setq arts (get-text-property + (point) 'articles))) + ;; Found a match, update scores. + (while arts + (setq art (car arts) + arts (cdr arts)) + (gnus-score-add-followups + (car art) score all-scores thread)))) + (end-of-line)) (while (funcall search-func match nil t) - (and (= (progn (beginning-of-line) (point)) - (match-beginning 0)) - (= (progn (end-of-line) (point)) - (match-end 0)) - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (while arts - (setq art (car arts) - arts (cdr arts)) - (gnus-score-add-followups - (car art) score all-scores thread)))) - (end-of-line)) - (while (funcall search-func match nil t) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (when (setq new (gnus-score-add-followups - (car art) score all-scores thread)) - (push new news))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest)))) - ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file current-score-file)) - (list (cons "references" news)))) + (end-of-line) + (setq found (setq arts (get-text-property (point) 'articles))) + ;; Found a match, update scores. + (while (setq art (pop arts)) + (when (setq new (gnus-score-add-followups + (car art) score all-scores thread)) + (push new news))))) + ;; Update expire date + (cond ((null date)) ;Permanent entry. + ((and found gnus-update-score-entry-dates) + ;Match, update date. + (gnus-score-set 'touched '(t) alist) + (setcar (nthcdr 2 kill) now)) + ((and expire (< date expire)) ;Old entry, remove. + (gnus-score-set 'touched '(t) alist) + (setcdr entries (cdr rest)) + (setq rest entries))) + (setq entries rest)))) + ;; We change the score file back to the previous one. + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-score-load-file current-score-file)) + (list (cons "references" news))))) (defun gnus-score-add-followups (header score scores &optional thread) "Add a score entry to the adapt file." @@ -1945,7 +1931,7 @@ EXTRA is the possible non-standard header." ;; with working on them as a group. What a hassle. ;; Just wait 'til you see what horrors we commit against `match'... (if (= gnus-score-index 9) - (setq this (prin1-to-string this))) ; ick. + (setq this (prin1-to-string this))) ; ick. (if simplify (setq this (gnus-map-function gnus-simplify-subject-functions this))) @@ -1998,7 +1984,7 @@ EXTRA is the possible non-standard header." (when extra (setq match (concat "[ (](" extra " \\. \"[^)]*" match "[^(]*\")[ )]") - search-func 're-search-forward)) ; XXX danger?!? + search-func 're-search-forward)) ; XXX danger?!? (cond ;; Fuzzy matches. We save these for later. @@ -2126,6 +2112,7 @@ EXTRA is the possible non-standard header." (cond ;; Permanent. ((null date) + ;; Do nothing. ) ;; Match, update date. ((and found gnus-update-score-entry-dates) @@ -2164,6 +2151,7 @@ EXTRA is the possible non-standard header." (cond ;; Permanent. ((null date) + ;; Do nothing. ) ;; Match, update date. ((and found gnus-update-score-entry-dates) @@ -2470,14 +2458,14 @@ EXTRA is the possible non-standard header." (gnus-summary-raise-score score)) (gnus-summary-next-subject 1 t))) -(defun gnus-score-default (level) +(defun gnus-score-delta-default (level) (if level (prefix-numeric-value level) gnus-score-interactive-default-score)) (defun gnus-summary-raise-thread (&optional score) "Raise the score of the articles in the current thread with SCORE." (interactive "P") - (setq score (gnus-score-default score)) + (setq score (gnus-score-delta-default score)) (let (e) (save-excursion (let ((articles (gnus-summary-articles-in-thread))) @@ -2506,7 +2494,7 @@ EXTRA is the possible non-standard header." (defun gnus-summary-lower-thread (&optional score) "Lower score of articles in the current thread with SCORE." (interactive "P") - (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) + (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score))))) ;;; Finding score files. @@ -2606,12 +2594,12 @@ GROUP using BNews sys file syntax." ;; too much. (delete-char (min (1- (point-max)) klen)) (goto-char (point-max)) - (search-backward "/") + (search-backward (char-to-string directory-sep-char)) (delete-region (1+ (point)) (point-min))) ;; If short file names were used, we have to translate slashes. (goto-char (point-min)) (let ((regexp (concat - "[/:" (if trans (char-to-string trans) "") "]"))) + "[/:" (if trans (char-to-string trans)) "]"))) (while (re-search-forward regexp nil t) (replace-match "." t t))) ;; Kludge to get rid of "nntp+" problems. @@ -2762,19 +2750,20 @@ The list is determined from the variable gnus-score-file-alist." (and funcs (not (listp funcs)) (setq funcs (list funcs))) - ;; Get the initial score files for this group. - (when funcs - (setq score-files (nreverse (gnus-score-find-alist group)))) - ;; Add any home adapt files. - (let ((home (gnus-home-score-file group t))) - (when home - (push home score-files) - (setq gnus-newsgroup-adaptive-score-file home))) - ;; Check whether there is a `adapt-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'adapt-file))) - (when param-file - (push param-file score-files) - (setq gnus-newsgroup-adaptive-score-file param-file))) + (when gnus-score-use-all-scores + ;; Get the initial score files for this group. + (when funcs + (setq score-files (nreverse (gnus-score-find-alist group)))) + ;; Add any home adapt files. + (let ((home (gnus-home-score-file group t))) + (when home + (push home score-files) + (setq gnus-newsgroup-adaptive-score-file home))) + ;; Check whether there is a `adapt-file' group parameter. + (let ((param-file (gnus-group-find-parameter group 'adapt-file))) + (when param-file + (push param-file score-files) + (setq gnus-newsgroup-adaptive-score-file param-file)))) ;; Go through all the functions for finding score files (or actual ;; scores) and add them to a list. (while funcs @@ -2782,14 +2771,15 @@ The list is determined from the variable gnus-score-file-alist." (setq score-files (nconc score-files (nreverse (funcall (car funcs) group))))) (setq funcs (cdr funcs))) - ;; Add any home score files. - (let ((home (gnus-home-score-file group))) - (when home - (push home score-files))) - ;; Check whether there is a `score-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'score-file))) - (when param-file - (push param-file score-files))) + (when gnus-score-use-all-scores + ;; Add any home score files. + (let ((home (gnus-home-score-file group))) + (when home + (push home score-files))) + ;; Check whether there is a `score-file' group parameter. + (let ((param-file (gnus-group-find-parameter group 'score-file))) + (when param-file + (push param-file score-files)))) ;; Expand all files names. (let ((files score-files)) (while files @@ -2881,10 +2871,10 @@ If ADAPT, return the home adaptive file instead." ;; Function. ((gnus-functionp elem) (funcall elem group)) - ;; Regexp-file cons + ;; Regexp-file cons. ((consp elem) (when (string-match (gnus-globalify-regexp (car elem)) group) - (replace-match (cadr elem) t nil group )))))) + (replace-match (cadr elem) t nil group)))))) (when found (if (file-name-absolute-p found) found @@ -2999,8 +2989,7 @@ See `(Gnus)Scoring Tips' for examples of good regular expressions." (cond (bad (cons 'bad bad)) (new (cons 'new new)) - ;; or nil - ))))) + (t nil)))))) (provide 'gnus-score) diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el index 29c2a31..307aaaf 100644 --- a/lisp/gnus-setup.el +++ b/lisp/gnus-setup.el @@ -1,5 +1,6 @@ ;;; gnus-setup.el --- Initialization & Setup for Gnus 5 -;; Copyright (C) 1995, 96 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc. ;; Author: Steven L. Baur ;; Keywords: news @@ -33,52 +34,43 @@ (eval-when-compile (require 'cl)) -(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) - (defvar gnus-use-installed-gnus t "*If non-nil Use installed version of Gnus.") -(defvar gnus-use-installed-tm running-xemacs - "*If non-nil use installed version of tm.") - -(defvar gnus-use-installed-mailcrypt running-xemacs +(defvar gnus-use-installed-mailcrypt (featurep 'xemacs) "*If non-nil use installed version of mailcrypt.") -(defvar gnus-emacs-lisp-directory (if running-xemacs +(defvar gnus-emacs-lisp-directory (if (featurep 'xemacs) "/usr/local/lib/xemacs/" "/usr/local/share/emacs/") "Directory where Emacs site lisp is located.") (defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory - "gnus-5.0.15/lisp/") + "gnus/lisp/") "Directory where Gnus Emacs lisp is found.") -(defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/") - "Directory where TM Emacs lisp is found.") - (defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/mailcrypt-3.4/") + "site-lisp/mailcrypt/") "Directory where Mailcrypt Emacs Lisp is found.") (defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/bbdb-1.51/") + "site-lisp/bbdb/") "Directory where Big Brother Database is found.") (defvar gnus-use-mhe nil - "Set this if you want to use MH-E for mail reading") + "Set this if you want to use MH-E for mail reading.") (defvar gnus-use-rmail nil - "Set this if you want to use RMAIL for mail reading") + "Set this if you want to use RMAIL for mail reading.") (defvar gnus-use-sendmail t - "Set this if you want to use SENDMAIL for mail reading") + "Set this if you want to use SENDMAIL for mail reading.") (defvar gnus-use-vm nil - "Set this if you want to use the VM package for mail reading") + "Set this if you want to use the VM package for mail reading.") (defvar gnus-use-sc nil - "Set this if you want to use Supercite") + "Set this if you want to use Supercite.") (defvar gnus-use-mailcrypt t - "Set this if you want to use Mailcrypt for dealing with PGP messages") + "Set this if you want to use Mailcrypt for dealing with PGP messages.") (defvar gnus-use-bbdb nil - "Set this if you want to use the Big Brother DataBase") + "Set this if you want to use the Big Brother DataBase.") (when (and (not gnus-use-installed-gnus) (null (member gnus-gnus-lisp-directory load-path))) @@ -97,8 +89,8 @@ (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) (autoload 'mc-install-write-mode "mailcrypt" nil t) (autoload 'mc-install-read-mode "mailcrypt" nil t) - (add-hook 'message-mode-hook 'mc-install-write-mode) - (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) +;;; (add-hook 'message-mode-hook 'mc-install-write-mode) +;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) (when gnus-use-mhe (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))) diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 8a9a206..9b974a8 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -1,5 +1,7 @@ ;;; gnus-soup.el --- SOUP packet writing support for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -67,9 +69,9 @@ The SOUP packet file name will be inserted at the %s.") ;;; Internal Variables: -(defvar gnus-soup-encoding-type ?n +(defvar gnus-soup-encoding-type ?u "*Soup encoding type. -`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox +`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox format.") (defvar gnus-soup-index-type ?c @@ -140,7 +142,7 @@ move those articles instead." (buffer-disable-undo tmp-buf) (save-excursion (while articles - ;; Put the article in a buffer. + ;; Put the article in a buffer. (set-buffer tmp-buf) (when (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) @@ -245,7 +247,8 @@ Note -- this function hasn't been implemented yet." ;; a soup header. (setq head-line (cond - ((= gnus-soup-encoding-type ?n) + ((or (= gnus-soup-encoding-type ?u) + (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility. (format "#! rnews %d\n" (buffer-size))) ((= gnus-soup-encoding-type ?m) (while (search-forward "\nFrom " nil t) @@ -335,7 +338,9 @@ If NOT-ALL, don't pack ticked articles." (while (setq prefix (pop prefixes)) (erase-buffer) (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix))) - (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))) + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system + (concat (car prefix) gnus-soup-prefix-file)))))) (defun gnus-soup-pack (dir packer) (let* ((files (mapconcat 'identity @@ -513,9 +518,12 @@ Return whether the unpacking was successful." (tmp-buf (gnus-get-buffer-create " *soup send*")) beg end) (cond - ((/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?n) + ((and (/= (gnus-soup-encoding-format + (gnus-soup-reply-encoding (car replies))) + ?u) + (/= (gnus-soup-encoding-format + (gnus-soup-reply-encoding (car replies))) + ?n)) ;; Gnus back compatibility. (error "Unsupported encoding")) ((null msg-buf) t) diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 23781b6..cf43cfa 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,5 +1,6 @@ -;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;;; gnus-spec.el --- format spec functions for Gnus -*- coding: iso-latin-1 -*- +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Katsumi Yamaoka @@ -27,6 +28,8 @@ ;;; Code: (eval-when-compile (require 'cl)) + +(require 'alist) (require 'gnus) ;;; Internal variables. @@ -118,14 +121,19 @@ (gnus-byte-code 'gnus-group-line-format-spec)) (defvar gnus-format-specs - `((version . ,emacs-version) - (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: %-20,20n%]%) %s\n" - ,gnus-summary-line-format-spec)) + `((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: %-20,20n%]%) %s\n" + ,gnus-summary-line-format-spec))) "Alist of format specs.") +(defvar gnus-format-specs-compiled nil + "Alist of compiled format specs. Each element should be the form: +\(TYPE (FORMAT-STRING-1 . COMPILED-FUNCTION-1) + : + (FORMAT-STRING-n . COMPILED-FUNCTION-n)).") + (defvar gnus-article-mode-line-format-spec nil) (defvar gnus-summary-mode-line-format-spec nil) (defvar gnus-group-mode-line-format-spec nil) @@ -146,78 +154,101 @@ (match-string 1))))) (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) (match-string 1 var)))) - (entry (assq type gnus-format-specs)) - value spec) - (when entry - (setq gnus-format-specs (delq entry gnus-format-specs))) - (set - (intern (format "%s-spec" var)) - (gnus-parse-format (setq value (symbol-value (intern var))) - (symbol-value (intern (format "%s-alist" var))) - (not (string-match "mode" var)))) - (setq spec (symbol-value (intern (format "%s-spec" var)))) - (push (list type value spec) gnus-format-specs) + (value (symbol-value (intern var))) + (spec (set + (intern (format "%s-spec" var)) + (gnus-parse-format + value (symbol-value (intern (format "%s-alist" var))) + (not (string-match "mode" var))))) + (entry (assq type gnus-format-specs))) + (if entry + (let ((elem (assoc value entry))) + (if elem + (setcdr elem spec) + (setcdr entry (cons (cons value elem) (cdr entry))))) + (push (list type (cons value spec)) gnus-format-specs)) + (gnus-product-variable-touch 'gnus-format-specs) (pop-to-buffer "*Gnus Format*") (erase-buffer) (lisp-interaction-mode) (insert (pp-to-string spec)))) +(put 'gnus-search-or-regist-spec 'lisp-indent-function 1) +(defmacro gnus-search-or-regist-spec (mspec &rest body) + (let ((specs (nth 0 mspec)) (type (nth 1 mspec)) (format (nth 2 mspec)) + (spec (nth 3 mspec)) (entry (nth 4 mspec)) (elem (nth 5 mspec))) + `(let* ((,entry (assq ,type ,specs)) + (,elem (assoc ,format (cdr ,entry)))) + (or (cdr ,elem) + (when (progn ,@body) + (if ,entry + (if ,elem + (setcdr ,elem ,spec) + (setcdr ,entry (cons (cons ,format ,spec) (cdr ,entry)))) + (push (list ,type (cons ,format ,spec)) ,specs)) + (gnus-product-variable-touch (quote ,specs))) + ,spec)))) + +(defun gnus-update-format-specification-1 (type format val) + (set (intern (format "gnus-%s-line-format-spec" type)) + (gnus-search-or-regist-spec (gnus-format-specs-compiled + type format val entry elem) + (when (and gnus-compile-user-specs val) + (setq val (prog1 + (progn + (fset 'gnus-tmp-func `(lambda () ,val)) + (require 'bytecomp) + (let (byte-compile-warnings) + (byte-compile 'gnus-tmp-func)) + (gnus-byte-code 'gnus-tmp-func)) + (when (get-buffer "*Compile-Log*") + (bury-buffer "*Compile-Log*")) + (when (get-buffer "*Compile-Log-Show*") + (bury-buffer "*Compile-Log-Show*")))))))) + (defun gnus-update-format-specifications (&optional force &rest types) "Update all (necessary) format specifications." ;; Make the indentation array. ;; See whether all the stored info needs to be flushed. - (when (or force - (not (equal emacs-version - (cdr (assq 'version gnus-format-specs)))) - (not (equal gnus-version - (cdr (assq 'gnus-version gnus-format-specs))))) + (when force (message "%s" "Force update format specs.") - (setq gnus-format-specs nil)) + (setq gnus-format-specs nil + gnus-format-specs-compiled nil) + (gnus-product-variable-touch 'gnus-format-specs + 'gnus-format-specs-compiled)) ;; Go through all the formats and see whether they need updating. - (let (new-format entry type val) - (while (setq type (pop types)) - ;; Jump to the proper buffer to find out the value of - ;; the variable, if possible. (It may be buffer-local.) - (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) - (when (and (boundp buffer) - (setq val (symbol-value buffer)) - (gnus-buffer-exists-p val)) - (set-buffer val)) - (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type))))) - (setq entry (cdr (assq type gnus-format-specs))) - (if (and (car entry) - (equal (car entry) new-format)) - ;; Use the old format. - (set (intern (format "gnus-%s-line-format-spec" type)) - (cadr entry)) - ;; This is a new format. - (setq val - (if (not (stringp new-format)) - ;; This is a function call or something. - new-format - ;; This is a "real" format. - (gnus-parse-format - new-format - (symbol-value - (intern (format "gnus-%s-line-format-alist" type))) - (not (string-match "mode$" (symbol-name type)))))) - ;; Enter the new format spec into the list. - (if entry - (progn - (setcar (cdr entry) val) - (setcar entry new-format)) - (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val))))) - - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs)) - (unless (assq 'gnus-version gnus-format-specs) - (push (cons 'gnus-version gnus-version) gnus-format-specs))) + (let (type val) + (save-excursion + (while (setq type (pop types)) + ;; Jump to the proper buffer to find out the value of + ;; the variable, if possible. (It may be buffer-local.) + (let* ((new-format + (let ((buffer (intern (format "gnus-%s-buffer" type)))) + (when (and (boundp buffer) + (setq val (symbol-value buffer)) + (gnus-buffer-exists-p val)) + (set-buffer val)) + (symbol-value + (intern (format "gnus-%s-line-format" type)))))) + (or (gnus-update-format-specification-1 type new-format nil) + ;; This is a new format. + (gnus-update-format-specification-1 + type new-format + (gnus-search-or-regist-spec (gnus-format-specs + type new-format val entry elem) + (setq val (if (stringp new-format) + ;; This is a "real" format. + (gnus-parse-format + new-format + (symbol-value + (intern (format "gnus-%s-line-format-alist" + type))) + (not (string-match "mode$" + (symbol-name type)))) + ;; This is a function call or something. + new-format)))))))))) (defvar gnus-mouse-face-0 'highlight) (defvar gnus-mouse-face-1 'highlight) @@ -355,7 +386,7 @@ by `gnus-xmas-redefine'." ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return a ;; string. - (let ((xemacs-mule-p (and gnus-xemacs (featurep 'mule))) + (let ((xemacs-mule-p (and (featurep 'xemacs) (featurep 'mule))) max-width spec flist fstring elem result dontinsert user-defined type value pad-width spec-beg cut-width ignore-value @@ -531,13 +562,14 @@ If PROPS, insert the result." (require 'bytecomp) (let ((entries gnus-format-specs) (byte-compile-warnings '(unresolved callargs redefine)) - entry gnus-tmp-func) + entry type compiled-function) (save-excursion (gnus-message 7 "Compiling format specs...") (while entries - (setq entry (pop entries)) - (if (eq (car entry) 'version) + (setq entry (pop entries) + type (car entry)) + (if (memq type '(version gnus-version)) (setq gnus-format-specs (delq entry gnus-format-specs)) (let ((form (caddr entry))) (when (and (listp form) @@ -546,13 +578,18 @@ If PROPS, insert the result." ;; Under XEmacs, it's (funcall #) (not (and (eq 'funcall (car form)) (byte-code-function-p (cadr form))))) - (fset 'gnus-tmp-func `(lambda () ,form)) + (defalias 'gnus-tmp-func `(lambda () ,form)) (byte-compile 'gnus-tmp-func) - (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) + (setq compiled-function (gnus-byte-code 'gnus-tmp-func)) + (set (intern (format "gnus-%s-line-format-spec" type)) + compiled-function) + (let ((elem (cdr (assq type gnus-format-specs-compiled)))) + (if elem + (set-alist 'elem (cadr entry) compiled-function) + (setq elem (list (cadr entry) compiled-function))) + (set-alist 'gnus-format-specs-compiled type elem)))))) (push (cons 'version emacs-version) gnus-format-specs) - ;; Mark the .newsrc.eld file as "dirty". - (gnus-dribble-touch) (gnus-message 7 "Compiling user specs...done")))) (defun gnus-set-format (type &optional insertable) @@ -562,7 +599,12 @@ If PROPS, insert the result." (symbol-value (intern (format "gnus-%s-line-format-alist" type))) insertable))) +(gnus-ems-redefine) (provide 'gnus-spec) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; gnus-spec.el ends here diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 66c67ed..8182382 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -1,5 +1,6 @@ ;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-spec) (require 'gnus-group) @@ -53,6 +55,9 @@ The following specs are understood: (defvar gnus-server-exit-hook nil "*Hook run when exiting the server buffer.") +(defvar gnus-server-browse-in-group-buffer t + "Whether browse server in group buffer.") + ;;; Internal variables. (defvar gnus-inserted-opened-servers nil) @@ -115,7 +120,7 @@ The following specs are understood: (suppress-keymap gnus-server-mode-map) (gnus-define-keys gnus-server-mode-map - " " gnus-server-read-server + " " gnus-server-read-server-in-server-buffer "\r" gnus-server-read-server gnus-mouse-2 gnus-server-pick-server "q" gnus-server-exit @@ -173,12 +178,12 @@ The following commands are available: (gnus-tmp-where (nth 1 method)) (elem (assoc method gnus-opened-servers)) (gnus-tmp-status (cond ((eq (nth 1 elem) 'denied) - "(denied)") - ((or (gnus-server-opened method) - (eq (nth 1 elem) 'ok)) - "(opened)") - (t - "(closed)")))) + "(denied)") + ((or (gnus-server-opened method) + (eq (nth 1 elem) 'ok)) + "(opened)") + (t + "(closed)")))) (beginning-of-line) (gnus-add-text-properties (point) @@ -295,6 +300,18 @@ The following commands are available: (push (assoc server gnus-server-alist) gnus-server-killed-servers) (setq gnus-server-alist (delq (car gnus-server-killed-servers) gnus-server-alist)) + (let ((groups (gnus-groups-from-server server))) + (when (and groups + (gnus-yes-or-no-p + (format "Kill all %s groups from this server? " + (length groups)))) + (dolist (group groups) + (setq gnus-newsrc-alist + (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist)) + (when gnus-group-change-level-function + (funcall gnus-group-change-level-function + group gnus-level-killed 3))))) (gnus-server-position-point)) (defun gnus-server-yank-server () @@ -475,6 +492,12 @@ The following commands are available: (gnus-request-scan nil method) (gnus-message 3 "Scanning %s...done" server)))) +(defun gnus-server-read-server-in-server-buffer (server) + "Browse a server in server buffer." + (interactive (list (gnus-server-server-name))) + (let (gnus-server-browse-in-group-buffer) + (gnus-server-read-server server))) + (defun gnus-server-read-server (server) "Browse a server." (interactive (list (gnus-server-server-name))) @@ -508,28 +531,28 @@ The following commands are available: (suppress-keymap gnus-browse-mode-map) (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - [delete] gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-unsubscribe-current-group - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) + gnus-browse-mode-map + " " gnus-browse-read-group + "=" gnus-browse-select-group + "n" gnus-browse-next-group + "p" gnus-browse-prev-group + "\177" gnus-browse-prev-group + [delete] gnus-browse-prev-group + "N" gnus-browse-next-group + "P" gnus-browse-prev-group + "\M-n" gnus-browse-next-group + "\M-p" gnus-browse-prev-group + "\r" gnus-browse-select-group + "u" gnus-browse-unsubscribe-current-group + "l" gnus-browse-exit + "L" gnus-browse-exit + "q" gnus-browse-exit + "Q" gnus-browse-exit + "\C-c\C-c" gnus-browse-exit + "?" gnus-browse-describe-briefly + + "\C-c\C-i" gnus-info-find-node + "\C-c\C-b" gnus-bug)) (defun gnus-browse-make-menu-bar () (gnus-turn-off-edit-menu 'browse) @@ -555,6 +578,7 @@ The following commands are available: (setq gnus-browse-current-method (gnus-server-to-method server)) (setq gnus-browse-return-buffer return-buffer) (let* ((method gnus-browse-current-method) + (orig-select-method gnus-select-method) (gnus-select-method method) groups group) (gnus-message 5 "Connecting to %s..." (nth 1 method)) @@ -573,18 +597,6 @@ The following commands are available: 1 "Couldn't request list: %s" (gnus-status-message method)) nil) (t - (gnus-get-buffer-create gnus-browse-buffer) - (when gnus-carpal - (gnus-carpal-setup-buffer 'browse)) - (gnus-configure-windows 'browse) - (buffer-disable-undo) - (let ((buffer-read-only nil)) - (erase-buffer)) - (gnus-browse-mode) - (setq mode-line-buffer-identification - (list - (format - "Gnus: %%b {%s:%s}" (car method) (cadr method)))) (save-excursion (set-buffer nntp-server-buffer) (let ((cur (current-buffer))) @@ -606,25 +618,62 @@ The following commands are available: (setq name (concat name (buffer-substring p (point))))) name)) - (max 0 (- (1+ (read cur)) (read cur)))) + (let ((last (read cur))) + (cons (read cur) last))) groups)) (forward-line)))) (setq groups (sort groups (lambda (l1 l2) (string< (car l1) (car l2))))) - (let ((buffer-read-only nil) - (gnus-select-method nil) - name) - (while groups - (setq group (car groups) - name (format "%s" (car group))) - (insert (if (cadr (gnus-gethash - (gnus-group-prefixed-name name method) - gnus-newsrc-hashtb)) - " " "K") - (format "%7d: " (cdr group)) name "\n") - (setq groups (cdr groups)))) - (switch-to-buffer (current-buffer)) + (if gnus-server-browse-in-group-buffer + (let* ((gnus-select-method orig-select-method) + (gnus-group-listed-groups + (mapcar (lambda (group) + (let ((name + (gnus-group-prefixed-name + (car group) method))) + (gnus-set-active name (cdr group)) + name)) + groups))) + (gnus-configure-windows 'group) + (funcall gnus-group-prepare-function + gnus-level-killed 'ignore 1 'ingore)) + (gnus-get-buffer-create gnus-browse-buffer) + (when gnus-carpal + (gnus-carpal-setup-buffer 'browse)) + (gnus-configure-windows 'browse) + (buffer-disable-undo) + (let ((buffer-read-only nil)) + (erase-buffer)) + (gnus-browse-mode) + (setq mode-line-buffer-identification + (list + (format + "Gnus: %%b {%s:%s}" (car method) (cadr method)))) + (let ((buffer-read-only nil) charset) + (while groups + (setq group (car groups)) + (setq charset (gnus-group-name-charset method group)) + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + (insert + (format "%c%7d: %s\n" + (let ((level + (let ((gnus-select-method orig-select-method)) + (gnus-group-level + (gnus-group-prefixed-name (car group) + method))))) + (cond + ((<= level gnus-level-subscribed) ? ) + ((<= level gnus-level-unsubscribed) ?U) + ((= level gnus-level-zombie) ?Z) + (t ?K))) + (max 0 (- (1+ (cddr group)) (cadr group))) + (gnus-group-name-decode (car group) charset)))) + (list 'gnus-group (car group))) + (setq groups (cdr groups)))) + (switch-to-buffer (current-buffer))) (goto-char (point-min)) (gnus-group-position-point) (gnus-message 5 "Connecting to %s...done" (nth 1 method)) @@ -667,7 +716,7 @@ buffer. (if (or (not (gnus-get-info group)) (gnus-ephemeral-group-p group)) (unless (gnus-group-read-ephemeral-group - group gnus-browse-current-method nil + (gnus-group-real-name group) gnus-browse-current-method nil (cons (current-buffer) 'browse)) (error "Couldn't enter %s" group)) (unless (gnus-group-read-group nil no-article group) @@ -710,11 +759,12 @@ buffer. (defun gnus-browse-group-name () (save-excursion (beginning-of-line) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) - (gnus-group-prefixed-name - ;; Remove text props. - (format "%s" (match-string 1)) - gnus-browse-current-method)))) + (let ((name (get-text-property (point) 'gnus-group))) + (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) + (gnus-group-prefixed-name + (or name + (match-string-no-properties 1)) + gnus-browse-current-method))))) (defun gnus-browse-unsubscribe-group () "Toggle subscription of the current group in the browse buffer." @@ -724,13 +774,13 @@ buffer. (save-excursion (beginning-of-line) ;; If this group it killed, then we want to subscribe it. - (when (eq (char-after) ?K) + (unless (eq (char-after) ? ) (setq sub t)) (setq group (gnus-browse-group-name)) - (when (and sub - (cadr (gnus-gethash group gnus-newsrc-hashtb))) - (error "Group already subscribed")) - (delete-char 1) + ;;;; + ;;(when (and sub + ;; (cadr (gnus-gethash group gnus-newsrc-hashtb))) + ;;(error "Group already subscribed")) (if sub (progn ;; Make sure the group has been properly removed before we @@ -743,15 +793,17 @@ buffer. nil (gnus-method-simplify gnus-browse-current-method))) - gnus-level-default-subscribed gnus-level-killed + gnus-level-default-subscribed (gnus-group-level group) (and (car (nth 1 gnus-newsrc-alist)) (gnus-gethash (car (nth 1 gnus-newsrc-alist)) gnus-newsrc-hashtb)) t) + (delete-char 1) (insert ? )) (gnus-group-change-level - group gnus-level-killed gnus-level-default-subscribed) - (insert ?K))) + group gnus-level-unsubscribed gnus-level-default-subscribed) + (delete-char 1) + (insert ?U))) t)) (defun gnus-browse-exit () diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index bf285a5..27af8ee 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,6 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -27,6 +28,7 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) + (require 'gnus) (require 'gnus-win) (require 'gnus-int) @@ -41,6 +43,12 @@ :group 'gnus-start :type 'file) +(defcustom gnus-product-directory + (nnheader-concat gnus-directory (concat "." gnus-product-name)) + "Product depend data files directory." + :group 'gnus-start + :type '(choice directory (const nil))) + (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") "Your Gnus Emacs-Lisp startup file name. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." @@ -53,7 +61,7 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead." (directory-file-name installation-directory)) "site-lisp/gnus-init") (error nil)) - "*The site-wide Gnus Emacs-Lisp startup file name, or nil if none. + "The site-wide Gnus Emacs-Lisp startup file name, or nil if none. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." :group 'gnus-start :type '(choice file (const nil))) @@ -197,6 +205,7 @@ Gnus always reads its own startup file, which is called be readily understood by other newsreaders. If you don't plan on using other newsreaders, set this variable to nil to save some time on entry." + :version "21.1" :group 'gnus-newsrc :type 'boolean) @@ -226,12 +235,12 @@ not match this regexp will be removed before saving the list." :type 'boolean) (defcustom gnus-ignored-newsgroups - (mapconcat 'identity - '("^to\\." ; not "real" groups - "^[0-9. \t]+ " ; all digits in name - "^[\"][]\"[#'()]" ; bogus characters - ) - "\\|") + (mapconcat 'identity + '("^to\\." ; not "real" groups + "^[0-9. \t]+ " ; all digits in name + "^[\"][]\"[#'()]" ; bogus characters + ) + "\\|") "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, @@ -591,13 +600,25 @@ the first newsgroup." (defvar nnoo-state-alist) (defvar gnus-current-select-method) -(defun gnus-clear-system () - "Clear all variables and buffers." - ;; Clear Gnus variables. +(defun gnus-clear-quick-file-variables () + "Clear all variables in quick startup files." (let ((variables gnus-variable-list)) + ;; Clear Gnus variables. (while variables (set (car variables) nil) (setq variables (cdr variables)))) + (let ((files gnus-product-variable-file-list)) + (while files + (let ((variables (nthcdr 3 (car files)))) + (while variables + (set (car variables) nil) + (setq variables (cdr variables)))) + (setq files (cdr files))))) + +(defun gnus-clear-system () + "Clear all variables and buffers." + ;; Clear gnus variables. + (gnus-clear-quick-file-variables) ;; Clear other internal variables. (setq gnus-list-of-killed-groups nil gnus-have-read-active-file nil @@ -621,6 +642,7 @@ the first newsgroup." gnus-newsgroup-unreads nil nnoo-state-alist nil gnus-current-select-method nil + nnmail-split-history nil gnus-ephemeral-servers nil) (gnus-shutdown 'gnus) ;; Kill the startup file. @@ -678,9 +700,9 @@ prompt the user for the name of an NNTP server to use." (when gnus-simple-splash (setq gnus-simple-splash nil) (cond - (gnus-xemacs + ((featurep 'xemacs) (gnus-xmas-splash)) - ((and (eq window-system 'x) + ((and window-system (= (frame-height) (1+ (window-height)))) (gnus-x-splash)))) @@ -734,17 +756,14 @@ prompt the user for the name of an NNTP server to use." ;;;###autoload (defun gnus-unload () - "Unload all Gnus features." + "Unload all Gnus features. +\(For some value of `all' or `Gnus'.) Currently, features whose names +have prefixes `gnus-', `nn', `mm-' or `rfc' are unloaded. Use +cautiously -- unloading may cause trouble." (interactive) - (unless (boundp 'load-history) - (error "Sorry, `gnus-unload' is not implemented in this Emacs version")) - (let ((history load-history) - feature) - (while history - (and (string-match "^\\(gnus\\|nn\\)" (caar history)) - (setq feature (cdr (assq 'provide (car history)))) - (unload-feature feature 'force)) - (setq history (cdr history))))) + (dolist (feature features) + (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature)) + (unload-feature feature 'force)))) ;;; @@ -962,16 +981,16 @@ for new groups, and subscribe the new groups as zombies." (let* ((gnus-subscribe-newsgroup-method gnus-subscribe-newsgroup-method) (check (cond - ((or (and (= (or arg 1) 4) - (not (listp gnus-check-new-newsgroups))) - (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - 'ask-server) - ((= (or arg 1) 16) - (setq gnus-subscribe-newsgroup-method - 'gnus-subscribe-zombies) - t) - (t gnus-check-new-newsgroups)))) + ((or (and (= (or arg 1) 4) + (not (listp gnus-check-new-newsgroups))) + (null gnus-read-active-file) + (eq gnus-read-active-file 'some)) + 'ask-server) + ((= (or arg 1) 16) + (setq gnus-subscribe-newsgroup-method + 'gnus-subscribe-zombies) + t) + (t gnus-check-new-newsgroups)))) (unless (gnus-check-first-time-used) (if (or (consp check) (eq check 'ask-server)) @@ -1106,39 +1125,40 @@ for new groups, and subscribe the new groups as zombies." hashtb)) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups))) - (if (> groups 0) - (gnus-message 5 "%d new newsgroup%s arrived" - groups (if (> groups 1) "s have" " has")) - (gnus-message 5 "No new newsgroups")) + (if (> groups 0) + (gnus-message 5 "%d new newsgroup%s arrived" + groups (if (> groups 1) "s have" " has")) + (gnus-message 5 "No new newsgroups")) (when got-new (setq gnus-newsrc-last-checked-date new-date)) got-new)) (defun gnus-check-first-time-used () (catch 'ended - (let ((files (list gnus-current-startup-file - (concat gnus-current-startup-file ".el") - (concat gnus-current-startup-file ".eld") - gnus-startup-file - (concat gnus-startup-file ".el") - (concat gnus-startup-file ".eld")))) - (while files - (when (file-exists-p (pop files)) - (throw 'ended nil)))) + ;; First check if any of the following files exist. If they do, + ;; it's not the first time the user has used Gnus. + (dolist (file (list gnus-current-startup-file + (concat gnus-current-startup-file ".el") + (concat gnus-current-startup-file ".eld") + gnus-startup-file + (concat gnus-startup-file ".el") + (concat gnus-startup-file ".eld"))) + (when (file-exists-p file) + (throw 'ended nil))) (gnus-message 6 "First time user; subscribing you to default groups") (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t)) (gnus-read-active-file))) (setq gnus-newsrc-last-checked-date (current-time-string)) - (let ((groups gnus-default-subscribed-newsgroups) + ;; Subscribe to the default newsgroups. + (let ((groups (or gnus-default-subscribed-newsgroups + gnus-backup-default-subscribed-newsgroups)) group) - (if (eq groups t) - nil - (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) + (when (eq groups t) + ;; If t, we subscribe (or not) all groups as if they were new. (mapatoms (lambda (sym) - (if (null (setq group (symbol-name sym))) - () + (when (setq group (symbol-name sym)) (let ((do-sub (gnus-matches-options-n group))) (cond ((eq do-sub 'subscribe) @@ -1149,18 +1169,17 @@ for new groups, and subscribe the new groups as zombies." (t (push group gnus-killed-list)))))) gnus-active-hashtb) - (while groups - (when (gnus-active (car groups)) + (dolist (group groups) + ;; Only subscribe the default groups that are activated. + (when (gnus-active group) (gnus-group-change-level - (car groups) gnus-level-default-subscribed gnus-level-killed)) - (setq groups (cdr groups))) + group gnus-level-default-subscribed gnus-level-killed))) (save-excursion (set-buffer gnus-group-buffer) (gnus-group-make-help-group)) (when gnus-novice-user (gnus-message 7 "`A k' to list killed groups")))))) - (defun gnus-subscribe-group (group &optional previous method) "Subcribe GROUP and put it after PREVIOUS." (gnus-group-change-level @@ -1247,7 +1266,11 @@ for new groups, and subscribe the new groups as zombies." (unless (gnus-group-foreign-p group) (if (= level gnus-level-zombie) (push group gnus-zombie-list) - (push group gnus-killed-list)))) + (if (= oldlevel gnus-level-killed) + ;; Remove from active hashtb. + (unintern group gnus-active-hashtb) + ;; Don't add it into killed-list if it was killed. + (push group gnus-killed-list))))) (t ;; If the list is to be entered into the newsrc assoc, and ;; it was killed, we have to create an entry in the newsrc @@ -1263,14 +1286,14 @@ for new groups, and subscribe the new groups as zombies." (setq active (gnus-active group)) (setq num (if active (- (1+ (cdr active)) (car active)) t)) - ;; Shorten the select method if possible, if we need to - ;; store it at all (native groups). - (let ((method (gnus-method-simplify - (or gnus-override-subscribe-method - (gnus-group-method group))))) - (if method - (setq info (list group level nil nil method)) - (setq info (list group level nil))))) + ;; Shorten the select method if possible, if we need to + ;; store it at all (native groups). + (let ((method (gnus-method-simplify + (or gnus-override-subscribe-method + (gnus-group-method group))))) + (if method + (setq info (list group level nil nil method)) + (setq info (list group level nil))))) (unless previous (setq previous (let ((p gnus-newsrc-alist)) @@ -1388,8 +1411,10 @@ newsgroup." t) (condition-case () (inline (gnus-request-group group dont-check method)) - ;(error nil) - (quit nil)) + ;;(error nil) + (quit + (message "Quit activating %s" group) + nil)) (setq active (gnus-parse-active)) ;; If there are no articles in the group, the GROUP ;; command may have responded with the `(0 . 0)'. We @@ -1502,7 +1527,7 @@ newsgroup." gnus-activate-foreign-newsgroups) (t 0)) level)) - info group active method retrievegroups) + scanned-methods info group active method retrievegroups) (gnus-message 5 "Checking new news...") (while newsrc @@ -1514,6 +1539,13 @@ newsgroup." ;; be reached) we just set the number of unread articles in this ;; newsgroup to t. This means that Gnus thinks that there are ;; unread articles, but it has no idea how many. + + ;; To be more explicit: + ;; >0 for an active group with messages + ;; 0 for an active group with no unread messages + ;; nil for non-foreign groups that the user has requested not be checked + ;; t for unchecked foreign groups or bogus groups, or groups that can't + ;; be checked, for one reason or other. (if (and (setq method (gnus-info-method info)) (not (inline (gnus-server-equal @@ -1521,8 +1553,8 @@ newsgroup." (setq method (gnus-server-get-method nil method))))) (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. - (when (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan)) + (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) (gnus-agent-save-group-info @@ -1546,8 +1578,25 @@ newsgroup." (setcdr (assoc method retrievegroups) (cons group (cdr (assoc method retrievegroups)))) (push (list method group) retrievegroups)) - (setq active (gnus-activate-group group 'scan)) - (inline (gnus-close-group group)))))) + ;; hack: `nnmail-get-new-mail' changes the mail-source depending + ;; on the group, so we must perform a scan for every group + ;; if the users has any directory mail sources. + ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, + ;; for it scan all spool files even when the groups are + ;; not required. + (if (and + (or nnmail-scan-directory-mail-source-once + (null (assq 'directory + (or mail-sources + (if (listp nnmail-spool-file) + nnmail-spool-file + (list nnmail-spool-file)))))) + (member method scanned-methods)) + (setq active (gnus-activate-group group)) + (setq active (gnus-activate-group group 'scan)) + (push method scanned-methods)) + (when active + (gnus-close-group group)))))) ;; Get the number of unread articles in the group. (cond @@ -1569,23 +1618,23 @@ newsgroup." (let* ((mg (pop retrievegroups)) (method (or (car mg) gnus-select-method)) (groups (cdr mg))) - (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (gnus-read-active-file-2 (mapcar (lambda (group) - (gnus-group-real-name group)) - groups) method) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))) + (when (gnus-check-server method) + ;; Request that the backend scan its incoming messages. + (when (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan nil method)) + (gnus-read-active-file-2 (mapcar (lambda (group) + (gnus-group-real-name group)) + groups) method) + (dolist (group groups) + (cond + ((setq active (gnus-active (gnus-info-group + (setq info (gnus-get-info group))))) + (inline (gnus-get-unread-articles-in-group info active t))) + (t + ;; The group couldn't be reached, so we nix out the number of + ;; unread articles and stuff. + (gnus-set-active group nil) + (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) (gnus-message 5 "Checking new news...done"))) @@ -1718,7 +1767,9 @@ newsgroup." (gnus-read-active-file-1 method force) ;; We catch C-g so that we can continue past servers ;; that do not respond. - (quit nil))))))) + (quit + (message "Quit reading the active file") + nil))))))) (defun gnus-read-active-file-1 (method force) (let (where mesg) @@ -1770,14 +1821,14 @@ newsgroup." (gnus-check-server method) (let ((list-type (gnus-retrieve-groups groups method))) (cond ((not list-type) - (gnus-error + (gnus-error 1.2 "Cannot read partial active file from %s server." (car method))) ((eq list-type 'active) (gnus-active-to-gnus-format method gnus-active-hashtb nil t)) (t (gnus-groups-to-gnus-format method gnus-active-hashtb t))))))) - + ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors real-active) @@ -1884,7 +1935,10 @@ newsgroup." (gnus-group-prefixed-name "" method)))) ;; Let the Gnus agent save the active file. - (if (and gnus-agent real-active gnus-plugged (gnus-agent-method-p method)) + (if (and gnus-agent + real-active + gnus-plugged + (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) (gnus-active-to-gnus-format method hashtb nil real-active)) @@ -1924,10 +1978,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)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) + (gnus-clear-quick-file-variables) (let* ((newsrc-file gnus-current-startup-file) (quick-file (concat newsrc-file ".el"))) (save-excursion @@ -1956,36 +2007,7 @@ If FORCE is non-nil, the .newsrc file is read." (buffer-disable-undo) (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) - - ;; Convert old to new. - (gnus-convert-old-newsrc)))) - -(defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." - (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) - -(defun gnus-convert-old-ticks () - (let ((newsrc (cdr gnus-newsrc-alist)) - marks info dormant ticked) - (while (setq info (pop newsrc)) - (when (setq marks (gnus-info-marks info)) - (setq dormant (cdr (assq 'dormant marks)) - ticked (cdr (assq 'tick marks))) - (when (or dormant ticked) - (gnus-info-set-read - info - (gnus-add-to-range - (gnus-info-read info) - (nconc (gnus-uncompress-range dormant) - (gnus-uncompress-range ticked))))))))) + (gnus-message 5 "Reading %s...done" newsrc-file)))))) (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) @@ -1993,16 +2015,20 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) (when (file-exists-p ding-file) - (condition-case nil - (with-temp-buffer - (insert-file-contents-as-coding-system - gnus-startup-file-coding-system ding-file) - (eval-region (point-min) (point-max))) - (error - (ding) - (unless (gnus-yes-or-no-p - (format "Error in %s; continue? " ding-file)) - (error "Error in %s" ding-file)))) + (with-temp-buffer + (condition-case nil + (progn + (insert-file-contents-as-coding-system + gnus-startup-file-coding-system ding-file) + (eval-region (point-min) (point-max))) + (error + (ding) + (or (not (or (zerop (buffer-size)) + (eq 'binary gnus-startup-file-coding-system) + (gnus-re-read-newsrc-el-file ding-file))) + (gnus-yes-or-no-p + (format "Error in %s; continue? " ding-file)) + (error "Error in %s" ding-file))))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) (gnus-make-hashtable-from-newsrc-alist) @@ -2011,7 +2037,71 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Reading %s..." file) ;; The .el file is newer than the .eld file, so we read that one ;; as well. - (gnus-read-old-newsrc-el-file file)))) + (gnus-read-old-newsrc-el-file file))) + (when (and gnus-product-directory + (file-directory-p gnus-product-directory)) + (let ((list gnus-product-variable-file-list)) + (while list + (apply 'gnus-product-read-variable-file-1 (car list)) + (setq list (cdr list)))))) + +(defun gnus-re-read-newsrc-el-file (file) + "Attempt to re-read .newsrc.eld file. Returns `nil' if successful. +The backup file \".newsrc.eld_\" will be created before re-reading." + (message "Error in %s; retrying..." file) + (if (and + (condition-case nil + (let ((backup (concat file "_"))) + (copy-file file backup 'ok-if-already-exists 'keep-time) + (message " (The backup file %s has been created)" backup) + t) + (error nil)) + (progn + (insert-file-contents-as-binary file nil nil nil 'replace) + (when (re-search-forward + "^[\t ]*([\t\n\r ]*setq[\t\n\r ]+gnus-format-specs" nil t) + (delete-region (goto-char (match-beginning 0)) (forward-list 1)) + (decode-coding-region (point-min) (point-max) + gnus-startup-file-coding-system) + (condition-case nil + (progn + (eval-region (point-min) (point-max)) + t) + (error nil))))) + (prog1 + nil + (message "Error in %s; retrying...done" file)) + (message "Error in %s; retrying...failed" file) + t)) + +(defun gnus-product-read-variable-file-1 (file checking-methods coding + &rest variables) + (let (error gnus-product-file-version method file-ver) + (when (or + (condition-case err + (let ((coding-system-for-read coding) + (input-coding-system coding)) + (load (expand-file-name file gnus-product-directory) t nil t) + nil) + (error + (message "%s" err) + (setq error t))) + (and (assq 'emacs-version checking-methods) + (not (string= emacs-version + (cdr (assq 'emacs-version + gnus-product-file-version))))) + (and (setq method (assq 'product-version checking-methods)) + (or (not (setq file-ver + (cdr (assq 'product-version + gnus-product-file-version)))) + (< (product-version-compare file-ver (cadr method)) 0)))) + (unless error + (message "\"%s\" seems to have mismatched contents, updating..." + file)) + (while variables + (set (car variables) nil) + (gnus-product-variable-touch (car variables)) + (setq variables (cdr variables)))))) ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) @@ -2363,12 +2453,15 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) (gnus-dribble-delete-file) - (gnus-group-set-mode-line))))) + (gnus-group-set-mode-line)))) + (when gnus-product-directory + (gnus-product-save-variable-file))) ;; Call the function above at C-x C-c. -(defadvice save-buffers-kill-emacs (before save-gnus-newsrc-file-maybe activate) +(defadvice save-buffers-kill-emacs (before save-gnus-newsrc-file-maybe + activate preactivate) "Save .newsrc and .newsrc.eld when Emacs is killed." - (when (get-buffer gnus-group-buffer) + (when (gnus-alive-p) (gnus-run-hooks 'gnus-exit-gnus-hook) (gnus-offer-save-summaries) (gnus-save-newsrc-file))) @@ -2377,6 +2470,7 @@ If FORCE is non-nil, the .newsrc file is read." "Insert Gnus variables such as gnus-newsrc-alist in lisp format." (let ((print-quoted t) (print-escape-newlines t)) + (insert ";; -*- emacs-lisp -*-\n") (insert ";; Gnus startup file.\n") (insert "\ @@ -2405,6 +2499,76 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-prin1 (symbol-value variable)) (insert ")\n")))))) +(defun gnus-product-variable-touch (&rest variables) + (while variables + (put (pop variables) 'gnus-product-variable 'dirty))) + +(defun gnus-product-variables-dirty-p (variables) + (catch 'done + (while variables + (when (eq (get (car variables) 'gnus-product-variable) 'dirty) + (throw 'done t)) + (setq variables (cdr variables))))) + +(defun gnus-product-save-variable-file (&optional force) + "Save all product variables to files, when need to be saved." + (let ((list gnus-product-variable-file-list)) + (gnus-make-directory gnus-product-directory) + (while list + (apply 'gnus-product-save-variable-file-1 force (car list)) + (setq list (cdr list))))) + +(defun gnus-product-save-variable-file-1 (force file checking-methods coding + &rest variables) + "Save a product variable file, when need to be saved." + (when (or force + (gnus-product-variables-dirty-p variables)) + (let ((product (product-find 'gnus-vers))) + (set-buffer (gnus-get-buffer-create " *gnus-product*")) + (make-local-variable 'version-control) + (setq version-control 'never) + (setq file (expand-file-name file gnus-product-directory) + buffer-file-name file + default-directory (file-name-directory file)) + (buffer-disable-undo) + (erase-buffer) + (gnus-message 5 "Saving %s..." file) + (apply 'gnus-product-quick-file-format product checking-methods coding + variables) + (save-buffer-as-coding-system coding) + (kill-buffer (current-buffer)) + (while variables + (put (car variables) 'gnus-product-variable nil) + (setq variables (cdr variables))) + (gnus-message + 5 "Saving %s...done" file)))) + +(defun gnus-product-quick-file-format (product checking-methods + coding &rest variables) + "Insert gnus product depend variables in lisp format." + (let ((print-quoted t) + (print-escape-newlines t) + variable param) + (insert (format ";; -*- Mode: emacs-lisp; coding: %s -*-\n" coding)) + (insert (format ";; %s startup file.\n" (product-name product))) + (when (setq param (cdr (assq 'product-version checking-methods))) + (insert "(or (>= (product-version-compare " + "(product-version (product-find 'gnus-vers))\n" + "\t\t\t\t '" (apply 'prin1-to-string param) ")\n" + "\t0)\n" + " (error \"This file was created by later version of " + "gnus.\"))\n")) + (insert "(setq gnus-product-file-version \n" + " '((product-version . " + (prin1-to-string (product-version product)) ")\n" + "\t(emacs-version . " (prin1-to-string emacs-version) ")))\n") + (while variables + (when (and (boundp (setq variable (pop variables))) + (symbol-value variable)) + (insert "(setq " (symbol-name variable) " '") + (gnus-prin1 (symbol-value variable)) + (insert ")\n"))))) + (defun gnus-strip-killed-list () "Return the killed list minus the groups that match `gnus-save-killed-list'." (let ((list gnus-killed-list) @@ -2490,7 +2654,8 @@ If FORCE is non-nil, the .newsrc file is read." (make-temp-name (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) - (gnus-write-buffer slave-name) + (gnus-write-buffer-as-coding-system + gnus-startup-file-coding-system slave-name) (when modes (set-file-modes slave-name modes))))) @@ -2520,7 +2685,7 @@ If FORCE is non-nil, the .newsrc file is read." (while slave-files (erase-buffer) (setq file (nth 1 (car slave-files))) - (insert-file-contents file) + (nnheader-insert-file-contents file) (when (condition-case () (progn (eval-buffer (current-buffer)) @@ -2613,7 +2778,7 @@ If FORCE is non-nil, the .newsrc file is read." (let ((str (buffer-substring (point) (progn (end-of-line) (point)))) (coding - (and (or gnus-xemacs + (and (or (featurep 'xemacs) (and (boundp 'enable-multibyte-characters) enable-multibyte-characters)) (fboundp 'gnus-mule-get-coding-system) @@ -2639,7 +2804,8 @@ If FORCE is non-nil, the .newsrc file is read." "Declare backend NAME with ABILITIES as a Gnus backend." (setq gnus-valid-select-methods (nconc gnus-valid-select-methods - (list (apply 'list name abilities))))) + (list (apply 'list name abilities)))) + (gnus-redefine-select-method-widget)) (defun gnus-set-default-directory () "Set the default directory in the current buffer to `gnus-default-directory'. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 7587108..e3c0fc8 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Semi-gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -28,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-group) (require 'gnus-spec) @@ -35,6 +37,9 @@ (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) +;; Recursive :-(. +;; (require 'gnus-art) +(require 'nnoo) (require 'mime-view) (eval-when-compile @@ -42,10 +47,15 @@ (require 'static)) (eval-and-compile - (autoload 'gnus-cache-articles-in-group "gnus-cache")) + (autoload 'gnus-cache-articles-in-group "gnus-cache") + (autoload 'pgg-decrypt-region "pgg" nil t) + (autoload 'pgg-verify-region "pgg" nil t)) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-cache-write-active "gnus-cache") (autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) +(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) +(autoload 'mm-uu-dissect "mm-uu") (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -178,10 +188,15 @@ This variable will only be used if the value of :type 'string) (defcustom gnus-summary-goto-unread t - "*If t, marking commands will go to the next unread article. -If `never', commands that usually go to the next unread article, will -go to the next article, whether it is read or not. -If nil, only the marking commands will go to the next (un)read article." + "*If t, many commands will go to the next unread article. +This applies to marking commands as well as other commands that +\"naturally\" select the next article, like, for instance, `SPC' at +the end of an article. + +If nil, the marking commands do NOT go to the next unread article +(they go to the next article instead). If `never', commands that +usually go to the next unread article, will go to the next article, +whether it is read or not." :group 'gnus-summary-marks :link '(custom-manual "(gnus)Setting Marks") :type '(choice (const :tag "off" nil) @@ -364,13 +379,15 @@ The articles will simply be fed to the function given by (defcustom gnus-move-split-methods nil "*Variable used to suggest where articles are to be moved to. -It uses the same syntax as the `gnus-split-methods' variable." +It uses the same syntax as the `gnus-split-methods' variable. +However, whereas `gnus-split-methods' specifies file names as targets, +this variable specifies group names." :group 'gnus-summary-mail :type '(repeat (choice (list :value (fun) function) (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-unread-mark ? ;Whitespace +(defcustom gnus-unread-mark ? ;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks :type 'character) @@ -485,7 +502,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-empty-thread-mark ? ;Whitespace +(defcustom gnus-empty-thread-mark ? ;Whitespace "*There is no thread under the article." :group 'gnus-summary-marks :type 'character) @@ -505,11 +522,13 @@ It uses the same syntax as the `gnus-split-methods' variable." gnus-low-score-mark gnus-ancient-mark gnus-read-mark gnus-souped-mark gnus-duplicate-mark) "*The list of marks converted into expiration if a group is auto-expirable." + :version "21.1" :group 'gnus-summary :type '(repeat character)) (defcustom gnus-inhibit-user-auto-expire t "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." + :version "21.1" :group 'gnus-summary :type 'boolean) @@ -570,6 +589,7 @@ with some simple extensions: (defcustom gnus-list-identifiers nil "Regexp that matches list identifiers to be removed from subject. This can also be a list of regexps." + :version "21.1" :group 'gnus-summary-format :group 'gnus-article-hiding :type '(choice (const :tag "none" nil) @@ -648,6 +668,7 @@ This variable is local to the summary buffers." (defcustom gnus-summary-mode-hook nil "*A hook for Gnus summary mode. This hook is run before any variables are set in the summary buffer." + :options '(turn-on-gnus-mailing-list-mode) :group 'gnus-summary-various :type 'hook) @@ -718,7 +739,8 @@ is not run if `gnus-visual' is nil." :type 'hook) (defcustom gnus-exit-group-hook nil - "*A hook called when exiting (not quitting) summary mode." + "*A hook called when exiting summary mode. +This hook is not called from the non-updating exit commands like `Q'." :group 'gnus-various :type 'hook) @@ -779,7 +801,7 @@ automatically when it is selected." . gnus-summary-high-unread-face) ((and (< score default) (= mark gnus-unread-mark)) . gnus-summary-low-unread-face) - ((and (memq article gnus-newsgroup-incorporated) + ((and (memq article gnus-newsgroup-incorporated) (= mark gnus-unread-mark)) . gnus-summary-incorporated-face) ((= mark gnus-unread-mark) @@ -826,12 +848,14 @@ which it may alter in any way.") (defcustom gnus-extra-headers nil "*Extra headers to parse." + :version "21.1" :group 'gnus-summary :type '(repeat symbol)) (defcustom gnus-ignored-from-addresses (and user-mail-address (regexp-quote user-mail-address)) "*Regexp of From headers that may be suppressed in favor of To headers." + :version "21.1" :group 'gnus-summary :type 'regexp) @@ -839,11 +863,14 @@ which it may alter in any way.") '(("^hk\\>\\|^tw\\>\\|\\" cn-big5) ("^cn\\>\\|\\" cn-gb-2312) ("^fj\\>\\|^japan\\>" iso-2022-jp-2) + ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit) ("^relcom\\>" koi8-r) ("^fido7\\>" koi8-r) ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) ("^israel\\>" iso-8859-1) ("^han\\>" euc-kr) + ("^alt.chinese.text.big5\\>" chinese-big5) + ("^soc.culture.vietnamese\\>" vietnamese-viqr) ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) (".*" iso-8859-1)) "Alist of regexps (to match group names) and default charsets to be used when reading." @@ -855,10 +882,11 @@ which it may alter in any way.") "List of charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." + :version "21.1" :type '(repeat symbol) :group 'gnus-charset) -(defcustom gnus-group-ignored-charsets-alist +(defcustom gnus-group-ignored-charsets-alist '(("alt\\.chinese\\.text" iso-8859-1)) "Alist of regexps (to match group names) and charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the @@ -870,11 +898,12 @@ default charset will be used instead." (defcustom gnus-group-highlight-words-alist nil "Alist of group regexps and highlight regexps. This variable uses the same syntax as `gnus-emphasis-alist'." + :version "21.1" :type '(repeat (cons (regexp :tag "Group") (repeat (list (regexp :tag "Highlight regexp") (number :tag "Group for entire word" 0) (number :tag "Group for displayed part" 0) - (symbol :tag "Face" + (symbol :tag "Face" gnus-emphasis-highlight-words))))) :group 'gnus-summary-visual) @@ -897,8 +926,56 @@ by moving the mouse over the edge of the article window." :type 'integer :group 'gnus-summary-maneuvering) +(defcustom gnus-summary-show-article-charset-alist + nil + "Alist of number and charset. +The article will be shown with the charset corresponding to the +numbered argument. +For example: ((1 . cn-gb-2312) (2 . big5))." + :version "21.1" + :type '(repeat (cons (number :tag "Argument" 1) + (symbol :tag "Charset"))) + :group 'gnus-charset) + +(defcustom gnus-preserve-marks t + "Whether marks are preserved when moving, copying and respooling messages." + :version "21.1" + :type 'boolean + :group 'gnus-summary-marks) + +(defcustom gnus-alter-articles-to-read-function nil + "Function to be called to alter the list of articles to be selected." + :type 'function + :group 'gnus-summary) + +(defcustom gnus-orphan-score nil + "*All orphans get this score added. Set in the score file." + :group 'gnus-score-default + :type '(choice (const nil) + integer)) + +(defcustom gnus-summary-save-parts-default-mime "image/.*" + "*A regexp to match MIME parts when saving multiple parts of a message +with gnus-summary-save-parts (X m). This regexp will be used by default +when prompting the user for which type of files to save." + :group 'gnus-summary + :type 'regexp) + + +(defcustom gnus-summary-save-parts-default-mime "image/.*" + "*A regexp to match MIME parts when saving multiple parts of a message +with gnus-summary-save-parts (X m). This regexp will be used by default +when prompting the user for which type of files to save." + :group 'gnus-summary + :type 'regexp) + + ;;; Internal variables +(defvar gnus-article-mime-handles nil) +(defvar gnus-article-decoded-p nil) +(defvar gnus-article-charset nil) +(defvar gnus-article-ignored-charsets nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-page-broken nil) (defvar gnus-inhibit-mime-unbuttonizing nil) @@ -910,8 +987,13 @@ by moving the mouse over the edge of the article window." (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number - "Function called to sort the articles within a thread after it has -been gathered together.") + "Function called to sort the articles within a thread after it has been gathered together.") + +(defvar gnus-summary-save-parts-type-history nil) +(defvar gnus-summary-save-parts-last-directory nil) + +(defvar gnus-summary-save-parts-type-history nil) +(defvar gnus-summary-save-parts-last-directory nil) ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) @@ -935,9 +1017,9 @@ been gathered together.") (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) (?A (std11-address-string - (car (mime-read-field 'From gnus-tmp-header))) ?s) + (car (mime-entity-read-field gnus-tmp-header 'From))) ?s) (?a (or (std11-full-name-string - (car (mime-read-field 'From gnus-tmp-header))) + (car (mime-entity-read-field gnus-tmp-header 'From))) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) @@ -969,9 +1051,9 @@ been gathered together.") ?c) (?u gnus-tmp-user-defined ?s) (?P (gnus-pick-line-number) ?d)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") + "An alist of format specifications that can appear in summary lines. +These are paired with what variables they correspond with, along with +the type of the variable (string, integer, character, etc).") (defvar gnus-summary-dummy-line-format-alist `((?S gnus-tmp-subject ?s) @@ -1099,6 +1181,8 @@ end position and text.") (defvar gnus-newsgroup-ephemeral-charset nil) (defvar gnus-newsgroup-ephemeral-ignored-charsets nil) +(defvar gnus-article-before-search nil) + (defconst gnus-summary-local-variables '(gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end @@ -1122,6 +1206,7 @@ end position and text.") gnus-score-alist gnus-current-score-file (gnus-summary-expunge-below . global) (gnus-summary-mark-below . global) + (gnus-orphan-score . global) gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient gnus-newsgroup-sparse gnus-newsgroup-process-stack @@ -1135,13 +1220,16 @@ end position and text.") gnus-newsgroup-incorporated) "Variables that are buffer-local to the summary buffers.") +(defvar gnus-newsgroup-variables nil + "Variables that have separate values in the newsgroups.") + ;; Byte-compiler warning. -(defvar gnus-article-mode-map) +(eval-when-compile (defvar gnus-article-mode-map)) ;; Subject simplification. (defun gnus-simplify-whitespace (str) - "Remove excessive whitespace." + "Remove excessive whitespace from STR." (let ((mystr str)) ;; Multiple spaces. (while (string-match "[ \t][ \t]+" mystr) @@ -1186,7 +1274,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." (defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (replace-match (or newtext "")))) + (replace-match (or newtext "")))) (defun gnus-simplify-buffer-fuzzy () "Simplify string in the buffer fuzzily. @@ -1194,7 +1282,7 @@ The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. Whitespace is generally cleaned up, and miscellaneous leading/trailing matter is removed. Additional things can be deleted by setting -gnus-simplify-subject-fuzzy-regexp." +`gnus-simplify-subject-fuzzy-regexp'." (let ((case-fold-search t) (modified-tick)) (gnus-simplify-buffer-fuzzy-step "\t" " ") @@ -1318,6 +1406,8 @@ increase the score of each group you read." "\M-\C-h" gnus-summary-hide-thread "\M-\C-f" gnus-summary-next-thread "\M-\C-b" gnus-summary-prev-thread + [(meta down)] gnus-summary-next-thread + [(meta up)] gnus-summary-prev-thread "\M-\C-u" gnus-summary-up-thread "\M-\C-d" gnus-summary-down-thread "&" gnus-summary-execute-command @@ -1368,7 +1458,7 @@ increase the score of each group you read." "\C-d" gnus-summary-enter-digest-group "\M-\C-d" gnus-summary-read-document "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-g" gnus-summary-customize-parameters + "\M-\C-a" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1427,7 +1517,7 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age - "x" gnus-summary-limit-to-extra + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read) @@ -1505,6 +1595,7 @@ increase the score of each group you read." "g" gnus-summary-show-article "s" gnus-summary-isearch-article "P" gnus-summary-print-article + "M" gnus-mailing-list-insinuate "t" gnus-article-babel) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) @@ -1516,6 +1607,7 @@ increase the score of each group you read." "Q" gnus-article-fill-long-lines "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr + "Z" gnus-article-decode-HZ "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message @@ -1523,6 +1615,7 @@ increase the score of each group you read." "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime "H" gnus-article-strip-headers-in-body + "p" gnus-article-verify-x-pgp-sig "d" gnus-article-treat-dumbquotes "s" gnus-smiley-display) @@ -1604,10 +1697,11 @@ increase the score of each group you read." "v" gnus-article-view-part "o" gnus-article-save-part "c" gnus-article-copy-part + "C" gnus-article-view-part-as-charset "e" gnus-article-externalize-part + "E" gnus-article-encrypt-body "i" gnus-article-inline-part - "|" gnus-article-pipe-part) - ) + "|" gnus-article-pipe-part)) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1645,7 +1739,7 @@ increase the score of each group you read." ;; Define both the Article menu in the summary buffer and the equivalent ;; Commands menu in the article buffer here for consistency. (let ((innards - '(("Hide" + `(("Hide" ["All" gnus-article-hide t] ["Headers" gnus-article-toggle-headers t] ["Signature" gnus-article-hide-signature t] @@ -1683,7 +1777,9 @@ increase the score of each group you read." ["Capitalize sentences" gnus-article-capitalize-sentences t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] - ["Rot 13" gnus-summary-caesar-message t] + ["Rot 13" gnus-summary-caesar-message + ,@(if (featurep 'xemacs) nil + '(:help "\"Caesar rotate\" article by 13"))] ["Unix pipe" gnus-summary-pipe-message t] ["Add buttons" gnus-article-add-buttons t] ["Add buttons to head" gnus-article-add-buttons-to-head t] @@ -1691,10 +1787,16 @@ increase the score of each group you read." ["Toggle MIME" gnus-summary-toggle-mime t] ["Verbose header" gnus-summary-verbose-headers t] ["Toggle header" gnus-summary-toggle-header t] - ["Toggle smileys" gnus-smiley-display t]) + ["Toggle smileys" gnus-smiley-display t] + ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] + ["HZ" gnus-article-decode-HZ t]) ("Output" - ["Save in default format" gnus-summary-save-article t] - ["Save in file" gnus-summary-save-article-file t] + ["Save in default format" gnus-summary-save-article + ,@(if (featurep 'xemacs) nil + '(:help "Save article using default method"))] + ["Save in file" gnus-summary-save-article-file + ,@(if (featurep 'xemacs) nil + '(:help "Save article in file"))] ["Save in Unix mail format" gnus-summary-save-article-mail t] ["Save in MH folder" gnus-summary-save-article-folder t] ["Save in VM folder" gnus-summary-save-article-vm t] @@ -1725,7 +1827,9 @@ increase the score of each group you read." (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)]) ("Extract" - ["Uudecode" gnus-uu-decode-uu t] + ["Uudecode" gnus-uu-decode-uu + ,@(if (featurep 'xemacs) nil + '(:help "Decode uuencoded article(s)"))] ["Uudecode and save" gnus-uu-decode-uu-and-save t] ["Unshar" gnus-uu-decode-unshar t] ["Unshar and save" gnus-uu-decode-unshar-and-save t] @@ -1745,6 +1849,7 @@ increase the score of each group you read." ["Fetch referenced articles" gnus-summary-refer-references t] ["Fetch current thread" gnus-summary-refer-thread t] ["Fetch article with id..." gnus-summary-refer-article t] + ["Setup Mailing List Params" gnus-mailing-list-insinuate t] ["Redisplay" gnus-summary-show-article t]))) (easy-menu-define gnus-summary-article-menu gnus-summary-mode-map "" @@ -1770,29 +1875,40 @@ increase the score of each group you read." ["Mark thread as read" gnus-summary-kill-thread t] ["Lower thread score" gnus-summary-lower-thread t] ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t] - )) + ["Rethread current" gnus-summary-rethread-current t])) (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" - '("Post" - ["Post an article" gnus-summary-post-news t] - ["Followup" gnus-summary-followup t] - ["Followup and yank" gnus-summary-followup-with-original t] + `("Post" + ["Post an article" gnus-summary-post-news + ,@(if (featurep 'xemacs) nil + '(:help "Post an article"))] + ["Followup" gnus-summary-followup + ,@(if (featurep 'xemacs) nil + '(:help "Post followup to this article"))] + ["Followup and yank" gnus-summary-followup-with-original + ,@(if (featurep 'xemacs) nil + '(:help "Post followup to this article, quoting its contents"))] ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article t] + ["Cancel article" gnus-summary-cancel-article + ,@(if (featurep 'xemacs) nil + '(:help "Cancel an article you posted"))] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ["Wide reply" gnus-summary-wide-reply t] - ["Wide reply and yank" gnus-summary-wide-reply-with-original t] + ["Wide reply and yank" gnus-summary-wide-reply-with-original + ,@(if (featurep 'xemacs) nil + '(:help "Mail a reply, quoting this article"))] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-summary-mail-digest t] - ["Digest and post" gnus-summary-post-digest t] + ["Digest and mail" gnus-uu-digest-mail-forward t] + ["Digest and post" gnus-uu-digest-post-forward t] ["Resend message" gnus-summary-resend-message t] ["Send bounced mail" gnus-summary-resend-bounced-mail t] ["Send a mail" gnus-summary-mail-other-window t] - ["Uuencode and post" gnus-uu-post-news t] + ["Uuencode and post" gnus-uu-post-news + ,@(if (featurep 'xemacs) nil + '(:help "Post a uuencoded article"))] ["Followup via news" gnus-summary-followup-to-mail t] ["Followup via news and yank" gnus-summary-followup-to-mail-with-original t] @@ -1803,13 +1919,15 @@ increase the score of each group you read." (easy-menu-define gnus-summary-misc-menu gnus-summary-mode-map "" - '("Misc" + `("Misc" ("Mark Read" ["Mark as read" gnus-summary-mark-as-read-forward t] ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup t] + ["Catchup" gnus-summary-catchup + ,@(if (featurep 'xemacs) nil + '(:help "Mark unread articles in this group as read"))] ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] ["Catchup region" gnus-summary-mark-region-as-read t] @@ -1859,8 +1977,12 @@ increase the score of each group you read." gnus-newsgroup-process-stack] ["Save" gnus-summary-save-process-mark t])) ("Scroll article" - ["Page forward" gnus-summary-next-page t] - ["Page backward" gnus-summary-prev-page t] + ["Page forward" gnus-summary-next-page + ,@(if (featurep 'xemacs) nil + '(:help "Show next page of article"))] + ["Page backward" gnus-summary-prev-page + ,@(if (featurep 'xemacs) nil + '(:help "Show previous page of article"))] ["Line forward" gnus-summary-scroll-up t]) ("Move" ["Next unread article" gnus-summary-next-unread-article t] @@ -1911,10 +2033,14 @@ increase the score of each group you read." ["Customize group parameters" gnus-summary-customize-parameters t] ["Send a bug report" gnus-bug t] ("Exit" - ["Catchup and exit" gnus-summary-catchup-and-exit t] + ["Catchup and exit" gnus-summary-catchup-and-exit + ,@(if (featurep 'xemacs) nil + '(:help "Mark unread articles in this group as read, then exit"))] ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] - ["Exit group" gnus-summary-exit t] + ["Exit group" gnus-summary-exit + ,@(if (featurep 'xemacs) nil + '(:help "Exit current group, return to group selection mode"))] ["Exit group without updating" gnus-summary-exit-no-update t] ["Exit and goto next group" gnus-summary-next-group t] ["Exit and goto prev group" gnus-summary-prev-group t] @@ -1924,6 +2050,49 @@ increase the score of each group you read." (gnus-run-hooks 'gnus-summary-menu-hook))) +(defvar gnus-summary-tool-bar-map nil) + +;; Emacs 21 tool bar. Should be no-op otherwise. +(defun gnus-summary-make-tool-bar () + (if (and (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-summary-tool-bar-map)) + (setq gnus-summary-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + (tool-bar-add-item-from-menu + 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-post-news "post" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-followup "followup" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-reply "reply" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-save-article "save-art" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-uu-post-news "uu-post" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-catchup "catchup" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-exit "exit-summ" gnus-summary-mode-map) + tool-bar-map))) + (if gnus-summary-tool-bar-map + (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) + (defun gnus-score-set-default (var value) "A version of set that updates the GNU Emacs menu-bar." (set var value) @@ -1994,7 +2163,8 @@ increase the score of each group you read." (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) - (list 'gnus-score-default nil) + (list 'gnus-score-delta-default + nil) (nth 1 (car ps)) t) t) @@ -2031,10 +2201,13 @@ The following commands are available: \\{gnus-summary-mode-map}" (interactive) - (when (gnus-visual-p 'summary-menu 'menu) - (gnus-summary-make-menu-bar)) (kill-all-local-variables) + (when (gnus-visual-p 'summary-menu 'menu) + (gnus-summary-make-menu-bar) + (gnus-summary-make-tool-bar)) (gnus-summary-make-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-make-local-variables)) (gnus-make-thread-indent-array) (gnus-simplify-mode-line) (setq major-mode 'gnus-summary-mode) @@ -2396,12 +2569,13 @@ marks of articles." (defun gnus-restore-hidden-threads-configuration (config) "Restore hidden threads configuration from CONFIG." - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (eq (char-after) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r))))) + (save-excursion + (let (point buffer-read-only) + (while (setq point (pop config)) + (when (and (< point (point-max)) + (goto-char point) + (eq (char-after) ?\n)) + (subst-char-in-region point (1+ point) ?\n ?\r)))))) ;; Various summary mode internalish functions. @@ -2411,9 +2585,10 @@ marks of articles." (gnus-summary-next-page nil t)) (defun gnus-summary-set-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. + "Change the display table. +Odd characters have a tendency to mess +up nicely formatted displays - we make all possible glyphs +display only a single character." ;; We start from the standard display table, if any. (let ((table (or (copy-sequence standard-display-table) @@ -2457,9 +2632,9 @@ marks of articles." t))) (defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. + "Set the global equivalents of the buffer-local variables. +They are set to the latest values they had. These reflect the summary +buffer that was in action when the last article was fetched." (when (eq major-mode 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) @@ -2473,7 +2648,15 @@ marks of articles." (gac gnus-article-current) (reffed gnus-reffed-article-number) (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset)) + (default-charset gnus-newsgroup-charset) + vlist) + (let ((locals gnus-newsgroup-variables)) + (while locals + (if (consp (car locals)) + (push (eval (caar locals)) vlist) + (push (eval (car locals)) vlist)) + (setq locals (cdr locals))) + (setq vlist (nreverse vlist))) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2488,6 +2671,12 @@ marks of articles." gnus-reffed-article-number reffed gnus-current-score-file score-file gnus-newsgroup-charset default-charset) + (let ((locals gnus-newsgroup-variables)) + (while locals + (if (consp (car locals)) + (set (caar locals) (pop vlist)) + (set (car locals) (pop vlist))) + (setq locals (cdr locals)))) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -2600,7 +2789,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) (gnus-tmp-replied @@ -2616,9 +2805,8 @@ marks of articles." (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg)))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -2643,7 +2831,7 @@ marks of articles." (forward-line 1)))) (defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. + "Update summary line after change." (when (and gnus-summary-default-score (not gnus-summary-inhibit-highlight)) (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. @@ -2665,7 +2853,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) 'score)) @@ -2974,7 +3162,8 @@ If SHOW-ALL is non-nil, already read articles are also listed." "Query where the respool algorithm would put this article." (interactive) (gnus-summary-select-article) - (message (gnus-general-simplify-subject (gnus-summary-article-subject)))) + (message "%s" + (gnus-general-simplify-subject (gnus-summary-article-subject)))) (defun gnus-gather-threads-by-subject (threads) "Gather threads by looking at Subject headers." @@ -3048,7 +3237,7 @@ If SHOW-ALL is non-nil, already read articles are also listed." result)) (defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by article number." + "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'." (let ((result threads)) (while threads (when (stringp (caar threads)) @@ -3222,7 +3411,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (mapcar (lambda (relation) (when (gnus-dependencies-add-header - (make-full-mail-header + (make-full-mail-header-from-decoded-header gnus-reffed-article-number (nth 3 relation) "" (or (nth 4 relation) "") (nth 1 relation) @@ -3265,31 +3454,38 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header) ;; overview: [num subject from date id refs chars lines misc] - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - number ; number - (nnheader-nov-field) ; subject - (nnheader-nov-field) ; from - (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id - (nnheader-nov-field) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines - (unless (eobp) - (nnheader-nov-field)) ; misc - (nnheader-nov-parse-extra))) ; extra + (unwind-protect + (progn + (narrow-to-region (point) eol) + (unless (eobp) + (forward-char)) + + (setq header + (make-full-mail-header + number ; number + (nnheader-nov-field) ; subject + (nnheader-nov-field) ; from + (nnheader-nov-field) ; date + (nnheader-nov-read-message-id) ; id + (nnheader-nov-field) ; refs + (nnheader-nov-read-integer) ; chars + (nnheader-nov-read-integer) ; lines + (unless (eobp) + (if (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field)) ; Xref + (nnheader-nov-parse-extra)))) ; extra + + (widen)) (when gnus-alter-header-function (funcall gnus-alter-header-function header)) (gnus-dependencies-add-header header dependencies force-new))) (defun gnus-build-get-header (id) - ;; Look through the buffer of NOV lines and find the header to - ;; ID. Enter this line into the dependencies hash table, and return - ;; the id of the parent article (if any). + "Look through the buffer of NOV lines and find the header to ID. +Enter this line into the dependencies hash table, and return +the id of the parent article (if any)." (let ((deps gnus-newsgroup-dependencies) found header) (prog1 @@ -3371,17 +3567,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (memq article gnus-newsgroup-expirable) ;; Only insert the Subject string when it's different ;; from the previous Subject string. - (if (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - ;; Error on the side of excessive subjects. - (error "")) - (mail-header-subject header)) + (if (and + gnus-show-threads + (gnus-subject-equal + (condition-case () + (mail-header-subject + (gnus-data-header + (cadr + (gnus-data-find-list + article + (gnus-data-list t))))) + ;; Error on the side of excessive subjects. + (error "")) + (mail-header-subject header))) "" (mail-header-subject header)) nil (cdr (assq article gnus-newsgroup-scored)) @@ -3595,7 +3793,6 @@ If LINE, insert the rebuilt thread starting on line LINE." (while thread (gnus-remove-thread-1 (car thread)) (setq thread (cdr thread)))) - (gnus-summary-show-all-threads) (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) @@ -3607,6 +3804,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-remove-thread-1 (pop thread))) (when (setq d (gnus-data-find number)) (goto-char (gnus-data-pos d)) + (gnus-summary-show-thread) (gnus-data-remove number (- (gnus-point-at-bol) @@ -3614,13 +3812,22 @@ If LINE, insert the rebuilt thread starting on line LINE." (1+ (gnus-point-at-eol)) (gnus-delete-line))))))) +(defun gnus-sort-threads-1 (threads func) + (sort (mapcar (lambda (thread) + (cons (car thread) + (and (cdr thread) + (gnus-sort-threads-1 (cdr thread) func)))) + threads) func)) + (defun gnus-sort-threads (threads) "Sort THREADS." (if (not gnus-thread-sort-functions) threads (gnus-message 8 "Sorting threads...") (prog1 - (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) + (gnus-sort-threads-1 + threads + (gnus-make-sort-function gnus-thread-sort-functions)) (gnus-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) @@ -3635,12 +3842,12 @@ If LINE, insert the rebuilt thread starting on line LINE." ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. + "Return header of first article in THREAD. +Note that THREAD must never, ever be anything else than a variable - +using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) @@ -3676,11 +3883,11 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp - (let ((addr (car (mime-read-field 'From h1)))) + (let ((addr (car (mime-entity-read-field h1 'From)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) - (let ((addr (car (mime-read-field 'From h2)))) + (let ((addr (car (mime-entity-read-field h2 'From)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) @@ -3765,7 +3972,7 @@ Unscored articles will be counted as having a score of zero." (defvar gnus-tmp-root-expunged nil) (defvar gnus-tmp-dummy-line nil) -(defvar gnus-tmp-header) +(eval-when-compile (defvar gnus-tmp-header)) (defun gnus-extra-header (type &optional header) "Return the extra header of TYPE." (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header)))) @@ -3968,7 +4175,7 @@ or a straight list of headers." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) gnus-tmp-replied @@ -3986,9 +4193,8 @@ or a straight list of headers." (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (setq beg-match (match-beginning 0)) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg-match))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -4058,13 +4264,17 @@ or a straight list of headers." gnus-list-identifiers (mapconcat 'identity gnus-list-identifiers " *\\|")))) (dolist (header gnus-newsgroup-headers) - (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)") + (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") (mail-header-subject header)) (mail-header-set-subject header (concat (substring (mail-header-subject header) - 0 (match-beginning 2)) + 0 (match-beginning 1)) + (or + (match-string 3 (mail-header-subject header)) + (match-string 5 (mail-header-subject header))) (substring (mail-header-subject header) - (match-end 2)))))))) + (match-end 1)))))))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. @@ -4089,7 +4299,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (progn ; Or we bug out. (when (equal major-mode 'gnus-summary-mode) (kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" + (error "Couldn't activate group %s: %s" group (gnus-status-message group)))) (unless (gnus-request-group group t) @@ -4202,7 +4412,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or gnus-newsgroup-headers t))))) (defun gnus-articles-to-read (group &optional read-all) - ;; Find out what articles the user wants to read. + "Find out what articles the user wants to read." (let* ((articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. @@ -4232,16 +4442,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." ((and (or (<= scored marked) (= scored number)) (natnump gnus-large-newsgroup) (> number gnus-large-newsgroup)) - (let ((input (read-from-minibuffer - (format - "How many articles from %s (max %d): " - (gnus-limit-string gnus-newsgroup-name 35) - number) - (static-if (< emacs-major-version 20) - (number-to-string gnus-large-newsgroup) - (cons - (number-to-string gnus-large-newsgroup) - 0))))) + (let* ((cursor-in-echo-area nil) + (input (read-from-minibuffer + (format + "How many articles from %s (max %d): " + (gnus-limit-string gnus-newsgroup-name 35) + number) + (cons (number-to-string gnus-large-newsgroup) + 0)))) (if (string-match "^[ \t]*$" input) number input))) @@ -4255,7 +4463,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (if (string-match "^[ \t]*$" input) number input))) (t number)) - (quit nil)))))) + (quit + (message "Quit getting the articles to read") + nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) select @@ -4275,6 +4485,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-sorted-intersection gnus-newsgroup-unreads (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (when gnus-alter-articles-to-read-function + (setq gnus-newsgroup-unreads + (sort + (funcall gnus-alter-articles-to-read-function + gnus-newsgroup-name gnus-newsgroup-unreads) + '<))) articles))) (defun gnus-killed-articles (killed articles) @@ -4360,9 +4576,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Add all marks lists to the list of marks lists. (while (setq type (pop types)) (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) + (setq symbol + (intern (format "gnus-newsgroup-%s" + (car type)))))) (when list ;; Get rid of the entries of the articles that have the @@ -4381,30 +4597,36 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq arts (cdr arts))) (setq list (cdr all))))) - (or (memq (cdr type) uncompressed) - (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) - - (when (gnus-check-backend-function 'request-set-mark - gnus-newsgroup-name) - ;; uncompressed:s are not proper flags (they are cons cells) - ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range (gnus-copy-sequence list) old))) - (if add - (push (list add 'add (list (cdr type))) delta-marks)) - (if del - (push (list del 'del (list (cdr type))) delta-marks))))) - + (unless (memq (cdr type) uncompressed) + (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) + + (when (gnus-check-backend-function + 'request-set-mark gnus-newsgroup-name) + ;; propagate flags to server, with the following exceptions: + ;; uncompressed:s are not proper flags (they are cons cells) + ;; cache is a internal gnus flag + ;; download are local to one gnus installation (well) + ;; unsend are for nndraft groups only + ;; xxx: generality of this? this suits nnimap anyway + (unless (memq (cdr type) (append '(cache download unsend) + uncompressed)) + (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) + (del (gnus-remove-from-range (gnus-copy-sequence old) list)) + (add (gnus-remove-from-range + (gnus-copy-sequence list) old))) + (when add + (push (list add 'add (list (cdr type))) delta-marks)) + (when del + (push (list del 'del (list (cdr type))) delta-marks))))) + (when list - (push (cons (cdr type) list) newmarked))) + (push (cons (cdr type) list) newmarked))) (when delta-marks (unless (gnus-check-group gnus-newsgroup-name) (error "Can't open server for %s" gnus-newsgroup-name)) (gnus-request-set-mark gnus-newsgroup-name delta-marks)) - + ;; Enter these new marks into the info of the group. (if (nthcdr 3 info) (setcar (nthcdr 3 info) newmarked) @@ -4420,7 +4642,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr (nthcdr i info) nil))))))) (defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. + "Set the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." ;; Is this mode line one we keep updated? (when (and (memq where gnus-updated-mode-lines) @@ -4436,7 +4658,11 @@ If WHERE is `summary', the summary mode line format will be used." (let* ((mformat (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name gnus-newsgroup-name) + (gnus-tmp-group-name (gnus-group-name-decode + gnus-newsgroup-name + (gnus-group-name-charset + nil + gnus-newsgroup-name))) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) @@ -4673,19 +4899,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) "(none)")) ;; From. (progn (goto-char p) - (if (search-forward "\nfrom: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (if (or (search-forward "\nfrom: " nil t) + (search-forward "\nfrom:" nil t)) + (nnheader-header-value) "(nobody)")) ;; Date. (progn (goto-char p) (if (search-forward "\ndate: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) "")) ;; Message-ID. (progn @@ -4706,7 +4933,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (setq end (point)) (prog1 - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) (setq ref (buffer-substring (progn @@ -4720,9 +4947,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; were no references and the in-reply-to header looks ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to - (buffer-substring (match-end 0) - (std11-field-end))) + (setq in-reply-to (nnheader-header-value)) (string-match "<[^>]+>" in-reply-to)) (let (ref2) (setq ref (substring in-reply-to (match-beginning 0) @@ -4752,7 +4977,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (and (search-forward "\nxref: " nil t) - (buffer-substring (match-end 0) (std11-field-end)))) + (nnheader-header-value))) ;; Extra. (when gnus-extra-headers (let ((extra gnus-extra-headers) @@ -4761,16 +4986,12 @@ The resulting hash table is returned, or nil if no Xrefs were found." (goto-char p) (when (search-forward (concat "\n" (symbol-name (car extra)) ": ") nil t) - (push (cons (car extra) - (buffer-substring (match-end 0) - (std11-field-end))) - out)) + (push (cons (car extra) (nnheader-header-value)) out)) (pop extra)) out)))) (goto-char p) (if (and (search-forward "\ncontent-type: " nil t) - (setq ctype - (buffer-substring (match-end 0) (std11-field-end)))) + (setq ctype (nnheader-header-value))) (mime-entity-set-content-type-internal header (mime-parse-Content-Type ctype))) (when (equal id ref) @@ -4793,8 +5014,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + "Parse the news overview data in the server buffer. +Return a list of headers that match SEQUENCE (see +`nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) @@ -5123,6 +5345,7 @@ If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. + (interactive) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) (t (if (numberp gnus-auto-center-summary) @@ -5140,10 +5363,22 @@ displayed, no centering will be performed." ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. - (set-window-start - window (min bottom (save-excursion - (forward-line (- top)) (point))) - t)) + (let ((top-pos (save-excursion (forward-line (- top)) (point)))) + (if (> bottom top-pos) + ;; Keep the second line from the top visible + (set-window-start window top-pos t) + ;; Try to keep the bottom line visible; if it's partially + ;; obscured, either scroll one more line to make it fully + ;; visible, or revert to using TOP-POS. + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (let ((last-line-start (point))) + (goto-char bottom) + (set-window-start window (point) t) + (when (not (pos-visible-in-window-p last-line-start window)) + (forward-line 1) + (set-window-start window (min (point) top-pos) t))))))) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) (not (eq gnus-auto-center-summary 'vertical))) @@ -5183,7 +5418,10 @@ displayed, no centering will be performed." ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? - (if (not (listp (cdr read))) + (if (and (not (listp (cdr read))) + (or (< (car read) (car active)) + (progn (setq read (list read)) + nil))) (setq first (max (car active) (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) @@ -5240,8 +5478,7 @@ displayed, no centering will be performed." (key-binding (read-key-sequence (substitute-command-keys - "\\\\[gnus-summary-universal-argument]" - )))) + "\\\\[gnus-summary-universal-argument]")))) 'undefined) (gnus-error 1 "Undefined key") (save-excursion @@ -5262,24 +5499,25 @@ With arg, turn line truncation on iff arg is positive." (redraw-display)) (defun gnus-summary-reselect-current-group (&optional all rescan) - "Rescan the current newsgroup, exit and then reselect it. + "Exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." (interactive "P") (when (gnus-ephemeral-group-p gnus-newsgroup-name) (error "Ephemeral groups can't be reselected")) (let ((current-subject (gnus-summary-article-number)) (group gnus-newsgroup-name)) - (save-excursion - (set-buffer gnus-group-buffer) - ;; We have to adjust the point of group mode buffer because - ;; point was moved to the next unread newsgroup by exiting. - (gnus-summary-jump-to-group group) - (when rescan - (save-excursion - (gnus-group-get-new-news-this-group 1)))) (setq gnus-newsgroup-begin nil) (gnus-summary-exit) - (gnus-group-read-group all t group) + ;; We have to adjust the point of group mode buffer because + ;; point was moved to the next unread newsgroup by exiting. + (gnus-summary-jump-to-group group) + (when rescan + (save-excursion + (save-window-excursion + ;; Don't show group contents. + (set-window-start (selected-window) (point-max)) + (gnus-group-get-new-news-this-group 1)))) + (gnus-group-read-group all t) (gnus-summary-goto-subject current-subject nil t))) (defun gnus-summary-rescan-group (&optional all) @@ -5339,7 +5577,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. -gnus-exit-group-hook is called with no arguments if that value is non-nil." +`gnus-exit-group-hook' is called with no arguments if that value is non-nil." (interactive) (gnus-set-global-variables) (gnus-kill-save-kill-buffer) @@ -5368,6 +5606,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-dup-enter-articles)) (when gnus-use-trees (gnus-tree-close group)) + (when gnus-use-cache + (gnus-cache-write-active)) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) ;; Make all changes in this group permanent. @@ -5401,12 +5641,16 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." ;; not garbage-collected, it seems. This would the lead to en ;; ever-growing Emacs. (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) ;; Return to group mode buffer. (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) @@ -5415,7 +5659,14 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (if (not quit-config) (progn (goto-char group-point) - (gnus-configure-windows 'group 'force)) + (gnus-configure-windows 'group 'force) + (unless (pos-visible-in-window-p) + (forward-line (/ (static-if (featurep 'xemacs) + (window-displayed-height) + (1- (window-height))) + -2)) + (set-window-start (selected-window) (point)) + (goto-char group-point))) (gnus-handle-ephemeral-exit quit-config)) ;; Clear the current group name. (unless quit-config @@ -5443,8 +5694,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-deaden-summary) (gnus-close-group group) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (when (get-buffer gnus-summary-buffer) (kill-buffer gnus-summary-buffer))) (unless gnus-single-article-buffer @@ -5549,7 +5804,8 @@ The state which existed when entering the ephemeral is reset." (rename-buffer (concat (substring name 0 (match-beginning 0)) "Dead " (substring name (match-beginning 0))) - t)))) + t) + (bury-buffer)))) (defun gnus-kill-or-deaden-summary (buffer) "Kill or deaden the summary BUFFER." @@ -5716,8 +5972,8 @@ returned." (if backward (gnus-summary-find-prev unread) (gnus-summary-find-next unread))) - (gnus-summary-show-thread) - (setq n (1- n))) + (unless (zerop (setq n (1- n))) + (gnus-summary-show-thread))) (when (/= 0 n) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) @@ -5778,7 +6034,14 @@ Given a prefix, will force an `article' buffer configuration." (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (mm-enable-multibyte-mule4))) (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))) (if (null article) nil (prog1 @@ -5811,39 +6074,40 @@ be displayed." (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. - gnus-summary-display-article-function - did) + gnus-summary-display-article-function) (and (not pseudo) (gnus-summary-article-pseudo-p article) (error "This is a pseudo-article")) - (prog1 - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (prog1 - (gnus-summary-display-article article all-headers) - (setq did article) - (when (or all-headers gnus-show-all-headers) - (if (eq 'gnus-summary-toggle-mime this-command) - (gnus-article-show-all) - (gnus-article-show-all-headers)))) + (save-excursion + (set-buffer gnus-summary-buffer) + (if (or (and gnus-single-article-buffer + (or (null gnus-current-article) + (null gnus-article-current) + (null (get-buffer gnus-article-buffer)) + (not (eq article (cdr gnus-article-current))) + (not (equal (car gnus-article-current) + gnus-newsgroup-name)))) + (and (not gnus-single-article-buffer) + (or (null gnus-current-article) + (not (eq gnus-current-article article)))) + force) + ;; The requested article is different from the current article. + (progn + (gnus-summary-display-article article all-headers) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) - 'old)) - (when did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) + (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)) + 'old)))) + +(defun gnus-summary-force-verify-and-decrypt () + (interactive) + (let ((mm-verify-option 'known) + (mm-decrypt-option 'known)) + (gnus-summary-select-article nil 'force))) (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." @@ -6262,7 +6526,7 @@ articles that are younger than AGE days." (while (not days-got) (setq days (if younger (read-string "Limit to articles within (in days): ") - (read-string "Limit to articles old than (in days): "))) + (read-string "Limit to articles older than (in days): "))) (when (> (length days) 0) (setq days (read days))) (if (numberp days) @@ -6295,12 +6559,12 @@ articles that are younger than AGE days." (let ((header (intern (gnus-completing-read - (symbol-name (car gnus-extra-headers)) - "Limit extra header:" - (mapcar (lambda (x) + (symbol-name (car gnus-extra-headers)) + "Limit extra header:" + (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) - nil + nil t)))) (list header (read-string (format "Limit to header %s (regexp): " header))))) @@ -6796,15 +7060,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." (t ;; We fetch the article. (catch 'found - (dolist (gnus-override-method - (cond ((null gnus-refer-article-method) - (list 'current gnus-select-method)) - ((consp (car gnus-refer-article-method)) - gnus-refer-article-method) - (t - (list gnus-refer-article-method)))) - (when (eq 'current gnus-override-method) - (setq gnus-override-method gnus-current-select-method)) + (dolist (gnus-override-method (gnus-refer-article-methods)) (gnus-check-server gnus-override-method) ;; Fetch the header, and display the article. (when (setq number (gnus-summary-insert-subject message-id)) @@ -6812,6 +7068,29 @@ of what's specified by the `gnus-refer-thread-limit' variable." (throw 'found t))) (gnus-message 3 "Couldn't fetch article %s" message-id))))))) +(defun gnus-refer-article-methods () + "Return a list of referrable methods." + (cond + ;; No method, so we default to current and native. + ((null gnus-refer-article-method) + (list gnus-current-select-method gnus-select-method)) + ;; Current. + ((eq 'current gnus-refer-article-method) + (list gnus-current-select-method)) + ;; List of select methods. + ((not (and (symbolp (car gnus-refer-article-method)) + (assq (car gnus-refer-article-method) nnoo-definition-alist))) + (let (out) + (dolist (method gnus-refer-article-method) + (push (if (eq 'current method) + gnus-current-select-method + method) + out)) + (nreverse out))) + ;; One single select method. + (t + (list gnus-refer-article-method)))) + (defun gnus-summary-edit-parameters () "Edit the group parameters of the current group." (interactive) @@ -6843,8 +7122,17 @@ to guess what the document format is." (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) - dig) + dig to-address) (save-excursion + (set-buffer gnus-original-article-buffer) + ;; Have the digest group inherit the main mail address of + ;; the parent article. + (when (setq to-address (or (message-fetch-field "reply-to") + (message-fetch-field "from"))) + (setq params (append + (list (cons 'to-address + (funcall gnus-decode-encoded-word-function + to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) ;; Remove lines that may lead nndoc to misinterpret the @@ -6951,10 +7239,14 @@ If BACKWARD, search backward instead." current-prefix-arg)) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) - (setq gnus-last-search-regexp regexp)) - (if (gnus-summary-search-article regexp backward) - (gnus-summary-show-thread) - (error "Search failed: \"%s\"" regexp))) + (setq gnus-last-search-regexp regexp) + (setq gnus-article-before-search gnus-current-article)) + ;; Intentionally set gnus-last-article. + (setq gnus-last-article gnus-article-before-search) + (let ((gnus-last-article gnus-last-article)) + (if (gnus-summary-search-article regexp backward) + (gnus-summary-show-thread) + (error "Search failed: \"%s\"" regexp)))) (defun gnus-summary-search-article-backward (regexp) "Search for an article containing REGEXP backward." @@ -6995,11 +7287,11 @@ If BACKWARD, search backward instead." (goto-char (, opoint))))) (` (let ((end (if (search-forward "\n\n" nil t) (goto-char (1- (point))) - (point-min)))) + (point-min))) + (start (or (search-backward "\n\n" nil t) (point-min)))) (goto-char - (or (text-property-any (or (search-backward "\n\n" nil t) - (point-min)) - end 'x-face-mule-bitmap-image t) + (or (text-property-any start end 'x-face-image t);; x-face-e21 + (text-property-any start end 'x-face-mule-bitmap-image t) (, opoint))))))) (defmacro gnus-summary-search-article-highlight-matched-text @@ -7262,12 +7554,42 @@ to save in." (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. -If ARG (the prefix) is non-nil, show the raw article without any -article massaging functions being run." +If ARG (the prefix) is a number, show the article with the charset +defined in `gnus-summary-show-article-charset-alist', or the charset +inputed. +If ARG (the prefix) is non-nil and not a number, show the raw article +without any article massaging functions being run." (interactive "P") - (if (not arg) - ;; Select the article the normal way. + (cond + ((numberp arg) + (let ((gnus-newsgroup-charset + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: "))) + (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) + (let ((deps gnus-newsgroup-dependencies) + head header) + (save-excursion + (set-buffer gnus-original-article-buffer) + (save-restriction + (message-narrow-to-head) + (setq head (buffer-string))) + (with-temp-buffer + (insert (format "211 %d Article retrieved.\n" + (cdr gnus-article-current))) + (insert head) + (insert ".\n") + (let ((nntp-server-buffer (current-buffer))) + (setq header (car (gnus-get-newsgroup-headers deps t)))))) + (gnus-data-set-header + (gnus-data-find (cdr gnus-article-current)) + header) + (gnus-summary-update-article-line + (cdr gnus-article-current) header)))) + ((not arg) + ;; Select the article the normal way. + (gnus-summary-select-article nil 'force)) + (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -7278,9 +7600,8 @@ article massaging functions being run." gnus-article-prepare-hook gnus-article-decode-hook gnus-break-pages - gnus-show-mime - gnus-visual) - (gnus-summary-select-article nil 'force))) + gnus-show-mime) + (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -7311,7 +7632,7 @@ If ARG is a negative number, hide the unwanted header lines." (setq hidden (if (numberp arg) (>= arg 0) - (save-restriction + (save-restriction (article-narrow-to-head) (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) @@ -7329,8 +7650,11 @@ If ARG is a negative number, hide the unwanted header lines." (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) + (setq gnus-article-wash-types + (delq 'headers gnus-article-wash-types)) (gnus-treat-article 'head)) - (gnus-treat-article 'head))))))) + (gnus-treat-article 'head))) + (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -7387,7 +7711,9 @@ re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' -and `request-accept' functions." +and `request-accept' functions. + +ACTION can be either `move' (the default), `crosspost' or `copy'." (interactive "P") (unless action (setq action 'move)) @@ -7405,7 +7731,10 @@ and `request-accept' functions." 'request-replace-article gnus-newsgroup-name))) (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) + (prefix (if (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name) + (gnus-group-real-prefix gnus-newsgroup-name) + "")) (names '((move "Move" "Moving") (copy "Copy" "Copying") (crosspost "Crosspost" "Crossposting"))) @@ -7427,7 +7756,8 @@ and `request-accept' functions." articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) (setq to-method (or select-method - (gnus-group-name-to-method to-newsgroup))) + (gnus-server-to-method + (gnus-group-method to-newsgroup)))) ;; Check the method we are to move this article to... (unless (gnus-check-backend-function 'request-accept-article (car to-method)) @@ -7453,7 +7783,7 @@ and `request-accept' functions." gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) - (not articles) t) ; Accept form + (not articles) t) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) @@ -7494,13 +7824,13 @@ and `request-accept' functions." art-group)))))) (cond ((not art-group) - (gnus-message 1 "Couldn't %s article %s: %s" - (cadr (assq action names)) article - (nnheader-get-report (car to-method)))) - ((and (eq art-group 'junk) - (eq action 'move)) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article)) + (gnus-message 1 "Couldn't %s article %s: %s" + (cadr (assq action names)) article + (nnheader-get-report (car to-method)))) + ((eq art-group 'junk) + (when (eq action 'move) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) @@ -7521,13 +7851,14 @@ and `request-accept' functions." info (gnus-add-to-range (gnus-info-read info) (list (cdr art-group))))) - ;; Copy any marks over to the new group. + ;; See whether the article is to be put in the cache. (let ((marks (if (gnus-group-auto-expirable-p to-group) default-marks no-expire-marks)) (to-article (cdr art-group))) - ;; See whether the article is to be put in the cache. + ;; Enter the article into the cache in the new group, + ;; if that is required. (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article @@ -7539,34 +7870,36 @@ and `request-accept' functions." (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - (push (cdar marks) to-marks) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info)) - (setq marks (cdr marks))) - - (gnus-request-set-mark to-group (list (list (list to-article) - 'set - to-marks))) + (when gnus-preserve-marks + ;; Copy any marks over to the new group. + (when (and (equal to-group gnus-newsgroup-name) + (not (memq article gnus-newsgroup-unreads))) + ;; Mark this article as read in this group. + (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) + (setcdr (gnus-active to-group) to-article) + (setcdr gnus-newsgroup-active to-article)) + + (while marks + (when (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))) + (push (cdar marks) to-marks) + ;; If the other group is the same as this group, + ;; then we have to add the mark to the list. + (when (equal to-group gnus-newsgroup-name) + (set (intern (format "gnus-newsgroup-%s" (caar marks))) + (cons to-article + (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))))) + ;; Copy the marks to other group. + (gnus-add-marked-articles + to-group (cdar marks) (list to-article) info)) + (setq marks (cdr marks))) + + (gnus-request-set-mark to-group (list (list (list to-article) + 'set + to-marks)))) (gnus-dribble-enter (concat "(gnus-group-set-info '" @@ -7697,12 +8030,11 @@ latter case, they will be copied into the relevant groups." (kill-buffer (current-buffer))))) (defun gnus-summary-article-posted-p () - "Say whether the current (mail) article is available from `gnus-select-method' as well. + "Say whether the current (mail) article is available from news as well. This will be the case if the article has both been mailed and posted." (interactive) (let ((id (mail-header-references (gnus-summary-article-header))) - (gnus-override-method - (or gnus-refer-article-method gnus-select-method))) + (gnus-override-method (car (gnus-refer-article-methods)))) (if (gnus-request-head id "") (gnus-message 2 "The current message was found on %s" gnus-override-method) @@ -7730,6 +8062,9 @@ This will be the case if the article has both been mailed and posted." (expiry-wait (if now 'immediate (gnus-group-find-parameter gnus-newsgroup-name 'expiry-wait))) + (nnmail-expiry-target + (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target) + nnmail-expiry-target)) es) (when expirable ;; There are expirable articles in this group, so we run them @@ -7745,19 +8080,19 @@ This will be the case if the article has both been mailed and posted." (setq es (gnus-request-expire-articles expirable gnus-newsgroup-name))) (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name)))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable))))) + expirable gnus-newsgroup-name))) + (unless total + (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (while expirable + (unless (memq (car expirable) es) + (when (gnus-data-find (car expirable)) + (gnus-summary-mark-article + (car expirable) gnus-canceled-mark))) + (setq expirable (cdr expirable)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -7784,6 +8119,8 @@ delete these instead." (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion")) + (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) + (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) not-deleted) @@ -7829,6 +8166,8 @@ groups." 'ignore `(lambda (no-highlight) (let ((mail-parse-charset ',gnus-newsgroup-charset) + (message-options message-options) + (message-options-set-recipient) (mail-parse-ignored-charsets ',gnus-newsgroup-ignored-charsets)) (gnus-summary-edit-article-done @@ -7841,10 +8180,31 @@ groups." no-highlight) "Make edits to the current article permanent." (interactive) + (save-excursion + ;; The buffer restriction contains the entire article if it exists. + (when (article-goto-body) + (let ((lines (count-lines (point) (point-max))) + (length (- (point-max) (point))) + (case-fold-search t) + (body (copy-marker (point)))) + (goto-char (point-min)) + (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string length))) + (goto-char (point-min)) + (when (re-search-forward + "^x-content-length:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string length))) + (goto-char (point-min)) + (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string lines)))))) ;; Replace the article. (let ((buf (current-buffer))) (with-temp-buffer (insert-buffer-substring buf) + (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) @@ -8130,7 +8490,8 @@ the actual number of articles marked is returned." "Mark N articles as read forwards. If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is -returned." +returned. +Iff NO-EXPIRE, auto-expiry will be inhibited." (interactive "p") (gnus-summary-show-thread) (let ((backward (< n 0)) @@ -8223,7 +8584,8 @@ Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?r' is used. If ARTICLE is nil, then the article on the current line will be -marked." +marked. +Iff NO-EXPIRE, auto-expiry will be inhibited." ;; The mark might be a string. (when (stringp mark) (setq mark (aref mark 0))) @@ -8593,6 +8955,37 @@ read." (gnus-summary-catchup all)) (gnus-summary-next-group)) +;;; +;;; with article +;;; + +(defmacro gnus-with-article (article &rest forms) + "Select ARTICLE and perform FORMS in the original article buffer. +Then replace the article with the result." + `(progn + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil ,article)) + (set-buffer gnus-original-article-buffer) + ,@forms + (if (not (gnus-check-backend-function + 'request-replace-article (car gnus-article-current))) + (gnus-message 5 "Read-only group; not replacing") + (unless (gnus-request-replace-article + ,article (car gnus-article-current) + (current-buffer) t) + (error "Couldn't replace article"))) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))))) + +(put 'gnus-with-article 'lisp-indent-function 1) +(put 'gnus-with-article 'edebug-form-spec '(form body)) + ;; Thread-based commands. (defun gnus-summary-articles-in-thread (&optional article) @@ -8671,14 +9064,16 @@ is non-nil or the Subject: of both articles are the same." (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) (gnus-with-article current-article - (goto-char (point-min)) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n"))) + (save-restriction + (goto-char (point-min)) + (message-narrow-to-head) + (if (re-search-forward "^References: " nil t) + (progn + (re-search-forward "^[^ \t]" nil t) + (forward-line -1) + (end-of-line) + (insert " " message-id)) + (insert "References: " message-id "\n")))) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) @@ -8753,9 +9148,7 @@ Returns nil if no threads were there to be hidden." (subst-char-in-region start (point) ?\n ?\^M) (gnus-summary-goto-subject article)) (goto-char start) - nil) - ;;(gnus-summary-position-point) - )))) + nil))))) (defun gnus-summary-go-to-next-thread (&optional previous) "Go to the same level (or less) next thread. @@ -8887,14 +9280,14 @@ Argument REVERSE means reverse order." (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'subject reverse)) @@ -8921,7 +9314,7 @@ Argument REVERSE means reverse order." "Sort the summary buffer by article length. Argument REVERSE means reverse order." (interactive "P") - (gnus-summary-sort 'chars reverse)) + (gnus-summary-sort 'chars reverse)) (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." @@ -8932,6 +9325,8 @@ Argument REVERSE means reverse order." thread `(lambda (t1 t2) (,thread t2 t1)))) + (gnus-sort-gathered-threads-function + gnus-thread-sort-functions) (gnus-article-sort-functions (if (not reverse) article @@ -9065,7 +9460,7 @@ save those articles instead." (set-buffer gnus-original-article-buffer) (save-restriction (nnheader-narrow-to-headers) - (while methods + (while (and methods (not split-name)) (goto-char (point-min)) (setq method (pop methods)) (setq match (car method)) @@ -9084,7 +9479,7 @@ save those articles instead." (save-restriction (widen) (setq result (eval match))))) - (setq split-name (append (cdr method) split-name)) + (setq split-name (cdr method)) (cond ((stringp result) (push (expand-file-name result gnus-article-save-directory) @@ -9129,7 +9524,8 @@ save those articles instead." (mapcar (lambda (el) (list el)) (nreverse split-name)) nil nil nil - 'gnus-group-history))))) + 'gnus-group-history)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) @@ -9137,25 +9533,29 @@ save those articles instead." (unless to-newsgroup (error "No group name entered")) (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) + (gnus-activate-group to-newsgroup nil nil to-method) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) + (or (and (gnus-request-create-group to-newsgroup to-method) (gnus-activate-group - to-newsgroup nil nil - (gnus-group-name-to-method to-newsgroup)) + to-newsgroup nil nil to-method) (gnus-subscribe-group to-newsgroup)) (error "Couldn't create group %s" to-newsgroup))) (error "No such group: %s" to-newsgroup))) to-newsgroup)) -(defun gnus-summary-save-parts (type dir n reverse) +(defun gnus-summary-save-parts (type dir n &optional reverse) "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive - (list (read-string "Save parts of type: " "image/.*") - (read-file-name "Save to directory: " t nil t) + (list (read-string "Save parts of type: " + (or (car gnus-summary-save-parts-type-history) + gnus-summary-save-parts-default-mime) + 'gnus-summary-save-parts-type-history) + (setq gnus-summary-save-parts-last-directory + (read-file-name "Save to directory: " + gnus-summary-save-parts-last-directory + nil t)) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) @@ -9163,10 +9563,12 @@ If REVERSE, save parts that do not match TYPE." (gnus-summary-select-article)) (save-excursion (set-buffer gnus-article-buffer) - (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (let ((handles (or gnus-article-mime-handles + (mm-dissect-buffer) (mm-uu-dissect)))) (when handles (gnus-summary-save-parts-1 type dir handles reverse) - (mm-destroy-parts handles)))))) + (unless gnus-article-mime-handles ;; Don't destroy this case. + (mm-destroy-parts handles))))))) (defun gnus-summary-save-parts-1 (type dir handle reverse) (if (stringp (car handle)) @@ -9180,7 +9582,9 @@ If REVERSE, save parts that do not match TYPE." (or (mail-content-type-get (mm-handle-disposition handle) 'filename) - (concat gnus-newsgroup-name "." gnus-current-article))) + (concat gnus-newsgroup-name + "." (number-to-string + (cdr gnus-article-current))))) dir))) (unless (file-exists-p file) (mm-save-part-to-file handle file)))))) @@ -9297,8 +9701,10 @@ If REVERSE, save parts that do not match TYPE." "Read the headers of article ID and enter them into the Gnus system." (let ((group gnus-newsgroup-name) (gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) + (or + gnus-override-method + (and (gnus-news-group-p gnus-newsgroup-name) + (car (gnus-refer-article-methods))))) where) ;; First we check to see whether the header in question is already ;; fetched. @@ -9372,8 +9778,8 @@ If REVERSE, save parts that do not match TYPE." ;;; (defun gnus-highlight-selected-summary () + "Highlight selected article in summary buffer." ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer (when gnus-summary-selected-face (save-excursion (let* ((beg (progn (beginning-of-line) (point))) @@ -9468,23 +9874,32 @@ If REVERSE, save parts that do not match TYPE." (if compute read (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-group-update-group ,group t)))) - ;; Propagate the read marks to the backend. - (if (gnus-check-backend-function 'request-set-mark group) - (let ((del (gnus-remove-from-range (gnus-info-read info) read)) - (add (gnus-remove-from-range read (gnus-info-read info)))) - (when (or add del) - (unless (gnus-check-group group) - (error "Can't open server for %s" group)) - (gnus-request-set-mark - group (delq nil (list (if add (list add 'add '(read))) - (if del (list del 'del '(read))))))))) + (let (setmarkundo) + ;; Propagate the read marks to the backend. + (when (gnus-check-backend-function 'request-set-mark group) + (let ((del (gnus-remove-from-range (gnus-info-read info) read)) + (add (gnus-remove-from-range read (gnus-info-read info)))) + (when (or add del) + (unless (gnus-check-group group) + (error "Can't open server for %s" group)) + (gnus-request-set-mark + group (delq nil (list (if add (list add 'add '(read))) + (if del (list del 'del '(read)))))) + (setq setmarkundo + `(gnus-request-set-mark + ,group + ',(delq nil (list + (if del (list del 'add '(read))) + (if add (list add 'del '(read)))))))))) + (set-buffer gnus-group-buffer) + (gnus-undo-register + `(progn + (gnus-info-set-marks ',info ',(gnus-info-marks info) t) + (gnus-info-set-read ',info ',(gnus-info-read info)) + (gnus-get-unread-articles-in-group ',info + (gnus-active ,group)) + (gnus-group-update-group ,group t) + ,setmarkundo)))) ;; Enter this list into the group info. (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. @@ -9553,40 +9968,31 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-mime-extract-message/rfc822 (entity situation) (let (group article num cwin swin cur) - (with-current-buffer (mime-entity-buffer entity) - (save-restriction - (narrow-to-region (mime-entity-body-start entity) - (mime-entity-body-end entity)) - (setq group (or (cdr (assq 'group situation)) - (completing-read "Group: " - gnus-active-hashtb - nil - (gnus-read-active-file-p) - gnus-newsgroup-name)) - article (gnus-request-accept-article group) - ) - )) + (with-temp-buffer + (mime-insert-entity-content entity) + (setq group (or (cdr (assq 'group situation)) + (completing-read "Group: " + gnus-active-hashtb + nil + (gnus-read-active-file-p) + gnus-newsgroup-name)) + article (gnus-request-accept-article group))) (when (and (consp article) (numberp (setq article (cdr article)))) (setq num (1+ (or (cdr (assq 'number situation)) 0)) - cwin (get-buffer-window (current-buffer) t) - ) + cwin (get-buffer-window (current-buffer) t)) (save-window-excursion (if (setq swin (get-buffer-window gnus-summary-buffer t)) (select-window swin) - (set-buffer gnus-summary-buffer) - ) + (set-buffer gnus-summary-buffer)) (setq cur gnus-current-article) (forward-line num) (let (gnus-show-threads) - (gnus-summary-goto-subject article t) - ) + (gnus-summary-goto-subject article t)) (gnus-summary-clear-mark-forward 1) - (gnus-summary-goto-subject cur) - ) + (gnus-summary-goto-subject cur)) (when (and cwin (window-frame cwin)) - (select-frame (window-frame cwin)) - ) + (select-frame (window-frame cwin))) (when (boundp 'mime-acting-situation-to-override) (set-alist 'mime-acting-situation-to-override 'group @@ -9596,15 +10002,11 @@ If REVERSE, save parts that do not match TYPE." `(progn (save-current-buffer (set-buffer gnus-group-buffer) - (gnus-activate-group ,group) - ) + (gnus-activate-group ,group)) (gnus-summary-goto-article ,cur - gnus-show-all-headers) - )) + gnus-show-all-headers))) (set-alist 'mime-acting-situation-to-override - 'number num) - ) - ))) + 'number num))))) (mime-add-condition 'action '((type . message)(subtype . rfc822) @@ -9632,7 +10034,7 @@ If REVERSE, save parts that do not match TYPE." (if (setq f (cdr (assq 'after-method mime-acting-situation-to-override))) (eval f) - ))) + ))) (mime-add-condition 'action '((type . multipart) @@ -9649,39 +10051,38 @@ If REVERSE, save parts that do not match TYPE." "Setup newsgroup default charset." (if (equal gnus-newsgroup-name "nndraft:drafts") (setq gnus-newsgroup-charset nil) - (let* ((name (and gnus-newsgroup-name - (gnus-group-real-name gnus-newsgroup-name))) - (ignored-charsets - (or gnus-newsgroup-ephemeral-ignored-charsets - (append - (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name - 'ignored-charsets t) - (let ((alist gnus-group-ignored-charsets-alist) - elem (charsets nil)) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - charsets (cdr elem)))) - charsets)))) - gnus-newsgroup-ignored-charsets))) - (setq gnus-newsgroup-charset - (or gnus-newsgroup-ephemeral-charset - (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name - 'charset) - (let ((alist gnus-group-charset-alist) - elem (charset nil)) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - charset (cadr elem)))) - charset))) - gnus-default-charset)) - (set (make-local-variable 'gnus-newsgroup-ignored-charsets) - ignored-charsets)))) + (let* ((name (and gnus-newsgroup-name + (gnus-group-real-name gnus-newsgroup-name))) + (ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name + 'ignored-charsets t) + (let ((alist gnus-group-ignored-charsets-alist) + elem (charsets nil)) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charsets (cdr elem)))) + charsets))) + gnus-newsgroup-ignored-charsets)))) + (setq gnus-newsgroup-charset + (or gnus-newsgroup-ephemeral-charset + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name 'charset) + (let ((alist gnus-group-charset-alist) + elem charset) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charset (cadr elem)))) + charset))) + gnus-default-charset)) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + ignored-charsets)))) ;;; ;;; Mime Commands @@ -9702,17 +10103,17 @@ treated as multipart/mixed." (interactive (list (gnus-summary-article-number))) (gnus-with-article article (message-narrow-to-head) + (message-remove-header "Mime-Version") (goto-char (point-max)) + (insert "Mime-Version: 1.0\n") (widen) (when (search-forward "\n--" nil t) (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) (message-narrow-to-head) - (message-remove-header "Mime-Version") (message-remove-header "Content-Type") (goto-char (point-max)) (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" separator)) - (insert "Mime-Version: 1.0\n") (widen)))) (let (gnus-mark-article-hook) (gnus-summary-select-article t t nil article))) @@ -9769,15 +10170,13 @@ treated as multipart/mixed." 'gnus-wheel-edge (* (1+ edge) direction)) nil)) - (eq last-command 'gnus-wheel-summary-scroll)) - )) - (gnus-summary-next-article nil nil (minusp direction))) - )) + (eq last-command 'gnus-wheel-summary-scroll)))) + (gnus-summary-next-article nil nil (minusp direction))))) (defun gnus-wheel-install () "Enable mouse wheel support on summary window." (when gnus-use-wheel - (let ((keys + (let ((keys '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)]))) (dolist (key keys) (define-key gnus-summary-mode-map key @@ -9786,35 +10185,46 @@ treated as multipart/mixed." (add-hook 'gnus-summary-mode-hook 'gnus-wheel-install) ;;; -;;; with article +;;; Traditional PGP commmands ;;; -(defmacro gnus-with-article (article &rest forms) - "Select ARTICLE and perform FORMS in the original article buffer. -Then replace the article with the result." - `(progn - ;; We don't want the article to be marked as read. - (let (gnus-mark-article-hook) - (gnus-summary-select-article t t nil ,article)) - (set-buffer gnus-original-article-buffer) - ,@forms - (if (not (gnus-check-backend-function - 'request-replace-article (car gnus-article-current))) - (gnus-message 5 "Read-only group; not replacing") - (unless (gnus-request-replace-article - ,article (car gnus-article-current) - (current-buffer) t) - (error "Couldn't replace article"))) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))))) +(defun gnus-summary-decrypt-article (&optional force) + "Decrypt the current article in traditional PGP way. +This will have permanent effect only in mail groups. +If FORCE is non-nil, allow editing of articles even in read-only +groups." + (interactive "P") + (gnus-summary-select-article t) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (unless (re-search-forward (car pgg-armor-header-lines) nil t) + (error "Not a traditional PGP message!")) + (let ((armor-start (match-beginning 0))) + (if (and (pgg-decrypt-region armor-start (point-max)) + (or force (not (gnus-group-read-only-p)))) + (let ((inhibit-read-only t) + buffer-read-only) + (delete-region armor-start + (progn + (re-search-forward "^-+END PGP" nil t) + (beginning-of-line 2) + (point))) + (insert-buffer-substring pgg-output-buffer)))))))) -(put 'gnus-with-article 'lisp-indent-function 1) -(put 'gnus-with-article 'edebug-form-spec '(form body)) +(defun gnus-summary-verify-article () + "Verify the current article in traditional PGP way." + (interactive) + (save-excursion + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (unless (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE" nil t) + (error "Not a traditional PGP message!")) + (re-search-forward "^-+END PGP" nil t) + (beginning-of-line 2) + (call-interactively (function pgg-verify-region)))) ;;; ;;; Generic summary marking commands @@ -9848,8 +10258,8 @@ Then replace the article with the result." mark (car lway) lway name))) (setq func (eval func)) (define-key map (nth 4 lway) func))))) - -(defun gnus-summary-make-marking-command-1 (mark way lway name) + +(defun gnus-summary-make-marking-command-1 (mark way lway name) `(defun ,(intern (format "gnus-summary-put-mark-as-%s%s" name (if (eq way 'nomove) @@ -9865,7 +10275,7 @@ returned." name (car (cdr lway))) (interactive "p") (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) - + (defun gnus-summary-generic-mark (n mark move unread) "Mark N articles with MARK." (unless (eq major-mode 'gnus-summary-mode) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index d86f573..1181d67 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,6 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Ilja Weis ;; Lars Magne Ingebrigtsen @@ -27,6 +28,8 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'gnus) (require 'gnus-group) (require 'gnus-start) @@ -190,8 +193,9 @@ If TOPIC, start with that topic." (beginning-of-line) (get-text-property (point) 'gnus-active))) -(defun gnus-topic-find-groups (topic &optional level all lowest) - "Return entries for all visible groups in TOPIC." +(defun gnus-topic-find-groups (topic &optional level all lowest recursive) + "Return entries for all visible groups in TOPIC. +If RECURSIVE is t, return groups in its subtopics too." (let ((groups (cdr (assoc topic gnus-topic-alist))) info clevel unread group params visible-groups entry active) (setq lowest (or lowest 1)) @@ -221,7 +225,7 @@ If TOPIC, start with that topic." (> unread 0)) (and gnus-list-groups-with-ticked-articles (cdr (assq 'tick (gnus-info-marks info)))) - ; Has right readedness. + ;; Has right readedness. ;; Check for permanent visibility. (and gnus-permanently-visible-groups (string-match gnus-permanently-visible-groups group)) @@ -229,7 +233,18 @@ If TOPIC, start with that topic." (cdr (assq 'visible params))) ;; Add this group to the list of visible groups. (push (or entry group) visible-groups))) - (nreverse visible-groups))) + (setq visible-groups (nreverse visible-groups)) + (when recursive + (if (eq recursive t) + (setq recursive (cdr (gnus-topic-find-topology topic)))) + (mapcar (lambda (topic-topology) + (setq visible-groups + (nconc visible-groups + (gnus-topic-find-groups + (caar topic-topology) + level all lowest topic-topology)))) + (cdr recursive))) + visible-groups)) (defun gnus-topic-previous-topic (topic) "Return the previous topic on the same level as TOPIC." @@ -370,15 +385,19 @@ If TOPIC, start with that topic." ;;; Generating group buffers -(defun gnus-group-prepare-topics (level &optional all lowest +(defun gnus-group-prepare-topics (level &optional predicate lowest regexp list-topic topic-level) "List all newsgroups with unread articles of level LEVEL or lower. Use the `gnus-group-topics' to sort the groups. -If ALL is non-nil, list groups that have no unread articles. +If PREDICTE is a function, list groups that the function returns non-nil; +if it is t, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (set-buffer gnus-group-buffer) (let ((buffer-read-only nil) - (lowest (or lowest 1))) + (lowest (or lowest 1)) + (not-in-list + (and gnus-group-listed-groups + (copy-sequence gnus-group-listed-groups)))) (when (or (not gnus-topic-alist) (not gnus-topology-checked-p)) @@ -388,48 +407,60 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (erase-buffer)) ;; List dead groups? - (when (and (>= level gnus-level-zombie) - (<= lowest gnus-level-zombie)) + (when (or gnus-group-listed-groups + (and (>= level gnus-level-zombie) + (<= lowest gnus-level-zombie))) (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) - (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)) + (when (or gnus-group-listed-groups + (and (>= level gnus-level-killed) + (<= lowest gnus-level-killed))) (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) + (gnus-union + (and not-in-list + (gnus-delete-if (lambda (group) + (< (gnus-group-level group) gnus-level-killed)) + not-in-list)) + (setq gnus-killed-list (sort gnus-killed-list 'string<))) gnus-level-killed ?K regexp)) ;; Use topics. (prog1 - (when (< lowest gnus-level-zombie) + (when (or (< lowest gnus-level-zombie) + gnus-group-listed-groups) (if list-topic (let ((top (gnus-topic-find-topology list-topic))) (gnus-topic-prepare-topic (cdr top) (car top) - (or topic-level level) all - nil lowest)) + (or topic-level level) predicate + nil lowest regexp)) (gnus-topic-prepare-topic gnus-topic-topology 0 - (or topic-level level) all - nil lowest))) - + (or topic-level level) predicate + nil lowest regexp))) (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) + (setq gnus-group-list-mode (cons level predicate)) (gnus-run-hooks 'gnus-group-prepare-hook)))) -(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent - lowest) +(defun gnus-topic-prepare-topic (topicl level &optional list-level + predicate silent + lowest regexp) "Insert TOPIC into the group buffer. If SILENT, don't insert anything. Return the number of unread articles in the topic and its subtopics." (let* ((type (pop topicl)) (entries (gnus-topic-find-groups - (car type) list-level - (or all + (car type) + (if gnus-group-listed-groups + gnus-level-killed + list-level) + (or predicate gnus-group-listed-groups (cdr (assq 'visible (gnus-topic-hierarchical-parameters (car type))))) - lowest)) + (if gnus-group-listed-groups 0 lowest))) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) @@ -444,32 +475,61 @@ articles in the topic and its subtopics." (while topicl (incf unread (gnus-topic-prepare-topic - (pop topicl) (1+ level) list-level all - (not visiblep) lowest))) + (pop topicl) (1+ level) list-level predicate + (not visiblep) lowest regexp))) (setq end (point)) (goto-char beg) ;; Insert all the groups that belong in this topic. (while (setq entry (pop entries)) - (when visiblep - (if (stringp entry) - ;; Dead groups. - (gnus-group-insert-group-line - entry (if (member entry gnus-zombie-list) - gnus-level-zombie gnus-level-killed) - nil (- (1+ (cdr (setq active (gnus-active entry)))) - (car active)) - nil) - ;; Living groups. - (when (setq info (nth 2 entry)) - (gnus-group-insert-group-line - (gnus-info-group info) - (gnus-info-level info) (gnus-info-marks info) - (car entry) (gnus-info-method info))))) - (when (and (listp entry) - (numberp (car entry))) - (incf unread (car entry))) - (when (listp entry) - (setq tick t))) + (when (if (stringp entry) + (gnus-group-prepare-logic + entry + (and + (or (not gnus-group-listed-groups) + (if (< list-level gnus-level-zombie) nil + (let ((entry-level + (if (member entry gnus-zombie-list) + gnus-level-zombie gnus-level-killed))) + (and (<= entry-level list-level) + (>= entry-level lowest))))) + (cond + ((stringp regexp) + (string-match regexp entry)) + ((functionp regexp) + (funcall regexp entry)) + ((null regexp) t) + (t nil)))) + (setq info (nth 2 entry)) + (gnus-group-prepare-logic + (gnus-info-group info) + (and (or (not gnus-group-listed-groups) + (let ((entry-level (gnus-info-level info))) + (and (<= entry-level list-level) + (>= entry-level lowest)))) + (or (not (functionp predicate)) + (funcall predicate info)) + (or (not (stringp regexp)) + (string-match regexp (gnus-info-group info)))))) + (when visiblep + (if (stringp entry) + ;; Dead groups. + (gnus-group-insert-group-line + entry (if (member entry gnus-zombie-list) + gnus-level-zombie gnus-level-killed) + nil (- (1+ (cdr (setq active (gnus-active entry)))) + (car active)) + nil) + ;; Living groups. + (when (setq info (nth 2 entry)) + (gnus-group-insert-group-line + (gnus-info-group info) + (gnus-info-level info) (gnus-info-marks info) + (car entry) (gnus-info-method info))))) + (when (and (listp entry) + (numberp (car entry))) + (incf unread (car entry))) + (when (listp entry) + (setq tick t)))) (goto-char beg) ;; Insert the topic line. (when (and (not silent) @@ -503,7 +563,7 @@ articles in the topic and its subtopics." (let ((data (cadr (gnus-topic-find-topology topic)))) (setcdr data (list (if insert 'visible 'invisible) - (if hide 'hide nil) + (caddr data) (cadddr data)))) (if total-remove (setq gnus-topic-alist @@ -542,15 +602,16 @@ articles in the topic and its subtopics." (gnus-topic-update-unreads name unread) (beginning-of-line) ;; Insert the text. - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec)) - (list 'gnus-topic (intern name) - 'gnus-topic-level level - 'gnus-topic-unread unread - 'gnus-active active-topic - 'gnus-topic-visible visiblep)))) + (if shownp + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + (eval gnus-topic-line-format-spec)) + (list 'gnus-topic (intern name) + 'gnus-topic-level level + 'gnus-topic-unread unread + 'gnus-active active-topic + 'gnus-topic-visible visiblep))))) (defun gnus-topic-update-unreads (topic unreads) (setq gnus-topic-unreads (delq (assoc topic gnus-topic-unreads) @@ -593,7 +654,8 @@ articles in the topic and its subtopics." (let* ((topic (gnus-group-topic group)) (groups (cdr (assoc topic gnus-topic-alist))) (g (cdr (member group groups))) - (unfound t)) + (unfound t) + entry) ;; Try to jump to a visible group. (while (and g (not (gnus-group-goto-group (car g) t))) (pop g)) @@ -607,8 +669,20 @@ articles in the topic and its subtopics." (when (and unfound topic (not (gnus-topic-goto-missing-topic topic))) - (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil 0))))) + (let* ((top (gnus-topic-find-topology topic)) + (children (cddr top)) + (type (cadr top)) + (unread 0) + (entries (gnus-topic-find-groups + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode)))) + (while children + (incf unread (gnus-topic-unread (caar (pop children))))) + (while (setq entry (pop entries)) + (when (numberp (car entry)) + (incf unread (car entry)))) + (gnus-topic-insert-topic-line + topic t t (car (gnus-topic-find-topology topic)) nil unread)))))) (defun gnus-topic-goto-missing-topic (topic) (if (gnus-topic-goto-topic topic) @@ -935,7 +1009,7 @@ articles in the topic and its subtopics." gnus-mouse-2 gnus-mouse-pick-topic) ;; Define a new submap. - (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) + (gnus-define-keys (gnus-group-topic-map "T" gnus-topic-mode-map) "#" gnus-topic-mark-topic "\M-#" gnus-topic-unmark-topic "n" gnus-topic-create-topic @@ -998,12 +1072,15 @@ articles in the topic and its subtopics." (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. - (if (not gnus-topic-mode) + (if (not gnus-topic-mode) (setq gnus-goto-missing-group-function nil) (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) - (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) + (gnus-add-minor-mode 'gnus-topic-mode " Topic" + gnus-topic-mode-map nil (lambda (&rest junk) + (interactive) + (gnus-topic-mode nil t))) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) (set (make-local-variable 'gnus-group-prepare-function) 'gnus-group-prepare-topics) @@ -1029,8 +1106,7 @@ articles in the topic and its subtopics." ;; Remove topic infestation. (unless gnus-topic-mode (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (remove-hook 'gnus-group-change-level-function - 'gnus-topic-change-level) + (setq gnus-group-change-level-function nil) (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) @@ -1048,7 +1124,8 @@ If performed over a topic line, toggle folding the topic." (if (gnus-group-topic-p) (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) + (gnus-topic-fold all) + (gnus-dribble-touch)) (gnus-group-select-group all))) (defun gnus-mouse-pick-topic (e) @@ -1065,9 +1142,9 @@ If performed over a topic line, toggle folding the topic." (save-excursion (gnus-message 5 "Expiring groups in %s..." topic) (let ((gnus-group-marked - (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t)))) - (gnus-group-expire-articles nil)) + (mapcar (lambda (entry) (car (nth 2 entry))) + (gnus-topic-find-groups topic gnus-level-killed t)))) + (gnus-group-expire-articles nil)) (gnus-message 5 "Expiring groups in %s...done" topic)))) (defun gnus-topic-read-group (&optional all no-article group) @@ -1115,13 +1192,21 @@ When used interactively, PARENT will be the topic under point." (gnus-group-list-groups) (gnus-topic-goto-topic topic)) +;; FIXME: +;; 1. When the marked groups are overlapped with the process +;; region, the behavior of move or remove is not right. +;; 2. Can't process on several marked groups with a same name, +;; because gnus-group-marked only keeps one copy. + (defun gnus-topic-move-group (n topic &optional copyp) "Move the next N groups to TOPIC. If COPYP, copy the groups instead." (interactive (list current-prefix-arg (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((groups (gnus-group-process-prefix n)) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) + gnus-group-marked t)) + (groups (gnus-group-process-prefix n)) (topicl (assoc topic gnus-topic-alist)) (start-topic (gnus-group-topic-name)) (start-group (progn (forward-line 1) (gnus-group-group-name))) @@ -1130,7 +1215,7 @@ If COPYP, copy the groups instead." (gnus-topic-move start-topic topic) (mapcar (lambda (g) - (gnus-group-remove-mark g) + (gnus-group-remove-mark g use-marked) (when (and (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) (not copyp)) @@ -1143,18 +1228,24 @@ If COPYP, copy the groups instead." (gnus-topic-goto-topic start-topic)) (gnus-group-list-groups)))) -(defun gnus-topic-remove-group (&optional arg) +(defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) - (when (and topicl group) - (gnus-delete-line) - (gnus-delete-first group topicl)) - (gnus-topic-update-topic) - (gnus-group-position-point))))) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) + gnus-group-marked t)) + (groups (gnus-group-process-prefix n))) + (mapcar + (lambda (group) + (gnus-group-remove-mark group use-marked) + (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) + (buffer-read-only nil)) + (when (and topicl group) + (gnus-delete-line) + (gnus-delete-first group topicl)) + (gnus-topic-update-topic))) + groups) + (gnus-topic-enter-dribble) + (gnus-group-position-point))) (defun gnus-topic-copy-group (n topic) "Copy the current group to a topic." @@ -1176,7 +1267,12 @@ If COPYP, copy the groups instead." (gnus-topic-find-topology topic nil nil gnus-topic-topology) (gnus-topic-enter-dribble)) (gnus-group-kill-group n discard) - (gnus-topic-update-topic))) + (if (not (gnus-group-topic-p)) + (gnus-topic-update-topic) + ;; Move up one line so that we update the right topic. + (forward-line -1) + (gnus-topic-update-topic) + (forward-line 1)))) (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." @@ -1226,43 +1322,64 @@ If COPYP, copy the groups instead." (setq alist (cdr alist)))))) (gnus-topic-update-topic))) -(defun gnus-topic-hide-topic () - "Hide the current topic." - (interactive) +(defun gnus-topic-hide-topic (&optional permanent) + "Hide the current topic. +If PERMANENT, make it stay hidden in subsequent sessions as well." + (interactive "P") (when (gnus-current-topic) (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-topic-remove-topic nil nil 'hidden))) - -(defun gnus-topic-show-topic () - "Show the hidden topic." - (interactive) + (if permanent + (setcar (cddr + (cadr + (gnus-topic-find-topology (gnus-current-topic)))) + 'hidden)) + (gnus-topic-remove-topic nil nil))) + +(defun gnus-topic-show-topic (&optional permanent) + "Show the hidden topic. +If PERMANENT, make it stay shown in subsequent sessions as well." + (interactive "P") (when (gnus-group-topic-p) - (gnus-topic-remove-topic t nil 'shown))) - -(defun gnus-topic-mark-topic (topic &optional unmark) - "Mark all groups in the topic with the process mark." - (interactive (list (gnus-group-topic-name))) + (if (not permanent) + (gnus-topic-remove-topic t nil) + (let ((topic + (gnus-topic-find-topology + (completing-read "Show topic: " gnus-topic-alist nil t)))) + (setcar (cddr (cadr topic)) nil) + (setcar (cdr (cadr topic)) 'visible) + (gnus-group-list-groups))))) + +(defun gnus-topic-mark-topic (topic &optional unmark recursive) + "Mark all groups in the TOPIC with the process mark. +If RECURSIVE is t, mark its subtopics too." + (interactive (list (gnus-group-topic-name) + nil + (and current-prefix-arg t))) (if (not topic) (call-interactively 'gnus-group-mark-group) (save-excursion - (let ((groups (gnus-topic-find-groups topic gnus-level-killed t))) + (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil + recursive))) (while groups (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) (gnus-info-group (nth 2 (pop groups))))))))) -(defun gnus-topic-unmark-topic (topic &optional unmark) - "Remove the process mark from all groups in the topic." - (interactive (list (gnus-group-topic-name))) +(defun gnus-topic-unmark-topic (topic &optional dummy recursive) + "Remove the process mark from all groups in the TOPIC. +If RECURSIVE is t, unmark its subtopics too." + (interactive (list (gnus-group-topic-name) + nil + (and current-prefix-arg t))) (if (not topic) (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t))) + (gnus-topic-mark-topic topic t recursive))) (defun gnus-topic-get-new-news-this-topic (&optional n) "Check for new news in the current topic." (interactive "P") (if (not (gnus-group-topic-p)) (gnus-group-get-new-news-this-group n) - (gnus-topic-mark-topic (gnus-group-topic-name)) + (gnus-topic-mark-topic (gnus-group-topic-name) nil (and n t)) (gnus-group-get-new-news-this-group))) (defun gnus-topic-move-matching (regexp topic &optional copyp) @@ -1309,7 +1426,7 @@ If COPYP, copy the groups instead." (interactive (let ((topic (gnus-current-topic))) (list topic - (read-string (format "Rename %s to: " topic))))) + (read-string "Rename topic to: " topic)))) ;; Check whether the new name exists. (when (gnus-topic-find-topology new-name) (error "Topic '%s' already exists" new-name)) @@ -1520,7 +1637,7 @@ If REVERSE, reverse the sorting order." (error "Can't find topic `%s'" current)) (unless to-top (error "Can't find topic `%s'" to)) - (if (gnus-topic-find-topology to current-top 0) ;; Don't care the level + (if (gnus-topic-find-topology to current-top 0);; Don't care the level (error "Can't move `%s' to its sub-level" current)) (gnus-topic-find-topology current nil nil 'delete) (while (cdr to-top) diff --git a/lisp/gnus-undo.el b/lisp/gnus-undo.el index 6d7e4ab..7dd333f 100644 --- a/lisp/gnus-undo.el +++ b/lisp/gnus-undo.el @@ -1,5 +1,7 @@ ;;; gnus-undo.el --- minor mode for undoing in Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -84,11 +86,11 @@ (setq gnus-undo-mode-map (make-sparse-keymap)) (gnus-define-keys gnus-undo-mode-map - "\M-\C-_" gnus-undo - "\C-_" gnus-undo - "\C-xu" gnus-undo - ;; many people are used to type `C-/' on X terminals and get `C-_'. - [(control /)] gnus-undo)) + "\M-\C-_" gnus-undo + "\C-_" gnus-undo + "\C-xu" gnus-undo + ;; many people are used to type `C-/' on X terminals and get `C-_'. + [(control /)] gnus-undo)) (defun gnus-undo-make-menu-bar () ;; This is disabled for the time being. diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 54f73e0..c94bac7 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,5 +1,6 @@ ;;; gnus-util.el --- utility functions for Semi-gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Tatsuya Ichikawa @@ -33,12 +34,13 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) + (require 'custom) (require 'nnheader) -(require 'message) (require 'time-date) (eval-and-compile + (autoload 'message-fetch-field "message") (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail")) @@ -116,9 +118,9 @@ (static-cond ((fboundp 'point-at-bol) - (fset 'gnus-point-at-bol 'point-at-bol)) + (defalias 'gnus-point-at-bol 'point-at-bol)) ((fboundp 'line-beginning-position) - (fset 'gnus-point-at-bol 'line-beginning-position)) + (defalias 'gnus-point-at-bol 'line-beginning-position)) (t (defun gnus-point-at-bol () "Return point at the beginning of the line." @@ -130,9 +132,9 @@ )) (static-cond ((fboundp 'point-at-eol) - (fset 'gnus-point-at-eol 'point-at-eol)) + (defalias 'gnus-point-at-eol 'point-at-eol)) ((fboundp 'line-end-position) - (fset 'gnus-point-at-eol 'line-end-position)) + (defalias 'gnus-point-at-eol 'line-end-position)) (t (defun gnus-point-at-eol () "Return point at the end of the line." @@ -195,8 +197,8 @@ (and (string-match "(.*" from) (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) - ;; Fix by Hallvard B Furuseth . - (list (or name from) (or address from)))) + (list (if (string= name "") nil name) (or address from)))) + (defun gnus-fetch-field (field) "Return the value of the header FIELD of current article." @@ -341,11 +343,11 @@ Cache the result as a text property stored in DATE." time))))) (defsubst gnus-time-iso8601 (time) - "Return a string of TIME in YYMMDDTHHMMSS format." + "Return a string of TIME in YYYYMMDDTHHMMSS format." (format-time-string "%Y%m%dT%H%M%S" time)) (defun gnus-date-iso8601 (date) - "Convert the DATE to YYMMDDTHHMMSS." + "Convert the DATE to YYYYMMDDTHHMMSS." (condition-case () (gnus-time-iso8601 (gnus-date-get-time date)) (error ""))) @@ -481,14 +483,6 @@ If N, return the Nth ancestor instead." (file-name-nondirectory file)))) (copy-file file to)) -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays))))) - (defvar gnus-work-buffer " *gnus work*") (defun gnus-set-work-buffer () @@ -536,6 +530,7 @@ If N, return the Nth ancestor instead." first 't2 last 't1)) ((gnus-functionp function) + ;; Do nothing. ) (t (error "Invalid sort spec: %s" function)))) @@ -567,17 +562,21 @@ Bind `print-quoted' and `print-readably' to t while printing." (defun gnus-make-directory (directory) "Make DIRECTORY (and all its parents) if it doesn't exist." - (when (and directory - (not (file-exists-p directory))) - (make-directory directory t)) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (when (and directory + (not (file-exists-p directory))) + (make-directory directory t))) t) (defun gnus-write-buffer (file) "Write the current buffer's contents to FILE." ;; Make sure the directory exists. (gnus-make-directory (file-name-directory file)) - ;; Write the buffer. - (write-region (point-min) (point-max) file nil 'quietly)) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + ;; Write the buffer. + (write-region (point-min) (point-max) file nil 'quietly))) (defun gnus-write-buffer-as-binary (file) "Write the current buffer's contents to FILE without code conversion." @@ -611,7 +610,7 @@ Bind `print-quoted' and `print-readably' to t while printing." (save-excursion (save-restriction (goto-char beg) - (while (re-search-forward "[ \t]*\n" end 'move) + (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) (gnus-put-text-property beg (match-beginning 0) prop val) (setq beg (point))) (gnus-put-text-property beg (point) prop val))))) @@ -725,7 +724,8 @@ with potentially long computations." (set-buffer file-buffer) (rmail-insert-rmail-file-header) (let ((require-final-newline nil)) - (gnus-write-buffer filename))) + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) (set-buffer tmpbuf) @@ -776,7 +776,8 @@ with potentially long computations." (save-excursion (set-buffer file-buffer) (let ((require-final-newline nil)) - (gnus-write-buffer-as-binary filename))) + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) (set-buffer tmpbuf) @@ -850,7 +851,8 @@ ARG is passed to the first function." (when (file-exists-p file) (with-temp-buffer (let ((tokens '("machine" "default" "login" - "password" "account" "macdef" "force")) + "password" "account" "macdef" "force" + "port")) alist elem result pair) (insert-file-contents file) (goto-char (point-min)) @@ -898,16 +900,30 @@ ARG is passed to the first function." (forward-line 1)) (nreverse result))))) -(defun gnus-netrc-machine (list machine) - "Return the netrc values from LIST for MACHINE or for the default entry." - (let ((rest list)) - (while (and list - (not (equal (cdr (assoc "machine" (car list))) machine))) +(defun gnus-netrc-machine (list machine &optional port defaultport) + "Return the netrc values from LIST for MACHINE or for the default entry. +If PORT specified, only return entries with matching port tokens. +Entries without port tokens default to DEFAULTPORT." + (let ((rest list) + result) + (while list + (when (equal (cdr (assoc "machine" (car list))) machine) + (push (car list) result)) (pop list)) - (car (or list - (progn (while (and rest (not (assoc "default" (car rest)))) - (pop rest)) - rest))))) + (unless result + ;; No machine name matches, so we look for default entries. + (while rest + (when (assoc "default" (car rest)) + (push (car rest) result)) + (pop rest))) + (when result + (setq result (nreverse result)) + (while (and result + (not (equal (or port defaultport "nntp") + (or (gnus-netrc-get (car result) "port") + defaultport "nntp")))) + (pop result)) + (car result)))) (defun gnus-netrc-get (alist type) "Return the value of token TYPE from ALIST." @@ -987,11 +1003,9 @@ ARG is passed to the first function." (throw 'found nil))) t)) -(defun gnus-write-active-file-as-coding-system (coding-system file hashtb - &optional - full-names) - (let ((output-coding-system coding-system) - (coding-system-for-write coding-system)) +(defun gnus-write-active-file (file hashtb &optional full-names) + (let ((output-coding-system nnmail-active-file-coding-system) + (coding-system-for-write nnmail-active-file-coding-system)) (with-temp-file file (mapatoms (lambda (sym) @@ -1010,14 +1024,45 @@ ARG is passed to the first function." (while (search-backward "\\." nil t) (delete-char 1))))) -(defun gnus-union (a b) - "Add members of list A to list B -if they are not equal to items already in B." - (if (null a) - b - (if (member (car a) b) - (gnus-union (cdr a) b) - (gnus-union (cdr a) (cons (car a) b))))) +(if (fboundp 'union) + (defalias 'gnus-union 'union) + (defun gnus-union (l1 l2) + "Set union of lists L1 and L2." + (cond ((null l1) l2) + ((null l2) l1) + ((equal l1 l2) l1) + (t + (or (>= (length l1) (length l2)) + (setq l1 (prog1 l2 (setq l2 l1)))) + (while l2 + (or (member (car l2) l1) + (push (car l2) l1)) + (pop l2)) + l1)))) + +(defun gnus-add-text-properties-when + (property value start end properties &optional object) + "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE." + (let (point) + (while (and start + (< start end) ;; XEmacs will loop for every when start=end. + (setq point (text-property-not-all start end property value))) + (gnus-add-text-properties start point properties object) + (setq start (text-property-any point end property value))) + (if start + (gnus-add-text-properties start end properties object)))) + +(defun gnus-remove-text-properties-when + (property value start end properties &optional object) + "Like `remove-text-properties', only applied on where PROPERTY is VALUE." + (let (point) + (while (and start + (< start end) + (setq point (text-property-not-all start end property value))) + (remove-text-properties start point properties object) + (setq start (text-property-any point end property value))) + (if start + (remove-text-properties start end properties object)))) (provide 'gnus-util) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index b3f6a37..993914b 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,5 +1,6 @@ ;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 198,995,86,87,93,94,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 @@ -293,7 +294,9 @@ so I simply dropped them." (defcustom gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:") + "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:" + "^MIME-Version:" "^Content-Disposition:" "^Content-Description:" + "^Content-ID:" "^User-Agent:" "^X-Face:") "*List of regexps to match headers included in digested messages. The headers will be included in the sequence they are matched." :group 'gnus-extract @@ -347,6 +350,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-default-dir gnus-article-save-directory) (defvar gnus-uu-digest-from-subject nil) +(defvar gnus-uu-digest-buffer nil) ;; Keymaps @@ -368,12 +372,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "k" gnus-summary-kill-process-mark "y" gnus-summary-yank-process-mark "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable - "m" gnus-summary-save-parts) + "i" gnus-uu-invert-processable) (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) ;;"x" gnus-uu-extract-any - ;;"m" gnus-uu-extract-mime + "m" gnus-summary-save-parts "u" gnus-uu-decode-uu "U" gnus-uu-decode-uu-and-save "s" gnus-uu-decode-unshar @@ -386,17 +389,17 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "P" gnus-uu-decode-postscript-and-save) (gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) + (gnus-uu-extract-view-map "v" gnus-uu-extract-map) + "u" gnus-uu-decode-uu-view + "U" gnus-uu-decode-uu-and-save-view + "s" gnus-uu-decode-unshar-view + "S" gnus-uu-decode-unshar-and-save-view + "o" gnus-uu-decode-save-view + "O" gnus-uu-decode-save-view + "b" gnus-uu-decode-binhex-view + "B" gnus-uu-decode-binhex-view + "p" gnus-uu-decode-postscript-view + "P" gnus-uu-decode-postscript-and-save-view) ;; Commands. @@ -518,15 +521,13 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive "P") (let ((gnus-uu-save-in-digest t) (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward"))) - buf subject from) + gnus-uu-digest-buffer subject from) (gnus-setup-message 'forward (setq gnus-uu-digest-from-subject nil) + (setq gnus-uu-digest-buffer + (gnus-get-buffer-create " *gnus-uu-forward*")) (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer - (gnus-get-buffer-create " *gnus-uu-forward*"))) - (erase-buffer) - (insert-file file) - (delete-file file) + (set-buffer gnus-uu-digest-buffer) (let ((fs gnus-uu-digest-from-subject)) (when fs (setq from (caar fs) @@ -548,15 +549,19 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (if (gnus-news-group-p gnus-newsgroup-name) gnus-newsgroup-name "Various")))) - (goto-char (point-min)) - (when (re-search-forward "^Subject: ") - (delete-region (point) (gnus-point-at-eol)) - (insert subject)) - (goto-char (point-min)) - (when (re-search-forward "^From: ") - (delete-region (point) (gnus-point-at-eol)) - (insert from)) - (message-forward post)) + (mime-edit-enclose-digest-region (point-min) (point-max)) + (if post + (message-news nil (concat "[" from "] " subject)) + (message-mail nil (concat "[" from "] " subject))) + (message-goto-body) + ;; Make sure we're at the start of the line. + (unless (bolp) + (insert "\n")) + ;; Insert the forwarded buffer. + (insert-buffer gnus-uu-digest-buffer) + (kill-buffer gnus-uu-digest-buffer) + (set-text-properties (point-min) (point-max) nil) + (message-position-point)) (setq gnus-uu-digest-from-subject nil))) (defun gnus-uu-digest-post-forward (&optional n) @@ -567,8 +572,10 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; Process marking. (defun gnus-uu-mark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and set the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) + "Set the process mark on articles whose subjects match REGEXP. +When called interactively, prompt for REGEXP. +Optional UNMARK non-nil means unmark instead of mark." + (interactive "sMark (regexp): \nP") (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles (if unmark @@ -577,9 +584,10 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (message "")) (gnus-summary-position-point)) -(defun gnus-uu-unmark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and remove the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) +(defun gnus-uu-unmark-by-regexp (regexp) + "Remove the process mark from articles whose subjects match REGEXP. +When called interactively, prompt for REGEXP." + (interactive "sUnmark (regexp): ") (gnus-uu-mark-by-regexp regexp t)) (defun gnus-uu-mark-series () @@ -656,7 +664,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-mark-over (&optional score) "Mark all articles with a score over SCORE (the prefix)." (interactive "P") - (let ((score (gnus-score-default score)) + (let ((score (or score gnus-summary-default-score 0)) (data gnus-newsgroup-data)) (save-excursion (while data @@ -812,7 +820,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-save-separate-articles (save-excursion (set-buffer buffer) - (gnus-write-buffer + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system (concat gnus-uu-saved-article-name gnus-current-article)) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name @@ -845,9 +854,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (save-excursion (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*")) (erase-buffer) - (insert (format - "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" - (current-time-string) name name)))) + (unless gnus-uu-digest-buffer + (insert (format "From: %s\nSubject: %s Digest\n\n" name name))) + (insert "Topics:\n"))) (when (not (eq in-state 'end)) (setq state (list 'middle)))) (save-excursion @@ -863,12 +872,13 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (put-text-property (point-min) (point-max) 'intangible nil)) (goto-char (point-min)) (re-search-forward "\n\n") - ;; Quote all 30-dash lines. - (save-excursion - (while (re-search-forward "^-" nil t) - (beginning-of-line) - (delete-char 1) - (insert "- "))) + (unless gnus-uu-digest-buffer + ;; Quote all 30-dash lines. + (save-excursion + (while (re-search-forward "^-" nil t) + (beginning-of-line) + (delete-char 1) + (insert "- ")))) (setq body (buffer-substring (1- (point)) (point-max))) (narrow-to-region (point-min) (point)) (if (not (setq headers gnus-uu-digest-headers)) @@ -886,30 +896,49 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (1- (point))) (progn (forward-line 1) (point))))))))) (widen))) + (insert message-forward-start-separator) (insert sorthead) (goto-char (point-max)) (insert body) (goto-char (point-max)) - (insert (concat "\n" (make-string 30 ?-) "\n\n")) (goto-char beg) - (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subj (buffer-substring (match-beginning 1) (match-end 1))) + (when (re-search-forward "^Subject:" nil t) + (setq subj (nnheader-decode-subject + (buffer-substring (match-end 0) (std11-field-end)))) (save-excursion (set-buffer "*gnus-uu-pre*") (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) (eq in-state 'first-and-last)) - (save-excursion - (set-buffer "*gnus-uu-pre*") - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (gnus-write-buffer gnus-uu-saved-article-name)) - (save-excursion - (set-buffer "*gnus-uu-body*") - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (write-region - (point-min) (point-max) gnus-uu-saved-article-name t)) + (if gnus-uu-digest-buffer + (with-current-buffer gnus-uu-digest-buffer + (erase-buffer) + (insert-buffer "*gnus-uu-pre*") + (goto-char (point-max)) + (insert-buffer "*gnus-uu-body*")) + (save-excursion + (set-buffer "*gnus-uu-pre*") + (insert (format "\n\n%s\n\n" (make-string 70 ?-))) + (if gnus-uu-digest-buffer + (with-current-buffer gnus-uu-digest-buffer + (erase-buffer) + (insert-buffer "*gnus-uu-pre*")) + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system gnus-uu-saved-article-name))) + (save-excursion + (set-buffer "*gnus-uu-body*") + (goto-char (point-max)) + (insert + (concat (setq end-string (format "End of %s Digest" name)) + "\n")) + (insert (concat (make-string (length end-string) ?*) "\n")) + (if gnus-uu-digest-buffer + (with-current-buffer gnus-uu-digest-buffer + (goto-char (point-max)) + (insert-buffer "*gnus-uu-body*")) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (write-region-as-coding-system + nnheader-text-coding-system + (point-min) (point-max) gnus-uu-saved-article-name t))))) (gnus-kill-buffer "*gnus-uu-pre*") (gnus-kill-buffer "*gnus-uu-body*") (push 'end state)) @@ -1210,7 +1239,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-inhibit-treatment t) has-been-begin article result-file result-files process-state gnus-summary-display-article-function - gnus-article-display-hook gnus-article-prepare-hook + gnus-article-display-hook gnus-article-prepare-hook gnus-display-mime-function article-series files) (while (and articles @@ -1351,9 +1380,12 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (when gnus-uu-default-dir (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) (file-name-nondirectory file)))) - (rename-file file to-file) - (unless (file-exists-p file) - (make-symbolic-link to-file file))))) + (cond ((fboundp 'make-symbolic-link) + (rename-file file to-file) + (unless (file-exists-p file) + (make-symbolic-link to-file file))) + (t + (copy-file file to-file)))))) (defun gnus-uu-part-number (article) (let* ((header (gnus-summary-article-header article)) @@ -1478,6 +1510,21 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (cons (if (= (length files) 1) (car files) files) state) state)))) +(defvar gnus-uu-unshar-warning + "*** WARNING *** + +Shell archives are an archaic method of bundling files for distribution +across computer networks. During the unpacking process, arbitrary commands +are executed on your system, and all kinds of nasty things can happen. +Please examine the archive very carefully before you instruct Emacs to +unpack it. You can browse the archive buffer using \\[scroll-other-window]. + +If you are unsure what to do, please answer \"no\"." + "Text of warning message displayed by `gnus-uu-unshar-article'. +Make sure that this text consists only of few text lines. Otherwise, +Gnus might fail to display all of it.") + + ;; This function is used by `gnus-uu-grab-articles' to treat ;; a shared article. (defun gnus-uu-unshar-article (process-buffer in-state) @@ -1488,14 +1535,31 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (goto-char (point-min)) (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (call-process-region - start-char (point-max) shell-file-name nil - (gnus-get-buffer-create gnus-uu-output-buffer-name) nil - shell-command-switch - (concat "cd " gnus-uu-work-dir " " - gnus-shell-command-separator " sh")))) + (save-window-excursion + (save-excursion + (switch-to-buffer (current-buffer)) + (delete-other-windows) + (let ((buffer (get-buffer-create (generate-new-buffer-name + "*Warning*")))) + (unless + (unwind-protect + (with-current-buffer buffer + (insert (substitute-command-keys + gnus-uu-unshar-warning)) + (goto-char (point-min)) + (display-buffer buffer) + (yes-or-no-p "This is a shell archive, unshar it? ")) + (kill-buffer buffer)) + (setq state (list 'error)))))) + (unless (memq 'error state) + (beginning-of-line) + (setq start-char (point)) + (call-process-region + start-char (point-max) shell-file-name nil + (gnus-get-buffer-create gnus-uu-output-buffer-name) nil + shell-command-switch + (concat "cd " gnus-uu-work-dir " " + gnus-shell-command-separator " sh"))))) state)) ;; Returns the name of what the shar file is going to unpack. @@ -1818,7 +1882,7 @@ is t." (let ((map (make-sparse-keymap))) (set-keymap-parent map (current-local-map)) (use-local-map map)) - (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) + ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) diff --git a/lisp/gnus-vers.el b/lisp/gnus-vers.el new file mode 100644 index 0000000..f1332f8 --- /dev/null +++ b/lisp/gnus-vers.el @@ -0,0 +1,85 @@ +;;; gnus-vers.el --- Declare gnus version. + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Keiichi Suzuki +;; Katsumi Yamaoka +;; Keywords: news, mail, compatibility + +;; This file is part of T-gnus. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; 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: + +(require 'poe) +(require 'product) +(provide 'gnus-vers) + +(defconst gnus-revision-number "00" + "Revision number for this version of gnus.") + +;; Product information of this gnus. +(product-provide 'gnus-vers + (product-define "T-gnus" nil + (list 6 15 0 + (string-to-number gnus-revision-number)))) + +(defconst gnus-original-version-number "0.01" + "Version number for this version of Gnus.") + +(provide 'running-pterodactyl-gnus-0_73-or-later) + +(defconst gnus-original-product-name "Oort Gnus" + "Product name of the original version of Gnus.") + +(defconst gnus-product-name (product-name (product-find 'gnus-vers)) + "Product name of this version of gnus.") + +(defconst gnus-version-number + (mapconcat + 'number-to-string + (butlast (product-version (product-find 'gnus-vers))) + ".") + "Version number for this version of gnus.") + +(defconst gnus-version + (format "%s %s r%s (based on %s v%s ; for SEMI 1.13, FLIM 1.13)" + gnus-product-name gnus-version-number gnus-revision-number + gnus-original-product-name gnus-original-version-number) + "Version string for this version of gnus.") + +(defun gnus-version (&optional arg) + "Version number of this version of Gnus. +If ARG, insert string at point." + (interactive "P") + (if arg + (insert (message "%s" gnus-version)) + (message "%s" gnus-version))) + +(defun gnus-extended-version () + "Stringified gnus version." + (concat gnus-product-name "/" gnus-version-number + " (based on " + gnus-original-product-name " v" gnus-original-version-number ")" + (if (zerop (string-to-number gnus-revision-number)) + "" + (concat " (revision " gnus-revision-number ")")) + )) + +;; gnus-vers.el ends here diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index 74fae9f..e0bf16e 100644 --- a/lisp/gnus-vm.el +++ b/lisp/gnus-vm.el @@ -1,5 +1,7 @@ ;;; gnus-vm.el --- vm interface for Gnus -;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Per Persson ;; Katsumi Yamaoka @@ -32,6 +34,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus-art) (eval-when-compile diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index bbaa4f9..51934fd 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -1,5 +1,6 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (defgroup gnus-windows nil @@ -84,9 +86,9 @@ (article 1.0))) (t '(vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0))))) + (summary 0.25 point) + (if gnus-carpal '(summary-carpal 4)) + (article 1.0))))) (server (vertical 1.0 (server 1.0 point) @@ -284,125 +286,128 @@ See the Gnus manual for an explanation of the syntax used.") (defun gnus-configure-frame (split &optional window) "Split WINDOW according to SPLIT." - (unless window - (setq window (get-buffer-window (current-buffer)))) - (select-window window) - ;; This might be an old-stylee buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - (let* ((type (car split)) - (subs (cddr split)) - (len (if (eq type 'horizontal) (window-width) (window-height))) - (total 0) - (window-min-width (or gnus-window-min-width window-min-width)) - (window-min-height (or gnus-window-min-height window-min-height)) - s result new-win rest comp-subs size sub) - (cond - ;; Nothing to do here. - ((null split)) - ;; Don't switch buffers. - ((null type) - (and (memq 'point split) window)) - ;; This is a buffer to be selected. - ((not (memq type '(frame horizontal vertical))) - (let ((buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer)))))) - (unless buffer - (error "Invalid buffer type: %s" type)) - (switch-to-buffer (gnus-get-buffer-create - (gnus-window-to-buffer-helper buffer))) - (when (memq 'frame-focus split) - (setq gnus-window-frame-focus window)) - ;; We return the window if it has the `point' spec. - (and (memq 'point split) window))) - ;; This is a frame split. - ((eq type 'frame) - (unless gnus-frame-list - (setq gnus-frame-list (list (window-frame - (get-buffer-window (current-buffer)))))) - (let ((i 0) - params frame fresult) - (while (< i (length subs)) - ;; Frame parameter is gotten from the sub-split. - (setq params (cadr (elt subs i))) - ;; It should be a list. - (unless (listp params) - (setq params nil)) - ;; Create a new frame? - (unless (setq frame (elt gnus-frame-list i)) - (nconc gnus-frame-list (list (setq frame (make-frame params)))) - (push frame gnus-created-frames)) - ;; Is the old frame still alive? - (unless (frame-live-p frame) - (setcar (nthcdr i gnus-frame-list) - (setq frame (make-frame params)))) - ;; Select the frame in question and do more splits there. - (select-frame frame) - (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) - (incf i)) - ;; Select the frame that has the selected buffer. - (when fresult - (select-frame (window-frame fresult))))) - ;; This is a normal split. - (t - (when (> (length subs) 0) - ;; First we have to compute the sizes of all new windows. - (while subs - (setq sub (append (pop subs) nil)) - (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) - (setq sub (eval sub))) - (when sub - (push sub comp-subs) - (setq size (cadar comp-subs)) - (cond ((equal size 1.0) - (setq rest (car comp-subs)) - (setq s 0)) - ((floatp size) - (setq s (floor (* size len)))) - ((integerp size) - (setq s size)) - (t - (error "Invalid size: %s" size))) - ;; Try to make sure that we are inside the safe limits. - (cond ((zerop s)) - ((eq type 'horizontal) - (setq s (max s window-min-width))) - ((eq type 'vertical) - (setq s (max s window-min-height)))) - (setcar (cdar comp-subs) s) - (incf total s))) - ;; Take care of the "1.0" spec. - (if rest - (setcar (cdr rest) (- len total)) - (error "No 1.0 specs in %s" split)) - ;; The we do the actual splitting in a nice recursive - ;; fashion. - (setq comp-subs (nreverse comp-subs)) - (while comp-subs - (if (null (cdr comp-subs)) - (setq new-win window) - (setq new-win - (split-window window (cadar comp-subs) - (eq type 'horizontal)))) - (setq result (or (gnus-configure-frame - (car comp-subs) window) - result)) - (select-window new-win) - (setq window new-win) - (setq comp-subs (cdr comp-subs)))) - ;; Return the proper window, if any. - (when result - (select-window result)))))) + (let ((current-window + (or (get-buffer-window (current-buffer)) (selected-window)))) + (unless window + (setq window current-window)) + (select-window window) + ;; This might be an old-stylee buffer config. + (when (vectorp split) + (setq split (append split nil))) + (when (or (consp (car split)) + (vectorp (car split))) + (push 1.0 split) + (push 'vertical split)) + ;; The SPLIT might be something that is to be evaled to + ;; return a new SPLIT. + (while (and (not (assq (car split) gnus-window-to-buffer)) + (gnus-functionp (car split))) + (setq split (eval split))) + (let* ((type (car split)) + (subs (cddr split)) + (len (if (eq type 'horizontal) (window-width) (window-height))) + (total 0) + (window-min-width (or gnus-window-min-width window-min-width)) + (window-min-height (or gnus-window-min-height window-min-height)) + s result new-win rest comp-subs size sub) + (cond + ;; Nothing to do here. + ((null split)) + ;; Don't switch buffers. + ((null type) + (and (memq 'point split) window)) + ;; This is a buffer to be selected. + ((not (memq type '(frame horizontal vertical))) + (let ((buffer (cond ((stringp type) type) + (t (cdr (assq type gnus-window-to-buffer)))))) + (unless buffer + (error "Invalid buffer type: %s" type)) + (let ((buf (gnus-get-buffer-create + (gnus-window-to-buffer-helper buffer)))) + (if (eq buf (window-buffer (selected-window))) (set-buffer buf) + (switch-to-buffer buf))) + (when (memq 'frame-focus split) + (setq gnus-window-frame-focus window)) + ;; We return the window if it has the `point' spec. + (and (memq 'point split) window))) + ;; This is a frame split. + ((eq type 'frame) + (unless gnus-frame-list + (setq gnus-frame-list (list (window-frame current-window)))) + (let ((i 0) + params frame fresult) + (while (< i (length subs)) + ;; Frame parameter is gotten from the sub-split. + (setq params (cadr (elt subs i))) + ;; It should be a list. + (unless (listp params) + (setq params nil)) + ;; Create a new frame? + (unless (setq frame (elt gnus-frame-list i)) + (nconc gnus-frame-list (list (setq frame (make-frame params)))) + (push frame gnus-created-frames)) + ;; Is the old frame still alive? + (unless (frame-live-p frame) + (setcar (nthcdr i gnus-frame-list) + (setq frame (make-frame params)))) + ;; Select the frame in question and do more splits there. + (select-frame frame) + (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) + (incf i)) + ;; Select the frame that has the selected buffer. + (when fresult + (select-frame (window-frame fresult))))) + ;; This is a normal split. + (t + (when (> (length subs) 0) + ;; First we have to compute the sizes of all new windows. + (while subs + (setq sub (append (pop subs) nil)) + (while (and (not (assq (car sub) gnus-window-to-buffer)) + (gnus-functionp (car sub))) + (setq sub (eval sub))) + (when sub + (push sub comp-subs) + (setq size (cadar comp-subs)) + (cond ((equal size 1.0) + (setq rest (car comp-subs)) + (setq s 0)) + ((floatp size) + (setq s (floor (* size len)))) + ((integerp size) + (setq s size)) + (t + (error "Invalid size: %s" size))) + ;; Try to make sure that we are inside the safe limits. + (cond ((zerop s)) + ((eq type 'horizontal) + (setq s (max s window-min-width))) + ((eq type 'vertical) + (setq s (max s window-min-height)))) + (setcar (cdar comp-subs) s) + (incf total s))) + ;; Take care of the "1.0" spec. + (if rest + (setcar (cdr rest) (- len total)) + (error "No 1.0 specs in %s" split)) + ;; The we do the actual splitting in a nice recursive + ;; fashion. + (setq comp-subs (nreverse comp-subs)) + (while comp-subs + (if (null (cdr comp-subs)) + (setq new-win window) + (setq new-win + (split-window window (cadar comp-subs) + (eq type 'horizontal)))) + (setq result (or (gnus-configure-frame + (car comp-subs) window) + result)) + (select-window new-win) + (setq window new-win) + (setq comp-subs (cdr comp-subs)))) + ;; Return the proper window, if any. + (when result + (select-window result))))))) (defvar gnus-frame-split-p nil) @@ -420,7 +425,7 @@ See the Gnus manual for an explanation of the syntax used.") (setq gnus-frame-split-p nil) (unless split - (error "No such setting: %s" setting)) + (error "No such setting in `gnus-buffer-configuration': %s" setting)) (if (and (setq all-visible (gnus-all-windows-visible-p split)) (not force)) @@ -428,6 +433,10 @@ See the Gnus manual for an explanation of the syntax used.") ;; put point in the assigned buffer, and do not touch the ;; winconf. (select-window all-visible) + + ;; Make sure "the other" buffer, nntp-server-buffer, is live. + (unless (gnus-buffer-live-p nntp-server-buffer) + (nnheader-init-server-buffer)) ;; Either remove all windows or just remove all Gnus windows. (let ((frame (selected-frame))) @@ -443,12 +452,12 @@ See the Gnus manual for an explanation of the syntax used.") (gnus-delete-windows-in-gnusey-frames)) ;; Just remove some windows. (gnus-remove-some-windows) - (switch-to-buffer nntp-server-buffer)) + (set-buffer nntp-server-buffer)) (select-frame frame))) - (switch-to-buffer nntp-server-buffer) (let (gnus-window-frame-focus) - (gnus-configure-frame split (get-buffer-window (current-buffer))) + (set-buffer nntp-server-buffer) + (gnus-configure-frame split) (when gnus-window-frame-focus (select-frame (window-frame gnus-window-frame-focus)))))))) @@ -505,7 +514,7 @@ should have point." (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer))) (setq win (get-buffer-window buf t))) (if (memq 'point split) - (setq all-visible win)) + (setq all-visible win)) (setq all-visible nil))) (t (when (eq type 'frame) @@ -532,7 +541,7 @@ should have point." lowest-buf buf)))) (when lowest-buf (pop-to-buffer lowest-buf) - (switch-to-buffer nntp-server-buffer)) + (set-buffer nntp-server-buffer)) (mapcar (lambda (b) (delete-windows-on b t)) bufs)))) (provide 'gnus-win) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 4b74674..d21cfa7 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -407,26 +407,28 @@ call it with the value of the `gnus-data' text property." (cond ((fboundp 'char-or-char-int-p) ;; Handle both types of marks for XEmacs-20.x. - (fset 'gnus-characterp 'char-or-char-int-p)) + (defalias 'gnus-characterp 'char-or-char-int-p)) ;; V19 of XEmacs, probably. (t - (fset 'gnus-characterp 'characterp))) - - (fset 'gnus-make-overlay 'make-extent) - (fset 'gnus-delete-overlay 'delete-extent) - (fset 'gnus-overlay-put 'set-extent-property) - (fset 'gnus-move-overlay 'gnus-xmas-move-overlay) - (fset 'gnus-overlay-end 'extent-end-position) - (fset 'gnus-kill-all-overlays 'gnus-xmas-kill-all-overlays) - (fset 'gnus-extent-detached-p 'extent-detached-p) - (fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties) - (fset 'gnus-put-text-property 'gnus-xmas-put-text-property) - (fset 'gnus-deactivate-mark 'ignore) - (fset 'gnus-window-edges 'window-pixel-edges) + (defalias 'gnus-characterp 'characterp))) + + (defalias 'gnus-make-overlay 'make-extent) + (defalias 'gnus-delete-overlay 'delete-extent) + (defalias 'gnus-overlay-put 'set-extent-property) + (defalias 'gnus-move-overlay 'gnus-xmas-move-overlay) + (defalias 'gnus-overlay-buffer 'extent-object) + (defalias 'gnus-overlay-start 'extent-start-position) + (defalias 'gnus-overlay-end 'extent-end-position) + (defalias 'gnus-kill-all-overlays 'gnus-xmas-kill-all-overlays) + (defalias 'gnus-extent-detached-p 'extent-detached-p) + (defalias 'gnus-add-text-properties 'gnus-xmas-add-text-properties) + (defalias 'gnus-put-text-property 'gnus-xmas-put-text-property) + (defalias 'gnus-deactivate-mark 'ignore) + (defalias 'gnus-window-edges 'window-pixel-edges) (if (and (<= emacs-major-version 19) (< emacs-minor-version 14)) - (fset 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) + (defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) (when (fboundp 'turn-off-scroll-in-place) (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) @@ -443,34 +445,34 @@ call it with the value of the `gnus-data' text property." (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) - (fset 'gnus-x-color-values - (if (fboundp 'x-color-values) - 'x-color-values - (lambda (color) - (color-instance-rgb-components - (make-color-instance color)))))) + (defalias 'gnus-x-color-values + (if (fboundp 'x-color-values) + 'x-color-values + (lambda (color) + (color-instance-rgb-components + (make-color-instance color)))))) (defun gnus-xmas-redefine () "Redefine lots of Gnus functions for XEmacs." - (fset 'gnus-summary-set-display-table 'gnus-xmas-summary-set-display-table) - (fset 'gnus-visual-turn-off-edit-menu 'identity) - (fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter) - (fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open) - (fset 'gnus-article-push-button 'gnus-xmas-article-push-button) - (fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge) - (fset 'gnus-read-event-char 'gnus-xmas-read-event-char) - (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message) - (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) - (fset 'gnus-appt-select-lowest-window + (defalias 'gnus-summary-set-display-table 'gnus-xmas-summary-set-display-table) + (defalias 'gnus-visual-turn-off-edit-menu 'identity) + (defalias 'gnus-summary-recenter 'gnus-xmas-summary-recenter) + (defalias 'gnus-extent-start-open 'gnus-xmas-extent-start-open) + (defalias 'gnus-article-push-button 'gnus-xmas-article-push-button) + (defalias 'gnus-window-top-edge 'gnus-xmas-window-top-edge) + (defalias 'gnus-read-event-char 'gnus-xmas-read-event-char) + (defalias 'gnus-group-startup-message 'gnus-xmas-group-startup-message) + (defalias 'gnus-tree-minimize 'gnus-xmas-tree-minimize) + (defalias 'gnus-appt-select-lowest-window 'gnus-xmas-appt-select-lowest-window) - (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) - (fset 'gnus-character-to-event 'character-to-event) - (fset 'gnus-mode-line-buffer-identification + (defalias 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) + (defalias 'gnus-character-to-event 'character-to-event) + (defalias 'gnus-mode-line-buffer-identification 'gnus-xmas-mode-line-buffer-identification) - (fset 'gnus-key-press-event-p 'key-press-event-p) - (fset 'gnus-region-active-p 'region-active-p) - (fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) - (fset 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) + (defalias 'gnus-key-press-event-p 'key-press-event-p) + (defalias 'gnus-region-active-p 'region-active-p) + (defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) + (defalias 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) @@ -572,34 +574,6 @@ the resulting string may be narrower than END-COLUMN. (concat (make-string (max 0 (- ,pad (string-width val))) ?\ ) val)))))) - - (defun gnus-tilde-max-form (el max-width) - "Return a form that limits EL to MAX-WIDTH." - (let ((max (abs max-width))) - (if (symbolp el) - (if (< max-width 0) - `(let ((width (string-width ,el))) - (gnus-truncate-string ,el width (- width ,max))) - `(gnus-truncate-string ,el ,max)) - (if (< max-width 0) - `(let* ((val (eval ,el)) - (width (string-width val))) - (gnus-truncate-string val width (- width ,max))) - `(let ((val (eval ,el))) - (gnus-truncate-string val ,max)))))) - - (defun gnus-tilde-cut-form (el cut-width) - "Return a form that cuts CUT-WIDTH off of EL." - (let ((cut (abs cut-width))) - (if (symbolp el) - (if (< cut-width 0) - `(gnus-truncate-string ,el (- (string-width ,el) ,cut)) - `(gnus-truncate-string ,el (string-width ,el) ,cut)) - (if (< cut-width 0) - `(let ((val (eval ,el))) - (gnus-truncate-string val (- (string-width val) ,cut))) - `(let ((val (eval ,el))) - (gnus-truncate-string val (string-width val) ,cut)))))) )) ;;; XEmacs logo and toolbar. @@ -645,10 +619,11 @@ the resulting string may be narrower than END-COLUMN. (concat " (r" gnus-revision-number ")")) " based on " gnus-original-product-name " v" gnus-original-version-number "\n") - (goto-char (point-min)) - (put-text-property (point) (gnus-point-at-eol) 'face 'gnus-splash-face) - (insert-char ?\ ; space - (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2))) + (end-of-line 0) + (put-text-property (point-min) (point) 'face 'gnus-splash-face) + (insert-char ?\ (prog1 + (max 0 (/ (- (window-width) (point)) 2)) + (goto-char (point-min)))) (forward-line 1) (insert-char ?\n rest) (set-window-start (selected-window) (point-min)))) @@ -681,9 +656,9 @@ the resulting string may be narrower than END-COLUMN. (concat " (r" gnus-revision-number ")")) " based on " gnus-original-product-name " v" gnus-original-version-number) - (goto-char (point-min)) - (insert-char ?\ ; space - (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2))) + (insert-char ?\ (prog1 + (max 0 (/ (- (window-width) (point)) 2)) + (goto-char (point-min)))) (forward-line 1) ;; And then hack it. (gnus-indent-rigidly (point) (point-max) @@ -762,8 +737,7 @@ If it is non-nil, it must be a toolbar. The five valid values are gnus-summary-catchup t "Catchup"] [gnus-summary-catchup-and-exit gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"] - ) + [gnus-summary-exit gnus-summary-exit t "Exit this summary"]) "The summary buffer toolbar.") (defvar gnus-summary-mail-toolbar @@ -773,14 +747,10 @@ If it is non-nil, it must be a toolbar. The five valid values are [gnus-summary-next-unread gnus-summary-next-unread-article t "Next unread article"] [gnus-summary-mail-reply gnus-summary-reply t "Reply"] -; [gnus-summary-mail-get gnus-mail-get t "Message get"] [gnus-summary-mail-originate gnus-summary-post-news t "Originate"] [gnus-summary-mail-save gnus-summary-save-article t "Save"] [gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"] -; [gnus-summary-mail-delete gnus-summary-delete-article t "Delete message"] [gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"] -; [gnus-summary-mail-spell gnus-mail-spell t "Spell"] -; [gnus-summary-mail-help gnus-mail-help t "Message help"] [gnus-summary-caesar-message gnus-summary-caesar-message t "Rot 13"] [gnus-uu-decode-uu @@ -793,8 +763,7 @@ If it is non-nil, it must be a toolbar. The five valid values are gnus-summary-catchup t "Catchup"] [gnus-summary-catchup-and-exit gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"] - ) + [gnus-summary-exit gnus-summary-exit t "Exit this summary"]) "The summary buffer mail toolbar.") (defun gnus-xmas-setup-group-toolbar () @@ -840,7 +809,7 @@ XEmacs compatibility workaround." (let ((cur (current-buffer))) (save-excursion (gnus-set-work-buffer) - (insert (format "%s" (buffer-substring beg end cur))) + (insert-buffer-substring cur beg end) (gnus-xmas-call-region "uncompface") (goto-char (point-min)) (insert "/* Width=48, Height=48 */\n") @@ -927,6 +896,80 @@ XEmacs compatibility workaround." (goto-char (event-point event)) (funcall (event-function response) (event-object response)))) +(defun gnus-group-add-icon () + "Add an icon to the current line according to `gnus-group-icon-list'." + (let* ((p (point)) + (end (progn (end-of-line) (point))) + ;; now find out where the line starts and leave point there. + (beg (progn (beginning-of-line) (point)))) + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (when (search-forward "==&&==" nil t) + (let* ((group (gnus-group-group-name)) + (entry (gnus-group-entry group)) + (unread (if (numberp (car entry)) (car entry) 0)) + (active (gnus-active group)) + (total (if active (1+ (- (cdr active) (car active))) 0)) + (info (nth 2 entry)) + (method (gnus-server-get-method group (gnus-info-method info))) + (marked (gnus-info-marks info)) + (mailp (memq 'mail (assoc (symbol-name + (car (or method gnus-select-method))) + gnus-valid-select-methods))) + (level (or (gnus-info-level info) gnus-level-killed)) + (score (or (gnus-info-score info) 0)) + (ticked (gnus-range-length (cdr (assq 'tick marked)))) + (group-age (gnus-group-timestamp-delta group)) + (inhibit-read-only t) + (list gnus-group-icon-list) + (mystart (match-beginning 0)) + (myend (match-end 0))) + (goto-char (point-min)) + (while (and list + (not (eval (caar list)))) + (setq list (cdr list))) + (if list + (let* ((file (cdar list)) + (glyph (gnus-group-icon-create-glyph + (buffer-substring mystart myend) + file))) + (if glyph + (progn + (mapcar 'delete-annotation (annotations-at myend)) + (let ((ext (make-extent mystart myend)) + (ant (make-annotation glyph myend 'text))) + ;; set text extent params + (set-extent-property ext 'end-open t) + (set-extent-property ext 'start-open t) + (set-extent-property ext 'invisible t))) + (delete-region mystart myend))) + (delete-region mystart myend)))) + (widen)) + (goto-char p))) + +(defun gnus-group-icon-create-glyph (substring pixmap) + "Create a glyph for insertion into a group line." + (or + (cdr-safe (assoc pixmap gnus-group-icon-cache)) + (let* ((glyph (make-glyph + (list + (cons 'x + (expand-file-name pixmap gnus-xmas-glyph-directory)) + (cons 'mswindows + (expand-file-name pixmap gnus-xmas-glyph-directory)) + (cons 'tty substring))))) + (setq gnus-group-icon-cache + (cons (cons pixmap glyph) gnus-group-icon-cache)) + (set-glyph-face glyph 'default) + glyph))) + +(defun gnus-xmas-mailing-list-menu-add () + (gnus-xmas-menu-add mailing-list + gnus-mailing-list-menu)) + +(add-hook 'gnus-mailing-list-mode-hook 'gnus-xmas-mailing-list-menu-add) + (provide 'gnus-xmas) ;;; gnus-xmas.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el index 5a648ba..59b8926 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,5 +1,6 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -33,11 +34,7 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) -(require 'custom) -(eval-and-compile - (if (< emacs-major-version 20) - (require 'gnus-load))) -(require 'message) +(require 'gnus-vers) (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." @@ -47,6 +44,7 @@ (defgroup gnus-charset nil "Group character set issues." :link '(custom-manual "(gnus)Charsets") + :version "21.1" :group 'gnus) (defgroup gnus-cache nil @@ -262,29 +260,6 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-product-name "T-gnus" - "Product name of this version of gnus.") - -(defconst gnus-version-number "6.13.4" - "Version number for this version of gnus.") - -(defconst gnus-revision-number "01" - "Revision number for this version of gnus.") - -(defconst gnus-original-version-number "0.99" - "Version number for this version of Gnus.") - -(provide 'running-pterodactyl-gnus-0_73-or-later) - -(defconst gnus-original-product-name "Pterodactyl Gnus" - "Product name of the original version of Gnus.") - -(defconst gnus-version - (format "%s %s r%s (based on %s v%s ; for SEMI 1.13, FLIM 1.13)" - gnus-product-name gnus-version-number gnus-revision-number - gnus-original-product-name gnus-original-version-number) - "Version string for this version of gnus.") - (defcustom gnus-inhibit-startup-message nil "If non-nil, the startup message will not be displayed. This variable is used before `.gnus.el' is loaded, so it should @@ -302,6 +277,8 @@ be set in `.emacs' instead." (defalias 'gnus-delete-overlay 'delete-overlay) (defalias 'gnus-overlay-put 'overlay-put) (defalias 'gnus-move-overlay 'move-overlay) + (defalias 'gnus-overlay-buffer 'overlay-buffer) + (defalias 'gnus-overlay-start 'overlay-start) (defalias 'gnus-overlay-end 'overlay-end) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) @@ -312,7 +289,28 @@ be set in `.emacs' instead." (defalias 'gnus-character-to-event 'identity) (defalias 'gnus-add-text-properties 'add-text-properties) (defalias 'gnus-put-text-property 'put-text-property) - (defalias 'gnus-mode-line-buffer-identification 'identity) + (defvar gnus-mode-line-image-cache t) + (if (fboundp 'find-image) + (defun gnus-mode-line-buffer-identification (line) + (let ((str (car-safe line))) + (if (and (stringp str) + (string-match "^Gnus:" str)) + (progn (add-text-properties + 0 5 + (list 'display + (if (eq t gnus-mode-line-image-cache) + (setq gnus-mode-line-image-cache + (find-image + '((:type xpm :file "gnus-pointer.xpm" + :ascent center) + (:type xbm :file "gnus-pointer.xbm" + :ascent center)))) + gnus-mode-line-image-cache) + 'help-echo "This is Gnus") + str) + (list str)) + line))) + (defalias 'gnus-mode-line-buffer-identification 'identity)) (defalias 'gnus-characterp 'numberp) (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) @@ -774,7 +772,47 @@ be set in `.emacs' instead." "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) - (insert " + (cond + ((and (fboundp 'find-image) + (display-graphic-p) + (let* ((bg (face-background 'default)) + (fg (face-foreground 'gnus-splash-face)) + (image (find-image + `((:type xpm :file "gnus.xpm" + :color-symbols (("thing" . "#724214") + ("shadow" . "#1e3f03") + ("background" . ,bg))) + (:type pbm :file "gnus.pbm" + ;; Account for the pbm's blackground. + :background ,bg :foreground ,fg) + (:type xbm :file "gnus.xbm" + ;; Account for the xbm's blackground. + :background ,bg :foreground ,fg))))) + (when image + (insert + (propertize + (concat gnus-product-name " " gnus-version-number + (if (zerop (string-to-number gnus-revision-number)) + "" + (concat " (r" gnus-revision-number ")")) + " based on " gnus-original-product-name " v" + gnus-original-version-number) + 'face `(variable-pitch :background ,bg :foreground ,fg))) + (let ((fill-column (window-width))) + (center-region (point-min) (point))) + (let ((size (image-size image))) + (insert-char ?\n (max 1 (round (- (window-height) + (or y (cdr size))) 2))) + (insert + (propertize " " 'display + `(space :align-to + ,(max 0 (round (- (window-width) + (or x (car size))) 2))))) + (insert-image image)) + (setq gnus-simple-splash nil) + t)))) + (t + (insert " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -794,32 +832,32 @@ be set in `.emacs' instead." __ " - ) - (goto-char (point-min)) - (insert gnus-product-name " " gnus-version-number - (if (zerop (string-to-number gnus-revision-number)) - "" - (concat " (r" gnus-revision-number ")")) - " based on " gnus-original-product-name " v" - gnus-original-version-number) - (goto-char (point-min)) - (insert-char ?\ ; space - (max 0 (/ (- (window-width) (gnus-point-at-eol)) 2))) - (forward-line 1) - ;; And then hack it. - (gnus-indent-rigidly (point) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Fontify some. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) + ) + (goto-char (point-min)) + (insert gnus-product-name " " gnus-version-number + (if (zerop (string-to-number gnus-revision-number)) + "" + (concat " (r" gnus-revision-number ")")) + " based on " gnus-original-product-name " v" + gnus-original-version-number) + (insert-char ?\ (prog1 + (max 0 (/ (- (window-width) (point)) 2)) + (goto-char (point-min)))) + (forward-line 1) + ;; And then hack it. + (gnus-indent-rigidly (point) (point-max) + (/ (max (- (window-width) (or x 46)) 0) 2)) + (goto-char (point-min)) + (forward-line 1) + (let* ((pheight (count-lines (point-min) (point-max))) + (wheight (window-height)) + (rest (- wheight pheight))) + (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) + ;; Fontify some. + (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) + (setq gnus-simple-splash t))) (goto-char (point-min)) (setq mode-line-buffer-identification (concat " " gnus-version)) - (setq gnus-simple-splash t) (set-buffer-modified-p t)) (eval-when (load) @@ -831,7 +869,6 @@ be set in `.emacs' instead." ;;; Do the rest. -(require 'custom) (require 'gnus-util) (require 'nnheader) @@ -914,7 +951,7 @@ used to 899, you would say something along these lines: nil (list gnus-nntp-service))) (error nil)) - "*Default method for selecting a newsgroup. + "Default method for selecting a newsgroup. This variable should be a list, where the first element is how the news is to be fetched, the second is the address. @@ -935,17 +972,20 @@ see the manual for details." :type 'gnus-select-method) (defcustom gnus-message-archive-method - `(nnfolder - "archive" - (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) + (progn + ;; Don't require it at top level to avoid circularity. + (require 'message) + `(nnfolder + "archive" + (nnfolder-directory ,(nnheader-concat message-directory "archive")) + (nnfolder-active-file + ,(nnheader-concat message-directory "archive/active")) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t))) "*Method used for archiving messages you've sent. This should be a mail method. -It's probably not a very effective to change this variable once you've +It's probably not very effective to change this variable once you've run Gnus once. After doing that, you must edit this server from the server buffer." :group 'gnus-server @@ -1002,8 +1042,8 @@ If, for instance, you want to read your mail with the nnml backend, you could set this variable: \(setq gnus-secondary-select-methods '((nnml \"\")))" -:group 'gnus-server -:type '(repeat gnus-select-method)) + :group 'gnus-server + :type '(repeat gnus-select-method)) (defvar gnus-backup-default-subscribed-newsgroups '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") @@ -1041,12 +1081,12 @@ list, Gnus will try all the methods in the list until it finds a match." :type '(choice (const :tag "default" nil) (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews))) gnus-select-method - (repeat :menu-tag "Try multiple" + (repeat :menu-tag "Try multiple" :tag "Multiple" :value (current (nnweb "refer" (nnweb-type dejanews))) (choice :tag "Method" (const current) - (const :tag "DejaNews" + (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews))) gnus-select-method)))) @@ -1107,11 +1147,6 @@ newsgroups." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-asynchronous nil - "*If non-nil, Gnus will supply backends with data needed for async article fetching." - :group 'gnus-asynchronous - :type 'boolean) - (defcustom gnus-large-newsgroup 200 "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, @@ -1285,6 +1320,7 @@ slower." ("nnweb" none) ("nnslashdot" post) ("nnultimate" none) + ("nnwfm" none) ("nnwarchive" none) ("nnlistserv" none) ("nnagent" post-mail) @@ -1309,20 +1345,27 @@ this variable. I think." (const :format "%v " virtual) (const respool))))) -(define-widget 'gnus-select-method 'list - "Widget for entering a select method." - :value '(nntp "") - :tag "Select Method" - :args `((choice :tag "Method" - ,@(mapcar (lambda (entry) - (list 'const :format "%v\n" - (intern (car entry)))) - gnus-valid-select-methods)) - (string :tag "Address") - (editable-list :inline t - (list :format "%v" - variable - (sexp :tag "Value"))))) +(defun gnus-redefine-select-method-widget () + "Recomputes the select-method widget based on the value of +`gnus-valid-select-methods'." + (define-widget 'gnus-select-method 'list + "Widget for entering a select method." + :value '(nntp "") + :tag "Select Method" + :args `((choice :tag "Method" + ,@(mapcar (lambda (entry) + (list 'const :format "%v\n" + (intern (car entry)))) + gnus-valid-select-methods) + (symbol :tag "other")) + (string :tag "Address") + (repeat :tag "Options" + :inline t + (list :format "%v" + variable + (sexp :tag "Value")))))) + +(gnus-redefine-select-method-widget) (defcustom gnus-updated-mode-lines '(group article summary tree) "List of buffers that should update their mode lines. @@ -1495,6 +1538,7 @@ If nil, no default charset is assumed when posting." ;;; Internal variables +(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) (defvar gnus-original-article-buffer " *Original Article*") @@ -1504,6 +1548,12 @@ If nil, no default charset is assumed when posting." (defvar gnus-agent nil "Whether we want to use the Gnus agent or not.") +(defvar gnus-agent-fetching nil + "Whether Gnus agent is in fetching mode.") + +(defvar gnus-agent-fetching nil + "Whether Gnus agent is in fetching mode.") + (defvar gnus-command-method nil "Dynamically bound variable that says what the current backend is.") @@ -1564,7 +1614,7 @@ If nil, no default charset is assumed when posting." (defvar gnus-have-read-active-file nil) (defconst gnus-maintainer - "semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (T-gnus Bugfixing Girls + Boys)" + "semi-gnus-ja@meadowy.org (T-gnus Bugfixing Girls + Boys)" "The mail address of the T-gnus maintainers.") (defcustom gnus-info-filename nil @@ -1599,13 +1649,30 @@ This variable can be nil, gnus or gnus-ja." (defvar gnus-variable-list '(gnus-newsrc-options gnus-newsrc-options-n - gnus-newsrc-last-checked-date - gnus-newsrc-alist gnus-server-alist - gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist - gnus-format-specs) + gnus-newsrc-last-checked-date + gnus-newsrc-alist gnus-server-alist + gnus-killed-list gnus-zombie-list + gnus-topic-topology gnus-topic-alist) "Gnus variables saved in the quick startup file.") +(defvar gnus-product-variable-file-list + (let ((version (product-version (product-find 'gnus-vers))) + (codesys (static-if (boundp 'MULE) '*ctext* 'ctext))) + `(("strict-cache" ((product-version ,version) (emacs-version)) + binary + gnus-format-specs-compiled) + ("cache" ((product-version ,version) (emacs-version)) + ,codesys + gnus-format-specs))) + "Gnus variables are saved in the produce depend quick startup files.") + +(defcustom gnus-compile-user-specs t + "If non-nil, the user-defined format specs will be byte-compiled +automatically. +It has an effect on the values of `gnus-*-line-format-spec'." + :group 'gnus + :type 'boolean) + (defvar gnus-newsrc-alist nil "Assoc list of read articles. gnus-newsrc-hashtb should be kept so that both hold the same information.") @@ -1649,6 +1716,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") use the article treating faculties instead. Is is described in Info node `Customizing Articles'.") +(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$" + "Regexp matching invalid groups.") + ;;; End of variables. ;; Define some autoload functions Gnus might use. @@ -1665,15 +1735,14 @@ use the article treating faculties instead. Is is described in Info node (when (consp function) (setq keymap (car (memq 'keymap function))) (setq function (car function))) - (autoload function (car package) nil interactive keymap))) + (unless (fboundp function) + (autoload function (car package) nil interactive keymap)))) (if (eq (nth 1 package) ':interactive) - (cdddr package) + (nthcdr 3 package) (cdr package))))) - '(("info" Info-goto-node) - ("pp" pp pp-to-string pp-eval-expression) + '(("info" :interactive t Info-goto-node) + ("pp" pp-to-string) ("ps-print" ps-print-preprint) - ("mail-extr" mail-extract-address-components) - ("browse-url" browse-url) ("message" :interactive t message-send-and-exit message-yank-original) ("babel" babel-as-string) @@ -1717,21 +1786,22 @@ use the article treating faculties instead. Is is described in Info node gnus-cache-possibly-remove-articles gnus-cache-request-article gnus-cache-retrieve-headers gnus-cache-possibly-alter-active gnus-cache-enter-remove-article gnus-cached-article-p - gnus-cache-open gnus-cache-close gnus-cache-update-article) - ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article - gnus-cache-remove-article gnus-summary-insert-cached-articles) - ("gnus-score" :interactive t - gnus-summary-increase-score gnus-summary-set-score - gnus-summary-raise-thread gnus-summary-raise-same-subject - gnus-summary-raise-score gnus-summary-raise-same-subject-and-select - gnus-summary-lower-thread gnus-summary-lower-same-subject - gnus-summary-lower-score gnus-summary-lower-same-subject-and-select - gnus-summary-current-score gnus-score-default - gnus-score-flush-cache gnus-score-close - gnus-possibly-score-headers gnus-score-followup-article - gnus-score-followup-thread) - ("gnus-score" - (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers + gnus-cache-open gnus-cache-close gnus-cache-update-article + gnus-cache-articles-in-group) + ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article + gnus-cache-remove-article gnus-summary-insert-cached-articles) + ("gnus-score" :interactive t + gnus-summary-increase-score gnus-summary-set-score + gnus-summary-raise-thread gnus-summary-raise-same-subject + gnus-summary-raise-score gnus-summary-raise-same-subject-and-select + gnus-summary-lower-thread gnus-summary-lower-same-subject + gnus-summary-lower-score gnus-summary-lower-same-subject-and-select + gnus-summary-current-score gnus-score-delta-default + gnus-score-flush-cache gnus-score-close + gnus-possibly-score-headers gnus-score-followup-article + gnus-score-followup-thread) + ("gnus-score" + (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers gnus-current-score-file-nondirectory gnus-score-adaptive gnus-score-find-trace gnus-score-file-name) ("gnus-cus" :interactive t gnus-custom-mode gnus-group-customize @@ -1756,8 +1826,7 @@ use the article treating faculties instead. Is is described in Info node ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) - gnus-article-mail gnus-copy-article-buffer gnus-extended-version - gnus-following-method) + gnus-article-mail gnus-copy-article-buffer gnus-following-method) ("gnus-msg" :interactive t gnus-group-post-news gnus-group-mail gnus-summary-post-news gnus-summary-followup gnus-summary-followup-with-original @@ -1776,6 +1845,7 @@ use the article treating faculties instead. Is is described in Info node ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) ("smiley" :interactive t gnus-smiley-display) + ("smiley" smiley-toggle-buffer) ("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 @@ -1799,9 +1869,11 @@ use the article treating faculties instead. Is is described in Info node gnus-article-delete-invisible-text gnus-treat-article) ("gnus-art" :interactive t gnus-article-hide-headers gnus-article-hide-boring-headers - gnus-article-treat-overstrike + gnus-article-treat-overstrike gnus-article-remove-cr gnus-article-remove-trailing-blank-lines gnus-article-display-x-face + gnus-article-decode-HZ + gnus-article-wash-html gnus-article-hide-pgp gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local @@ -1854,8 +1926,11 @@ use the article treating faculties instead. Is is described in Info node (eval-and-compile (unless (featurep 'xemacs) - (autoload 'gnus-smiley-display "gnus-bitmap") - (autoload 'x-face-mule-gnus-article-display-x-face "x-face-mule"))) + (autoload 'gnus-smiley-display "gnus-bitmap" nil t) + (autoload 'smiley-toggle-buffer "gnus-bitmap") + (autoload 'x-face-mule-gnus-article-display-x-face "x-face-mule") + (when (>= emacs-major-version 21) + (autoload 'x-face-decode-message-header "x-face-e21")))) ;;; gnus-sum.el thingies @@ -2103,42 +2178,6 @@ STRINGS will be evaluated in normal `or' order." (setq strings nil))) string)) -(defun gnus-version (&optional arg) - "Version number of this version of Gnus. -If ARG, insert string at point." - (interactive "P") - (if arg - (insert (message gnus-version)) - (message gnus-version))) - -(defun gnus-continuum-version (version) - "Return VERSION as a floating point number." - (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) - (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) - (let ((alpha (and (match-beginning 1) (match-string 1 version))) - (number (match-string 2 version)) - major minor least) - (unless (string-match - "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (error "Invalid version string: %s" version)) - (setq major (string-to-number (match-string 1 number)) - minor (string-to-number (match-string 2 number)) - least (if (match-beginning 3) - (string-to-number (match-string 3 number)) - 0)) - (string-to-number - (if (zerop major) - (format "%s00%02d%02d" - (if (member alpha '("(ding)" "d")) - "4.99" - (+ 5 (* 0.02 - (abs - (- (char-int (aref (downcase alpha) 0)) - (char-int ?t)))) - -0.01)) - minor least) - (format "%d.%02d%02d" major minor least)))))) - (defun gnus-info-find-node () "Find Info documentation of Gnus." (interactive) @@ -2324,7 +2363,14 @@ that that variable is buffer-local to the summary buffers." "Return non-nil if GROUP (and ARTICLE) come from a news server." (or (gnus-member-of-valid 'post group) ; Ordinary news group. (and (gnus-member-of-valid 'post-mail group) ; Combined group. - (eq (gnus-request-type group article) 'news)))) + (if (or (null article) + (not (< article 0))) + (eq (gnus-request-type group article) 'news) + (if (not (vectorp article)) + nil + ;; It's a real article. + (eq (gnus-request-type group (mail-header-id article)) + 'news)))))) ;; Returns a list of writable groups. (defun gnus-writable-groups () @@ -2540,9 +2586,9 @@ You should probably use `gnus-find-method-for-group' instead." (let ((methods gnus-secondary-select-methods) (gmethod (gnus-server-get-method nil method))) (while (and methods - (not (gnus-method-equal - (gnus-server-get-method nil (car methods)) - gmethod))) + (not (gnus-method-equal + (gnus-server-get-method nil (car methods)) + gmethod))) (setq methods (cdr methods))) methods)) @@ -2686,9 +2732,21 @@ just the host name." group (substring group (+ 1 colon)))) (setq foreign (concat foreign ":"))) ;; Collapse group name leaving LEVELS uncollapsed elements - (let* ((glist (split-string group "\\.")) - (glen (length glist)) + (let* ((slist (split-string group "/")) + (slen (length slist)) + (dlist (split-string group "\\.")) + (dlen (length dlist)) + glist + glen + gsep res) + (if (> slen dlen) + (setq glist slist + glen slen + gsep "/") + (setq glist dlist + glen dlen + gsep ".")) (setq levels (- glen levels)) (dolist (g glist) (push (if (>= (decf levels) 0) @@ -2697,7 +2755,7 @@ just the host name." (substring g 0 1)) g) res)) - (concat foreign (mapconcat 'identity (nreverse res) ".")))))) + (concat foreign (mapconcat 'identity (nreverse res) gsep)))))) (defun gnus-narrow-to-body () "Narrow to the body of an article." @@ -2775,7 +2833,7 @@ If NEWSGROUP is nil, return the global kill file name instead." (let ((opened gnus-opened-servers)) (while (and method opened) (when (and (equal (cadr method) (cadaar opened)) - (equal (car method) (caaar opened)) + (equal (car method) (caaar opened)) (not (equal method (caar opened)))) (setq method nil)) (pop opened)) @@ -2812,6 +2870,8 @@ If NEWSGROUP is nil, return the global kill file name instead." (or gnus-override-method (and (not group) gnus-select-method) + (and (not (gnus-group-entry group));; a new group + (gnus-group-name-to-method group)) (let ((info (or info (gnus-get-info group))) method) (if (or (not info) @@ -2848,8 +2908,8 @@ Disallow invalid group names." (let ((prefix "") group) (while (not group) - (when (string-match - "[: `'\"/]\\|^$" + (when (string-match + gnus-invalid-group-regexp (setq group (read-string (concat prefix prompt) (cons (or default "") 0) 'gnus-group-history))) @@ -2882,7 +2942,7 @@ Allow completion over sensible values." (or (let ((opened gnus-opened-servers)) (while (and opened (not (equal (format "%s:%s" method address) - (format "%s:%s" (caaar opened) + (format "%s:%s" (caaar opened) (cadaar opened))))) (pop opened)) (caar opened)) @@ -2967,6 +3027,6 @@ prompt the user for the name of an NNTP server to use." (gnus-ems-redefine) -(provide 'gnus) +(product-provide (provide 'gnus) 'gnus-vers) ;;; gnus.el ends here diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index c28c942..b39decb 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -1,5 +1,6 @@ ;;; ietf-drums.el --- Functions for parsing RFC822bis headers -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -28,6 +29,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'time-date) (require 'mm-util) @@ -115,7 +117,7 @@ (buffer-string)))) (defun ietf-drums-remove-whitespace (string) - "Remove comments from STRING." + "Remove whitespace from STRING." (with-temp-buffer (ietf-drums-init string) (let (c) @@ -151,6 +153,10 @@ (forward-char 1)))) result))) +(defun ietf-drums-strip (string) + "Remove comments and whitespace from STRING." + (ietf-drums-remove-whitespace (ietf-drums-remove-comments string))) + (defun ietf-drums-parse-address (string) "Parse STRING and return a MAILBOX / DISPLAY-NAME pair." (with-temp-buffer @@ -228,8 +234,8 @@ "Narrow to the header section in the current buffer." (narrow-to-region (goto-char (point-min)) - (if (re-search-forward "^\n" nil 1) - (1- (point)) + (if (re-search-forward "^\r?$" nil 1) + (match-beginning 0) (point-max))) (goto-char (point-min))) diff --git a/lisp/imap.el b/lisp/imap.el index d91e160..ec420ac 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -1,5 +1,6 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: mail @@ -29,7 +30,7 @@ ;; imap.el is roughly divided in two parts, one that parses IMAP ;; responses from the server and storing data into buffer-local ;; variables, and one for utility functions which send commands to -;; server, waits for an answer, and return information. The latter +;; server, waits for an answer, and return information. The latter ;; part is layered on top of the previous. ;; ;; The imap.el API consist of the following functions, other functions @@ -69,17 +70,19 @@ ;; imap-body-lines ;; ;; It is my hope that theese commands should be pretty self -;; explanatory for someone that know IMAP. All functions have +;; explanatory for someone that know IMAP. All functions have ;; additional documentation on how to invoke them. ;; ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP ;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 -;; (NAMESPACE), RFC2359 (UIDPLUS), and the kerberos V4 part of RFC1731 +;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, +;; LOGINDISABLED) (with use of external library starttls.el and +;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731 ;; (with use of external program `imtest'). It also take advantage ;; the UNSELECT extension in Cyrus IMAPD. ;; ;; Without the work of John McClary Prevost and Jim Radford this library -;; would not have seen the light of day. Many thanks. +;; would not have seen the light of day. Many thanks. ;; ;; This is a transcript of short interactive session for demonstration ;; purposes. @@ -88,7 +91,7 @@ ;; => " *imap* my.mail.server:0" ;; ;; The rest are invoked with current buffer as the buffer returned by -;; `imap-open'. It is possible to do all without this, but it would +;; `imap-open'. It is possible to do all without this, but it would ;; look ugly here since `buffer' is always the last argument for all ;; imap.el API functions. ;; @@ -122,12 +125,13 @@ ;; o Don't use `read' at all (important places already fixed) ;; o Accept list of articles instead of message set string in most ;; imap-message-* functions. -;; o Cyrus IMAPd 1.6.x `imtest' support in the imtest wrapper -;; o Format-spec'ify the ssl horror ;; ;; Revision history: ;; -;; - this is unreleased software +;; - 19991218 added starttls/digest-md5 patch, +;; by Daiki Ueno +;; NB! you need SLIM for starttls.el and digest-md5.el +;; - 19991023 commited to pgnus ;; ;;; Code: @@ -135,65 +139,82 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) +(require 'base64) + (eval-and-compile (autoload 'open-ssl-stream "ssl") (autoload 'starttls-open-stream "starttls") (autoload 'starttls-negotiate "starttls") (autoload 'rfc2104-hash "rfc2104") + (autoload 'md5 "md5") (autoload 'utf7-encode "utf7") (autoload 'utf7-decode "utf7") (autoload 'format-spec "format-spec") - (autoload 'format-spec-make "format-spec")) - -(static-if (and (fboundp 'base64-decode-string) - (subrp (symbol-function 'base64-decode-string))) - (eval-and-compile (fset 'imap-base64-decode-string 'base64-decode-string)) - (require 'mel) - (defun imap-base64-decode-string (string) - (fset 'imap-base64-decode-string - (symbol-function (mel-find-function 'mime-decode-string "base64"))) - (imap-base64-decode-string string)) - ) - -(static-if (and (fboundp 'base64-encode-string) - (subrp (symbol-function 'base64-encode-string))) - (eval-and-compile (fset 'imap-base64-encode-string 'base64-encode-string)) - (defun imap-base64-encode-string (string) - (fset 'imap-base64-encode-string - (symbol-function (mel-find-function 'mime-encode-string "base64"))) - (imap-base64-encode-string string)) - ) - -(autoload 'md5 "md5") + (autoload 'format-spec-make "format-spec") + ;; Avoid use gnus-point-at-eol so we're independent of Gnus. These + ;; days we have point-at-eol anyhow. + (if (fboundp 'point-at-eol) + (defalias 'imap-point-at-eol 'point-at-eol) + (defun imap-point-at-eol () + (save-excursion + (end-of-line) + (point)))) + (autoload 'sasl-digest-md5-digest-response "sasl")) ;; User variables. -(defvar imap-imtest-program "imtest -kp %s %p" - "How to call program for Kerberos 4 authentication. -%s is replaced with server and %p with port to connect to. The -program should accept IMAP commands on stdin and return responses to -stdout.") - -(defvar imap-ssl-program 'auto - "Program to use for SSL connections. It is called like this - -`imap-ssl-program' `imap-ssl-arguments' -ssl2 -connect host:port - -where -ssl2 can also be -ssl3 to indicate which ssl version to use. It -should accept IMAP commands on stdin and return responses to stdout. - -For SSLeay set this to \"s_client\" and `imap-ssl-arguments' to nil, -for OpenSSL set this to \"openssl\" and `imap-ssl-arguments' to -\"s_client\". - -If 'auto it tries s_client first and then openssl.") - -(defvar imap-ssl-arguments nil - "Arguments to pass to `imap-ssl-program'. - -For SSLeay set this to nil, for OpenSSL to \"s_client\". - -If `imap-ssl-program' is 'auto this variable has no effect.") +(defgroup imap nil + "Low-level IMAP issues." + :version "21.1" + :group 'mail) + +(defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s" + "imtest -kp %s %p") + "List of strings containing commands for Kerberos 4 authentication. +%s is replaced with server hostname, %p with port to connect to, and +%l with the value of `imap-default-user'. The program should accept +IMAP commands on stdin and return responses to stdout. Each entry in +the list is tried until a successful connection is made." + :group 'imap + :type '(repeat string)) + +(defcustom imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s") + "List of strings containing commands for GSSAPI (krb5) authentication. +%s is replaced with server hostname, %p with port to connect to, and +%l with the value of `imap-default-user'. The program should accept +IMAP commands on stdin and return responses to stdout. Each entry in +the list is tried until a successful connection is made." + :group 'imap + :type '(repeat string)) + +(defcustom imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p" + "openssl s_client -ssl2 -connect %s:%p" + "s_client -ssl3 -connect %s:%p" + "s_client -ssl2 -connect %s:%p") + "A string, or list of strings, containing commands for SSL connections. +Within a string, %s is replaced with the server address and %p with +port number on server. The program should accept IMAP commands on +stdin and return responses to stdout. Each entry in the list is tried +until a successful connection is made." + :group 'imap + :type '(choice string + (repeat string))) + +(defcustom imap-shell-program '("ssh %s imapd" + "rsh %s imapd" + "ssh %g ssh %s imapd" + "rsh %g rsh %s imapd") + "A list of strings, containing commands for IMAP connection. +Within a string, %s is replaced with the server address, %p with port +number on server, %g with `imap-shell-host', and %l with +`imap-default-user'. The program should read IMAP commands from stdin +and write IMAP response to stdout. Each entry in the list is tried +until a successful connection is made." + :group 'imap + :type '(repeat string)) + +(defvar imap-shell-host "gateway" + "Hostname of rlogin proxy.") (defvar imap-default-user (user-login-name) "Default username to use.") @@ -206,47 +227,54 @@ If `imap-ssl-program' is 'auto this variable has no effect.") (defvar imap-fetch-data-hook nil "Hooks called after receiving each FETCH response.") -(defvar imap-streams '(kerberos4 ssl network) - "Priority of streams to consider when opening connection to -server.") +(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell) + "Priority of streams to consider when opening connection to server.") (defvar imap-stream-alist - '((kerberos4 imap-kerberos4s-p imap-kerberos4-open) - (ssl imap-ssl-p imap-ssl-open) - (network imap-network-p imap-network-open) - (tls imap-tls-p imap-tls-open)) + '((gssapi imap-gssapi-stream-p imap-gssapi-open) + (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open) + (ssl imap-ssl-p imap-ssl-open) + (network imap-network-p imap-network-open) + (shell imap-shell-p imap-shell-open) + (starttls imap-starttls-p imap-starttls-open)) "Definition of network streams. -(NAME CHECK OPEN) +\(NAME CHECK OPEN) NAME names the stream, CHECK is a function returning non-nil if the server support the stream and OPEN is a function for opening the stream.") -(defvar imap-authenticators '(kerberos4 cram-md5 login anonymous) - "Priority of authenticators to consider when authenticating to -server.") +(defvar imap-authenticators '(gssapi + kerberos4 + digest-md5 + cram-md5 + login + anonymous) + "Priority of authenticators to consider when authenticating to server.") (defvar imap-authenticator-alist - '((kerberos4 imap-kerberos4a-p imap-kerberos4-auth) - (cram-md5 imap-cram-md5-p imap-cram-md5-auth) - (login imap-login-p imap-login-auth) - (anonymous imap-anonymous-p imap-anonymous-auth)) + '((gssapi imap-gssapi-auth-p imap-gssapi-auth) + (kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth) + (cram-md5 imap-cram-md5-p imap-cram-md5-auth) + (login imap-login-p imap-login-auth) + (anonymous imap-anonymous-p imap-anonymous-auth) + (digest-md5 imap-digest-md5-p imap-digest-md5-auth)) "Definition of authenticators. -(NAME CHECK AUTHENTICATE) +\(NAME CHECK AUTHENTICATE) -NAME names the authenticator. CHECK is a function returning non-nil if +NAME names the authenticator. CHECK is a function returning non-nil if the server support the authenticator and AUTHENTICATE is a function for doing the actuall authentification.") -(defvar imap-utf7-p nil +(defvar imap-use-utf7 t "If non-nil, do utf7 encoding/decoding of mailbox names. Since the UTF7 decoding currently only decodes into ISO-8859-1 characters, you may disable this decoding if you need to access UTF7 encoded mailboxes which doesn't translate into ISO-8859-1.") -;; Internal constants. Change theese and die. +;; Internal constants. Change theese and die. (defconst imap-default-port 143) (defconst imap-default-ssl-port 993) @@ -269,6 +297,7 @@ encoded mailboxes which doesn't translate into ISO-8859-1.") imap-failed-tags imap-tag imap-process + imap-calculate-literal-size-first imap-mailbox-data)) ;; Internal variables. @@ -279,9 +308,11 @@ encoded mailboxes which doesn't translate into ISO-8859-1.") (defvar imap-port nil) (defvar imap-username nil) (defvar imap-password nil) +(defvar imap-calculate-literal-size-first nil) (defvar imap-state 'closed - "IMAP state. Valid states are `closed', `initial', `nonauth', -`auth', `selected' and `examine'.") + "IMAP state. +Valid states are `closed', `initial', `nonauth', `auth', `selected' +and `examine'.") (defvar imap-server-eol "\r\n" "The EOL string sent from the server.") @@ -320,10 +351,10 @@ encoded mailboxes which doesn't translate into ISO-8859-1.") "Lower limit on command tags that have been parsed.") (defvar imap-failed-tags nil - "Alist of tags that failed. Each element is a list with four -elements; tag (a integer), response state (a symbol, `OK', `NO' or -`BAD'), response code (a string), and human readable response text (a -string).") + "Alist of tags that failed. +Each element is a list with four elements; tag (a integer), response +state (a symbol, `OK', `NO' or `BAD'), response code (a string), and +human readable response text (a string).") (defvar imap-tag 0 "Command tag number.") @@ -332,21 +363,23 @@ string).") "Process.") (defvar imap-continuation nil - "Non-nil indicates that the server emitted a continuation request. The -actually value is really the text on the continuation line.") + "Non-nil indicates that the server emitted a continuation request. +The actually value is really the text on the continuation line.") (defvar imap-log nil - "Imap session trace.") + "Name of buffer for imap session trace. +For example: (setq imap-log \"*imap-log*\")") -(defvar imap-debug nil;"*imap-debug*" - "Random debug spew.") +(defvar imap-debug nil ;"*imap-debug*" + "Name of buffer for random debug spew. +For example: (setq imap-debug \"*imap-debug*\")") ;; Utility functions: (defun imap-read-passwd (prompt &rest args) - "Read a password using PROMPT. If ARGS, PROMPT is used as an -argument to `format'." + "Read a password using PROMPT. +If ARGS, PROMPT is used as an argument to `format'." (let ((prompt (if args (apply 'format prompt args) prompt))) @@ -361,7 +394,7 @@ argument to `format'." prompt))) (defsubst imap-utf7-encode (string) - (if imap-utf7-p + (if imap-use-utf7 (and string (condition-case () (utf7-encode string t) @@ -372,7 +405,7 @@ argument to `format'." string)) (defsubst imap-utf7-decode (string) - (if imap-utf7-p + (if imap-use-utf7 (and string (condition-case () (utf7-decode string t) @@ -395,96 +428,174 @@ argument to `format'." ;; Server functions; stream stuff: -(defun imap-kerberos4s-p (buffer) +(defun imap-kerberos4-stream-p (buffer) (imap-capability 'AUTH=KERBEROS_V4 buffer)) (defun imap-kerberos4-open (name buffer server port) - (message "Opening Kerberized IMAP connection...") - (let* ((port (or port imap-default-port)) - (process (as-binary-process - (start-process - name buffer shell-file-name shell-command-switch - (format-spec - imap-imtest-program - (format-spec-make ?s server ?p (number-to-string port)) - ))))) - (when process - (with-current-buffer buffer - (setq imap-client-eol "\n") - ;; Result of authentication is a string: __Full privacy protection__ - (while (and (memq (process-status process) '(open run)) - (goto-char (point-min)) - (not (and (imap-parse-greeting) - (re-search-forward "__\\(.*\\)__\n" nil t)))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (let ((response (match-string 1))) - (erase-buffer) - (message "Kerberized IMAP connection: %s" response) - (if (and response (let ((case-fold-search nil)) - (not (string-match "failed" response)))) - process - (if (memq (process-status process) '(open run)) - (imap-send-command-wait "LOGOUT")) - (delete-process process) - nil)))))) + (let ((cmds imap-kerberos4-program) + cmd done) + (while (and (not done) (setq cmd (pop cmds))) + (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd) + (erase-buffer) + (let* ((port (or port imap-default-port)) + (process (as-binary-process + (start-process + name buffer shell-file-name shell-command-switch + (format-spec + cmd + (format-spec-make + ?s server + ?p (number-to-string port) + ?l imap-default-user))))) + response) + (when process + (with-current-buffer buffer + (setq imap-client-eol "\n" + imap-calculate-literal-size-first t) + (while (and (memq (process-status process) '(open run)) + (goto-char (point-min)) + ;; cyrus 1.6.x (13? < x <= 22) queries capabilities + (or (while (looking-at "^C:") + (forward-line)) + t) + ;; cyrus 1.6 imtest print "S: " before server greeting + (or (not (looking-at "S: ")) + (forward-char 3) + t) + (not (and (imap-parse-greeting) + ;; success in imtest < 1.6: + (or (re-search-forward + "^__\\(.*\\)__\n" nil t) + ;; success in imtest 1.6: + (re-search-forward + "^\\(Authenticat.*\\)" nil t)) + (setq response (match-string 1))))) + (accept-process-output process 1) + (sit-for 1)) + (and imap-log + (with-current-buffer (get-buffer-create imap-log) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer))) + (erase-buffer) + (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd + (if response (concat "done, " response) "failed")) + (if (and response (let ((case-fold-search nil)) + (not (string-match "failed" response)))) + (setq done process) + (if (memq (process-status process) '(open run)) + (imap-send-command-wait "LOGOUT")) + (delete-process process) + nil))))) + done)) +(defun imap-gssapi-stream-p (buffer) + (imap-capability 'AUTH=GSSAPI buffer)) + +(defun imap-gssapi-open (name buffer server port) + (let ((cmds imap-gssapi-program) + cmd done) + (while (and (not done) (setq cmd (pop cmds))) + (message "Opening GSSAPI IMAP connection with `%s'..." cmd) + (let* ((port (or port imap-default-port)) + (process (as-binary-process + (start-process + name buffer shell-file-name shell-command-switch + (format-spec + cmd + (format-spec-make + ?s server + ?p (number-to-string port) + ?l imap-default-user))))) + response) + (when process + (with-current-buffer buffer + (setq imap-client-eol "\n") + (while (and (memq (process-status process) '(open run)) + (goto-char (point-min)) + ;; cyrus 1.6.x (13? < x <= 22) queries capabilities + (or (while (looking-at "^C:") + (forward-line)) + t) + ;; cyrus 1.6 imtest print "S: " before server greeting + (or (not (looking-at "S: ")) + (forward-char 3) + t) + (not (and (imap-parse-greeting) + ;; success in imtest 1.6: + (re-search-forward + "^\\(Authenticat.*\\)" nil t) + (setq response (match-string 1))))) + (accept-process-output process 1) + (sit-for 1)) + (and imap-log + (with-current-buffer (get-buffer-create imap-log) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer))) + (erase-buffer) + (message "GSSAPI IMAP connection: %s" (or response "failed")) + (if (and response (let ((case-fold-search nil)) + (not (string-match "failed" response)))) + (setq done process) + (if (memq (process-status process) '(open run)) + (imap-send-command-wait "LOGOUT")) + (delete-process process) + nil))))) + done)) + (defun imap-ssl-p (buffer) nil) -(defun imap-ssl-open-2 (name buffer server port &optional extra-ssl-args) - (let* ((port (or port imap-default-ssl-port)) - (ssl-program-name imap-ssl-program) - (ssl-program-arguments (append imap-ssl-arguments extra-ssl-args - (list "-connect" - (format "%s:%d" server port)))) - (process (ignore-errors - (as-binary-process - (open-ssl-stream name buffer server port))))) - (when process - (with-current-buffer buffer - (goto-char (point-min)) - (while (and (memq (process-status process) '(open run)) - (goto-char (point-max)) - (forward-line -1) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (erase-buffer)) - (when (memq (process-status process) '(open run)) - process)))) - -(defun imap-ssl-open-1 (name buffer server port &optional extra-ssl-args) - (or (and (eq imap-ssl-program 'auto) - (let ((imap-ssl-program "s_client") - (imap-ssl-arguments nil)) - (message "imap: Opening IMAP connection with %s %s..." - imap-ssl-program (car-safe extra-ssl-args)) - (imap-ssl-open-2 name buffer server port extra-ssl-args))) - (and (eq imap-ssl-program 'auto) - (let ((imap-ssl-program "openssl") - (imap-ssl-arguments '("s_client"))) - (message "imap: Opening IMAP connection with %s %s..." - imap-ssl-program (car-safe extra-ssl-args)) - (imap-ssl-open-2 name buffer server port extra-ssl-args))) - (and (not (eq imap-ssl-program 'auto)) - (progn (message "imap: Opening IMAP connection with %s %s..." - imap-ssl-program (car-safe extra-ssl-args)) - (imap-ssl-open-2 name buffer server port extra-ssl-args))))) - (defun imap-ssl-open (name buffer server port) - (or (imap-ssl-open-1 name buffer server port '("-ssl3")) - (imap-ssl-open-1 name buffer server port '("-ssl2")))) + "Open a SSL connection to server." + (let ((cmds (if (listp imap-ssl-program) imap-ssl-program + (list imap-ssl-program))) + cmd done) + (while (and (not done) (setq cmd (pop cmds))) + (message "imap: Opening SSL connection with `%s'..." cmd) + (let* ((port (or port imap-default-ssl-port)) + (ssl-program-name shell-file-name) + (ssl-program-arguments + (list shell-command-switch + (format-spec cmd (format-spec-make + ?s server + ?p (number-to-string port))))) + process) + (when (setq process + (ignore-errors + (cond ((eq system-type 'windows-nt) + (let (selective-display + (coding-system-for-write 'binary) + (coding-system-for-read 'raw-text-dos) + (output-coding-system 'binary) + (input-coding-system 'raw-text-dos)) + (open-ssl-stream name buffer server port))) + (t + (as-binary-process + (open-ssl-stream name buffer server port)))))) + (with-current-buffer buffer + (goto-char (point-min)) + (while (and (memq (process-status process) '(open run)) + (goto-char (point-max)) + (forward-line -1) + (not (imap-parse-greeting))) + (accept-process-output process 1) + (sit-for 1)) + (and imap-log + (with-current-buffer (get-buffer-create imap-log) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer))) + (erase-buffer) + (when (memq (process-status process) '(open run)) + (setq done process)))))) + (if done + (progn + (message "imap: Opening SSL connection with `%s'...done" cmd) + done) + (message "imap: Opening SSL connection with `%s'...failed" cmd) + nil))) (defun imap-network-p (buffer) t) @@ -506,13 +617,61 @@ argument to `format'." (when (memq (process-status process) '(open run)) process)))) -(defun imap-tls-p (buffer) - (imap-capability 'STARTTLS buffer)) +(defun imap-shell-p (buffer) + nil) -(defun imap-tls-open (name buffer server port) +(defun imap-shell-open (name buffer server port) + (let ((cmds imap-shell-program) + cmd done) + (while (and (not done) (setq cmd (pop cmds))) + (message "imap: Opening IMAP connection with `%s'..." cmd) + (setq imap-client-eol "\n") + (let* ((port (or port imap-default-port)) + (process (as-binary-process + (start-process + name buffer shell-file-name shell-command-switch + (format-spec + cmd + (format-spec-make + ?s server + ?g imap-shell-host + ?p (number-to-string port) + ?l imap-default-user)))))) + (when process + (while (and (memq (process-status process) '(open run)) + (goto-char (point-min)) + (not (imap-parse-greeting))) + (accept-process-output process 1) + (sit-for 1)) + (erase-buffer) + (and imap-log + (with-current-buffer (get-buffer-create imap-log) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer))) + (when (memq (process-status process) '(open run)) + (setq done process))))) + (if done + (progn + (message "imap: Opening IMAP connection with `%s'...done" cmd) + done) + (message "imap: Opening IMAP connection with `%s'...failed" cmd) + nil))) + +(defun imap-starttls-p (buffer) + (and (imap-capability 'STARTTLS buffer) + (condition-case () + (progn + (require 'starttls) + (call-process "starttls")) + (error nil)))) + +(defun imap-starttls-open (name buffer server port) (let* ((port (or port imap-default-port)) (process (as-binary-process - (starttls-open-stream name buffer server port)))) + (starttls-open-stream name buffer server port))) + done) + (message "imap: Connecting with STARTTLS...") (when process (while (and (memq (process-status process) '(open run)) (goto-char (point-min)) @@ -528,57 +687,73 @@ argument to `format'." (unwind-protect (progn (set-process-filter imap-process 'imap-arrival-filter) - (when (and (eq imap-stream 'tls) + (when (and (eq imap-stream 'starttls) (imap-ok-p (imap-send-command-wait "STARTTLS"))) (starttls-negotiate imap-process))) (set-process-filter imap-process nil))) (when (memq (process-status process) '(open run)) - process)))) + (setq done process))) + (if done + (progn + (message "imap: Connecting with STARTTLS...done") + done) + (message "imap: Connecting with STARTTLS...failed") + nil))) ;; Server functions; authenticator stuff: (defun imap-interactive-login (buffer loginfunc) - "Login to server in BUFFER. LOGINFUNC is passed a username and a -password, it should return t if it where sucessful authenticating -itself to the server, nil otherwise. Returns t if login was -successful, nil otherwise." + "Login to server in BUFFER. +LOGINFUNC is passed a username and a password, it should return t if +it where sucessful authenticating itself to the server, nil otherwise. +Returns t if login was successful, nil otherwise." (with-current-buffer buffer (make-variable-buffer-local 'imap-username) (make-variable-buffer-local 'imap-password) (let (user passwd ret) -;; (condition-case () - (while (or (not user) (not passwd)) - (setq user (or imap-username - (read-from-minibuffer - (concat "IMAP username for " imap-server ": ") - (or user imap-default-user)))) - (setq passwd (or imap-password - (imap-read-passwd - (concat "IMAP password for " user "@" - imap-server ": ")))) - (when (and user passwd) - (if (funcall loginfunc user passwd) - (progn - (setq ret t - imap-username user) - (if (and (not imap-password) - (y-or-n-p "Store password for this session? ")) - (setq imap-password passwd))) - (message "Login failed...") - (setq passwd nil) - (sit-for 1)))) -;; (quit (with-current-buffer buffer -;; (setq user nil -;; passwd nil))) -;; (error (with-current-buffer buffer -;; (setq user nil -;; passwd nil)))) + ;; (condition-case () + (while (or (not user) (not passwd)) + (setq user (or imap-username + (read-from-minibuffer + (concat "IMAP username for " imap-server ": ") + (or user imap-default-user)))) + (setq passwd (or imap-password + (imap-read-passwd + (concat "IMAP password for " user "@" + imap-server ": ")))) + (when (and user passwd) + (if (funcall loginfunc user passwd) + (progn + (setq ret t + imap-username user) + (if (and (not imap-password) + (y-or-n-p "Store password for this session? ")) + (setq imap-password passwd))) + (message "Login failed...") + (setq passwd nil) + (sit-for 1)))) + ;; (quit (with-current-buffer buffer + ;; (setq user nil + ;; passwd nil))) + ;; (error (with-current-buffer buffer + ;; (setq user nil + ;; passwd nil)))) ret))) -(defun imap-kerberos4a-p (buffer) +(defun imap-gssapi-auth-p (buffer) + (imap-capability 'AUTH=GSSAPI buffer)) + +(defun imap-gssapi-auth (buffer) + (message "imap: Authenticating using GSSAPI...%s" + (if (eq imap-stream 'gssapi) "done" "failed")) + (eq imap-stream 'gssapi)) + +(defun imap-kerberos4-auth-p (buffer) (imap-capability 'AUTH=KERBEROS_V4 buffer)) (defun imap-kerberos4-auth (buffer) + (message "imap: Authenticating using Kerberos 4...%s" + (if (eq imap-stream 'kerberos4) "done" "failed")) (eq imap-stream 'kerberos4)) (defun imap-cram-md5-p (buffer) @@ -586,30 +761,38 @@ successful, nil otherwise." (defun imap-cram-md5-auth (buffer) "Login to server using the AUTH CRAM-MD5 method." - (imap-interactive-login - buffer - (lambda (user passwd) - (imap-ok-p - (imap-send-command-wait - (list - "AUTHENTICATE CRAM-MD5" - (lambda (challenge) - (let* ((decoded (imap-base64-decode-string challenge)) - (hash-function (if (and (featurep 'xemacs) - (>= (function-max-args 'md5) 4)) - (lambda (object &optional start end) - (md5 object start end 'binary)) - 'md5)) - (hash (rfc2104-hash hash-function 64 16 passwd decoded)) - (response (concat user " " hash)) - (encoded (imap-base64-encode-string response))) - encoded)))))))) + (message "imap: Authenticating using CRAM-MD5...") + (let ((done (imap-interactive-login + buffer + (lambda (user passwd) + (imap-ok-p + (imap-send-command-wait + (list + "AUTHENTICATE CRAM-MD5" + (lambda (challenge) + (let* ((decoded (base64-decode-string challenge)) + (hash-function + (if (and (featurep 'xemacs) + (>= (function-max-args 'md5) 4)) + (lambda (object &optional start end) + (md5 object start end 'binary)) + 'md5)) + (hash (rfc2104-hash hash-function 64 16 + passwd decoded)) + (response (concat user " " hash)) + (encoded (base64-encode-string response))) + encoded))))))))) + (if done + (message "imap: Authenticating using CRAM-MD5...done") + (message "imap: Authenticating using CRAM-MD5...failed")))) (defun imap-login-p (buffer) - (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))) + (and (not (imap-capability 'LOGINDISABLED buffer)) + (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))) (defun imap-login-auth (buffer) "Login to server using the LOGIN command." + (message "imap: Plaintext authentication...") (imap-interactive-login buffer (lambda (user passwd) (imap-ok-p (imap-send-command-wait @@ -620,11 +803,40 @@ successful, nil otherwise." t) (defun imap-anonymous-auth (buffer) + (message "imap: Loging in anonymously...") (with-current-buffer buffer (imap-ok-p (imap-send-command-wait (concat "LOGIN anonymous \"" (concat (user-login-name) "@" (system-name)) "\""))))) +(defun imap-digest-md5-p (buffer) + (and (imap-capability 'AUTH=DIGEST-MD5 buffer) + (condition-case () + (require 'digest-md5) + (error nil)))) + +(defun imap-digest-md5-auth (buffer) + "Login to server using the AUTH DIGEST-MD5 method." + (message "imap: Authenticating using DIGEST-MD5...") + (imap-interactive-login + buffer + (lambda (user passwd) + (let ((tag + (imap-send-command + (list + "AUTHENTICATE DIGEST-MD5" + (lambda (challenge) + (base64-encode-string + (sasl-digest-md5-digest-response + (base64-decode-string challenge) + user passwd "imap" imap-server) + 'no-line-break)))))) + (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) + nil + (setq imap-continuation nil) + (imap-send-command-1 "") + (imap-ok-p (imap-wait-for-tag tag))))))) + ;; Server functions: (defun imap-open-1 (buffer) @@ -650,64 +862,72 @@ successful, nil otherwise." imap-process)))) (defun imap-open (server &optional port stream auth buffer) - "Open a IMAP connection to host SERVER at PORT returning a -buffer. If PORT is unspecified, a default value is used (143 except + "Open a IMAP connection to host SERVER at PORT returning a buffer. +If PORT is unspecified, a default value is used (143 except for SSL which use 993). STREAM indicates the stream to use, see `imap-streams' for available -streams. If nil, it choices the best stream the server is capable of. +streams. If nil, it choices the best stream the server is capable of. AUTH indicates authenticator to use, see `imap-authenticators' for -available authenticators. If nil, it choices the best stream the +available authenticators. If nil, it choices the best stream the server is capable of. BUFFER can be a buffer or a name of a buffer, which is created if -necessery. If nil, the buffer name is generated." +necessery. If nil, the buffer name is generated." (setq buffer (or buffer (format " *imap* %s:%d" server (or port 0)))) (with-current-buffer (get-buffer-create buffer) (if (imap-opened buffer) (imap-close buffer)) - (mapc 'make-variable-buffer-local imap-local-variables) + (mapcar 'make-variable-buffer-local imap-local-variables) + (set-buffer-multibyte nil) (buffer-disable-undo) (setq imap-server (or server imap-server)) (setq imap-port (or port imap-port)) (setq imap-auth (or auth imap-auth)) (setq imap-stream (or stream imap-stream)) - (when (let ((imap-stream (or imap-stream imap-default-stream))) - (imap-open-1 buffer)) - ;; Choose stream. - (let (stream-changed) - (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 "Reconnecting with %s..." imap-stream) - (imap-close buffer) - (imap-open-1 buffer) - (setq imap-capability nil))) - (if (imap-opened buffer) - ;; Choose authenticator - (when (null imap-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..." 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))) (defun imap-opened (&optional buffer) - "Return non-nil if connection to imap server in BUFFER is open. If -BUFFER is nil then the current buffer is used." + "Return non-nil if connection to imap server in BUFFER is open. +If BUFFER is nil then the current buffer is used." (and (setq buffer (get-buffer (or buffer (current-buffer)))) (buffer-live-p buffer) (with-current-buffer buffer @@ -715,14 +935,17 @@ BUFFER is nil then the current buffer is used." (memq (process-status imap-process) '(open run)))))) (defun imap-authenticate (&optional user passwd buffer) - "Authenticate to server in BUFFER, using current buffer if nil. It -uses the authenticator specified when opening the server. If the + "Authenticate to server in BUFFER, using current buffer if nil. +It uses the authenticator specified when opening the server. If the authenticator requires username/passwords, they are queried from the user and optionally stored in the buffer. If USER and/or PASSWD is specified, the user will not be questioned and the username and/or password is remembered in the buffer." (with-current-buffer (or buffer (current-buffer)) - (when (eq imap-state 'nonauth) + (if (not (eq imap-state 'nonauth)) + (or (eq imap-state 'auth) + (eq imap-state 'select) + (eq imap-state 'examine)) (make-variable-buffer-local 'imap-username) (make-variable-buffer-local 'imap-password) (if user (setq imap-username user)) @@ -731,8 +954,8 @@ password is remembered in the buffer." (setq imap-state 'auth))))) (defun imap-close (&optional buffer) - "Close connection to server in BUFFER. If BUFFER is nil, the current -buffer is used." + "Close connection to server in BUFFER. +If BUFFER is nil, the current buffer is used." (with-current-buffer (or buffer (current-buffer)) (and (imap-opened) (not (imap-ok-p (imap-send-command-wait "LOGOUT"))) @@ -747,9 +970,9 @@ buffer is used." t)) (defun imap-capability (&optional identifier buffer) - "Return a list of identifiers which server in BUFFER support. If -IDENTIFIER, return non-nil if it's among the servers capabilities. If -BUFFER is nil, the current buffer is assumed." + "Return a list of identifiers which server in BUFFER support. +If IDENTIFIER, return non-nil if it's among the servers capabilities. +If BUFFER is nil, the current buffer is assumed." (with-current-buffer (or buffer (current-buffer)) (unless imap-capability (unless (imap-ok-p (imap-send-command-wait "CAPABILITY")) @@ -759,8 +982,8 @@ BUFFER is nil, the current buffer is assumed." imap-capability))) (defun imap-namespace (&optional buffer) - "Return a namespace hierarchy at server in BUFFER. If BUFFER is nil, -the current buffer is assumed." + "Return a namespace hierarchy at server in BUFFER. +If BUFFER is nil, the current buffer is assumed." (with-current-buffer (or buffer (current-buffer)) (unless imap-namespace (when (imap-capability 'NAMESPACE) @@ -803,8 +1026,8 @@ the current buffer is assumed." result))) (defun imap-mailbox-map (func &optional buffer) - "Map a function across each mailbox in `imap-mailbox-data', -returning a list. Function should take a mailbox name (a string) as + "Map a function across each mailbox in `imap-mailbox-data', returning a list. +Function should take a mailbox name (a string) as the only argument." (imap-mailbox-map-1 func 'imap-utf7-decode buffer)) @@ -824,8 +1047,8 @@ the only argument." (imap-current-mailbox-p-1 (imap-utf7-encode mailbox) examine))) (defun imap-mailbox-select-1 (mailbox &optional examine) - "Select MAILBOX on server in BUFFER. If EXAMINE is non-nil, do a -read-only select." + "Select MAILBOX on server in BUFFER. +If EXAMINE is non-nil, do a read-only select." (if (imap-current-mailbox-p-1 mailbox examine) imap-current-mailbox (setq imap-current-mailbox mailbox) @@ -844,8 +1067,12 @@ read-only select." (imap-utf7-decode (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine)))) +(defun imap-mailbox-examine-1 (mailbox &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (imap-mailbox-select-1 mailbox 'exmine))) + (defun imap-mailbox-examine (mailbox &optional buffer) - "Examine MAILBOX on server in BUFFER" + "Examine MAILBOX on server in BUFFER." (imap-mailbox-select mailbox 'exmine buffer)) (defun imap-mailbox-unselect (&optional buffer) @@ -865,43 +1092,43 @@ read-only select." t))) (defun imap-mailbox-expunge (&optional buffer) - "Expunge articles in current folder in BUFFER. If BUFFER is -nil the current buffer is assumed." + "Expunge articles in current folder in BUFFER. +If BUFFER is nil the current buffer is assumed." (with-current-buffer (or buffer (current-buffer)) (when (and imap-current-mailbox (not (eq imap-state 'examine))) (imap-ok-p (imap-send-command-wait "EXPUNGE"))))) (defun imap-mailbox-close (&optional buffer) - "Expunge articles and close current folder in BUFFER. If BUFFER is -nil the current buffer is assumed." + "Expunge articles and close current folder in BUFFER. +If BUFFER is nil the current buffer is assumed." (with-current-buffer (or buffer (current-buffer)) (when (and imap-current-mailbox (imap-ok-p (imap-send-command-wait "CLOSE"))) - (setq imap-current-mailbox nil - imap-message-data nil - imap-state 'auth) - t))) + (setq imap-current-mailbox nil + imap-message-data nil + imap-state 'auth) + t))) (defun imap-mailbox-create-1 (mailbox) (imap-ok-p (imap-send-command-wait (list "CREATE \"" mailbox "\"")))) (defun imap-mailbox-create (mailbox &optional buffer) - "Create MAILBOX on server in BUFFER. If BUFFER is nil the current -buffer is assumed." + "Create MAILBOX on server in BUFFER. +If BUFFER is nil the current buffer is assumed." (with-current-buffer (or buffer (current-buffer)) (imap-mailbox-create-1 (imap-utf7-encode mailbox)))) (defun imap-mailbox-delete (mailbox &optional buffer) - "Delete MAILBOX on server in BUFFER. If BUFFER is nil the current -buffer is assumed." + "Delete MAILBOX on server in BUFFER. +If BUFFER is nil the current buffer is assumed." (let ((mailbox (imap-utf7-encode mailbox))) (with-current-buffer (or buffer (current-buffer)) (imap-ok-p (imap-send-command-wait (list "DELETE \"" mailbox "\"")))))) (defun imap-mailbox-rename (oldname newname &optional buffer) - "Rename mailbox OLDNAME to NEWNAME on server in BUFFER. If BUFFER is -nil the current buffer is assumed." + "Rename mailbox OLDNAME to NEWNAME on server in BUFFER. +If BUFFER is nil the current buffer is assumed." (let ((oldname (imap-utf7-encode oldname)) (newname (imap-utf7-encode newname))) (with-current-buffer (or buffer (current-buffer)) @@ -912,7 +1139,7 @@ nil the current buffer is assumed." (defun imap-mailbox-lsub (&optional root reference add-delimiter buffer) "Return a list of subscribed mailboxes on server in BUFFER. If ROOT is non-nil, only list matching mailboxes. If ADD-DELIMITER is -non-nil, a hierarchy delimiter is added to root. REFERENCE is a +non-nil, a hierarchy delimiter is added to root. REFERENCE is a implementation-specific string that has to be passed to lsub command." (with-current-buffer (or buffer (current-buffer)) ;; Make sure we know the hierarchy separator for root's hierarchy @@ -936,7 +1163,7 @@ implementation-specific string that has to be passed to lsub command." (defun imap-mailbox-list (root &optional reference add-delimiter buffer) "Return a list of mailboxes matching ROOT on server in BUFFER. If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to -root. REFERENCE is a implementation-specific string that has to be +root. REFERENCE is a implementation-specific string that has to be passed to list command." (with-current-buffer (or buffer (current-buffer)) ;; Make sure we know the hierarchy separator for root's hierarchy @@ -958,27 +1185,27 @@ passed to list command." (nreverse out))))) (defun imap-mailbox-subscribe (mailbox &optional buffer) - "Send the SUBSCRIBE command on the mailbox to server in -BUFFER. Returns non-nil if successful." + "Send the SUBSCRIBE command on the mailbox to server in BUFFER. +Returns non-nil if successful." (with-current-buffer (or buffer (current-buffer)) (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \"" (imap-utf7-encode mailbox) "\""))))) (defun imap-mailbox-unsubscribe (mailbox &optional buffer) - "Send the SUBSCRIBE command on the mailbox to server in -BUFFER. Returns non-nil if successful." + "Send the SUBSCRIBE command on the mailbox to server in BUFFER. +Returns non-nil if successful." (with-current-buffer (or buffer (current-buffer)) (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " (imap-utf7-encode mailbox) "\""))))) (defun imap-mailbox-status (mailbox items &optional buffer) - "Get status items ITEM in MAILBOX from server in BUFFER. ITEMS can -be a symbol or a list of symbols, valid symbols are one of the STATUS -data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity or -'unseen. If ITEMS is a list of symbols, a list of values is returned, -if ITEMS is a symbol only it's value is returned." + "Get status items ITEM in MAILBOX from server in BUFFER. +ITEMS can be a symbol or a list of symbols, valid symbols are one of +the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity +or 'unseen. If ITEMS is a list of symbols, a list of values is +returned, if ITEMS is a symbol only it's value is returned." (with-current-buffer (or buffer (current-buffer)) (when (imap-ok-p (imap-send-command-wait (list "STATUS \"" @@ -990,9 +1217,9 @@ if ITEMS is a symbol only it's value is returned." (list items)))))) (if (listp items) (mapcar (lambda (item) - (imap-mailbox-get-1 item mailbox)) + (imap-mailbox-get item mailbox)) items) - (imap-mailbox-get-1 items mailbox))))) + (imap-mailbox-get items mailbox))))) (defun imap-mailbox-acl-get (&optional mailbox buffer) "Get ACL on mailbox from server in BUFFER." @@ -1002,11 +1229,10 @@ if ITEMS is a symbol only it's value is returned." (imap-send-command-wait (list "GETACL \"" (or mailbox imap-current-mailbox) "\""))) - (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox)))))) + (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox)))))) (defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer) - "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in -BUFFER." + "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in BUFFER." (let ((mailbox (imap-utf7-encode mailbox))) (with-current-buffer (or buffer (current-buffer)) (imap-ok-p @@ -1018,8 +1244,7 @@ BUFFER." rights)))))) (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer) - "Removes any pair for IDENTIFIER in MAILBOX from -server in BUFFER." + "Removes any pair for IDENTIFIER in MAILBOX from server in BUFFER." (let ((mailbox (imap-utf7-encode mailbox))) (with-current-buffer (or buffer (current-buffer)) (imap-ok-p @@ -1043,6 +1268,18 @@ server in BUFFER." (list list)) ",")) +(defun imap-range-to-message-set (range) + (mapconcat + (lambda (item) + (if (consp item) + (format "%d:%d" + (car item) (cdr item)) + (format "%d" item))) + (if (and (listp range) (not (listp (cdr range)))) + (list range) ;; make (1 . 2) into ((1 . 2)) + range) + ",")) + (defun imap-fetch-asynch (uids props &optional nouidfetch buffer) (with-current-buffer (or buffer (current-buffer)) (imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ") @@ -1052,8 +1289,8 @@ server in BUFFER." props)))) (defun imap-fetch (uids props &optional receive nouidfetch buffer) - "Fetch properties PROPS from message set UIDS from server in -BUFFER. UIDS can be a string, number or a list of numbers. If RECEIVE + "Fetch properties PROPS from message set UIDS from server in BUFFER. +UIDS can be a string, number or a list of numbers. If RECEIVE is non-nil return theese properties." (with-current-buffer (or buffer (current-buffer)) (when (imap-ok-p (imap-send-command-wait @@ -1089,8 +1326,7 @@ is non-nil return theese properties." propname))) (defun imap-message-map (func propname &optional buffer) - "Map a function across each mailbox in `imap-message-data', -returning a list." + "Map a function across each mailbox in `imap-message-data', returning a list." (with-current-buffer (or buffer (current-buffer)) (let (result) (mapatoms @@ -1152,8 +1388,7 @@ returning a list." (imap-mailbox-get-1 'search imap-current-mailbox))))) (defun imap-message-flag-permanent-p (flag &optional mailbox buffer) - "Return t iff FLAG can be permanently (between IMAP sessions) saved -on articles, in MAILBOX on server in BUFFER." + "Return t iff FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER." (with-current-buffer (or buffer (current-buffer)) (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox)) (member flag (imap-mailbox-get 'permanentflags mailbox))))) @@ -1186,7 +1421,7 @@ on articles, in MAILBOX on server in BUFFER." (let ((old-mailbox imap-current-mailbox) (state imap-state) (imap-message-data (make-vector 2 0))) - (when (imap-mailbox-examine mailbox) + (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch "*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) @@ -1203,8 +1438,8 @@ on articles, in MAILBOX on server in BUFFER." (defun imap-message-copy (articles mailbox &optional dont-create no-copyuid buffer) "Copy ARTICLES (a string message set) to MAILBOX on server in -BUFFER, creating mailbox if it doesn't exist. If dont-create is -non-nil, it will not create a mailbox. On success, return a list with +BUFFER, creating mailbox if it doesn't exist. If dont-create is +non-nil, it will not create a mailbox. On success, return a list with the UIDVALIDITY of the mailbox the article(s) was copied to as the first element, rest of list contain the saved articles' UIDs." (when articles @@ -1227,7 +1462,7 @@ first element, rest of list contain the saved articles' UIDs." (let ((old-mailbox imap-current-mailbox) (state imap-state) (imap-message-data (make-vector 2 0))) - (when (imap-mailbox-examine mailbox) + (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch "*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) @@ -1242,9 +1477,10 @@ first element, rest of list contain the saved articles' UIDs." (imap-message-appenduid-1 (imap-utf7-encode mailbox)))) (defun imap-message-append (mailbox article &optional flags date-time buffer) - "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER. FLAGS and -DATE-TIME is currently not used. Return a cons holding uidvalidity of -MAILBOX and UID the newly created article got, or nil on failure." + "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER. +FLAGS and DATE-TIME is currently not used. Return a cons holding +uidvalidity of MAILBOX and UID the newly created article got, or nil +on failure." (let ((mailbox (imap-utf7-encode mailbox))) (with-current-buffer (or buffer (current-buffer)) (and (let ((imap-current-target-mailbox mailbox)) @@ -1254,14 +1490,13 @@ MAILBOX and UID the newly created article got, or nil on failure." (imap-message-appenduid-1 mailbox))))) (defun imap-body-lines (body) - "Return number of lines in article by looking at the mime bodystructure -BODY." + "Return number of lines in article by looking at the mime bodystructure BODY." (if (listp body) (if (stringp (car body)) - (cond ((and (string= (car body) "TEXT") + (cond ((and (string= (upcase (car body)) "TEXT") (numberp (nth 7 body))) (nth 7 body)) - ((and (string= (car body) "MESSAGE") + ((and (string= (upcase (car body)) "MESSAGE") (numberp (nth 9 body))) (nth 9 body)) (t 0)) @@ -1300,23 +1535,31 @@ BODY." (cond ((stringp cmd) (setq cmdstr (concat cmdstr cmd))) ((bufferp cmd) - (setq cmdstr - (concat cmdstr (format "{%d}" (with-current-buffer cmd - (buffer-size))))) + (let ((eol imap-client-eol) + (calcfirst imap-calculate-literal-size-first) + size) + (with-current-buffer cmd + (if calcfirst + (setq size (buffer-size))) + (when (not (equal eol "\r\n")) + ;; XXX modifies buffer! + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match eol))) + (if (not calcfirst) + (setq size (buffer-size)))) + (setq cmdstr + (concat cmdstr (format "{%d}" size)))) (unwind-protect (progn (imap-send-command-1 cmdstr) (setq cmdstr nil) (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) - (setq command nil) ;; abort command if no cont-req + (setq command nil);; abort command if no cont-req (let ((process imap-process) - (stream imap-stream)) + (stream imap-stream) + (eol imap-client-eol)) (with-current-buffer cmd - (when (eq stream 'kerberos4) - ;; XXX modifies buffer! - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n"))) (and imap-log (with-current-buffer (get-buffer-create imap-log) @@ -1332,7 +1575,7 @@ BODY." (setq cmdstr nil) (unwind-protect (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) - (setq command nil) ;; abort command if no cont-req + (setq command nil);; abort command if no cont-req (setq command (cons (funcall cmd imap-continuation) command))) (setq imap-continuation nil))) @@ -1348,7 +1591,12 @@ BODY." (< imap-reached-tag tag)) (or (and (not (memq (process-status imap-process) '(open run))) (sit-for 1)) - (accept-process-output imap-process 1))) + (let ((len (/ (point-max) 1024)) + message-log-max) + (unless (< len 10) + (message "imap read: %dk" len)) + (accept-process-output imap-process 1)))) + (message "") (or (assq tag imap-failed-tags) (if imap-continuation 'INCOMPLETE @@ -1358,8 +1606,8 @@ BODY." (delete-process process)) (defun imap-find-next-line () - "Return point at end of current line, taking into account -literals. Return nil if no complete line has arrived." + "Return point at end of current line, taking into account literals. +Return nil if no complete line has arrived." (when (re-search-forward (concat imap-server-eol "\\|{\\([0-9]+\\)}" imap-server-eol) nil t) @@ -1426,7 +1674,7 @@ literals. Return nil if no complete line has arrived." (if (< (point-max) (+ pos len)) nil (goto-char (+ pos len)) - (buffer-substring-no-properties pos (+ pos len)))))) + (buffer-substring pos (+ pos len)))))) ;; string = quoted / literal ;; @@ -1440,13 +1688,20 @@ literals. Return nil if no complete line has arrived." ;; TEXT-CHAR = (defsubst imap-parse-string () - (let (strstart strend) - (cond ((and (eq (char-after (point)) ?\") - (setq strstart (point)) - (setq strend (search-forward "\"" nil t 2))) - (buffer-substring-no-properties (1+ strstart) (1- strend))) - ((eq (char-after) ?{) - (imap-parse-literal))))) + (cond ((eq (char-after) ?\") + (forward-char 1) + (let ((p (point)) (name "")) + (skip-chars-forward "^\"\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^\"\\\\") + (setq name (concat name (buffer-substring p (point))))) + (forward-char 1) + name)) + ((eq (char-after) ?{) + (imap-parse-literal)))) ;; nil = "NIL" @@ -1737,6 +1992,9 @@ literals. Return nil if no complete line has arrived." ;; resp-text-atom = 1* (defun imap-parse-resp-text-code () + ;; xxx next line for stalker communigate pro 3.3.1 bug + (when (looking-at " \\[") + (imap-forward)) (when (eq (char-after) ?\[) (imap-forward) (cond ((search-forward "PERMANENTFLAGS " nil t) @@ -1957,12 +2215,15 @@ literals. Return nil if no complete line has arrived." ;; ; revisions of this specification. (defun imap-parse-flag-list () - (let ((str (buffer-substring-no-properties - (point) (search-forward ")" nil t))) - pos) - (while (setq pos (string-match "\\\\" str (and pos (+ 2 pos)))) - (setq str (replace-match "\\\\" nil t str))) - (mapcar 'symbol-name (read str)))) + (let (flag-list start) + (assert (eq (char-after) ?\()) + (while (and (not (eq (char-after) ?\))) + (setq start (progn (imap-forward) (point))) + (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0)) + (push (buffer-substring start (point)) flag-list)) + (assert (eq (char-after) ?\))) + (imap-forward) + (nreverse flag-list))) ;; envelope = "(" env-date SP env-subject SP env-from SP env-sender SP ;; env-reply-to SP env-to SP env-cc SP env-bcc SP @@ -1991,36 +2252,39 @@ literals. Return nil if no complete line has arrived." (defun imap-parse-envelope () (when (eq (char-after) ?\() (imap-forward) - (vector (prog1 (imap-parse-nstring) ;; date + (vector (prog1 (imap-parse-nstring);; date (imap-forward)) - (prog1 (imap-parse-nstring) ;; subject + (prog1 (imap-parse-nstring);; subject (imap-forward)) - (prog1 (imap-parse-address-list) ;; from + (prog1 (imap-parse-address-list);; from (imap-forward)) - (prog1 (imap-parse-address-list) ;; sender + (prog1 (imap-parse-address-list);; sender (imap-forward)) - (prog1 (imap-parse-address-list) ;; reply-to + (prog1 (imap-parse-address-list);; reply-to (imap-forward)) - (prog1 (imap-parse-address-list) ;; to + (prog1 (imap-parse-address-list);; to (imap-forward)) - (prog1 (imap-parse-address-list) ;; cc + (prog1 (imap-parse-address-list);; cc (imap-forward)) - (prog1 (imap-parse-address-list) ;; bcc + (prog1 (imap-parse-address-list);; bcc (imap-forward)) - (prog1 (imap-parse-nstring) ;; in-reply-to + (prog1 (imap-parse-nstring);; in-reply-to (imap-forward)) - (prog1 (imap-parse-nstring) ;; message-id + (prog1 (imap-parse-nstring);; message-id (imap-forward))))) ;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil (defsubst imap-parse-string-list () - (cond ((eq (char-after) ?\() ;; body-fld-param + (cond ((eq (char-after) ?\();; body-fld-param (let (strlist str) (imap-forward) (while (setq str (imap-parse-string)) (push str strlist) - (imap-forward)) + ;; buggy stalker communigate pro 3.0 doesn't print SPC + ;; between body-fld-param's sometimes + (or (eq (char-after) ?\") + (imap-forward))) (nreverse strlist))) ((imap-parse-nil) nil))) @@ -2060,7 +2324,7 @@ literals. Return nil if no complete line has arrived." (defsubst imap-parse-body-ext () (let (ext) - (when (eq (char-after) ?\ ) ;; body-fld-dsp + (when (eq (char-after) ?\ );; body-fld-dsp (imap-forward) (let (dsp) (if (eq (char-after) ?\() @@ -2072,12 +2336,12 @@ literals. Return nil if no complete line has arrived." (imap-forward)) (assert (imap-parse-nil))) (push (nreverse dsp) ext)) - (when (eq (char-after) ?\ ) ;; body-fld-lang + (when (eq (char-after) ?\ );; body-fld-lang (imap-forward) (if (eq (char-after) ?\() (push (imap-parse-string-list) ext) (push (imap-parse-nstring) ext)) - (while (eq (char-after) ?\ ) ;; body-extension + (while (eq (char-after) ?\ );; body-extension (imap-forward) (setq ext (append (imap-parse-body-extension) ext))))) ext)) @@ -2151,37 +2415,45 @@ literals. Return nil if no complete line has arrived." (let (subbody) (while (and (eq (char-after) ?\() (setq subbody (imap-parse-body))) + ;; buggy stalker communigate pro 3.0 insert a SPC between + ;; parts in multiparts + (when (and (eq (char-after) ?\ ) + (eq (char-after (1+ (point))) ?\()) + (imap-forward)) (push subbody body)) (imap-forward) - (push (imap-parse-string) body) ;; media-subtype - (when (eq (char-after) ?\ ) ;; body-ext-mpart: + (push (imap-parse-string) body);; media-subtype + (when (eq (char-after) ?\ );; body-ext-mpart: (imap-forward) - (if (eq (char-after) ?\() ;; body-fld-param + (if (eq (char-after) ?\();; body-fld-param (push (imap-parse-string-list) body) (push (and (imap-parse-nil) nil) body)) (setq body - (append (imap-parse-body-ext) body))) ;; body-ext-... + (append (imap-parse-body-ext) body)));; body-ext-... (assert (eq (char-after) ?\))) (imap-forward) (nreverse body)) - (push (imap-parse-string) body) ;; media-type + (push (imap-parse-string) body);; media-type (imap-forward) - (push (imap-parse-string) body) ;; media-subtype + (push (imap-parse-string) body);; media-subtype (imap-forward) ;; next line for Sun SIMS bug (and (eq (char-after) ? ) (imap-forward)) - (if (eq (char-after) ?\() ;; body-fld-param + (if (eq (char-after) ?\();; body-fld-param (push (imap-parse-string-list) body) (push (and (imap-parse-nil) nil) body)) (imap-forward) - (push (imap-parse-nstring) body) ;; body-fld-id + (push (imap-parse-nstring) body);; body-fld-id (imap-forward) - (push (imap-parse-nstring) body) ;; body-fld-desc + (push (imap-parse-nstring) body);; body-fld-desc (imap-forward) - (push (imap-parse-string) body) ;; body-fld-enc + ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a + ;; nstring and return NIL instead of defaulting back to 7BIT + ;; as the standard says. + (push (or (imap-parse-nstring) "7BIT") body);; body-fld-enc (imap-forward) - (push (imap-parse-number) body) ;; body-fld-octets + (push (imap-parse-number) body);; body-fld-octets ;; ok, we're done parsing the required parts, what comes now is one ;; of three things: @@ -2191,131 +2463,134 @@ literals. Return nil if no complete line has arrived." ;; body-ext-1part (then we're parsing body-type-basic) ;; ;; the problem is that the two first are in turn optionally followed - ;; by the third. So we parse the first two here (if there are any)... + ;; by the third. So we parse the first two here (if there are any)... (when (eq (char-after) ?\ ) (imap-forward) (let (lines) - (cond ((eq (char-after) ?\() ;; body-type-msg: - (push (imap-parse-envelope) body) ;; envelope - (imap-forward) - (push (imap-parse-body) body) ;; body + (cond ((eq (char-after) ?\();; body-type-msg: + (push (imap-parse-envelope) body);; envelope (imap-forward) - (push (imap-parse-number) body)) ;; body-fld-lines - ((setq lines (imap-parse-number)) ;; body-type-text: - (push lines body)) ;; body-fld-lines + (push (imap-parse-body) body);; body + ;; buggy stalker communigate pro 3.0 doesn't print + ;; number of lines in message/rfc822 attachment + (if (eq (char-after) ?\)) + (push 0 body) + (imap-forward) + (push (imap-parse-number) body))) ;; body-fld-lines + ((setq lines (imap-parse-number)) ;; body-type-text: + (push lines body)) ;; body-fld-lines (t - (backward-char))))) ;; no match... + (backward-char))))) ;; no match... ;; ...and then parse the third one here... - (when (eq (char-after) ?\ ) ;; body-ext-1part: + (when (eq (char-after) ?\ );; body-ext-1part: (imap-forward) - (push (imap-parse-nstring) body) ;; body-fld-md5 + (push (imap-parse-nstring) body);; body-fld-md5 (setq body (append (imap-parse-body-ext) body)));; body-ext-1part.. (assert (eq (char-after) ?\))) (imap-forward) (nreverse body))))) -(when imap-debug ; (untrace-all) +(when imap-debug ; (untrace-all) (require 'trace) (buffer-disable-undo (get-buffer-create imap-debug)) - (mapc (lambda (f) (trace-function-background f imap-debug)) - '( -imap-read-passwd -imap-utf7-encode -imap-utf7-decode -imap-error-text -imap-kerberos4s-p -imap-kerberos4-open -imap-ssl-p -imap-ssl-open-2 -imap-ssl-open-1 -imap-ssl-open -imap-network-p -imap-network-open -imap-interactive-login -imap-kerberos4a-p -imap-kerberos4-auth -imap-cram-md5-p -imap-cram-md5-auth -imap-login-p -imap-login-auth -imap-anonymous-p -imap-anonymous-auth -imap-open-1 -imap-open -imap-opened -imap-authenticate -imap-close -imap-capability -imap-namespace -imap-send-command-wait -imap-mailbox-put -imap-mailbox-get -imap-mailbox-map-1 -imap-mailbox-map -imap-current-mailbox -imap-current-mailbox-p-1 -imap-current-mailbox-p -imap-mailbox-select-1 -imap-mailbox-select -imap-mailbox-examine -imap-mailbox-unselect -imap-mailbox-expunge -imap-mailbox-close -imap-mailbox-create-1 -imap-mailbox-create -imap-mailbox-delete -imap-mailbox-rename -imap-mailbox-lsub -imap-mailbox-list -imap-mailbox-subscribe -imap-mailbox-unsubscribe -imap-mailbox-status -imap-mailbox-acl-get -imap-mailbox-acl-set -imap-mailbox-acl-delete -imap-current-message -imap-list-to-message-set -imap-fetch-asynch -imap-fetch -imap-message-put -imap-message-get -imap-message-map -imap-search -imap-message-flag-permanent-p -imap-message-flags-set -imap-message-flags-del -imap-message-flags-add -imap-message-copyuid-1 -imap-message-copyuid -imap-message-copy -imap-message-appenduid-1 -imap-message-appenduid -imap-message-append -imap-body-lines -imap-envelope-from -imap-send-command-1 -imap-send-command -imap-wait-for-tag -imap-sentinel -imap-find-next-line -imap-arrival-filter -imap-parse-greeting -imap-parse-response -imap-parse-resp-text -imap-parse-resp-text-code -imap-parse-data-list -imap-parse-fetch -imap-parse-status -imap-parse-acl -imap-parse-flag-list -imap-parse-envelope -imap-parse-body-extension -imap-parse-body - ))) + (mapcar (lambda (f) (trace-function-background f imap-debug)) + '( + imap-read-passwd + imap-utf7-encode + imap-utf7-decode + imap-error-text + imap-kerberos4s-p + imap-kerberos4-open + imap-ssl-p + imap-ssl-open + imap-network-p + imap-network-open + imap-interactive-login + imap-kerberos4a-p + imap-kerberos4-auth + imap-cram-md5-p + imap-cram-md5-auth + imap-login-p + imap-login-auth + imap-anonymous-p + imap-anonymous-auth + imap-open-1 + imap-open + imap-opened + imap-authenticate + imap-close + imap-capability + imap-namespace + imap-send-command-wait + imap-mailbox-put + imap-mailbox-get + imap-mailbox-map-1 + imap-mailbox-map + imap-current-mailbox + imap-current-mailbox-p-1 + imap-current-mailbox-p + imap-mailbox-select-1 + imap-mailbox-select + imap-mailbox-examine-1 + imap-mailbox-examine + imap-mailbox-unselect + imap-mailbox-expunge + imap-mailbox-close + imap-mailbox-create-1 + imap-mailbox-create + imap-mailbox-delete + imap-mailbox-rename + imap-mailbox-lsub + imap-mailbox-list + imap-mailbox-subscribe + imap-mailbox-unsubscribe + imap-mailbox-status + imap-mailbox-acl-get + imap-mailbox-acl-set + imap-mailbox-acl-delete + imap-current-message + imap-list-to-message-set + imap-fetch-asynch + imap-fetch + imap-message-put + imap-message-get + imap-message-map + imap-search + imap-message-flag-permanent-p + imap-message-flags-set + imap-message-flags-del + imap-message-flags-add + imap-message-copyuid-1 + imap-message-copyuid + imap-message-copy + imap-message-appenduid-1 + imap-message-appenduid + imap-message-append + imap-body-lines + imap-envelope-from + imap-send-command-1 + imap-send-command + imap-wait-for-tag + imap-sentinel + imap-find-next-line + imap-arrival-filter + imap-parse-greeting + imap-parse-response + imap-parse-resp-text + imap-parse-resp-text-code + imap-parse-data-list + imap-parse-fetch + imap-parse-status + imap-parse-acl + imap-parse-flag-list + imap-parse-envelope + imap-parse-body-extension + imap-parse-body + ))) (provide 'imap) diff --git a/lisp/kill-group.pbm b/lisp/kill-group.pbm new file mode 100644 index 0000000000000000000000000000000000000000..50831447f5041925080300538cf32a5470704f5f GIT binary patch literal 81 zcmWGA;W9E&Ff!o^6%ABiVsH_0)c=1XgfWoAVnIx3C`S#4NR6O|1-FZUD8~+lP!~ZB k4F(qhK@AU%P!>TB28I|0Q4R(U5e7m1|F2y`LKzqs0K2vjGynhq literal 0 HcmV?d00001 diff --git a/lisp/kill-group.xpm b/lisp/kill-group.xpm new file mode 100644 index 0000000..de83fd9 --- /dev/null +++ b/lisp/kill-group.xpm @@ -0,0 +1,50 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 20 1", +" c Gray0", +". c Gray6", +"X c Gray12", +"o c #2ff42ff42ff4", +"O c #3fff3fff3fff", +"+ c Gray28", +"@ c #53e353e353e3", +"# c #5fe25fe25fe2", +"$ c #67e767e767e7", +"% c #6fff6fff6fff", +"& c #77d777d777d7", +"* c Gray50", +"= c Gray56", +"- c #9fff9fff9fff", +"; c Gray70", +": c Gray75", +"> c Gray81", +", c #dfffdfffdfff", +"< c #efffefffefff", +"1 c Gray100", +/* pixels */ +"::::::::::::::::::::::::", +"::::::::::::::::::::::::", +"::::::::::::::::::::::::", +"::::#oOOOOOOOOOo+;::::::", +"::::#:111111111:O$::::::", +"::::#:1111-O%11:*>@:::::", +"::::#:111=X.o#<>OOo#::::", +"::::#:111 OX# :111:#::::", +"::::#:111 = :111:#::::", +"::::#:111>Xo.-1111:#::::", +"::::#:1111*:O11111:#::::", +"::::#:11%1*oO->111:#::::", +"::::#:1-O:,1:*O111:#::::", +"::::#:111****:1111:#::::", +"::::#:1111* 111111:#::::", +"::::#:1,:O-1O*:111:#::::", +"::::#:1:X1111*#111:#::::", +"::::#:11>1111,<111:#::::", +"::::#:111111111111:#::::", +"::::#:111111111111:#::::", +"::::#:111111111111:#::::", +"::::&oooooooooooooo&::::", +"::::::::::::::::::::::::", +"::::::::::::::::::::::::" +}; diff --git a/lisp/lpath.el b/lisp/lpath.el index ebc9cec..109c54a 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -2,106 +2,114 @@ (defvar byte-compile-default-warnings) -(or (featurep 'path-util) - (load "apel/path-util")) -(add-path "apel") -(add-path "flim") -(add-path "semi") - (defun maybe-fbind (args) (while args (or (fboundp (car args)) - (fset (car args) 'ignore)) + (defalias (car args) 'ignore)) (setq args (cdr args)))) (defun maybe-bind (args) (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) -(if (string-match "XEmacs" emacs-version) +(maybe-fbind '(babel-fetch + babel-wash create-image decode-coding-string display-graphic-p + find-image font-create-object gnus-mule-get-coding-system + font-lock-set-defaults + image-size image-type-available-p insert-image + make-temp-file + mail-aliases-setup mm-copy-tree + mule-write-region-no-coding-system put-image + ring-elements + rmail-select-summary rmail-summary-exists rmail-update-summary + sc-cite-regexp set-font-family set-font-size temp-directory + string-as-multibyte + tool-bar-add-item tool-bar-add-item-from-menu + url-view-url vcard-pretty-print + url-insert-file-contents + w3-coding-system-for-mime-charset w3-prepare-buffer w3-region + widget-make-intangible x-defined-colors)) + +(maybe-bind '(adaptive-fill-first-line-regexp + adaptive-fill-regexp babel-history babel-translations + default-enable-multibyte-characters + display-time-mail-function imap-password mail-mode-hook + mc-pgp-always-sign + nnoo-definition-alist + url-current-callback-func url-be-asynchronous + url-current-callback-data url-working-buffer + url-current-mime-headers w3-meta-charset-content-type-regexp + w3-meta-content-type-charset-regexp)) + +(if (featurep 'xemacs) (progn (defvar track-mouse nil) - (maybe-fbind '(posn-point - event-start x-popup-menu - facemenu-get-face window-at coordinates-in-window-p - compute-motion x-defined-colors easy-menu-create-keymaps - read-event internal-find-face internal-next-face-id - make-face-internal set-frame-face-alist frame-face-alist - facemenu-add-new-face make-face-x-resource-internal - set-font-size set-font-family posn-window - run-with-idle-timer mouse-minibuffer-check window-edges - event-click-count track-mouse read-event mouse-movement-p - event-end mouse-scroll-subr overlay-lists delete-overlay - set-face-stipple mail-abbrevs-setup - make-char-table set-char-table-range font-create-object - x-color-values widget-make-intangible error-message-string - w3-form-encode-xwfu gnus-mule-get-coding-system - decode-coding-string mail-aliases-setup - url-view-url w3-prepare-buffer - set-buffer-multibyte - find-non-ascii-charset-region char-charset - find-charset-region - find-coding-systems-region get-charset-property - coding-system-get w3-region - w3-coding-system-for-mime-charset - rmail-summary-exists rmail-select-summary - rmail-update-summary url-retrieve - temp-directory babel-fetch babel-wash - find-coding-systems-for-charsets sc-cite-regexp)) - (maybe-bind '(global-face-data - mark-active transient-mark-mode mouse-selection-click-count - mouse-selection-click-count-buffer buffer-display-table - font-lock-defaults user-full-name user-login-name - gnus-newsgroup-name gnus-article-x-face-too-ugly + (maybe-fbind '(char-charset + coding-system-get compute-motion coordinates-in-window-p + delete-overlay easy-menu-create-keymaps + error-message-string event-click-count event-end + event-start facemenu-add-new-face facemenu-get-face + find-charset-region find-coding-systems-for-charsets + find-coding-systems-region find-non-ascii-charset-region + frame-face-alist get-charset-property internal-find-face + internal-next-face-id mail-abbrevs-setup make-char-table + make-face-internal make-face-x-resource-internal + make-overlay mouse-minibuffer-check mouse-movement-p + mouse-scroll-subr overlay-buffer overlay-end + overlay-get overlay-lists overlay-put + overlay-start posn-point posn-window + read-event read-event run-with-idle-timer + set-buffer-multibyte set-char-table-range + set-face-stipple set-frame-face-alist track-mouse + url-retrieve w3-form-encode-xwfu window-at + window-edges x-color-values x-popup-menu)) + (maybe-bind '(buffer-display-table + buffer-file-coding-system font-lock-defaults + global-face-data gnus-article-x-face-too-ugly gnus-newsgroup-charset gnus-newsgroup-emphasis-alist - mail-mode-hook - adaptive-fill-first-line-regexp adaptive-fill-regexp - url-current-mime-headers buffer-file-coding-system - w3-image-mappings url-current-mime-type - w3-meta-content-type-charset-regexp - w3-meta-charset-content-type-regexp - url-current-callback-func url-current-callback-data - url-be-asynchronous temporary-file-directory - babel-translations babel-history))) - (maybe-bind '(mail-mode-hook - enable-multibyte-characters browse-url-browser-function - adaptive-fill-first-line-regexp adaptive-fill-regexp - url-current-mime-headers help-echo-owns-message - w3-meta-content-type-charset-regexp - w3-meta-charset-content-type-regexp - babel-translations babel-history)) - (maybe-fbind '(color-instance-rgb-components - temp-directory - glyph-width annotation-glyph window-pixel-width glyph-height - window-pixel-height map-extents - make-color-instance color-instance-name specifier-instance - device-type device-class get-popup-menu-response event-object - x-defined-colors read-color add-submenu set-font-family - font-create-object set-font-size frame-device find-face - set-extent-property make-extent characterp display-error - set-face-doc-string frame-property face-doc-string - button-press-event-p next-command-event - widget-make-intangible glyphp make-glyph set-glyph-image - set-glyph-property event-glyph glyph-property event-point - device-on-window-system-p make-gui-button Info-goto-node - pp-to-string color-name - gnus-mule-get-coding-system decode-coding-string - mail-aliases-setup - url-view-url w3-prepare-buffer - char-int - annotationp delete-annotation make-image-specifier - make-annotation events-to-keys - w3-do-setup w3-region - w3-coding-system-for-mime-charset - rmail-summary-exists rmail-select-summary rmail-update-summary - url-generic-parse-url valid-image-instantiator-format-p - babel-fetch babel-wash find-coding-systems-for-charsets - sc-cite-regexp smiley-encode-buffer function-max-args - map-extents))) + gnus-newsgroup-name mark-active + mouse-selection-click-count + mouse-selection-click-count-buffer + temporary-file-directory transient-mark-mode + url-current-mime-type + user-full-name user-login-name + w3-image-mappings))) + (maybe-bind '(browse-url-browser-function + enable-multibyte-characters help-echo-owns-message)) + (maybe-fbind '(Info-goto-node + add-submenu annotation-glyph annotationp babel-as-string + button-press-event-p char-int characterp color-instance-name + color-instance-rgb-components color-name delete-annotation + device-class device-on-window-system-p device-type + display-error event-glyph event-object event-point + events-to-keys face-doc-string find-face frame-device + frame-property get-popup-menu-response glyph-height + glyph-property glyph-width glyphp make-annotation + make-event + make-color-instance make-extent make-glyph make-gui-button + make-image-specifier map-extents next-command-event + pp-to-string read-color set-extent-property + set-face-doc-string set-glyph-image set-glyph-property + specifier-instance url-generic-parse-url + valid-image-instantiator-format-p w3-do-setup + window-pixel-height window-pixel-width))) -(setq load-path (cons "." load-path)) -(require 'custom) +;; T-gnus. +(if (featurep 'xemacs) + (progn + (maybe-fbind '(propertize)) + (maybe-bind '(mh-lib-progs))) + ;; FSFmacs + (maybe-fbind '(charsetp + function-max-args propertize smiley-encode-buffer)) + (if (boundp 'MULE) + (progn + (maybe-fbind '(coding-system-get + compose-mail + file-name-extension find-coding-systems-region + get-charset-property shell-command-to-string)) + (maybe-bind '(mh-lib-progs))))) -(defun md5 (object &optional start end coding noerror) +(defun nnkiboze-score-file (a) ) (provide 'lpath) diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el index d9caac1..95a3359 100644 --- a/lisp/mail-parse.el +++ b/lisp/mail-parse.el @@ -1,5 +1,6 @@ ;;; mail-parse.el --- Interface functions for parsing mail -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -42,13 +43,15 @@ (require 'rfc2047) (require 'rfc2045) -(defalias 'mail-header-parse-content-type 'rfc2231-parse-string) -(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-string) +(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string) +(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string) (defalias 'mail-content-type-get 'rfc2231-get-value) -(defalias 'mail-header-encode-parameter 'rfc2045-encode-string) +;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string) +(defalias 'mail-header-encode-parameter 'rfc2231-encode-string) (defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) (defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) +(defalias 'mail-header-strip 'ietf-drums-strip) (defalias 'mail-header-get-comment 'ietf-drums-get-comment) (defalias 'mail-header-parse-address 'ietf-drums-parse-address) (defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses) diff --git a/lisp/mail-prsvr.el b/lisp/mail-prsvr.el index 82187fc..2566abc 100644 --- a/lisp/mail-prsvr.el +++ b/lisp/mail-prsvr.el @@ -1,5 +1,5 @@ ;;; mail-prsvr.el --- Interface variables for parsing mail -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -29,6 +29,10 @@ This variable should never be set. Instead, it should be bound by functions that wish to call mail-parse functions and let them know what the desired charset is to be.") +(defvar mail-parse-mule-charset nil + "Default MULE charset used by low-level libraries. +This variable should never be set.") + (defvar mail-parse-ignored-charsets nil "Ignored charsets used by low-level libraries. This variable should never be set. Instead, it should be bound by diff --git a/lisp/mail-reply.pbm b/lisp/mail-reply.pbm new file mode 100644 index 0000000000000000000000000000000000000000..9ca76596fb1dc23f14ce7fe6ee4085636e77bff3 GIT binary patch literal 81 zcmWGA;W9E&Ff!p{U}RumUckT-z+l6{=qkX>CBPygV6?!(Bp^i3 c Gray75", +", c Gray81", +"< c #dfffdfffdfff", +"1 c #efffefffefff", +"2 c Gray100", +/* pixels */ +">>>>>>>>>>>>>>>==:>>>>>>", +">>>>>>>>>>>>>>&**$&>>>>>", +">>>>>>>>>>>>>&-22,-o->>>", +">>>>>>>>>=$O@$,,2222O>>>", +">>>>>>>=#*>2*>2O222>$>>>", +">>>>>>o&>222O2%,22,$:>>>", +">>>:$O2222<#2*>222=+:>>>", +">>&$>;;2;2*>2><22;**$&>>", +">>o.;,,2,,*1%222;;,O;o>>", +">>o2;O><2O2,%221#o%22o>>", +">>o222***O2;22;**<222o>>", +">>o2222<>.;2,O;,22222o>>", +">>o2221>#2;O%;;,22222o>>", +">>o222**<22222;*>2222o>>", +">>o22%,222222221*,222o>>", +">>o;O,22222222222%#<2o>>", +">>o;22222222222222<**o>>", +">>oOOOOOOOOOOOOOOOOX o>>", +">>>>>>>>>>>>>>>>>>>>>>>>", +">>>>>>>>>>>>>>>>>>>>>>>>", +">>>>>>>>>>>>>>>>>>>>>>>>", +">>>>>>>>>>>>>>>>>>>>>>>>", +">>>>>>>>>>>>>>>>>>>>>>>>", +">>>>>>>>>>>>>>>>>>>>>>>>" +}; diff --git a/lisp/mail-source.el b/lisp/mail-source.el index f288242..7154b6a 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -1,5 +1,5 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -25,18 +25,198 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'imap) + (eval-when-compile (defvar display-time-mail-function))) (eval-and-compile - (autoload 'pop3-movemail "pop3")) + (defvar pop3-leave-mail-on-server) + (autoload 'pop3-movemail "pop3") + (autoload 'pop3-get-message-count "pop3") + (autoload 'nnheader-cancel-timer "nnheader") + (autoload 'nnheader-run-at-time "nnheader")) (require 'format-spec) (defgroup mail-source nil "The mail-fetching library." + :version "21.1" :group 'gnus) +;; Define these at compile time to avoid dragging in imap always. +(defconst mail-source-imap-authenticators + (eval-when-compile + (mapcar (lambda (a) + (list 'const (car a))) + imap-authenticator-alist))) +(defconst mail-source-imap-streams + (eval-when-compile + (mapcar (lambda (a) + (list 'const (car a))) + imap-stream-alist))) + (defcustom mail-sources nil "*Where the mail backends will look for incoming mail. -This variable is a list of mail source specifiers." +This variable is a list of mail source specifiers. +See Info node `(gnus)Mail Source Specifiers'." + :group 'mail-source + :type `(repeat + (choice :format "%[Value Menu%] %v" + :value (file) + (cons :tag "Spool file" + (const :format "" file) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + file))) + (cons :tag "Several files in a directory" + (const :format "" directory) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + (directory :tag "Path")) + (group :inline t + (const :format "" :value :suffix) + (string :tag "Suffix")) + (group :inline t + (const :format "" :value :predicate) + (function :tag "Predicate")) + (group :inline t + (const :format "" :value :prescript) + (string :tag "Prescript")) + (group :inline t + (const :format "" :value :postscript) + (string :tag "Postscript")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "POP3 server" + (const :format "" pop) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :server) + (string :tag "Server")) + (group :inline t + (const :format "" :value :port) + (choice :tag "Port" + :value "pop3" + (number :format "%v") + (string :format "%v"))) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" :value :program) + (string :tag "Program")) + (group :inline t + (const :format "" :value :prescript) + (string :tag "Prescript")) + (group :inline t + (const :format "" :value :postscript) + (string :tag "Postscript")) + (group :inline t + (const :format "" :value :function) + (function :tag "Function")) + (group :inline t + (const :format "" + :value :authentication) + (choice :tag "Authentication" + :value apop + (const password) + (const apop))) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "Maildir (qmail, postfix...)" + (const :format "" maildir) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + (directory :tag "Path")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "IMAP server" + (const :format "" imap) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :server) + (string :tag "Server")) + (group :inline t + (const :format "" :value :port) + (choice :tag "Port" + :value 143 + number string)) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" :value :stream) + (choice :tag "Stream" + :value network + ,@mail-source-imap-streams)) + (group :inline t + (const :format "" + :value :authenticator) + (choice :tag "Authenticator" + :value login + ,@mail-source-imap-authenticators)) + (group :inline t + (const :format "" :value :mailbox) + (string :tag "Mailbox" + :value "INBOX")) + (group :inline t + (const :format "" :value :predicate) + (string :tag "Predicate" + :value "UNSEEN UNDELETED")) + (group :inline t + (const :format "" :value :fetchflag) + (string :tag "Fetchflag" + :value "\\Deleted")) + (group :inline t + (const :format "" + :value :dontexpunge) + (boolean :tag "Dontexpunge")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "Webmail server" + (const :format "" webmail) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :subtype) + ;; Should be generated from + ;; `webmail-type-definition', but we + ;; can't require webmail without W3. + (choice :tag "Subtype" + :value hotmail + (const hotmail) + (const yahoo) + (const netaddress) + (const netscape) + (const my-deja))) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" + :value :dontexpunge) + (boolean :tag "Dontexpunge")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged"))))))) + +(defcustom mail-source-primary-source nil + "*Primary source for incoming mail. +If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'sexp) @@ -60,19 +240,42 @@ This variable is a list of mail source specifiers." :group 'mail-source :type 'boolean) +(defcustom mail-source-incoming-file-prefix "Incoming" + "Prefix for file name for storing incoming mail" + :group 'mail-source + :type 'string) + +(defcustom mail-source-report-new-mail-interval 5 + "Interval in minutes between checks for new mail." + :group 'mail-source + :type 'number) + +(defcustom mail-source-idle-time-delay 5 + "Number of idle seconds to wait before checking for new mail." + :group 'mail-source + :type 'number) + ;;; Internal variables. (defvar mail-source-string "" "A dynamically bound string that says what the current mail source is.") +(defvar mail-source-new-mail-available nil + "Flag indicating when new mail is available.") + (eval-and-compile + (defvar mail-source-common-keyword-map + '((:plugged)) + "Mapping from keywords to default values. +Common keywords should be listed here.") + (defvar mail-source-keyword-map '((file (:prescript) (:prescript-delay) (:postscript) (:path (or (getenv "MAIL") - (concat "/usr/spool/mail/" (user-login-name))))) + (expand-file-name (user-login-name) rmail-spool-directory)))) (directory (:path) (:suffix ".spool") @@ -88,9 +291,11 @@ This variable is a list of mail source specifiers." (:function) (:password) (:connection) - (:authentication password)) + (:authentication password) + (:leave)) (maildir - (:path "~/Maildir/new/") + (:path (or (getenv "MAILDIR") "~/Maildir/")) + (:subdirs ("new" "cur")) (:function)) (imap (:server (getenv "MAILHOST")) @@ -101,12 +306,13 @@ This variable is a list of mail source specifiers." (:password) (:mailbox "INBOX") (:predicate "UNSEEN UNDELETED") - (:fetchflag "\Deleted") + (:fetchflag "\\Deleted") (:dontexpunge)) (webmail (:subtype hotmail) (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) (:password) + (:dontexpunge) (:authentication password))) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) @@ -122,12 +328,14 @@ All keywords that can be used must be listed here.")) (defvar mail-source-password-cache nil) +(defvar mail-source-plugged t) + ;;; Functions (eval-and-compile (defun mail-source-strip-keyword (keyword) - "Strip the leading colon off the KEYWORD." - (intern (substring (symbol-name keyword) 1)))) + "Strip the leading colon off the KEYWORD." + (intern (substring (symbol-name keyword) 1)))) (eval-and-compile (defun mail-source-bind-1 (type) @@ -169,6 +377,39 @@ the `mail-source-keyword-map' variable." (mail-source-value value) (mail-source-value (cadr default))))))) +(eval-and-compile + (defun mail-source-bind-common-1 () + (let* ((defaults mail-source-common-keyword-map) + default bind) + (while (setq default (pop defaults)) + (push (list (mail-source-strip-keyword (car default)) + nil) + bind)) + bind))) + +(defun mail-source-set-common-1 (source) + (let* ((type (pop source)) + (defaults mail-source-common-keyword-map) + (defaults-1 (cdr (assq type mail-source-keyword-map))) + default value keyword) + (while (setq default (pop defaults)) + (set (mail-source-strip-keyword (setq keyword (car default))) + (if (setq value (plist-get source keyword)) + (mail-source-value value) + (if (setq value (assq keyword defaults-1)) + (mail-source-value (cadr value)) + (mail-source-value (cadr default)))))))) + +(defmacro mail-source-bind-common (source &rest body) + "Return a `let' form that binds all common variables. +See `mail-source-bind'." + `(let ,(mail-source-bind-common-1) + (mail-source-set-common-1 source) + ,@body)) + +(put 'mail-source-bind-common 'lisp-indent-function 1) +(put 'mail-source-bind-common 'edebug-form-spec '(form body)) + (defun mail-source-value (value) "Return the value of VALUE." (cond @@ -188,24 +429,26 @@ the `mail-source-keyword-map' variable." CALLBACK will be called with the name of the file where (some of) the mail from SOURCE is put. Return the number of files that were found." - (save-excursion - (let ((function (cadr (assq (car source) mail-source-fetcher-alist))) - (found 0)) - (unless function - (error "%S is an invalid mail source specification" source)) - ;; If there's anything in the crash box, we do it first. - (when (file-exists-p mail-source-crash-box) - (message "Processing mail from %s..." mail-source-crash-box) - (setq found (mail-source-callback - callback mail-source-crash-box))) - (+ found - (condition-case err - (funcall function source callback) - (error - (unless (yes-or-no-p - (format "Mail source error (%s). Continue? " err)) - (error "Cannot get new mail.")) - 0)))))) + (mail-source-bind-common source + (if (or mail-source-plugged plugged) + (save-excursion + (let ((function (cadr (assq (car source) mail-source-fetcher-alist))) + (found 0)) + (unless function + (error "%S is an invalid mail source specification" source)) + ;; If there's anything in the crash box, we do it first. + (when (file-exists-p mail-source-crash-box) + (message "Processing mail from %s..." mail-source-crash-box) + (setq found (mail-source-callback + callback mail-source-crash-box))) + (+ found + (condition-case err + (funcall function source callback) + (error + (unless (yes-or-no-p + (format "Mail source error (%s). Continue? " err)) + (error "Cannot get new mail.")) + 0)))))))) (defun mail-source-make-complex-temp-name (prefix) (let ((newname (make-temp-name prefix)) @@ -233,7 +476,8 @@ Pass INFO on to CALLBACK." (let ((incoming (mail-source-make-complex-temp-name (expand-file-name - "Incoming" mail-source-directory)))) + mail-source-incoming-file-prefix + mail-source-directory)))) (unless (file-exists-p (file-name-directory incoming)) (make-directory (file-name-directory incoming) t)) (rename-file mail-source-crash-box incoming t))))))) @@ -384,7 +628,7 @@ If ARGS, PROMPT is used as an argument to `format'." (mail-source-run-script prescript (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user) + ?s server ?P port ?u user) prescript-delay) (let ((from (format "%s:%s:%s" server user port)) (mail-source-string (format "pop:%s@%s" user server)) @@ -415,8 +659,20 @@ If ARGS, PROMPT is used as an argument to `format'." (pop3-port port) (pop3-authentication-scheme (if (eq authentication 'apop) 'apop 'pass)) - (pop3-connection-type connection)) - (save-excursion (pop3-movemail mail-source-crash-box)))))) + (pop3-connection-type connection) + (pop3-leave-mail-on-server + (or leave + (and (boundp 'pop3-leave-mail-on-server) + pop3-leave-mail-on-server)))) + (condition-case err + (save-excursion (pop3-movemail mail-source-crash-box)) + (error + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) + (signal (car err) (cdr err)))))))) (if result (progn (when (eq authentication 'password) @@ -424,6 +680,9 @@ If ARGS, PROMPT is used as an argument to `format'." (push (cons from password) mail-source-password-cache))) (prog1 (mail-source-callback callback server) + ;; Update display-time's mail flag, if relevant. + (if (equal source mail-source-primary-source) + (setq mail-source-new-mail-available nil)) (mail-source-run-script postscript (format-spec-make ?p password ?t mail-source-crash-box @@ -435,17 +694,160 @@ If ARGS, PROMPT is used as an argument to `format'." mail-source-password-cache)) 0)))) +(defun mail-source-check-pop (source) + "Check whether there is new mail." + (mail-source-bind (pop source) + (let ((from (format "%s:%s:%s" server user port)) + (mail-source-string (format "pop:%s@%s" user server)) + result) + (when (eq authentication 'password) + (setq password + (or password + (cdr (assoc from mail-source-password-cache)) + (mail-source-read-passwd + (format "Password for %s at %s: " user server)))) + (unless (assoc from mail-source-password-cache) + (push (cons from password) mail-source-password-cache))) + (when server + (setenv "MAILHOST" server)) + (setq result + (cond + ;; No easy way to check whether mail is waiting for these. + (program) + (function) + ;; The default is to use pop3.el. + (t + (let ((pop3-password password) + (pop3-maildrop user) + (pop3-mailhost server) + (pop3-port port) + (pop3-authentication-scheme + (if (eq authentication 'apop) 'apop 'pass))) + (condition-case err + (save-excursion (pop3-get-message-count)) + (error + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) + (signal (car err) (cdr err)))))))) + (if result + ;; Inform display-time that we have new mail. + (setq mail-source-new-mail-available (> result 0)) + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache))) + result))) + +(defun mail-source-new-mail-p () + "Handler for `display-time' to indicate when new mail is available." + ;; Only report flag setting; flag is updated on a different schedule. + mail-source-new-mail-available) + + +(defvar mail-source-report-new-mail nil) +(defvar mail-source-report-new-mail-timer nil) +(defvar mail-source-report-new-mail-idle-timer nil) + +(eval-when-compile + (if (featurep 'xemacs) + (require 'itimer) + (require 'timer))) + +(defun mail-source-start-idle-timer () + ;; Start our idle timer if necessary, so we delay the check until the + ;; user isn't typing. + (unless mail-source-report-new-mail-idle-timer + (setq mail-source-report-new-mail-idle-timer + (run-with-idle-timer + mail-source-idle-time-delay + nil + (lambda () + (mail-source-check-pop mail-source-primary-source) + (setq mail-source-report-new-mail-idle-timer nil)))) + ;; Since idle timers created when Emacs is already in the idle + ;; state don't get activated until Emacs _next_ becomes idle, we + ;; need to force our timer to be considered active now. We do + ;; this by being naughty and poking the timer internals directly + ;; (element 0 of the vector is nil if the timer is active). + (aset mail-source-report-new-mail-idle-timer 0 nil))) + +(defun mail-source-report-new-mail (arg) + "Toggle whether to report when new mail is available. +This only works when `display-time' is enabled." + (interactive "P") + (if (not mail-source-primary-source) + (error "Need to set `mail-source-primary-source' to check for new mail.")) + (let ((on (if (null arg) + (not mail-source-report-new-mail) + (> (prefix-numeric-value arg) 0)))) + (setq mail-source-report-new-mail on) + (and mail-source-report-new-mail-timer + (nnheader-cancel-timer mail-source-report-new-mail-timer)) + (and mail-source-report-new-mail-idle-timer + (nnheader-cancel-timer mail-source-report-new-mail-idle-timer)) + (setq mail-source-report-new-mail-timer nil) + (setq mail-source-report-new-mail-idle-timer nil) + (if on + (progn + (require 'time) + ;; display-time-mail-function is an Emacs 21 feature. + (setq display-time-mail-function #'mail-source-new-mail-p) + ;; Set up the main timer. + (setq mail-source-report-new-mail-timer + (nnheader-run-at-time + (* 60 mail-source-report-new-mail-interval) + (* 60 mail-source-report-new-mail-interval) + #'mail-source-start-idle-timer)) + ;; When you get new mail, clear "Mail" from the mode line. + (add-hook 'nnmail-post-get-new-mail-hook + 'display-time-event-handler) + (message "Mail check enabled")) + (setq display-time-mail-function nil) + (remove-hook 'nnmail-post-get-new-mail-hook + 'display-time-event-handler) + (message "Mail check disabled")))) + (defun mail-source-fetch-maildir (source callback) "Fetcher for maildir sources." (mail-source-bind (maildir source) (let ((found 0) - (mail-source-string (format "maildir:%s" path))) - (dolist (file (directory-files path t)) - (when (and (file-regular-p file) - (not (if function - (funcall function file mail-source-crash-box) - (rename-file file mail-source-crash-box)))) - (incf found (mail-source-callback callback file)))) + mail-source-string) + (unless (string-match "/$" path) + (setq path (concat path "/"))) + (dolist (subdir subdirs) + (when (file-directory-p (concat path subdir)) + (setq mail-source-string (format "maildir:%s%s" path subdir)) + (dolist (file (directory-files (concat path subdir) t)) + (when (and (not (file-directory-p file)) + (not (if function + (funcall function file mail-source-crash-box) + (let ((coding-system-for-write + nnheader-text-coding-system) + (coding-system-for-read + nnheader-text-coding-system) + (output-coding-system + nnheader-text-coding-system) + (input-coding-system + nnheader-text-coding-system)) + (with-temp-file mail-source-crash-box + (insert-file-contents file) + (goto-char (point-min)) +;;; ;; Unix mail format +;;; (unless (looking-at "\n*From ") +;;; (insert "From maildir " +;;; (current-time-string) "\n")) +;;; (while (re-search-forward "^From " nil t) +;;; (replace-match ">From ")) +;;; (goto-char (point-max)) +;;; (insert "\n\n") + ;; MMDF mail format + (insert "\001\001\001\001\n")) + (delete-file file))))) + (incf found (mail-source-callback callback file)))))) found))) (eval-and-compile @@ -460,20 +862,37 @@ If ARGS, PROMPT is used as an argument to `format'." (autoload 'imap-error-text "imap") (autoload 'imap-message-flags-add "imap") (autoload 'imap-list-to-message-set "imap") - (autoload 'nnheader-ms-strip-cr "nnheader")) + (autoload 'imap-range-to-message-set "imap")) + +(defvar mail-source-imap-file-coding-system 'binary + "Coding system for the crashbox made by `mail-source-fetch-imap'.") (defun mail-source-fetch-imap (source callback) "Fetcher for imap sources." (mail-source-bind (imap source) - (let ((found 0) - (buf (get-buffer-create (generate-new-buffer-name " *imap source*"))) + (let ((from (format "%s:%s:%s" server user port)) + (found 0) + (buf (get-buffer-create + (format " *imap source %s:%s:%s *" server user mailbox))) (mail-source-string (format "imap:%s:%s" server mailbox)) remove) (if (and (imap-open server port stream authentication buf) - (imap-authenticate user password buf) + (imap-authenticate + user (or (cdr (assoc from mail-source-password-cache)) + password) buf) (imap-mailbox-select mailbox nil buf)) - (let (str (coding-system-for-write 'binary)) + (let ((coding-system-for-write mail-source-imap-file-coding-system) + (output-coding-system mail-source-imap-file-coding-system) + str) (with-temp-file mail-source-crash-box + ;; Avoid converting 8-bit chars from inserted strings to + ;; multibyte. + (set-buffer-multibyte nil) + ;; remember password + (with-current-buffer buf + (when (or imap-password + (assoc from mail-source-password-cache)) + (push (cons from imap-password) mail-source-password-cache))) ;; if predicate is nil, use all uids (dolist (uid (imap-search (or predicate "1:*") buf)) (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)) @@ -488,12 +907,18 @@ If ARGS, PROMPT is used as an argument to `format'." (incf found (mail-source-callback callback server)) (when (and remove fetchflag) (imap-message-flags-add - (imap-list-to-message-set remove) fetchflag nil buf)) + (imap-range-to-message-set (gnus-compress-sequence remove)) + fetchflag nil buf)) (if dontexpunge (imap-mailbox-unselect buf) (imap-mailbox-close buf)) (imap-close buf)) (imap-close buf) + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) (error (imap-error-text buf))) (kill-buffer buf) found))) @@ -504,13 +929,23 @@ If ARGS, PROMPT is used as an argument to `format'." (defun mail-source-fetch-webmail (source callback) "Fetch for webmail source." (mail-source-bind (webmail source) - (when (eq authentication 'password) - (setq password - (or password - (mail-source-read-passwd - (format "Password for %s at %s: " user subtype))))) - (webmail-fetch mail-source-crash-box subtype user password) - (mail-source-callback callback (symbol-name subtype)))) + (let ((mail-source-string (format "webmail:%s:%s" subtype user)) + (webmail-newmail-only dontexpunge) + (webmail-move-to-trash-can (not dontexpunge))) + (when (eq authentication 'password) + (setq password + (or password + (cdr (assoc (format "webmail:%s:%s" subtype user) + mail-source-password-cache)) + (mail-source-read-passwd + (format "Password for %s at %s: " user subtype)))) + (when (and password + (not (assoc (format "webmail:%s:%s" subtype user) + mail-source-password-cache))) + (push (cons (format "webmail:%s:%s" subtype user) password) + mail-source-password-cache))) + (webmail-fetch mail-source-crash-box subtype user password) + (mail-source-callback callback (symbol-name subtype))))) (provide 'mail-source) diff --git a/lisp/md5.el b/lisp/md5.el index a6c19aa..a246b1a 100644 --- a/lisp/md5.el +++ b/lisp/md5.el @@ -360,10 +360,10 @@ Returns a vector of 16 bytes containing the message digest." c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) - (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) - (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) - (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) - (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) + (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) + (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) + (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) + (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Here begins the merger with the XEmacs API and the md5.el from the URL @@ -378,7 +378,7 @@ hash of a portion of OBJECT. The optional CODING and NOERROR arguments are ignored. They are only placeholders to ensure the compatibility with XEmacsen with file-coding or Mule support." - (let ((buffer nil)) + (let ((buffer nil)) (unwind-protect (save-excursion (setq buffer (generate-new-buffer " *md5-work*")) diff --git a/lisp/message.el b/lisp/message.el index c1cb1ff..5c4b212 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,6 @@ -;;; message.el --- composing mail and news messages -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*- +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -35,25 +36,22 @@ ;;; Code: -(eval-when-compile (require 'cl)) -(eval-when-compile (require 'smtp)) +(eval-when-compile + (require 'cl) + (require 'smtp) + (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary (require 'mailheader) (require 'nnheader) -(require 'easymenu) -(require 'custom) -(if (string-match "XEmacs\\|Lucid" emacs-version) - (require 'mail-abbrevs) - (require 'mailabbrev)) +;; This is apparently necessary even though things are autoloaded: +(if (featurep 'xemacs) + (require 'mail-abbrevs)) (require 'mime-edit) (eval-when-compile (require 'static)) ;; Avoid byte-compile warnings. (eval-when-compile (require 'mail-parse) - (require 'mm-bodies) - (require 'mm-encode) - (require 'mml) - ) + (require 'mml)) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -190,7 +188,7 @@ Otherwise, most addresses look like `angles', but they look like :group 'message-headers) (defcustom message-syntax-checks nil - ; Guess this one shouldn't be easy to customize... + ;; Guess this one shouldn't be easy to customize... "*Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add `(signature . disabled)' to this list. @@ -198,11 +196,12 @@ To disable checking of long signatures, for instance, add Don't touch this variable unless you really know what you're doing. Checks include subject-cmsg multiple-headers sendsys message-id from -long-lines control-chars size new-text redirected-followup signature -approved sender empty empty-headers message-id from subject -shorten-followup-to existing-newsgroups buffer-file-name unchanged -newsgroups." - :group 'message-news) +long-lines control-chars size new-text quoting-style +redirected-followup signature approved sender empty empty-headers +message-id from subject shorten-followup-to existing-newsgroups +buffer-file-name unchanged newsgroups." + :group 'message-news + :type '(repeat sexp)) (defcustom message-required-news-headers '(From Newsgroups Subject Date Message-ID @@ -245,7 +244,7 @@ included. Organization, Lines and User-Agent are optional." :group 'message-headers :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." @@ -347,7 +346,8 @@ If it is t, the buffer will be killed peremptorily." (function :tag "Other" t)) :group 'message-buffers) -(defvar gnus-local-organization) +(eval-when-compile + (defvar gnus-local-organization)) (defcustom message-user-organization (or (and (boundp 'gnus-local-organization) (stringp gnus-local-organization) @@ -378,11 +378,6 @@ If t, use `message-user-organization-file'." :group 'message-forwarding :type 'string) -(defcustom message-signature-before-forwarded-message t - "*If non-nil, put the signature before any included forwarded message." - :group 'message-forwarding - :type 'boolean) - (defcustom message-included-forward-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:" "*Regexp matching headers to be included in forwarded messages." @@ -391,7 +386,7 @@ If t, use `message-user-organization-file'." (defcustom message-make-forward-subject-function 'message-forward-subject-author-subject - "*A list of functions that are called to generate a subject header for forwarded messages. + "*A list of functions that are called to generate a subject header for forwarded messages. The subject generated by the previous function is passed into each successive function. @@ -401,12 +396,24 @@ The provided functions are: newsgroup)), in brackets followed by the subject * message-forward-subject-fwd (Subject of article with 'Fwd:' prepended to it." - :group 'message-forwarding - :type '(radio (function-item message-forward-subject-author-subject) - (function-item message-forward-subject-fwd))) + :group 'message-forwarding + :type '(radio (function-item message-forward-subject-author-subject) + (function-item message-forward-subject-fwd))) (defcustom message-forward-as-mime t "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message." + :version "21.1" + :group 'message-forwarding + :type 'boolean) + +(defcustom message-forward-show-mml t + "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." + :version "21.1" + :group 'message-forwarding + :type 'boolean) + +(defcustom message-forward-before-signature t + "*If non-nil, put forwarded message before signature, else after." :group 'message-forwarding :type 'boolean) @@ -420,8 +427,9 @@ The provided functions are: :group 'message-interface :type 'regexp) -(defcustom message-forward-ignored-headers nil +(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" "*All headers that match this regexp will be deleted when forwarding a message." + :version "21.1" :group 'message-forwarding :type '(choice (const :tag "None" nil) regexp)) @@ -431,7 +439,14 @@ The provided functions are: :group 'message-insertion :type 'regexp) -(defcustom message-cancel-message "I am canceling my own article." +(defcustom message-cite-prefix-regexp + ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. + "\\([ \t]*\\(\\w\\|[-_.]\\)+>+\\|[ \t]*[]>»|:}+]\\)+" + "*Regexp matching the longest possible citation prefix on a line." + :group 'message-insertion + :type 'regexp) + +(defcustom message-cancel-message "I am canceling my own article.\n" "Message to be inserted in the cancel message." :group 'message-interface :type 'string) @@ -532,10 +547,9 @@ is never used." (const :tag "always" use) (const :tag "ask" ask))) -;; stuff relating to broken sendmail in MMDF (defcustom message-sendmail-f-is-evil nil - "*Non-nil means that \"-f username\" should not be added to the sendmail -command line, because it is even more evil than leaving it out." + "*Non-nil means that \"-f username\" should not be added to the sendmail command line. +Doing so would be even more evil than leaving it out." :group 'message-sending :type 'boolean) @@ -555,8 +569,14 @@ might set this variable to '(\"-f\" \"you@some.where\")." :group 'message-sending :type '(repeat string)) -(defvar gnus-post-method) -(defvar gnus-select-method) +(defvar message-cater-to-broken-inn t + "Non-nil means Gnus should not fold the `References' header. +Folding `References' makes ancient versions of INN create incorrect +NOV lines.") + +(eval-when-compile + (defvar gnus-post-method) + (defvar gnus-select-method)) (defcustom message-post-method (cond ((and (boundp 'gnus-post-method) (listp gnus-post-method) @@ -632,14 +652,27 @@ The function `message-supersede' runs this hook." ;;;###autoload (defcustom message-yank-prefix "> " - "*Prefix inserted on the lines of yanked messages." + "*Prefix inserted on the lines of yanked messages. +Fix `message-cite-prefix-regexp' if it is set to an abnormal value." :type 'string :group 'message-insertion) (defcustom message-yank-add-new-references t - "*Non-nil means new IDs will be added to \"References\" field when an -article is yanked by the command `message-yank-original' interactively." - :type 'boolean + "Non-nil means new IDs will be added to \"References\" field when an +article is yanked by the command `message-yank-original' interactively. +If it is a symbol `message-id-only', only an ID from \"Message-ID\" field +is used, otherwise IDs extracted from \"References\", \"In-Reply-To\" and +\"Message-ID\" fields are used." + :type '(radio (const :tag "Do not add anything" nil) + (const :tag "From Message-Id, References and In-Reply-To fields" t) + (const :tag "From only Message-Id field." message-id-only)) + :group 'message-insertion) + +(defcustom message-list-references-add-position nil + "Integer value means position for adding to \"References\" field when +an article is yanked by the command `message-yank-original' interactively." + :type '(radio (const :tag "Add to last" nil) + (integer :tag "Position from last ID")) :group 'message-insertion) (defcustom message-indentation-spaces 3 @@ -728,7 +761,7 @@ If stringp, use this; if non-nil, use no host name (user name only)." (define-widget 'message-header-lines 'text "All header lines must be LFD terminated." - :format "%t:%n%v" + :format "%{%t%}:%n%v" :valid-regexp "^\\'" :error "All header lines must be newline terminated") @@ -746,8 +779,7 @@ these lines." :type 'message-header-lines) (defcustom message-default-news-headers "" - "*A string of header lines to be inserted in outgoing news -articles." + "*A string of header lines to be inserted in outgoing news articles." :group 'message-headers :group 'message-news :type 'message-header-lines) @@ -783,13 +815,13 @@ actually occur." (defvar message-user-agent nil "String of the form of PRODUCT/VERSION. Used for User-Agent header field.") -;; Ignore errors in case this is used in Emacs 19. -;; Don't use ignore-errors because this is copied into loaddefs.el. +(static-when (boundp 'MULE) + (require 'reporter));; `define-mail-user-agent' is here. + ;;;###autoload -(ignore-errors - (define-mail-user-agent 'message-user-agent - 'message-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook)) +(define-mail-user-agent 'message-user-agent + 'message-mail 'message-send-and-exit + 'message-kill-buffer 'message-send-hook) (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) "If non-nil, delete the deletable headers before feeding to mh.") @@ -808,13 +840,17 @@ a message of type TYPE; and FUNCTION is a function to be called if PREDICATE returns non-nil. FUNCTION is called with one parameter -- the prefix.") -(defvar message-mail-alias-type 'abbrev +(defcustom message-mail-alias-type 'abbrev "*What alias expansion type to use in Message buffers. The default is `abbrev', which uses mailabbrev. nil switches -mail aliases off.") +mail aliases off." + :group 'message + :link '(custom-manual "(message)Mail Aliases") + :type '(choice (const :tag "Use Mailabbrev" abbrev) + (const :tag "No expansion" nil))) (defcustom message-auto-save-directory - (nnheader-concat message-directory "drafts/") + (file-name-as-directory (nnheader-concat message-directory "drafts")) "*Directory where Message auto-saves buffers if Gnus isn't running. If nil, Message won't auto-save." :group 'message-buffers @@ -823,22 +859,41 @@ If nil, Message won't auto-save." (defcustom message-buffer-naming-style 'unique "*The way new message buffers are named. Valid valued are `unique' and `unsent'." + :version "21.1" :group 'message-buffers :type '(choice (const :tag "unique" unique) (const :tag "unsent" unsent))) -(defcustom message-default-charset nil +(defcustom message-default-charset + (and (featurep 'xemacs) (not (featurep 'mule)) 'iso-8859-1) "Default charset used in non-MULE XEmacsen." + :version "21.1" :group 'message :type 'symbol) -(defcustom message-dont-reply-to-names rmail-dont-reply-to-names +(defcustom message-dont-reply-to-names + (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) "*A regexp specifying names to prune when doing wide replies. A value of nil means exclude your own name only." + :version "21.1" :group 'message :type '(choice (const :tag "Yourself" nil) regexp)) +(defvar message-shoot-gnksa-feet nil + "*A list of GNKSA feet you are allowed to shoot. +Gnus gives you all the opportunity you could possibly want for +shooting yourself in the foot. Also, Gnus allows you to shoot the +feet of Good Net-Keeping Seal of Approval. The following are foot +candidates: +`empty-article' Allow you to post an empty article; +`quoted-text-only' Allow you to post quoted text only; +`multiple-copies' Allow you to post multiple copies.") + +(defsubst message-gnksa-enable-p (feature) + (or (not (listp message-shoot-gnksa-feet)) + (memq feature message-shoot-gnksa-feet))) + ;;; Internal variables. ;;; Well, not really internal. @@ -853,10 +908,6 @@ A value of nil means exclude your own name only." (defvar message-mode-abbrev-table text-mode-abbrev-table "Abbrev table used in Message mode buffers. Defaults to `text-mode-abbrev-table'.") -(defgroup message-headers nil - "Message headers." - :link '(custom-manual "(message)Variables") - :group 'message) (defface message-header-to-face '((((class color) @@ -1028,7 +1079,7 @@ before fontifying.") (eval-after-load "font-lock" '(defadvice font-lock-after-change-function - (before message-font-lock-save-last-position activate compile) + (before message-font-lock-save-last-position activate) "Save last cursor position before fontifying." (if (eq 'message-mode major-mode) (setq message-font-lock-last-position (point))))) @@ -1123,7 +1174,7 @@ See also the documentations for the following variables: (setq message-font-lock-last-position nil))) (defvar message-font-lock-keywords-1 - (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)")) + (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) `((,(concat "^\\([Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-to-face nil t)) @@ -1153,10 +1204,12 @@ See also the documentations for the following variables: (defvar message-font-lock-keywords-2 (append message-font-lock-keywords-1 - '((message-font-lock-cited-text-matcher + `((message-font-lock-cited-text-matcher (1 'message-cited-text-face) (2 'message-cited-text-face)) - ("<#/?\\(multipart\\|part\\|external\\).*>" + (,(concat "^\\(" message-cite-prefix-regexp "\\).*") + (0 'message-cited-text-face)) + ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>" (0 'message-mml-face))))) (defvar message-font-lock-keywords message-font-lock-keywords-2 @@ -1225,8 +1278,45 @@ The cdr of ech entry is a function for applying the face to a region.") (t nil)) "Coding system to compose mail.") +(defcustom message-send-mail-partially-limit 1000000 + "The limitation of messages sent as message/partial. +The lower bound of message size in characters, beyond which the message +should be sent in several parts. If it is nil, the size is unlimited." + :version "21.1" + :group 'message-buffers + :type '(choice (const :tag "unlimited" nil) + (integer 1000000))) + +(defcustom message-alternative-emails nil + "A regexp to match the alternative email addresses. +The first matched address (not primary one) is used in the From field." + :group 'message-headers + :type '(choice (const :tag "Always use primary" nil) + regexp)) + +(defcustom message-mail-user-agent nil + "Like `mail-user-agent'. +Except if it is `nil', use Gnus native MUA; if it is t, use +`mail-user-agent'." + :type '(radio (const :tag "Gnus native" + :format "%t\n" + nil) + (const :tag "`mail-user-agent'" + :format "%t\n" + t) + (function-item :tag "Default Emacs mail" + :format "%t\n" + sendmail-user-agent) + (function-item :tag "Emacs interface to MH" + :format "%t\n" + mh-e-user-agent) + (function :tag "Other")) + :version "21.1" + :group 'message) + ;;; Internal variables. +(defvar message-sending-message "Sending...") (defvar message-buffer-list nil) (defvar message-this-is-news nil) (defvar message-this-is-mail nil) @@ -1235,8 +1325,9 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-posting-charset nil) ;; Byte-compiler warning -(defvar gnus-active-hashtb) -(defvar gnus-read-active-file) +(eval-when-compile + (defvar gnus-active-hashtb) + (defvar gnus-read-active-file)) ;;; Regexp matching the delimiter of messages in UNIX mail format ;;; (UNIX From lines), minus the initial ^. It should be a copy @@ -1272,10 +1363,10 @@ The cdr of ech entry is a function for applying the face to a region.") "\\([^\0-\b\n-\r\^?].*\\)? " ;; The time the message was sent. - "\\([^\0-\r \^?]+\\) +" ; day of the week - "\\([^\0-\r \^?]+\\) +" ; month - "\\([0-3]?[0-9]\\) +" ; day of month - "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day + "\\([^\0-\r \^?]+\\) +" ; day of the week + "\\([^\0-\r \^?]+\\) +" ; month + "\\([0-3]?[0-9]\\) +" ; day of month + "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day ;; Perhaps a time zone, specified by an abbreviation, or by a ;; numeric offset. @@ -1322,12 +1413,16 @@ The cdr of ech entry is a function for applying the face to a region.") (User-Agent)) "Alist used for formatting headers.") +(defvar message-options nil + "Some saved answers when sending message.") + (eval-and-compile (autoload 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") (autoload 'mh-send-letter "mh-comp") (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-point-at-bol "gnus-util") + (autoload 'gnus-output-to-rmail "gnus-util") (autoload 'gnus-output-to-mail "gnus-util") (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev") (autoload 'nndraft-request-associate-buffer "nndraft") @@ -1336,6 +1431,7 @@ The cdr of ech entry is a function for applying the face to a region.") (autoload 'gnus-request-post "gnus-int") (autoload 'gnus-copy-article-buffer "gnus-msg") (autoload 'gnus-alive-p "gnus-util") + (autoload 'gnus-group-name-charset "gnus-group") (autoload 'rmail-output "rmail") (autoload 'mu-cite-original "mu-cite")) @@ -1370,9 +1466,19 @@ The cdr of ech entry is a function for applying the face to a region.") `(delete-region (progn (beginning-of-line) (point)) (progn (forward-line ,(or n 1)) (point)))) +(defun message-unquote-tokens (elems) + "Remove double quotes (\") from strings in list." + (mapcar (lambda (item) + (while (string-match "^\\(.*\\)\"\\(.*\\)$" item) + (setq item (concat (match-string 1 item) + (match-string 2 item)))) + item) + elems)) + (defun message-tokenize-header (header &optional separator) "Split HEADER into a list of header elements. -\",\" is used as the separator." +SEPARATOR is a string of characters to be used as separators. \",\" +is used by default." (if (not header) nil (let ((regexp (format "[%s]+" (or separator ","))) @@ -1402,7 +1508,7 @@ The cdr of ech entry is a function for applying the face to a region.") ((and (eq (char-after) ?\)) (not quoted)) (setq paren nil)))) - (nreverse elems))))) + (nreverse elems))))) (defun message-mail-file-mbox-p (file) "Say whether FILE looks like a Unix mbox file." @@ -1417,12 +1523,13 @@ The cdr of ech entry is a function for applying the face to a region.") (defun message-fetch-field (header &optional not-all) "The same as `mail-fetch-field', only remove all newlines." (let* ((inhibit-point-motion-hooks t) + (case-fold-search t) (value (mail-fetch-field header nil (not not-all)))) (when value (while (string-match "\n[\t ]+" value) (setq value (replace-match " " t t value))) - ;; We remove all text props. - (format "%s" value)))) + (set-text-properties 0 (length value) nil value) + value))) (defun message-narrow-to-field () "Narrow the buffer to the header on the current line." @@ -1445,10 +1552,10 @@ The cdr of ech entry is a function for applying the face to a region.") (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers)) (error "Invalid header `%s'" (car headers))) (setq hclean (match-string 1 (car headers))) - (save-restriction - (message-narrow-to-headers) - (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) - (insert (car headers) ?\n)))) + (save-restriction + (message-narrow-to-headers) + (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) + (insert (car headers) ?\n)))) (setq headers (cdr headers)))) @@ -1475,6 +1582,21 @@ The cdr of ech entry is a function for applying the face to a region.") (and (listp form) (eq (car form) 'lambda)) (byte-code-function-p form))) +(defun message-strip-list-identifiers (subject) + "Remove list identifiers in `gnus-list-identifiers'." + (require 'gnus-sum) ; for gnus-list-identifiers + (let ((regexp (if (stringp gnus-list-identifiers) + gnus-list-identifiers + (mapconcat 'identity gnus-list-identifiers " *\\|")))) + (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") subject) + (concat (substring subject 0 (match-beginning 1)) + (or (match-string 3 subject) + (match-string 5 subject)) + (substring subject + (match-end 1))) + subject))) + (defun message-strip-subject-re (subject) "Remove \"Re:\" from subject lines." (if (string-match message-subject-re-regexp subject) @@ -1538,10 +1660,8 @@ Return the number of headers removed." (point-max))) (goto-char (point-min))) -(defun message-narrow-to-head () - "Narrow the buffer to the head of the message. -Point is left at the beginning of the narrowed-to region." - (widen) +(defun message-narrow-to-head-1 () + "Like `message-narrow-to-head'. Don't widen." (narrow-to-region (goto-char (point-min)) (if (search-forward "\n\n" nil 1) @@ -1549,6 +1669,12 @@ Point is left at the beginning of the narrowed-to region." (point-max))) (goto-char (point-min))) +(defun message-narrow-to-head () + "Narrow the buffer to the head of the message. +Point is left at the beginning of the narrowed-to region." + (widen) + (message-narrow-to-head-1)) + (defun message-narrow-to-headers-or-head () "Narrow the buffer to the head of the message." (widen) @@ -1658,12 +1784,13 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) (define-key message-mode-map "\C-c\C-b" 'message-goto-body) (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) + (define-key message-mode-map "\C-c\C-fc" 'message-goto-mail-copies-to) (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-y" 'message-yank-original) - (define-key message-mode-map "\C-c\C-Y" 'message-yank-buffer) + (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) (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) @@ -1680,6 +1807,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) + (define-key message-mode-map "\M-q" 'message-fill-paragraph) (define-key message-mode-map "\t" 'message-tab) @@ -1688,7 +1816,7 @@ Point is left at the beginning of the narrowed-to region." (easy-menu-define message-mode-menu message-mode-map "Message Menu." - '("Message" + `("Message" ["Sort Headers" message-sort-headers t] ["Yank Original" message-yank-original t] ["Fill Yanked Message" message-fill-yanked-message t] @@ -1700,12 +1828,22 @@ 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] - ["Spellcheck" ispell-message t] - ["Attach file as MIME" mime-edit-insert-file t] + ["Spellcheck" ispell-message + ,@(if (featurep 'xemacs) nil + '(:help "Spellcheck this message"))] + ["Attach file as MIME" mime-edit-insert-file + ,@(if (featurep 'xemacs) nil + '(:help "Attach a file at point"))] "----" - ["Send Message" message-send-and-exit t] - ["Abort Message" message-dont-send t] - ["Kill Message" message-kill-buffer t])) + ["Send Message" message-send-and-exit + ,@(if (featurep 'xemacs) nil + '(:help "Send this message"))] + ["Abort Message" message-dont-send + ,@(if (featurep 'xemacs) nil + '(:help "File this draft message and exit"))] + ["Kill Message" message-kill-buffer + ,@(if (featurep 'xemacs) nil + '(:help "Delete this message without sending"))])) (easy-menu-define message-mode-field-menu message-mode-map "" @@ -1728,15 +1866,18 @@ Point is left at the beginning of the narrowed-to region." ["Body" message-goto-body t] ["Signature" message-goto-signature t])) -(defvar facemenu-add-face-function) -(defvar facemenu-remove-face-function) +(defvar message-tool-bar-map nil) + +(eval-when-compile + (defvar facemenu-add-face-function) + (defvar facemenu-remove-face-function)) ;;;###autoload (defun message-mode () "Major mode for editing mail and news to be sent. Like Text Mode but with these additional commands: C-c C-s message-send (send the message) C-c C-c message-send-and-exit -C-c C-d Pospone sending the message C-c C-k Kill the message +C-c C-d Postpone sending the message C-c C-k Kill the message C-c C-f move to a header field (and create it if there isn't): C-c C-f C-t move to To C-c C-f C-s move to Subject C-c C-f C-c move to Cc C-c C-f C-b move to Bcc @@ -1782,20 +1923,6 @@ M-RET message-newline-and-reformat (break the line and reformat)." (error "Face %s not configured for %s mode" face mode-name))) "") facemenu-remove-face-function t) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - ;; `-- ' precedes the signature. `-----' appears at the start of the - ;; lines that delimit forwarded messages. - ;; Lines containing just >= 3 dashes, perhaps after whitespace, - ;; are also sometimes used and should be separators. - (setq paragraph-start - (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|" - "-- $\\|---+$\\|" - page-delimiter - ;;!!! Uhm... shurely this can't be right? - "[> " (regexp-quote message-yank-prefix) "]+$")) - (setq paragraph-separate paragraph-start) (make-local-variable 'message-reply-headers) (setq message-reply-headers nil) (make-local-variable 'message-user-agent) @@ -1805,10 +1932,22 @@ M-RET message-newline-and-reformat (break the line and reformat)." (make-local-variable 'message-parameter-alist) (setq message-parameter-alist (copy-sequence message-startup-parameter-alist)) + (message-setup-fill-variables) + ;; Allow using comment commands to add/remove quoting. + (set (make-local-variable 'comment-start) message-yank-prefix) ;;(when (fboundp 'mail-hist-define-keys) ;; (mail-hist-define-keys)) - (when (string-match "XEmacs\\|Lucid" emacs-version) - (message-setup-toolbar)) + (if (featurep 'xemacs) + (message-setup-toolbar) + (set (make-local-variable 'font-lock-defaults) + '((message-font-lock-keywords + message-font-lock-keywords-1 + message-font-lock-keywords-2) + nil nil nil nil + (font-lock-mark-block-function . mark-paragraph))) + (if (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) (message-tool-bar-map)))) + (set (make-local-variable 'message-font-lock-last-position) nil) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) ;; Allow mail alias things. @@ -1817,27 +1956,39 @@ M-RET message-newline-and-reformat (break the line and reformat)." (mail-abbrevs-setup) (mail-aliases-setup))) (message-set-auto-save-file-name) - (unless (string-match "XEmacs" emacs-version) - (set (make-local-variable 'font-lock-defaults) - '((message-font-lock-keywords - message-font-lock-keywords-1 - message-font-lock-keywords-2) - nil nil nil nil - (font-lock-mark-block-function . mark-paragraph)))) - (set (make-local-variable 'message-font-lock-last-position) nil) + (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. + (setq indent-tabs-mode nil) + (run-hooks 'text-mode-hook 'message-mode-hook)) + +(defun message-setup-fill-variables () + "Setup message fill variables." + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) (make-local-variable 'adaptive-fill-regexp) - (setq adaptive-fill-regexp - (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" - adaptive-fill-regexp)) (unless (boundp 'adaptive-fill-first-line-regexp) (setq adaptive-fill-first-line-regexp nil)) (make-local-variable 'adaptive-fill-first-line-regexp) - (setq adaptive-fill-first-line-regexp - (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" - adaptive-fill-first-line-regexp)) - (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. - (setq indent-tabs-mode nil) - (run-hooks 'text-mode-hook 'message-mode-hook)) + (make-local-variable 'auto-fill-inhibit-regexp) + (let ((quote-prefix-regexp + ;; User should change message-cite-prefix-regexp if + ;; message-yank-prefix is set to an abnormal value. + (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*"))) + (setq paragraph-start + (concat + (regexp-quote mail-header-separator) "$\\|" + "[ \t]*$\\|" ; blank lines + "-- $\\|" ; signature delimiter + "---+$\\|" ; delimiters for forwarded messages + page-delimiter "$\\|" ; spoiler warnings + ".*wrote:$\\|" ; attribution lines + quote-prefix-regexp "$")) ; empty lines in quoted text + (setq paragraph-separate paragraph-start) + (setq adaptive-fill-regexp + (concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) + (setq adaptive-fill-first-line-regexp + (concat quote-prefix-regexp "\\|" + adaptive-fill-first-line-regexp)) + (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:"))) @@ -1883,14 +2034,29 @@ M-RET message-newline-and-reformat (break the line and reformat)." (message-position-on-field "Mail-Reply-To" "Subject")) (defun message-goto-mail-followup-to () - "Move point to the Mail-Followup-To header." + "Move point to the Mail-Followup-To header. If the header is newly created +and To field contains only one address, the address is inserted in default." (interactive) - (message-position-on-field "Mail-Followup-To" "Subject")) + (unless (message-position-on-field "Mail-Followup-To" "Subject") + (let ((start (point)) + addresses) + (save-restriction + (message-narrow-to-headers) + (setq addresses (split-string (mail-strip-quoted-names + (or (std11-fetch-field "to") "")) + "[ \f\t\n\r\v,]+")) + (when (eq 1 (length addresses)) + (goto-char start) + (insert (car addresses)) + (goto-char start)))))) (defun message-goto-mail-copies-to () - "Move point to the Mail-Copies-To header." + "Move point to the Mail-Copies-To header. If the header is newly created, +a string \"never\" is inserted in default." (interactive) - (message-position-on-field "Mail-Copies-To" "Subject")) + (unless (message-position-on-field "Mail-Copies-To" "Subject") + (insert "never") + (backward-char 5))) (defun message-goto-newsgroups () "Move point to the Newsgroups header." @@ -1960,9 +2126,28 @@ With the prefix argument FORCE, insert the header anyway." (mail-fetch-field "to") (not (string-match "\\` *\\'" (mail-fetch-field "to")))) (insert ", ")) - (insert (or (message-fetch-reply-field "reply-to") + (insert (or (message-fetch-reply-field "mail-reply-to") + (message-fetch-reply-field "reply-to") (message-fetch-reply-field "from") ""))) +(defun message-widen-reply () + "Widen the reply to include maximum recipients." + (interactive) + (let ((follow-to + (and message-reply-buffer + (buffer-name message-reply-buffer) + (save-excursion + (set-buffer message-reply-buffer) + (message-get-reply-headers t))))) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (dolist (elem follow-to) + (message-remove-header (symbol-name (car elem))) + (goto-char (point-min)) + (insert (symbol-name (car elem)) ": " + (cdr elem) "\n")))))) + (defun message-insert-newsgroups () "Insert the Newsgroups header from the article being replied to." (interactive) @@ -2004,27 +2189,88 @@ With the prefix argument FORCE, insert the header anyway." (unless (bolp) (insert "\n")))) -(defun message-newline-and-reformat () +(defun message-newline-and-reformat (&optional not-break) "Insert four newlines, and then reformat if inside quoted text." (interactive) - (let ((prefix "[]>»|:}+ \t]*") - (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*") - quoted point) - (unless (bolp) - (save-excursion - (beginning-of-line) - (when (looking-at (concat prefix - supercite-thing)) - (setq quoted (match-string 0)))) - (insert "\n")) + (let (quoted point beg end leading-space) (setq point (point)) - (insert "\n\n\n") - (delete-region (point) (re-search-forward "[ \t]*")) - (when quoted - (insert quoted)) - (fill-paragraph nil) + (beginning-of-line) + (setq beg (point)) + ;; Find first line of the paragraph. + (if not-break + (while (and (not (eobp)) + (not (looking-at message-cite-prefix-regexp)) + (looking-at paragraph-start)) + (forward-line 1))) + ;; Find the prefix + (when (looking-at message-cite-prefix-regexp) + (setq quoted (match-string 0)) + (goto-char (match-end 0)) + (looking-at "[ \t]*") + (setq leading-space (match-string 0))) + (if (and quoted + (not not-break) + (< (- point beg) (length quoted))) + ;; break in the cite prefix. + (setq quoted nil + end nil)) + (if quoted + (progn + (forward-line 1) + (while (and (not (eobp)) + (not (looking-at paragraph-separate)) + (looking-at message-cite-prefix-regexp) + (equal quoted (match-string 0))) + (goto-char (match-end 0)) + (looking-at "[ \t]*") + (if (> (length leading-space) (length (match-string 0))) + (setq leading-space (match-string 0))) + (forward-line 1)) + (setq end (point)) + (goto-char beg) + (while (and (if (bobp) nil (forward-line -1) t) + (not (looking-at paragraph-start)) + (looking-at message-cite-prefix-regexp) + (equal quoted (match-string 0))) + (setq beg (point)) + (goto-char (match-end 0)) + (looking-at "[ \t]*") + (if (> (length leading-space) (length (match-string 0))) + (setq leading-space (match-string 0))))) + (while (and (not (eobp)) + (not (looking-at paragraph-separate)) + (not (looking-at message-cite-prefix-regexp))) + (forward-line 1)) + (setq end (point)) + (goto-char beg) + (while (and (if (bobp) nil (forward-line -1) t) + (not (looking-at paragraph-start)) + (not (looking-at message-cite-prefix-regexp))) + (setq beg (point)))) (goto-char point) - (forward-line 1))) + (save-restriction + (narrow-to-region beg end) + (if not-break + (setq point nil) + (insert "\n\n") + (setq point (point)) + (insert "\n\n") + (delete-region (point) (re-search-forward "[ \t]*")) + (when quoted + (insert quoted leading-space))) + (if quoted + (let* ((adaptive-fill-regexp + (regexp-quote (concat quoted leading-space))) + (adaptive-fill-first-line-regexp + adaptive-fill-regexp )) + (fill-paragraph nil)) + (fill-paragraph nil)) + (if point (goto-char point))))) + +(defun message-fill-paragraph () + "Like `fill-paragraph'." + (interactive) + (message-newline-and-reformat t)) (defun message-insert-signature (&optional force) "Insert a signature. See documentation for the `message-signature' variable." @@ -2088,16 +2334,9 @@ text was killed." ;; We build the table, if necessary. (when (or (not message-caesar-translation-table) (/= (aref message-caesar-translation-table ?a) (+ ?a n))) - (setq message-caesar-translation-table - (message-make-caesar-translation-table n))) - ;; Then we translate the region. Do it this way to retain - ;; text properties. - (while (< b e) - (when (< (char-after b) 255) - (subst-char-in-region - b (1+ b) (char-after b) - (aref message-caesar-translation-table (char-after b)))) - (incf b)))) + (setq message-caesar-translation-table + (message-make-caesar-translation-table n))) + (translate-region b e message-caesar-translation-table))) (defun message-make-caesar-translation-table (n) "Create a rot table with offset N." @@ -2134,11 +2373,8 @@ Mail and USENET news headers are not rotated." (save-restriction (when (message-goto-body) (narrow-to-region (point) (point-max))) - (let ((body (buffer-substring (point-min) (point-max)))) - (unless (equal 0 (call-process-region - (point-min) (point-max) program t t)) - (insert body) - (message "%s failed" program)))))) + (shell-command-on-region + (point-min) (point-max) program nil t)))) (defun message-rename-buffer (&optional enter-string) "Rename the *message* buffer to \"*message* RECIPIENT\". @@ -2205,7 +2441,7 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (message-delete-line)) ;; Delete blank lines at the end of the buffer. (goto-char (point-max)) - (unless (eolp) + (unless (bolp) (insert "\n")) (while (and (zerop (forward-line -1)) (looking-at "$")) @@ -2223,23 +2459,25 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (defun message-list-references (refs-list &rest refs-strs) "Add `Message-ID's which appear in REFS-STRS but not in REFS-LIST, to REFS-LIST." - (let (refs ref id) + (let (refs ref id saved-id) + (when (and refs-list + (integerp message-list-references-add-position)) + (let ((pos message-list-references-add-position)) + (while (and refs-list + (> pos 0)) + (push (pop refs-list) saved-id) + (setq pos (1- pos))))) (while refs-strs - (setq refs (car refs-strs) - refs-strs (cdr refs-strs)) - (when refs + (when (setq refs (pop refs-strs)) (setq refs (std11-parse-msg-ids (std11-lexical-analyze refs))) (while refs - (setq ref (car refs) - refs (cdr refs)) - (when (eq (car ref) 'msg-id) - (setq id (concat "<" - (mapconcat - (function (lambda (p) (cdr p))) - (cdr ref) "") - ">")) + (when (eq (car (setq ref (pop refs))) 'msg-id) + (setq id (concat "<" (mapconcat 'cdr (cdr ref) "") ">")) (or (member id refs-list) + (member id saved-id) (push id refs-list)))))) + (while saved-id + (push (pop saved-id) refs-list)) refs-list)) (defvar gnus-article-copy) @@ -2256,7 +2494,8 @@ prefix, and don't delete any headers. In addition, if `message-yank-add-new-references' is non-nil and this command is called interactively, new IDs from the yanked article will -be added to \"References\" field." +be added to \"References\" field. +\(See also `message-yank-add-new-references'.)" (interactive "P") (let ((modified (buffer-modified-p)) (buffer (message-eval-parameter message-reply-buffer)) @@ -2281,8 +2520,10 @@ be added to \"References\" field." (std11-narrow-to-header) (when (setq refs (message-list-references refs - (or (message-fetch-field "References") - (message-fetch-field "In-Reply-To")) + (unless (eq message-yank-add-new-references + 'message-id-only) + (or (message-fetch-field "References") + (message-fetch-field "In-Reply-To"))) (message-fetch-field "Message-ID"))) (widen) (message-narrow-to-headers) @@ -2332,6 +2573,8 @@ be added to \"References\" field." (if (listp message-indent-citation-function) message-indent-citation-function (list message-indent-citation-function))))) + ;; Allow undoing. + (undo-boundary) (goto-char end) (when (re-search-backward message-signature-separator start t) ;; Also peel off any blank lines before the signature. @@ -2348,7 +2591,7 @@ be added to \"References\" field." (insert "\n")) (funcall message-citation-line-function)))) -(defvar mail-citation-hook) ;Compiler directive +(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive (defun message-cite-original () "Cite function in the standard Message manner." (if (and (boundp 'mail-citation-hook) @@ -2360,7 +2603,18 @@ be added to \"References\" field." (when message-indent-citation-function (if (listp message-indent-citation-function) message-indent-citation-function - (list message-indent-citation-function))))) + (list message-indent-citation-function)))) + (message-reply-headers (or message-reply-headers + (make-mail-header)))) + (mail-header-set-from message-reply-headers + (save-restriction + (narrow-to-region + (point) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (or (message-fetch-field "from") + "unknown sender"))) (goto-char start) (while functions (funcall (pop functions))) @@ -2525,10 +2779,12 @@ The text will also be indented the normal way." (defun message-send (&optional arg) "Send the message in the current buffer. -If `message-interactive' is non-nil, wait for success indication -or error messages, and inform user. -Otherwise any failure is reported in a message back to -the user from the mailer." +If `message-interactive' is non-nil, wait for success indication or +error messages, and inform user. +Otherwise any failure is reported in a message back to the user from +the mailer. +The usage of ARG is defined by the instance that called Message. +It should typically alter the sending method in some way or other." (interactive "P") ;; Disabled test. (when (or (buffer-modified-p) @@ -2539,31 +2795,38 @@ the user from the mailer." (let ((inhibit-read-only t)) (put-text-property (point-min) (point-max) 'read-only nil)) (run-hooks 'message-send-hook) - (message "Sending...") + (message-fix-before-sending) + (message message-sending-message) (let ((message-encoding-buffer (message-generate-new-buffer-clone-locals " message encoding")) (message-edit-buffer (current-buffer)) (message-mime-mode mime-edit-mode-flag) (alist message-send-method-alist) (success t) - elem sent) + elem sent + (message-options message-options)) + (message-options-set-recipient) (save-excursion (set-buffer message-encoding-buffer) (erase-buffer) - (insert-buffer message-edit-buffer) + ;; Avoid copying text props. + (insert (with-current-buffer message-edit-buffer + (buffer-substring-no-properties (point-min) (point-max)))) (funcall message-encode-function) - (message-fix-before-sending) (while (and success (setq elem (pop alist))) - (when (or (not (funcall (cadr elem))) - (and (or (not (memq (car elem) - message-sent-message-via)) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem)))) - (setq success (funcall (caddr elem) arg)))) - (setq sent t)))) + (when (funcall (cadr elem)) + (when (and (or (not (memq (car elem) + message-sent-message-via)) + (if (or (message-gnksa-enable-p 'multiple-copies) + (not (eq (car elem) 'news))) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem))) + (error "Denied posting -- multiple copies."))) + (setq success (funcall (caddr elem) arg))) + (setq sent t))))) (unless (or sent (not success)) (error "No methods specified to send by")) (prog1 @@ -2572,7 +2835,7 @@ the user from the mailer." (save-excursion (run-hooks 'message-sent-hook)) (message "Sending...done") - ;; Mark the buffer as unmodified and delete autosave. + ;; Mark the buffer as unmodified and delete auto-save. (set-buffer-modified-p nil) (delete-auto-save-file-if-necessary t) (message-disassociate-draft) @@ -2600,13 +2863,42 @@ the user from the mailer." (put 'message-check 'lisp-indent-function 1) (put 'message-check 'edebug-form-spec '(form body)) +;; This function will be used by MIME-Edit when inserting invisible parts. +(defun message-invisible-region (start end) + (if (featurep 'xemacs) + (if (save-excursion + (goto-char start) + (eq (following-char) ?\n)) + (setq start (1+ start))) + (if (save-excursion + (goto-char (1- end)) + (eq (following-char) ?\n)) + (setq end (1- end)))) + (put-text-property start end 'invisible t) + (if (eq 'message-mode major-mode) + (put-text-property start end 'message-invisible t))) + +(eval-after-load "invisible" + '(defalias 'invisible-region 'message-invisible-region)) + (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. + (widen) (goto-char (point-max)) (unless (bolp) (insert "\n")) - ;; Delete all invisible text. + ;; Expose all invisible text with the property `message-invisible'. + ;; We should believe that the things might be created by MIME-Edit. + (let (start) + (while (setq start (text-property-any (point-min) (point-max) + 'message-invisible t)) + (remove-text-properties start + (or (text-property-not-all start (point-max) + 'message-invisible t) + (point-max)) + '(invisible nil message-invisible nil)))) + ;; Expose 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) @@ -2679,12 +2971,85 @@ This sub function is for exclusive use of `message-send-mail'." (cadr failure) (prin1-to-string failure))))) +(defun message-send-mail-partially () + "Sendmail as message/partial." + ;; replace the header delimiter with a blank line + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (run-hooks 'message-send-mail-hook) + (let ((p (goto-char (point-min))) + (tembuf (message-generate-new-buffer-clone-locals " message temp")) + (curbuf (current-buffer)) + (id (message-make-message-id)) (n 1) + plist total header required-mail-headers) + (while (not (eobp)) + (if (< (point-max) (+ p message-send-mail-partially-limit)) + (goto-char (point-max)) + (goto-char (+ p message-send-mail-partially-limit)) + (beginning-of-line) + (if (<= (point) p) (forward-line 1))) ;; In case of bad message. + (push p plist) + (setq p (point))) + (setq total (length plist)) + (push (point-max) plist) + (setq plist (nreverse plist)) + (unwind-protect + (save-excursion + (setq p (pop plist)) + (while plist + (set-buffer curbuf) + (copy-to-buffer tembuf p (car plist)) + (set-buffer tembuf) + (goto-char (point-min)) + (if header + (progn + (goto-char (point-min)) + (narrow-to-region (point) (point)) + (insert header)) + (message-goto-eoh) + (setq header (buffer-substring (point-min) (point))) + (goto-char (point-min)) + (narrow-to-region (point) (point)) + (insert header) + (message-remove-header "Mime-Version") + (message-remove-header "Content-Type") + (message-remove-header "Content-Transfer-Encoding") + (message-remove-header "Message-ID") + (message-remove-header "Lines") + (goto-char (point-max)) + (insert "Mime-Version: 1.0\n") + (setq header (buffer-substring (point-min) (point-max)))) + (goto-char (point-max)) + (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n" + id n total)) + (let ((mail-header-separator "")) + (when (memq 'Message-ID message-required-mail-headers) + (insert "Message-ID: " (message-make-message-id) "\n")) + (when (memq 'Lines message-required-mail-headers) + (let ((mail-header-separator "")) + (insert "Lines: " (message-make-lines) "\n"))) + (message-goto-subject) + (end-of-line) + (insert (format " (%d/%d)" n total)) + (goto-char (point-max)) + (insert "\n") + (widen) + (mm-with-unibyte-current-buffer + (funcall message-send-mail-function))) + (setq n (+ n 1)) + (setq p (pop plist)) + (erase-buffer))) + (kill-buffer tembuf)))) + (defun message-send-mail (&optional arg) (require 'mail-utils) - (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) - (case-fold-search nil) - (news (message-news-p)) - failure) + (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp")) + (case-fold-search nil) + (news (message-news-p)) + (message-this-is-mail t) + failure) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -2715,9 +3080,15 @@ This sub function is for exclusive use of `message-send-mail'." ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) - (when (and news + (when + (save-restriction + (message-narrow-to-headers) + (and news (or (message-fetch-field "cc") - (message-fetch-field "to"))) + (message-fetch-field "to")) + (let ((ct (mime-read-Content-Type))) + (and (eq 'text (cdr (assq 'type ct))) + (eq 'plain (cdr (assq 'subtype ct))))))) (message-insert-courtesy-copy)) (setq failure (message-maybe-split-and-send-mail))) (kill-buffer tembuf)) @@ -2731,7 +3102,8 @@ This sub function is for exclusive use of `message-send-mail'." (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." (let ((errbuf (if message-interactive - (generate-new-buffer " sendmail errors") + (message-generate-new-buffer-clone-locals + " sendmail errors") 0)) resend-to-addresses delimline) (let ((case-fold-search t)) @@ -2768,7 +3140,7 @@ This sub function is for exclusive use of `message-send-mail'." ;; But some systems are more broken with -f, so ;; we'll let users override this. (if (null message-sendmail-f-is-evil) - (list "-f" (user-login-name))) + (list "-f" (message-make-address))) ;; These mean "report errors by mail" ;; and "deliver in background". (if (null message-interactive) '("-oem" "-odb")) @@ -2874,11 +3246,13 @@ to find out how to use this." (backward-char 1) (run-hooks 'message-send-mail-hook) (if recipients - (let ((result (smtp-via-smtp user-mail-address - recipients - (current-buffer)))) - (unless (eq result t) - (error "Sending failed; " result))) + (static-if (fboundp 'smtp-send-buffer) + (smtp-send-buffer user-mail-address recipients + (current-buffer)) + (let ((result (smtp-via-smtp user-mail-address recipients + (current-buffer)))) + (unless (eq result t) + (error "Sending failed; %s" result)))) (error "Sending failed; no recipients")))) (defsubst message-maybe-split-and-send-news (method) @@ -2914,23 +3288,29 @@ This sub function is for exclusive use of `message-send-news'." (not (funcall message-send-news-function method))))) (defun message-send-news (&optional arg) - (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) - (case-fold-search nil) - (method (if (message-functionp message-post-method) - (funcall message-post-method arg) - message-post-method)) - (message-syntax-checks - (if arg - (cons '(existing-newsgroups . disabled) - message-syntax-checks) - message-syntax-checks)) - result) + (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) + (case-fold-search nil) + (method (if (message-functionp message-post-method) + (funcall message-post-method arg) + message-post-method)) + (group-name-charset (gnus-group-name-charset method "")) + (message-syntax-checks + (if arg + (cons '(existing-newsgroups . disabled) + message-syntax-checks) + message-syntax-checks)) + (message-this-is-news t) + result) (save-restriction (message-narrow-to-headers) ;; Insert some headers. (message-generate-headers message-required-news-headers) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) + (if group-name-charset + (setq message-syntax-checks + (cons '(valid-newsgroups . disabled) + message-syntax-checks))) (message-cleanup-headers) (if (not (message-check-news-syntax)) nil @@ -3008,7 +3388,7 @@ This sub function is for exclusive use of `message-send-news'." (defun message-check-news-header-syntax () (and ;; Check Newsgroups header. - (message-check 'newsgroyps + (message-check 'newsgroups (let ((group (message-fetch-field "newsgroups"))) (or (and group @@ -3224,7 +3604,10 @@ This sub function is for exclusive use of `message-send-news'." (re-search-backward message-signature-separator nil t) (beginning-of-line) (or (re-search-backward "[^ \n\t]" b t) - (y-or-n-p "Empty article. Really post? ")))) + (if (message-gnksa-enable-p 'empty-article) + (y-or-n-p "Empty article. Really post? ") + (message "Denied posting -- Empty article.") + nil)))) ;; Check for control characters. (message-check 'control-chars (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t) @@ -3246,17 +3629,38 @@ This sub function is for exclusive use of `message-send-news'." (or (not message-checksum) (not (eq (message-checksum) message-checksum)) - (y-or-n-p - "It looks like no new text has been added. Really post? "))) + (if (message-gnksa-enable-p 'quoted-text-only) + (y-or-n-p + "It looks like no new text has been added. Really post? ") + (message "Denied posting -- no new text has been added.") + nil))) ;; Check the length of the signature. (message-check 'signature (goto-char (point-max)) (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (1- (count-lines (point) (point-max))))) - t)))) + (y-or-n-p + (format + "Your .sig is %d lines; it should be max 4. Really post? " + (1- (count-lines (point) (point-max))))) + t)) + ;; Ensure that text follows last quoted portion. + (message-check 'quoting-style + (goto-char (point-max)) + (let ((no-problem t)) + (when (search-backward-regexp "^>[^\n]*\n" nil t) + (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil t))) + (if no-problem + t + (if (message-gnksa-enable-p 'quoted-text-only) + (y-or-n-p "Your text should follow quoted text. Really post? ") + ;; Ensure that + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (if (search-forward-regexp "^[ \t]*[^>\n]" nil t) + (y-or-n-p "Your text should follow quoted text. Really post? ") + (message "Denied posting -- only quoted text.") + nil))))))) (defun message-check-mail-syntax () "Check the syntax of the message." @@ -3363,7 +3767,7 @@ This sub function is for exclusive use of `message-send-news'." "Append this article to Unix/babyl mail file.." (if (and (file-readable-p filename) (mail-file-babyl-p filename)) - (rmail-output-to-rmail-file filename t) + (gnus-output-to-rmail filename t) (gnus-output-to-mail filename t))) (defun message-cleanup-headers () @@ -3438,7 +3842,6 @@ If NOW, use that time instead." (mail-header-references message-reply-headers) (mail-header-subject message-reply-headers) psubject - (mail-header-subject message-reply-headers) (not (string= (message-strip-subject-re (mail-header-subject message-reply-headers)) @@ -3492,9 +3895,9 @@ If NOW, use that time instead." "Make an Organization header." (let* ((organization (when message-user-organization - (if (message-functionp message-user-organization) - (funcall message-user-organization) - message-user-organization)))) + (if (message-functionp message-user-organization) + (funcall message-user-organization) + message-user-organization)))) (save-excursion (message-set-work-buffer) (cond ((stringp organization) @@ -3777,7 +4180,7 @@ Headers already prepared in the buffer are not modified." ;; The element is a symbol. We insert the value ;; of this symbol, if any. (symbol-value header)) - (t + ((not (message-check-element header)) ;; We couldn't generate a value for this header, ;; so we just ask the user. (read-from-minibuffer @@ -3911,23 +4314,63 @@ Headers already prepared in the buffer are not modified." (replace-match " " t t)) (goto-char (point-max))))) +(defun message-shorten-1 (list cut surplus) + ;; Cut SURPLUS elements out of LIST, beginning with CUTth one. + (setcdr (nthcdr (- cut 2) list) + (nthcdr (+ (- cut 2) surplus 1) list))) + (defun message-shorten-references (header references) - "Limit REFERENCES to be shorter than 988 characters." - (let ((max 988) - (cut 4) + "Trim REFERENCES to be less than 31 Message-ID long, and fold them. +If folding is disallowed, also check that the REFERENCES are less +than 988 characters long, and if they are not, trim them until they are." + (let ((maxcount 31) + (count 0) + (cut 6) refs) (with-temp-buffer (insert references) (goto-char (point-min)) + ;; Cons a list of valid references. (while (re-search-forward "<[^>]+>" nil t) (push (match-string 0) refs)) - (setq refs (nreverse refs)) - (while (> (length (mapconcat 'identity refs " ")) max) - (when (< (length refs) (1+ cut)) - (decf cut)) - (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs))))) - (insert (capitalize (symbol-name header)) ": " - (mapconcat 'identity refs " ") "\n"))) + (setq refs (nreverse refs) + count (length refs))) + + ;; If the list has more than MAXCOUNT elements, trim it by + ;; removing the CUTth element and the required number of + ;; elements that follow. + (when (> count maxcount) + (let ((surplus (- count maxcount))) + (message-shorten-1 refs cut surplus) + (decf count surplus))) + + ;; If folding is disallowed, make sure the total length (including + ;; the spaces between) will be less than MAXSIZE characters. + ;; + ;; Only disallow folding for News messages. At this point the headers + ;; have not been generated, thus we use message-this-is-news directly. + (when (and message-this-is-news message-cater-to-broken-inn) + (let ((maxsize 988) + (totalsize (+ (apply #'+ (mapcar #'length refs)) + (1- count))) + (surplus 0) + (ptr (nthcdr (1- cut) refs))) + ;; Decide how many elements to cut off... + (while (> totalsize maxsize) + (decf totalsize (1+ (length (car ptr)))) + (incf surplus) + (setq ptr (cdr ptr))) + ;; ...and do it. + (when (> surplus 0) + (message-shorten-1 refs cut surplus)))) + + ;; Finally, collect the references back into a string and insert + ;; it into the buffer. + (let ((refstring (mapconcat #'identity refs " "))) + (if (and message-this-is-news message-cater-to-broken-inn) + (insert (capitalize (symbol-name header)) ": " + refstring "\n") + (message-fill-header header refstring))))) (defun message-position-point () "Move point to where the user probably wants to find it." @@ -4035,13 +4478,47 @@ Headers already prepared in the buffer are not modified." (setq message-buffer-list (nconc message-buffer-list (list (current-buffer)))))) -(defvar mc-modes-alist) -(defun message-setup (headers &optional replybuffer actions) - (when (and (boundp 'mc-modes-alist) - (not (assq 'message-mode mc-modes-alist))) - (push '(message-mode (encrypt . mc-encrypt-message) - (sign . mc-sign-message)) - mc-modes-alist)) +(defun message-mail-user-agent () + (let ((mua (cond + ((not message-mail-user-agent) nil) + ((eq message-mail-user-agent t) mail-user-agent) + (t message-mail-user-agent)))) + (if (memq mua '(message-user-agent gnus-user-agent)) + nil + mua))) + +(defun message-setup (headers &optional replybuffer actions switch-function) + (let ((mua (message-mail-user-agent)) + subject to field yank-action) + (if (not (and message-this-is-mail mua)) + (message-setup-1 headers replybuffer actions) + (if replybuffer + (setq yank-action (list 'insert-buffer replybuffer))) + (setq headers (copy-sequence headers)) + (setq field (assq 'Subject headers)) + (when field + (setq subject (cdr field)) + (setq headers (delq field headers))) + (setq field (assq 'To headers)) + (when field + (setq to (cdr field)) + (setq headers (delq field headers))) + (let ((mail-user-agent mua)) + (compose-mail to subject + (mapcar (lambda (item) + (cons + (format "%s" (car item)) + (cdr item))) + headers) + nil switch-function yank-action actions))))) + +;;;(defvar mc-modes-alist) +(defun message-setup-1 (headers &optional replybuffer actions) +;;; (when (and (boundp 'mc-modes-alist) +;;; (not (assq 'message-mode mc-modes-alist))) +;;; (push '(message-mode (encrypt . mc-encrypt-message) +;;; (sign . mc-sign-message)) +;;; mc-modes-alist)) (when actions (setq message-send-actions actions)) (setq message-reply-buffer @@ -4091,6 +4568,8 @@ Headers already prepared in the buffer are not modified." (message-insert-signature) (save-restriction (message-narrow-to-headers) + (if message-alternative-emails + (message-use-alternative-email-as-from)) (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) (setq buffer-undo-list nil) @@ -4101,6 +4580,9 @@ Headers already prepared in the buffer are not modified." (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." (when message-auto-save-directory + (unless (file-directory-p + (directory-file-name message-auto-save-directory)) + (gnus-make-directory message-auto-save-directory)) (if (gnus-alive-p) (setq message-draft-article (nndraft-request-associate-buffer "drafts")) @@ -4149,7 +4631,8 @@ Headers already prepared in the buffer are not modified." OTHER-HEADERS is an alist of header/value pairs." (interactive) (let ((message-this-is-mail t)) - (message-pop-to-buffer (message-buffer-name "mail" to)) + (unless (message-mail-user-agent) + (message-pop-to-buffer (message-buffer-name "mail" to))) (message-setup (nconc `((To . ,(or to "")) (Subject . ,(or subject ""))) @@ -4164,56 +4647,20 @@ OTHER-HEADERS is an alist of header/value pairs." (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) -;;;###autoload -(defun message-reply (&optional to-address wide) - "Start editing a reply to the article in the current buffer." - (interactive) - (let ((cur (current-buffer)) - from subject date to cc - references message-id follow-to - (inhibit-point-motion-hooks t) - (message-this-is-mail t) - mct never-mct mft mrt gnus-warning in-reply-to) - (save-restriction - (message-narrow-to-head) - ;; Allow customizations to have their say. - (if (not wide) - ;; This is a regular reply. - (if (message-functionp message-reply-to-function) - (setq follow-to (funcall message-reply-to-function))) - ;; This is a followup. - (if (message-functionp message-wide-reply-to-function) - (save-excursion - (setq follow-to - (funcall message-wide-reply-to-function))))) - ;; Find all relevant headers we need. - (setq from (message-fetch-field "from") - date (message-fetch-field "date" t) - subject (or (message-fetch-field "subject") "none") - references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t) - to (message-fetch-field "to") - cc (message-fetch-field "cc") - mct (when (and wide message-use-mail-copies-to) - (message-fetch-field "mail-copies-to")) - mft (when (and wide message-use-mail-followup-to) - (message-fetch-field "mail-followup-to")) - mrt (when message-use-mail-reply-to - (or (message-fetch-field "mail-reply-to") - (message-fetch-field "reply-to"))) - gnus-warning (message-fetch-field "gnus-warning")) - (when (and gnus-warning (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - ;; Get the references from "In-Reply-To" field if there were - ;; no references and "In-Reply-To" field looks promising. - (unless references - (when (and (setq in-reply-to (message-fetch-field "in-reply-to")) - (string-match "<[^>]+>" in-reply-to)) - (setq references (match-string 0 in-reply-to)))) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (setq subject (message-make-followup-subject subject)) - (widen)) +(defun message-get-reply-headers (wide &optional to-address) + (let (follow-to mct never-mct from to cc reply-to mrt mft) + ;; Find all relevant headers we need. + (setq from (message-fetch-field "from") + to (message-fetch-field "to") + cc (message-fetch-field "cc") + mct (when message-use-mail-copies-to + (message-fetch-field "mail-copies-to")) + reply-to (message-fetch-field "reply-to") + mrt (when message-use-mail-reply-to + (message-fetch-field "mail-reply-to")) + mft (when (and (not (or to-address mrt reply-to)) + message-use-mail-followup-to) + (message-fetch-field "mail-followup-to"))) ;; Handle special values of Mail-Copies-To. (when mct @@ -4238,7 +4685,7 @@ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: always' sends a copy of your response to the author."))) - (setq mct (or mrt from))) + (setq mct (or mrt reply-to from))) ((and (eq message-use-mail-copies-to 'ask) (not (message-y-or-n-p @@ -4249,18 +4696,13 @@ You should normally obey the Mail-Copies-To: header. sends a copy of your response to " (if (string-match "," mct) "the specified addresses" "that address") "."))) - (setq mct nil)) - )) + (setq mct nil)))) - (unless follow-to - (cond - (to-address (setq follow-to (list (cons 'To to-address)))) - ((not wide) (setq follow-to (list (cons 'To (or mrt from))))) - ;; Handle Mail-Followup-To. - ((and mft - (or (not (eq message-use-mail-followup-to 'ask)) - (message-y-or-n-p - (concat "Obey Mail-Followup-To: " mft "? ") t "\ + ;; Handle Mail-Followup-To. + (when (and mft + (eq message-use-mail-followup-to 'ask) + (not (message-y-or-n-p + (concat "Obey Mail-Followup-To: " mft "? ") t "\ You should normally obey the Mail-Followup-To: header. `Mail-Followup-To: " mft "' @@ -4273,48 +4715,124 @@ that further discussion should take place only in " (if (string-match "," mft) "the specified mailing lists" "that mailing list") "."))) - (setq follow-to (list (cons 'To mft))) - (when mct - (push (cons 'Cc mct) follow-to))) - (t - (let (ccalist) - (save-excursion - (message-set-work-buffer) + (setq mft nil)) + + (if (or (not wide) + to-address) + (progn + (setq follow-to (list (cons 'To + (or to-address mrt reply-to mft from)))) + (when (and wide mct) + (push (cons 'Cc mct) follow-to))) + (let (ccalist) + (save-excursion + (message-set-work-buffer) + (if (and mft + message-use-followup-to + (or (not (eq message-use-followup-to 'ask)) + (message-y-or-n-p "Obey Mail-Followup-To? " t "\ +You should normally obey the Mail-Followup-To: header. In this +article, it has the value of + +" mft " + +which directs your response to " (if (string-match "," mft) + "the specified addresses" + "that address only") ". + +If a message is posted to several mailing lists, Mail-Followup-To is +often 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. + +Also, some source/announcement lists are not indented for discussion; +responses here are directed to other addresses."))) + (insert mft) (unless never-mct - (insert (or mrt from ""))) + (insert (or mrt reply-to from ""))) (insert (if to (concat (if (bolp) "" ", ") to "") "")) (insert (if mct (concat (if (bolp) "" ", ") mct) "")) - (insert (if cc (concat (if (bolp) "" ", ") cc) "")) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " " t t)) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) - (insert (prog1 (rmail-dont-reply-to (buffer-string)) - (erase-buffer)))) - (goto-char (point-min)) - ;; Perhaps Mail-Copies-To: never removed the only address? - (when (eobp) - (insert (or mrt from ""))) - (setq ccalist - (mapcar - (lambda (addr) - (cons (mail-strip-quoted-names addr) addr)) - (message-tokenize-header (buffer-string)))) - (let ((s ccalist)) - (while s - (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) - (setq follow-to (list (cons 'To (cdr (pop ccalist))))) - (when ccalist - (let ((ccs (cons 'Cc (mapconcat - (lambda (addr) (cdr addr)) ccalist ", ")))) - (when (string-match "^ +" (cdr ccs)) - (setcdr ccs (substring (cdr ccs) (match-end 0)))) - (push ccs follow-to))))))) - - (message-pop-to-buffer (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil))) + (insert (if cc (concat (if (bolp) "" ", ") cc) ""))) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+" nil t) + (replace-match " " t t)) + ;; Remove addresses that match `rmail-dont-reply-to-names'. + (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) + (insert (prog1 (rmail-dont-reply-to (buffer-string)) + (erase-buffer)))) + (goto-char (point-min)) + ;; Perhaps "Mail-Copies-To: never" removed the only address? + (when (eobp) + (insert (or mrt reply-to from ""))) + (setq ccalist + (mapcar + (lambda (addr) + (cons (mail-strip-quoted-names addr) addr)) + (message-tokenize-header (buffer-string)))) + (let ((s ccalist)) + (while s + (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) + (setq follow-to (list (cons 'To (cdr (pop ccalist))))) + (when ccalist + (let ((ccs (cons 'Cc (mapconcat + (lambda (addr) (cdr addr)) ccalist ", ")))) + (when (string-match "^ +" (cdr ccs)) + (setcdr ccs (substring (cdr ccs) (match-end 0)))) + (push ccs follow-to))))) + follow-to)) + + +;;;###autoload +(defun message-reply (&optional to-address wide) + "Start editing a reply to the article in the current buffer." + (interactive) + (require 'gnus-sum) ; for gnus-list-identifiers + (let ((cur (current-buffer)) + from subject date + references message-id follow-to + (inhibit-point-motion-hooks t) + (message-this-is-mail t) + gnus-warning in-reply-to) + (save-restriction + (message-narrow-to-head-1) + ;; Allow customizations to have their say. + (if (not wide) + ;; This is a regular reply. + (if (message-functionp message-reply-to-function) + (setq follow-to (funcall message-reply-to-function))) + ;; This is a followup. + (if (message-functionp message-wide-reply-to-function) + (save-excursion + (setq follow-to + (funcall message-wide-reply-to-function))))) + (setq message-id (message-fetch-field "message-id" t) + references (message-fetch-field "references") + date (message-fetch-field "date") + from (message-fetch-field "from") + subject (or (message-fetch-field "subject") "none")) + (if gnus-list-identifiers + (setq subject (message-strip-list-identifiers subject))) + (setq subject (message-make-followup-subject subject)) + + (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) + (string-match "<[^>]+>" gnus-warning)) + (setq message-id (match-string 0 gnus-warning))) + + (unless follow-to + (setq follow-to (message-get-reply-headers wide to-address))) + + ;; Get the references from "In-Reply-To" field if there were + ;; no references and "In-Reply-To" field looks promising. + (unless references + (when (and (setq in-reply-to (message-fetch-field "in-reply-to")) + (string-match "<[^>]+>" in-reply-to)) + (setq references (match-string 0 in-reply-to))))) + + (unless (message-mail-user-agent) + (message-pop-to-buffer + (message-buffer-name + (if wide "wide reply" "reply") from + (if wide to-address nil)))) (setq message-reply-headers (make-full-mail-header-from-decoded-header @@ -4325,7 +4843,8 @@ that further discussion should take place only in " ,@follow-to ,@(if (or references message-id) `((References . ,(concat (or references "") (and references " ") - (or message-id "")))))) + (or message-id "")))) + nil)) cur))) ;;;###autoload @@ -4339,44 +4858,44 @@ that further discussion should take place only in " "Follow up to the message in the current buffer. If TO-NEWSGROUPS, use that as the new Newsgroups line." (interactive) + (require 'gnus-sum) ; for gnus-list-identifiers (let ((cur (current-buffer)) - from subject date mct + from subject date reply-to mrt mct mft references message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-news t) - followup-to distribution newsgroups gnus-warning posted-to mft mrt) + followup-to distribution newsgroups gnus-warning posted-to) (save-restriction (message-narrow-to-head) (when (message-functionp message-followup-to-function) (setq follow-to (funcall message-followup-to-function))) (setq from (message-fetch-field "from") - date (message-fetch-field "date" t) + date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") references (message-fetch-field "references") message-id (message-fetch-field "message-id" t) - followup-to (when message-use-followup-to - (message-fetch-field "followup-to")) - distribution (message-fetch-field "distribution") + followup-to (message-fetch-field "followup-to") newsgroups (message-fetch-field "newsgroups") posted-to (message-fetch-field "posted-to") + reply-to (message-fetch-field "reply-to") + mrt (when message-use-mail-reply-to + (message-fetch-field "mail-reply-to")) + distribution (message-fetch-field "distribution") mct (when message-use-mail-copies-to (message-fetch-field "mail-copies-to")) mft (when message-use-mail-followup-to - (message-fetch-field "mail-followup-to")) - mrt (when message-use-mail-reply-to - (or (message-fetch-field "mail-reply-to") - (message-fetch-field "reply-to"))) - gnus-warning (message-fetch-field "gnus-warning")) - (when (and gnus-warning (string-match "<[^>]+>" gnus-warning)) + (message-fetch-field "mail-followup-to"))) + (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) + (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) ;; Remove bogus distribution. (when (and (stringp distribution) (let ((case-fold-search t)) (string-match "world" distribution))) (setq distribution nil)) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. + (if gnus-list-identifiers + (setq subject (message-strip-list-identifiers subject))) (setq subject (message-make-followup-subject subject)) (widen)) @@ -4402,7 +4921,7 @@ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: always' sends a copy of your response to the author."))) - (setq mct (or mrt from))) + (setq mct (or mrt reply-to from))) ((and (eq message-use-mail-copies-to 'ask) (not (message-y-or-n-p @@ -4423,7 +4942,7 @@ sends a copy of your response to " (if (string-match "," mct) (followup-to (cond ((equal (downcase followup-to) "poster") - (if (or (eq message-use-followup-to 'use) + (if (or (and followup-to (eq message-use-followup-to 'use)) (message-y-or-n-p "Obey Followup-To: poster? " t "\ You should normally obey the Followup-To: header. @@ -4434,11 +4953,11 @@ A typical situation where `Followup-To: poster' is used is when the author does not read the newsgroup, so he wouldn't see any replies sent to it.")) (setq message-this-is-news nil distribution nil - follow-to (list (cons 'To (or mrt from "")))) + follow-to (list (cons 'To (or mrt reply-to from "")))) (setq follow-to (list (cons 'Newsgroups newsgroups))))) (t (if (or (equal followup-to newsgroups) - (not (eq message-use-followup-to 'ask)) + (not (and followup-to (eq message-use-followup-to 'ask))) (message-y-or-n-p (concat "Obey Followup-To: " followup-to "? ") t "\ You should normally obey the Followup-To: header. @@ -4483,10 +5002,6 @@ that further discussion should take place only in " (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) - (setq message-reply-headers - (make-full-mail-header-from-decoded-header - 0 subject from date message-id references 0 0 "")) - (message-setup `((Subject . ,subject) ,@follow-to @@ -4495,20 +5010,25 @@ that further discussion should take place only in " ,@(if (or references message-id) `((References . ,(concat (or references "") (and references " ") (or message-id "")))))) - cur))) + cur) + + (setq message-reply-headers + (make-full-mail-header-from-decoded-header + 0 subject from date message-id references 0 0 "")))) ;;;###autoload -(defun message-cancel-news () - "Cancel an article you posted." - (interactive) +(defun message-cancel-news (&optional arg) + "Cancel an article you posted. +If ARG, allow editing of the cancellation message." + (interactive "P") (unless (message-news-p) (error "This is not a news article; canceling is impossible")) (when (yes-or-no-p "Do you really want to cancel this article? ") (let (from newsgroups message-id distribution buf sender) (save-excursion - ;; Get header info. from original article. + ;; Get header info from original article. (save-restriction - (message-narrow-to-head) + (message-narrow-to-head-1) (setq from (message-fetch-field "from") sender (message-fetch-field "sender") newsgroups (message-fetch-field "newsgroups") @@ -4526,10 +5046,12 @@ that further discussion should take place only in " (message-make-from)))))) (error "This article is not yours")) ;; Make control message. - (setq buf (set-buffer (get-buffer-create " *message cancel*"))) + (if arg + (message-news) + (setq buf (set-buffer (get-buffer-create " *message cancel*")))) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" - "From: " (message-make-from) "\n" + "From: " from "\n" "Subject: cmsg cancel " message-id "\n" "Control: cancel " message-id "\n" (if distribution @@ -4539,13 +5061,14 @@ that further discussion should take place only in " message-cancel-message) (run-hooks 'message-cancel-hook) (message "Canceling your article...") - (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me) - (message-encoding-buffer (current-buffer)) - (message-edit-buffer (current-buffer))) - (message-send-news)) - (message "Canceling your article...done")) - (kill-buffer buf))))) + (unless arg + (if (let ((message-syntax-checks + 'dont-check-for-anything-just-trust-me) + (message-encoding-buffer (current-buffer)) + (message-edit-buffer (current-buffer))) + (message-send-news)) + (message "Canceling your article...done")) + (kill-buffer buf)))))) (defun message-supersede-setup-for-mime-edit () (set (make-local-variable 'message-setup-hook) nil) @@ -4573,7 +5096,7 @@ header line with the old Message-ID." ;; Get a normal message buffer. (message-pop-to-buffer (message-buffer-name "supersede")) (insert-buffer-substring cur) - (message-narrow-to-head) + (message-narrow-to-head-1) ;; Remove unwanted headers. (when message-ignored-supersedes-headers (message-remove-header message-ignored-supersedes-headers t)) @@ -4598,6 +5121,8 @@ header line with the old Message-ID." (cond ((save-window-excursion (if (not (eq system-type 'vax-vms)) (with-output-to-temp-buffer "*Directory*" + (with-current-buffer standard-output + (fundamental-mode)) ; for Emacs 20.4+ (buffer-disable-undo standard-output) (let ((default-directory "/")) (call-process @@ -4663,17 +5188,15 @@ the message." "Return a Subject header suitable for the message in the current buffer." (save-excursion (save-restriction - (current-buffer) - (message-narrow-to-head) + (message-narrow-to-head-1) (let ((funcs message-make-forward-subject-function) (subject (message-fetch-field "Subject"))) (setq subject (if subject - (if message-wash-forwarded-subjects - (message-wash-subject - (nnheader-decode-subject subject)) - (nnheader-decode-subject subject)) - "(none)")) + (nnheader-decode-subject subject) + "")) + (if message-wash-forwarded-subjects + (setq subject (message-wash-subject subject))) ;; Make sure funcs is a list. (and funcs (not (listp funcs)) @@ -4699,11 +5222,11 @@ Optional NEWS will use news to forward instead of mail." (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded ;; message. - (if message-signature-before-forwarded-message - (goto-char (point-max)) - (message-goto-body)) + (if message-forward-before-signature + (message-goto-body) + (goto-char (point-max))) ;; Make sure we're at the start of the line. - (unless (eolp) + (unless (bolp) (insert "\n")) ;; Narrow to the area we are to insert. (narrow-to-region (point) (point)) @@ -4734,12 +5257,13 @@ Optional NEWS will use news to forward instead of mail." (let ((cur (current-buffer)) beg) ;; We first set up a normal mail buffer. - (set-buffer (get-buffer-create " *message resend*")) - (erase-buffer) - ;; avoid to turn-on-mime-edit - (let (message-setup-hook) - (message-setup `((To . ,address))) - ) + (unless (message-mail-user-agent) + (set-buffer (get-buffer-create " *message resend*")) + (erase-buffer) + (let ((message-this-is-mail t) + ;; avoid to turn-on-mime-edit + message-setup-hook) + (message-setup `((To . ,address))))) ;; Insert our usual headers. (message-generate-headers '(From Date To)) (message-narrow-to-headers) @@ -4784,7 +5308,7 @@ Optional NEWS will use news to forward instead of mail." ;;;###autoload (defun message-bounce () "Re-mail the current message. -This only makes sense if the current message is a bounce message than +This only makes sense if the current message is a bounce message that contains some mail you have written which has been bounced back to you." (interactive) @@ -4816,7 +5340,7 @@ you." (match-beginning 0) (point))) (save-restriction - (message-narrow-to-head) + (message-narrow-to-head-1) (message-remove-header message-ignored-bounced-headers t) (goto-char (point-max)) (insert mail-header-separator)) @@ -4833,27 +5357,31 @@ you." (defun message-mail-other-window (&optional to subject) "Like `message-mail' command, but display mail buffer in another window." (interactive) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to))) + (unless (message-mail-user-agent) + (let ((pop-up-windows t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (message-pop-to-buffer (message-buffer-name "mail" to)))) (let ((message-this-is-mail t)) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))) + (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) + nil nil 'switch-to-buffer-other-window))) ;;;###autoload (defun message-mail-other-frame (&optional to subject) "Like `message-mail' command, but display mail buffer in another frame." (interactive) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to))) + (unless (message-mail-user-agent) + (let ((pop-up-frames t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (message-pop-to-buffer (message-buffer-name "mail" to)))) (let ((message-this-is-mail t)) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))) + (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) + nil nil 'switch-to-buffer-other-frame))) ;;;###autoload (defun message-news-other-window (&optional newsgroups subject) @@ -4920,8 +5448,35 @@ which specify the range to operate on." (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) ;; Support for toolbar -(when (string-match "XEmacs\\|Lucid" emacs-version) - (require 'messagexmas)) +(if (featurep 'xemacs) + (require 'messagexmas)) + +(eval-when-compile + (defvar tool-bar-map) + (defvar tool-bar-mode)) + +(defun message-tool-bar-map () + (or message-tool-bar-map + (setq message-tool-bar-map + (and (fboundp 'tool-bar-add-item-from-menu) + tool-bar-mode + (let ((tool-bar-map (copy-keymap tool-bar-map))) + ;; Zap some items which aren't so relevant and take + ;; up space. + (dolist (key '(print-buffer kill-buffer save-buffer + write-file dired open-file)) + (define-key tool-bar-map (vector key) nil)) + (tool-bar-add-item-from-menu + 'message-send-and-exit "mail_send" message-mode-map) + (tool-bar-add-item-from-menu + 'message-kill-buffer "close" message-mode-map) + (tool-bar-add-item-from-menu + 'message-dont-send "cancel" message-mode-map) + (tool-bar-add-item-from-menu + 'mml-attach-file "attach" message-mode-map) + (tool-bar-add-item-from-menu + 'ispell-message "spell" message-mode-map) + tool-bar-map))))) ;;; Group name completion. @@ -4938,7 +5493,6 @@ Do a `tab-to-tab-stop' if not in those headers." (message-expand-group) (tab-to-tab-stop))) -(defvar gnus-active-hashtb) (defun message-expand-group () "Expand the group name under point." (let* ((b (save-excursion @@ -4993,6 +5547,7 @@ The following arguments may contain lists of values." (save-excursion (with-output-to-temp-buffer " *MESSAGE information message*" (set-buffer " *MESSAGE information message*") + (fundamental-mode) ; for Emacs 20.4+ (mapcar 'princ text) (goto-char (point-min)))) (funcall ask question)) @@ -5016,10 +5571,10 @@ regexp varstr." (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (generate-new-buffer name)) - (message-clone-locals oldbuf) + (message-clone-locals oldbuf varstr) (current-buffer)))) -(defun message-clone-locals (buffer) +(defun message-clone-locals (buffer &optional varstr) "Clone the local variables from BUFFER to the current buffer." (let ((locals (save-excursion (set-buffer buffer) @@ -5030,7 +5585,9 @@ regexp varstr." (lambda (local) (when (and (consp local) (car local) - (string-match regexp (symbol-name (car local)))) + (string-match regexp (symbol-name (car local))) + (or (null varstr) + (string-match varstr (symbol-name (car local))))) (ignore-errors (set (make-local-variable (car local)) (cdr local))))) @@ -5082,17 +5639,20 @@ regexp varstr." ;;; Miscellaneous functions ;; stolen (and renamed) from nnheader.el -(defun message-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) +(static-if (fboundp 'subst-char-in-string) + (defsubst message-replace-chars-in-string (string from to) + (subst-char-in-string from to string)) + (defun message-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (when (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string))) ;;; ;;; MIME functions @@ -5103,8 +5663,7 @@ regexp varstr." (defun message-encode-message-body () (unless message-inhibit-body-encoding (let ((mail-parse-charset (or mail-parse-charset - message-default-charset - message-posting-charset)) + message-default-charset)) (case-fold-search t) lines content-type-p) (message-goto-body) @@ -5119,7 +5678,7 @@ regexp varstr." (delete-char 1) (search-forward "\n\n") (setq lines (buffer-substring (point-min) (1- (point)))) - (delete-region (point-min) (point)))))) + (delete-region (point-min) (point)))))) (save-restriction (message-narrow-to-headers-or-head) (message-remove-header "Mime-Version") @@ -5149,30 +5708,71 @@ regexp varstr." (if (fboundp 'mail-abbrevs-setup) (let ((mail-abbrev-mode-regexp "") (minibuffer-setup-hook 'mail-abbrevs-setup)) - (read-from-minibuffer prompt))) - (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)) - (read-string prompt))) + (read-from-minibuffer prompt)) + (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)) + (read-string prompt)))) + +(defun message-use-alternative-email-as-from () + (require 'mail-utils) + (let* ((fields '("To" "Cc")) + (emails + (split-string + (mail-strip-quoted-names + (mapconcat 'message-fetch-reply-field fields ",")) + "[ \f\t\n\r\v,]+")) + email) + (while emails + (if (string-match message-alternative-emails (car emails)) + (setq email (car emails) + emails nil)) + (pop emails)) + (unless (or (not email) (equal email user-mail-address)) + (goto-char (point-max)) + (insert "From: " email "\n")))) + +(defun message-options-get (symbol) + (cdr (assq symbol message-options))) + +(defun message-options-set (symbol value) + (let ((the-cons (assq symbol message-options))) + (if the-cons + (if value + (setcdr the-cons value) + (setq message-options (delq the-cons message-options))) + (and value + (push (cons symbol value) message-options)))) + value) + +(defun message-options-set-recipient () + (save-restriction + (message-narrow-to-headers-or-head) + (message-options-set 'message-sender + (mail-strip-quoted-names + (message-fetch-field "from"))) + (message-options-set 'message-recipients + (mail-strip-quoted-names + (message-fetch-field "to"))))) -(defvar message-save-buffer " *encoding") (defun message-save-drafts () + "Postponing the message." (interactive) - (if (not (get-buffer message-save-buffer)) - (get-buffer-create message-save-buffer)) - (let ((filename buffer-file-name) - (buffer (current-buffer)) - (reply-headers message-reply-headers)) - (set-buffer message-save-buffer) - (erase-buffer) - (insert-buffer buffer) - (setq message-reply-headers reply-headers) - (message-generate-headers '((optional . In-Reply-To))) - (mime-edit-translate-buffer) - (write-region (point-min) (point-max) filename) - (set-buffer buffer) - (set-buffer-modified-p nil))) + (message "Saving %s..." buffer-file-name) + (let ((reply-headers message-reply-headers) + (msg (buffer-substring-no-properties (point-min) (point-max)))) + (with-temp-file buffer-file-name + (insert msg) + (setq message-reply-headers reply-headers) + (message-generate-headers '((optional . In-Reply-To))) + (mime-edit-translate-buffer)) + (set-buffer-modified-p nil)) + (message "Saving %s...done" buffer-file-name)) (provide 'message) (run-hooks 'message-load-hook) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; message.el ends here diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el index b817f86..cf94e54 100644 --- a/lisp/messagexmas.el +++ b/lisp/messagexmas.el @@ -25,6 +25,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'nnheader) (defvar message-xmas-dont-activate-region t @@ -90,7 +91,8 @@ If it is non-nil, it must be a toolbar. The five valid values are "Exchange point and mark, but allow for XEmacs' optional argument." (exchange-point-and-mark message-xmas-dont-activate-region)) -(fset 'message-exchange-point-and-mark 'message-xmas-exchange-point-and-mark) +(defalias 'message-exchange-point-and-mark + 'message-xmas-exchange-point-and-mark) (defun message-xmas-maybe-fontify () (when (featurep 'font-lock) @@ -114,8 +116,8 @@ If it is non-nil, it must be a toolbar. The five valid values are (substring table (+ a 26) 255)))) (when (>= emacs-major-version 20) - (fset 'message-make-caesar-translation-table - 'message-xmas-make-caesar-translation-table)) + (defalias 'message-make-caesar-translation-table + 'message-xmas-make-caesar-translation-table)) (add-hook 'message-mode-hook 'message-xmas-maybe-fontify) diff --git a/lisp/messcompat.el b/lisp/messcompat.el index c9f0f7d..e3021ce 100644 --- a/lisp/messcompat.el +++ b/lisp/messcompat.el @@ -1,5 +1,7 @@ ;;; messcompat.el --- making message mode compatible with mail mode -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news @@ -72,7 +74,7 @@ If a form, the result from the form will be used instead.") ;; Deleted the autoload cookie because this crashes in loaddefs.el. (defvar message-signature-file mail-signature-file - "*File containing the text inserted at end of message. buffer.") + "*File containing the text inserted at end of the message buffer.") (defvar message-default-headers mail-default-headers "*A string containing header lines to be inserted in outgoing messages. diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index ad7bbeb..f7440c7 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -1,5 +1,5 @@ ;;; mm-bodies.el --- Functions for decoding MIME things -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -26,86 +26,112 @@ (eval-and-compile (or (fboundp 'base64-decode-region) - (require 'base64)) - (autoload 'binhex-decode-region "binhex")) + (require 'base64))) + +(eval-when-compile + (defvar mm-uu-decode-function) + (defvar mm-uu-binhex-decode-function)) (require 'mm-util) (require 'rfc2047) -(require 'qp) -(require 'uudecode) +(require 'mm-encode) ;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL, ;; BS, vertical TAB, form feed, and ^_ -(defvar mm-8bit-char-regexp "[^\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f]") +(defvar mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f") -(defvar mm-body-charset-encoding-alist nil +(defcustom mm-body-charset-encoding-alist + '((iso-2022-jp . 7bit) + (iso-2022-jp-2 . 7bit)) "Alist of MIME charsets to encodings. -Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'.") +Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." + :type '(repeat (cons (symbol :tag "charset") + (choice :tag "encoding" + (const 7bit) + (const 8bit) + (const quoted-printable) + (const base64)))) + :group 'mime) -(defun mm-encode-body () +(defun mm-encode-body (&optional charset) "Encode a body. Should be called narrowed to the body that is to be encoded. If there is more than one non-ASCII MULE charset, then list of found MULE charsets are returned. +If CHARSET is non-nil, it is used. If successful, the MIME charset is returned. If no encoding was done, nil is returned." - (if (not (featurep 'mule)) + (if (not (mm-multibyte-p)) ;; In the non-Mule case, we search for non-ASCII chars and - ;; return the value of `mm-default-charset' if any are found. - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "[^\x0-\x7f]" nil t) - (or mail-parse-charset - (mm-read-charset "Charset used in the article: ")) - ;; The logic in `mml-generate-mime-1' confirms that it's OK - ;; to return nil here. - nil)) + ;; return the value of `mail-parse-charset' if any are found. + (or charset + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "[^\x0-\x7f]" nil t) + (or mail-parse-charset + (message-options-get 'mm-encody-body-charset) + (message-options-set + 'mm-encody-body-charset + (mm-read-charset "Charset used in the article: "))) + ;; The logic in `mml-generate-mime-1' confirms that it's OK + ;; to return nil here. + nil))) (save-excursion - (goto-char (point-min)) - (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))) + (if charset + (progn + (mm-encode-coding-region (point-min) (point-max) charset) charset) - (cond - ;; No encoding. - ((null charsets) - nil) - ;; Too many charsets. - ((> (length charsets) 1) - charsets) - ;; We encode. - (t - (let ((charset (car charsets)) - start) - (when (or t - ;; We always decode. - (not (mm-coding-system-equal - charset buffer-file-coding-system))) - (while (not (eobp)) - (if (eq (char-charset (char-after)) 'ascii) - (when start - (save-restriction - (narrow-to-region start (point)) - (mm-encode-coding-region start (point) charset) - (goto-char (point-max))) - (setq start nil)) - (unless start - (setq start (point)))) - (forward-char 1)) - (when start - (mm-encode-coding-region start (point) charset) - (setq start nil))) + (goto-char (point-min)) + (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))) + start) + (cond + ;; No encoding. + ((null charsets) + nil) + ;; Too many charsets. + ((> (length charsets) 1) + charsets) + ;; We encode. + (t + (setq charset (car charsets)) + (while (not (eobp)) + (if (eq (mm-charset-after) 'ascii) + (when start + (save-restriction + (narrow-to-region start (point)) + (mm-encode-coding-region + start (point) (mm-charset-to-coding-system charset)) + (goto-char (point-max))) + (setq start nil)) + (unless start + (setq start (point)))) + (forward-char 1)) + (when start + (mm-encode-coding-region start (point) + (mm-charset-to-coding-system charset)) + (setq start nil)) charset))))))) -(defun mm-body-encoding (charset) +(eval-when-compile (defvar message-posting-charset)) + +(defun mm-body-encoding (charset &optional encoding) "Do Content-Transfer-Encoding and return the encoding of the current buffer." (let ((bits (mm-body-7-or-8))) + (require 'message) (cond - ((eq bits '7bit) + ((and (not mm-use-ultra-safe-encoding) (eq bits '7bit)) bits) - ((eq charset mail-parse-charset) + ((and (not mm-use-ultra-safe-encoding) + (or (eq t (cdr message-posting-charset)) + (memq charset (cdr message-posting-charset)) + (eq charset mail-parse-charset))) bits) (t - (let ((encoding (or (cdr (assq charset mm-body-charset-encoding-alist)) + (let ((encoding (or encoding + (cdr (assq charset mm-body-charset-encoding-alist)) (mm-qp-or-base64)))) + (when mm-use-ultra-safe-encoding + (setq encoding (mm-safer-encoding encoding))) (mm-encode-content-transfer-encoding encoding "text/plain") encoding))))) @@ -115,9 +141,10 @@ If no encoding was done, nil is returned." ((not (featurep 'mule)) (if (save-excursion (goto-char (point-min)) - (re-search-forward mm-8bit-char-regexp nil t)) - '8bit - '7bit)) + (skip-chars-forward mm-7bit-chars) + (eobp)) + '7bit + '8bit)) (t ;; Mule version (if (and (null (delq 'ascii @@ -127,7 +154,7 @@ If no encoding was done, nil is returned." ;;!!!Emacs 20.3. Sometimes. (save-excursion (goto-char (point-min)) - (skip-chars-forward "\0-\177") + (skip-chars-forward mm-7bit-chars) (eobp))) '7bit '8bit)))) @@ -143,22 +170,33 @@ If no encoding was done, nil is returned." ((eq encoding 'quoted-printable) (quoted-printable-decode-region (point-min) (point-max))) ((eq encoding 'base64) - (base64-decode-region (point-min) - ;; Some mailers insert whitespace - ;; junk at the end which - ;; base64-decode-region dislikes. - (save-excursion - (goto-char (point-max)) - (skip-chars-backward "\n\t ") - (delete-region (point) (point-max)) - (point)))) + (base64-decode-region + (point-min) + ;; Some mailers insert whitespace + ;; junk at the end which + ;; base64-decode-region dislikes. + ;; Also remove possible junk which could + ;; have been added by mailing list software. + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[\t ]*\r?\n" nil t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-max)) + (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) + (forward-line) + (delete-region (point) (point-max))) + (point-max)))) ((memq encoding '(7bit 8bit binary)) + ;; Do nothing. ) ((null encoding) + ;; Do nothing. ) ((memq encoding '(x-uuencode x-uue)) + (require 'mm-uu) (funcall mm-uu-decode-function (point-min) (point-max))) ((eq encoding 'x-binhex) + (require 'mm-uu) (funcall mm-uu-binhex-decode-function (point-min) (point-max))) ((functionp encoding) (funcall encoding (point-min) (point-max))) @@ -178,40 +216,54 @@ If no encoding was done, nil is returned." "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded." (if (stringp charset) - (setq charset (intern (downcase charset)))) - (if (or (not charset) (memq charset mail-parse-ignored-charsets)) + (setq charset (intern (downcase charset)))) + (if (or (not charset) + (eq 'gnus-all mail-parse-ignored-charsets) + (memq 'gnus-all mail-parse-ignored-charsets) + (memq charset mail-parse-ignored-charsets)) (setq charset mail-parse-charset)) (save-excursion (when encoding (mm-decode-content-transfer-encoding encoding type)) (when (featurep 'mule) - (let (mule-charset) - (when (and charset - (setq mule-charset (mm-charset-to-coding-system charset)) + (let ((coding-system (mm-charset-to-coding-system charset))) + (if (and (not coding-system) + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq coding-system + (mm-charset-to-coding-system mail-parse-charset))) + (when (and charset coding-system ;; buffer-file-coding-system ;;Article buffer is nil coding system ;;in XEmacs (mm-multibyte-p) - (or (not (eq mule-charset 'ascii)) - (setq mule-charset mail-parse-charset)) - (not (eq mule-charset 'gnus-decoded))) - (mm-decode-coding-region (point-min) (point-max) mule-charset)))))) + (or (not (eq coding-system 'ascii)) + (setq coding-system mail-parse-charset)) + (not (eq coding-system 'gnus-decoded))) + (mm-decode-coding-region (point-min) (point-max) coding-system)))))) (defun mm-decode-string (string charset) "Decode STRING with CHARSET." - (if (stringp charset) + (when (stringp charset) (setq charset (intern (downcase charset)))) - (if (or (not charset) (memq charset mail-parse-ignored-charsets)) - (setq charset mail-parse-charset)) + (when (or (not charset) + (eq 'gnus-all mail-parse-ignored-charsets) + (memq 'gnus-all mail-parse-ignored-charsets) + (memq charset mail-parse-ignored-charsets)) + (setq charset mail-parse-charset)) (or (when (featurep 'mule) - (let (mule-charset) - (when (and charset - (setq mule-charset (mm-charset-to-coding-system charset)) + (let ((coding-system (mm-charset-to-coding-system charset))) + (if (and (not coding-system) + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq coding-system + (mm-charset-to-coding-system mail-parse-charset))) + (when (and charset coding-system (mm-multibyte-p) - (or (not (eq mule-charset 'ascii)) - (setq mule-charset mail-parse-charset))) - (mm-decode-coding-string string mule-charset)))) + (or (not (eq coding-system 'ascii)) + (setq coding-system mail-parse-charset))) + (mm-decode-coding-string string coding-system)))) string)) (provide 'mm-bodies) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 8fbef31..c18b35b 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,5 +1,5 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -27,6 +27,27 @@ (require 'mail-parse) (require 'gnus-mailcap) (require 'mm-bodies) +(eval-when-compile (require 'cl)) + +(eval-and-compile + (autoload 'mm-inline-partial "mm-partial") + (autoload 'mm-inline-external-body "mm-extern") + (autoload 'mm-insert-inline "mm-view")) + +(defgroup mime-display () + "Display of MIME in mail and news articles." + :link '(custom-manual "(emacs-mime)Customization") + :version "21.1" + :group 'mail + :group 'news + :group 'multimedia) + +(defgroup mime-security () + "MIME security in mail and news articles." + :link '(custom-manual "(emacs-mime)Customization") + :group 'mail + :group 'news + :group 'multimedia) ;;; Convenience macros. @@ -58,13 +79,18 @@ `(setcar (nthcdr 6 ,handle) ,contents)) (defmacro mm-handle-id (handle) `(nth 7 ,handle)) +(defmacro mm-handle-multipart-original-buffer (handle) + `(get-text-property 0 'buffer (car ,handle))) +(defmacro mm-handle-multipart-ctl-parameter (handle parameter) + `(get-text-property 0 ,parameter (car ,handle))) + (defmacro mm-make-handle (&optional buffer type encoding undisplayer disposition description cache id) `(list ,buffer ,type ,encoding ,undisplayer ,disposition ,description ,cache ,id)) -(defvar mm-inline-media-tests +(defcustom mm-inline-media-tests '(("image/jpeg" mm-inline-image (lambda (handle) @@ -107,6 +133,7 @@ ("text/x-patch" mm-display-patch-inline (lambda (handle) (locate-library "diff-mode"))) + ("application/emacs-lisp" mm-display-elisp-inline identity) ("text/html" mm-inline-text (lambda (handle) @@ -118,6 +145,8 @@ (locate-library "vcard")))) ("message/delivery-status" mm-inline-text identity) ("message/rfc822" mm-inline-message identity) + ("message/partial" mm-inline-partial identity) + ("message/external-body" mm-inline-external-body identity) ("text/.*" mm-inline-text identity) ("audio/wav" mm-inline-audio (lambda (handle) @@ -129,44 +158,63 @@ (and (or (featurep 'nas-sound) (featurep 'native-sound)) (device-sound-enabled-p)))) ("application/pgp-signature" ignore identity) + ("application/x-pkcs7-signature" ignore identity) + ("application/pkcs7-signature" ignore identity) ("multipart/alternative" ignore identity) ("multipart/mixed" ignore identity) ("multipart/related" ignore identity)) - "Alist of media types/test that say whether the media types can be displayed inline.") + "Alist of media types/tests saying whether types can be displayed inline." + :type '(repeat (list (string :tag "MIME type") + (function :tag "Display function") + (function :tag "Display test"))) + :group 'mime-display) -(defvar mm-inlined-types +(defcustom mm-inlined-types '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" - "application/pgp-signature") - "List of media types that are to be displayed inline.") + "message/partial" "message/external-body" "application/emacs-lisp" + "application/pgp-signature" "application/x-pkcs7-signature" + "application/pkcs7-signature") + "List of media types that are to be displayed inline." + :type '(repeat string) + :group 'mime-display) -(defvar mm-automatic-display +(defcustom mm-automatic-display '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" - "message/rfc822" "text/x-patch" "application/pgp-signature") - "A list of MIME types to be displayed automatically.") + "message/rfc822" "text/x-patch" "application/pgp-signature" + "application/emacs-lisp" "application/x-pkcs7-signature" + "application/pkcs7-signature") + "A list of MIME types to be displayed automatically." + :type '(repeat string) + :group 'mime-display) -(defvar mm-attachment-override-types '("text/x-vcard") - "Types that should have \"attachment\" ignored if they can be displayed inline.") +(defcustom mm-attachment-override-types '("text/x-vcard") + "Types to have \"attachment\" ignored if they can be displayed inline." + :type '(repeat string) + :group 'mime-display) -(defvar mm-inline-override-types nil - "Types that should be treated as attachments even if they can be displayed inline.") +(defcustom mm-inline-override-types nil + "Types to be treated as attachments even if they can be displayed inline." + :type '(repeat string) + :group 'mime-display) -(defvar mm-inline-override-types nil - "Types that should be treated as attachments even if they can be displayed inline.") +(defcustom mm-automatic-external-display nil + "List of MIME type regexps that will be displayed externally automatically." + :type '(repeat string) + :group 'mime-display) -(defvar mm-automatic-external-display nil - "List of MIME type regexps that will be displayed externally automatically.") - -(defvar mm-discouraged-alternatives nil +(defcustom mm-discouraged-alternatives nil "List of MIME types that are discouraged when viewing multipart/alternative. Viewing agents are supposed to view the last possible part of a message, as that is supposed to be the richest. However, users may prefer other types instead, and this list says what types are most unwanted. If, -for instance, text/html parts are very unwanted, and text/richtech are +for instance, text/html parts are very unwanted, and text/richtext are somewhat unwanted, then the value of this variable should be set to: - (\"text/html\" \"text/richtext\")") + (\"text/html\" \"text/richtext\")" + :type '(repeat string) + :group 'mime-display) (defvar mm-tmp-directory (cond ((fboundp 'temp-directory) (temp-directory)) @@ -174,8 +222,10 @@ to: ("/tmp/")) "Where mm will store its temporary files.") -(defvar mm-inline-large-images nil - "If non-nil, then all images fit in the buffer.") +(defcustom mm-inline-large-images nil + "If non-nil, then all images fit in the buffer." + :type 'boolean + :group 'mime-display) ;;; Internal variables. @@ -183,8 +233,91 @@ to: (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) +;; According to RFC2046, in particular, in a digest, the default +;; Content-Type value for a body part is changed from "text/plain" to +;; "message/rfc822". +(defvar mm-dissect-default-type "text/plain") + +(autoload 'mml2015-verify "mml2015") +(autoload 'mml2015-verify-test "mml2015") +(autoload 'mml-smime-verify "mml-smime") +(autoload 'mml-smime-verify-test "mml-smime") + +(defvar mm-verify-function-alist + '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test) + ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP" + mm-uu-pgp-signed-test) + ("application/pkcs7-signature" mml-smime-verify "S/MIME" + mml-smime-verify-test) + ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" + mml-smime-verify-test))) + +(defcustom mm-verify-option 'never + "Option of verifying signed parts. +`never', not verify; `always', always verify; +`known', only verify known protocols. Otherwise, ask user." + :type '(choice (item always) + (item never) + (item :tag "only known protocols" known) + (item :tag "ask" nil)) + :group 'mime-security) + +(autoload 'mml2015-decrypt "mml2015") +(autoload 'mml2015-decrypt-test "mml2015") + +(defvar mm-decrypt-function-alist + '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test) + ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP" + mm-uu-pgp-encrypted-test))) + +(defcustom mm-decrypt-option nil + "Option of decrypting encrypted parts. +`never', not decrypt; `always', always decrypt; +`known', only decrypt known protocols. Otherwise, ask user." + :type '(choice (item always) + (item never) + (item :tag "only known protocols" known) + (item :tag "ask" nil)) + :group 'mime-security) + +(defvar mm-viewer-completion-map + (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) + (set-keymap-parent map minibuffer-local-completion-map) + map) + "Keymap for input viewer with completion.") + +;; Should we bind other key to minibuffer-complete-word? +(define-key mm-viewer-completion-map " " 'self-insert-command) + +(defvar mm-viewer-completion-map + (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) + (set-keymap-parent map minibuffer-local-completion-map) + map) + "Keymap for input viewer with completion.") + +;; Should we bind other key to minibuffer-complete-word? +(define-key mm-viewer-completion-map " " 'self-insert-command) + ;;; The functions. +(defun mm-alist-to-plist (alist) + "Convert association list ALIST into the equivalent property-list form. +The plist is returned. This converts from + +\((a . 1) (b . 2) (c . 3)) + +into + +\(a 1 b 2 c 3) + +The original alist is not modified. See also `destructive-alist-to-plist'." + (let (plist) + (while alist + (let ((el (car alist))) + (setq plist (cons (cdr el) (cons (car el) plist)))) + (setq alist (cdr alist))) + (nreverse plist))) + (defun mm-dissect-buffer (&optional no-strict-mime) "Dissect the current buffer and return a list of MIME handles." (save-excursion @@ -199,10 +332,12 @@ to: cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") id (mail-fetch-field "content-id")))) + (when cte + (setq cte (mail-header-strip cte))) (if (or (not ctl) (not (string-match "/" (car ctl)))) (mm-dissect-singlepart - '("text/plain") + (list mm-dissect-default-type) (and cte (intern (downcase (mail-header-remove-whitespace (mail-header-remove-comments cte))))) @@ -216,7 +351,21 @@ to: result (cond ((equal type "multipart") - (cons (car ctl) (mm-dissect-multipart ctl))) + (let ((mm-dissect-default-type (if (equal subtype "digest") + "message/rfc822" + "text/plain"))) + (add-text-properties 0 (length (car ctl)) + (mm-alist-to-plist (cdr ctl)) (car ctl)) + + ;; what really needs to be done here is a way to link a + ;; MIME handle back to it's parent MIME handle (in a multilevel + ;; MIME article). That would probably require changing + ;; the mm-handle API so we simply store the multipart buffert + ;; name as a text property of the "multipart/whatever" string. + (add-text-properties 0 (length (car ctl)) + (list 'buffer (mm-copy-to-buffer)) + (car ctl)) + (cons (car ctl) (mm-dissect-multipart ctl)))) (t (mm-dissect-singlepart ctl @@ -234,7 +383,9 @@ to: (defun mm-dissect-singlepart (ctl cte &optional force cdl description id) (when (or force - (not (equal "text/plain" (car ctl)))) + (if (equal "text/plain" (car ctl)) + (assoc 'format ctl) + t)) (let ((res (mm-make-handle (mm-copy-to-buffer) ctl cte nil cdl description nil id))) (push (car res) mm-dissection-list) @@ -249,14 +400,15 @@ to: (defun mm-dissect-multipart (ctl) (goto-char (point-min)) (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) - (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) - start parts - (end (save-excursion - (goto-char (point-max)) - (if (re-search-backward close-delimiter nil t) - (match-beginning 0) - (point-max))))) - (while (search-forward boundary end t) + (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) + start parts + (end (save-excursion + (goto-char (point-max)) + (if (re-search-backward close-delimiter nil t) + (match-beginning 0) + (point-max))))) + (setq boundary (concat (regexp-quote boundary) "[ \t]*$")) + (while (re-search-forward boundary end t) (goto-char (match-beginning 0)) (when start (save-excursion @@ -270,7 +422,7 @@ to: (save-restriction (narrow-to-region start end) (setq parts (nconc (list (mm-dissect-buffer t)) parts))))) - (nreverse parts))) + (mm-possibly-verify-or-decrypt (nreverse parts) ctl))) (defun mm-copy-to-buffer () "Copy the contents of the current buffer to a fresh buffer." @@ -284,6 +436,16 @@ to: (insert-buffer-substring obuf beg) (current-buffer)))) +(defun mm-display-parts (handle &optional no-default) + (if (stringp (car handle)) + (mapcar 'mm-display-parts (cdr handle)) + (if (bufferp (car handle)) + (save-restriction + (narrow-to-region (point) (point)) + (mm-display-part handle) + (goto-char (point-max))) + (mapcar 'mm-display-parts handle)))) + (defun mm-display-part (handle &optional no-default) "Display the MIME part represented by HANDLE. Returns nil if the part is removed; inline if displayed inline; @@ -308,109 +470,137 @@ external if displayed external." (mm-insert-inline handle (mm-get-part handle)) 'inline) (mm-display-external - handle (or method 'mailcap-save-binary-file)) - 'external))))))) + handle (or method 'mailcap-save-binary-file))))))))) (defun mm-display-external (handle method) "Display HANDLE using METHOD." - (mm-with-unibyte-buffer - (if (functionp method) - (let ((cur (current-buffer))) - (if (eq method 'mailcap-save-binary-file) - (progn - (set-buffer (generate-new-buffer "*mm*")) - (setq method nil)) - (mm-insert-part handle) - (let ((win (get-buffer-window cur t))) - (when win - (select-window win))) - (switch-to-buffer (generate-new-buffer "*mm*"))) - (buffer-disable-undo) - (mm-set-buffer-file-coding-system mm-binary-coding-system) - (insert-buffer-substring cur) + (let ((outbuf (current-buffer))) + (mm-with-unibyte-buffer + (if (functionp method) + (let ((cur (current-buffer))) + (if (eq method 'mailcap-save-binary-file) + (progn + (set-buffer (generate-new-buffer " *mm*")) + (setq method nil)) + (mm-insert-part handle) + (let ((win (get-buffer-window cur t))) + (when win + (select-window win))) + (switch-to-buffer (generate-new-buffer " *mm*"))) + (buffer-disable-undo) + (mm-set-buffer-file-coding-system mm-binary-coding-system) + (insert-buffer-substring cur) + (goto-char (point-min)) + (message "Viewing with %s" method) + (let ((mm (current-buffer)) + (non-viewer (assq 'non-viewer + (mailcap-mime-info + (mm-handle-media-type handle) t)))) + (unwind-protect + (if method + (funcall method) + (mm-save-part handle)) + (when (and (not non-viewer) + method) + (mm-handle-set-undisplayer handle mm))))) + ;; The function is a string to be executed. + (mm-insert-part handle) + (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory))) + (filename (mail-content-type-get + (mm-handle-disposition handle) 'filename)) + (mime-info (mailcap-mime-info + (mm-handle-media-type handle) t)) + (needsterm (or (assoc "needsterm" mime-info) + (assoc "needsterminal" mime-info))) + (copiousoutput (assoc "copiousoutput" mime-info)) + file buffer) + ;; We create a private sub-directory where we store our files. + (make-directory dir) + (set-file-modes dir 448) + (if filename + (setq file (expand-file-name (file-name-nondirectory filename) + dir)) + (setq file (make-temp-name (expand-file-name "mm." dir)))) + (let ((coding-system-for-write mm-binary-coding-system)) + (write-region (point-min) (point-max) file nil 'nomesg)) (message "Viewing with %s" method) - (let ((mm (current-buffer)) - (non-viewer (assq 'non-viewer - (mailcap-mime-info - (mm-handle-media-type handle) t)))) - (unwind-protect - (if method - (funcall method) - (mm-save-part handle)) - (when (and (not non-viewer) - method) - (mm-handle-set-undisplayer handle mm))))) - ;; The function is a string to be executed. - (mm-insert-part handle) - (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory))) - (filename (mail-content-type-get - (mm-handle-disposition handle) 'filename)) - (mime-info (mailcap-mime-info - (mm-handle-media-type handle) t)) - (needsterm (or (assoc "needsterm" mime-info) - (assoc "needsterminal" mime-info))) - (copiousoutput (assoc "copiousoutput" mime-info)) - process file buffer) - ;; We create a private sub-directory where we store our files. - (make-directory dir) - (set-file-modes dir 448) - (if filename - (setq file (expand-file-name (file-name-nondirectory filename) - dir)) - (setq file (make-temp-name (expand-file-name "mm." dir)))) - (let ((coding-system-for-write mm-binary-coding-system)) - (write-region (point-min) (point-max) file nil 'nomesg)) - (message "Viewing with %s" method) - (unwind-protect - (setq process - (cond (needsterm - (start-process "*display*" nil - "xterm" - "-e" shell-file-name - shell-command-switch - (mm-mailcap-command - method file (mm-handle-type handle)))) - (copiousoutput - (start-process "*display*" - (setq buffer - (generate-new-buffer "*mm*")) - shell-file-name - shell-command-switch - (mm-mailcap-command - method file (mm-handle-type handle))) - (switch-to-buffer buffer)) - (t - (start-process "*display*" + (cond (needsterm + (unwind-protect + (start-process "*display*" nil + "xterm" + "-e" shell-file-name + shell-command-switch + (mm-mailcap-command + method file (mm-handle-type handle))) + (mm-handle-set-undisplayer handle (cons file buffer))) + (message "Displaying %s..." (format method file)) + 'external) + (copiousoutput + (with-current-buffer outbuf + (forward-line 1) + (mm-insert-inline + handle + (unwind-protect + (progn + (call-process shell-file-name nil (setq buffer - (generate-new-buffer "*mm*")) - shell-file-name + (generate-new-buffer " *mm*")) + nil shell-command-switch (mm-mailcap-command - method file (mm-handle-type handle)))))) - (mm-handle-set-undisplayer handle (cons file buffer))) - (message "Displaying %s..." (format method file)))))) - + method file (mm-handle-type handle))) + (if (buffer-live-p buffer) + (save-excursion + (set-buffer buffer) + (buffer-string)))) + (progn + (ignore-errors (delete-file file)) + (ignore-errors (delete-directory + (file-name-directory file))) + (ignore-errors (kill-buffer buffer)))))) + 'inline) + (t + (unwind-protect + (start-process "*display*" + (setq buffer + (generate-new-buffer " *mm*")) + shell-file-name + shell-command-switch + (mm-mailcap-command + method file (mm-handle-type handle))) + (mm-handle-set-undisplayer handle (cons file buffer))) + (message "Displaying %s..." (format method file)) + 'external))))))) + (defun mm-mailcap-command (method file type-list) (let ((ctl (cdr type-list)) (beg 0) + (uses-stdin t) out sub total) - (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t" method beg) + (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg) (push (substring method beg (match-beginning 0)) out) (setq beg (match-end 0) total (match-string 0 method) sub (match-string 1 method)) (cond + ((string= total "%%") + (push "%" out)) ((string= total "%s") + (setq uses-stdin nil) (push (mm-quote-arg file) out)) ((string= total "%t") (push (mm-quote-arg (car type-list)) out)) (t (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out)))) (push (substring method beg (length method)) out) + (if uses-stdin + (progn + (push "<" out) + (push (mm-quote-arg file) out))) (mapconcat 'identity (nreverse out) ""))) - + (defun mm-remove-parts (handles) - "Remove the displayed MIME parts represented by HANDLE." + "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) (bufferp (car handles))) (mm-remove-part handles) @@ -418,7 +608,8 @@ external if displayed external." (while (setq handle (pop handles)) (cond ((stringp handle) - ) + (when (buffer-live-p (get-text-property 0 'buffer handle)) + (kill-buffer (get-text-property 0 'buffer handle)))) ((and (listp handle) (stringp (car handle))) (mm-remove-parts (cdr handle))) @@ -426,7 +617,7 @@ external if displayed external." (mm-remove-part handle))))))) (defun mm-destroy-parts (handles) - "Remove the displayed MIME parts represented by HANDLE." + "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) (bufferp (car handles))) (mm-destroy-part handles) @@ -434,10 +625,11 @@ external if displayed external." (while (setq handle (pop handles)) (cond ((stringp handle) - ) + (when (buffer-live-p (get-text-property 0 'buffer handle)) + (kill-buffer (get-text-property 0 'buffer handle)))) ((and (listp handle) (stringp (car handle))) - (mm-destroy-parts (cdr handle))) + (mm-destroy-parts handle)) (t (mm-destroy-part handle))))))) @@ -563,7 +755,12 @@ external if displayed external." (defun mm-get-part (handle) "Return the contents of HANDLE as a string." (mm-with-unibyte-buffer - (mm-insert-part handle) + (insert (with-current-buffer (mm-handle-buffer handle) + (mm-with-unibyte-current-buffer-mule4 + (buffer-string)))) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) (buffer-string))) (defun mm-insert-part (handle) @@ -572,7 +769,7 @@ external if displayed external." (save-excursion (if (member (mm-handle-media-supertype handle) '("text" "message")) (with-temp-buffer - (insert-buffer-substring (mm-handle-buffer handle)) + (insert-buffer-substring (mm-handle-buffer handle)) (mm-decode-content-transfer-encoding (mm-handle-encoding handle) (mm-handle-media-type handle)) @@ -604,10 +801,12 @@ external if displayed external." (or filename name "") (or mm-default-directory default-directory)))) (setq mm-default-directory (file-name-directory file)) - (when (or (not (file-exists-p file)) - (yes-or-no-p (format "File %s already exists; overwrite? " - file))) - (mm-save-part-to-file handle file)))) + (and (or (not (file-exists-p file)) + (yes-or-no-p (format "File %s already exists; overwrite? " + file))) + (progn + (mm-save-part-to-file handle file) + file)))) (defun mm-save-part-to-file (handle file) (mm-with-unibyte-buffer @@ -636,7 +835,13 @@ external if displayed external." (methods (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) (mailcap-mime-info type 'all))) - (method (completing-read "Viewer: " methods))) + (method (let ((minibuffer-local-completion-map + mm-viewer-completion-map)) + (completing-read "Viewer: " methods)))) + (when (string= method "") + (error "No method given")) + (if (string-match "^[^% \t]+$" method) + (setq method (concat method " %s"))) (mm-display-external (copy-sequence handle) method))) (defun mm-preferred-alternative (handles &optional preferred) @@ -662,9 +867,8 @@ external if displayed external." result)) (defun mm-preferred-alternative-precedence (handles) - "Return the precedence based on HANDLES and mm-discouraged-alternatives." - (let ((seq (nreverse (mapcar (lambda (h) - (mm-handle-media-type h)) + "Return the precedence based on HANDLES and `mm-discouraged-alternatives'." + (let ((seq (nreverse (mapcar #'mm-handle-media-type handles)))) (dolist (disc (reverse mm-discouraged-alternatives)) (dolist (elem (copy-sequence seq)) @@ -694,45 +898,212 @@ external if displayed external." (prog1 (setq spec (ignore-errors - (cond - ((equal type "xbm") - ;; xbm images require special handling, since - ;; the only way to create glyphs from these - ;; (without a ton of work) is to write them - ;; out to a file, and then create a file - ;; specifier. - (let ((file (make-temp-name - (expand-file-name "emm.xbm" - mm-tmp-directory)))) - (unwind-protect - (progn - (write-region (point-min) (point-max) file) - (make-glyph (list (cons 'x file)))) - (ignore-errors - (delete-file file))))) - (t - (make-glyph - (vector (intern type) :data (buffer-string))))))) + ;; Avoid testing `make-glyph' since W3 may define + ;; a bogus version of it. + (if (fboundp 'create-image) + (create-image (buffer-string) (intern type) 'data-p) + (cond + ((equal type "xbm") + ;; xbm images require special handling, since + ;; the only way to create glyphs from these + ;; (without a ton of work) is to write them + ;; out to a file, and then create a file + ;; specifier. + (let ((file (make-temp-name + (expand-file-name "emm.xbm" + mm-tmp-directory)))) + (unwind-protect + (progn + (write-region (point-min) (point-max) file) + (make-glyph (list (cons 'x file)))) + (ignore-errors + (delete-file file))))) + (t + (make-glyph + (vector (intern type) :data (buffer-string)))))))) (mm-handle-set-cache handle spec)))))) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) - (or mm-inline-large-images - (and (< (glyph-width image) (window-pixel-width)) - (< (glyph-height image) (window-pixel-height)))))) + (if (fboundp 'glyph-width) + ;; XEmacs' glyphs can actually tell us about their width, so + ;; lets be nice and smart about them. + (or mm-inline-large-images + (and (< (glyph-width image) (window-pixel-width)) + (< (glyph-height image) (window-pixel-height)))) + (let* ((size (image-size image)) + (w (car size)) + (h (cdr size))) + (or mm-inline-large-images + (and (< h (1- (window-height))) ; Don't include mode line. + (< w (window-width)))))))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." - (and (fboundp 'valid-image-instantiator-format-p) - (valid-image-instantiator-format-p format))) + (cond + ;; Handle XEmacs + ((fboundp 'valid-image-instantiator-format-p) + (valid-image-instantiator-format-p format)) + ;; Handle Emacs 21 + ((fboundp 'image-type-available-p) + (and (display-graphic-p) + (image-type-available-p format))) + ;; Nobody else can do images yet. + (t + nil))) (defun mm-valid-and-fit-image-p (format handle) "Say whether FORMAT can be displayed natively and HANDLE fits the window." - (and window-system - (mm-valid-image-format-p format) + (and (mm-valid-image-format-p format) (mm-image-fit-p handle))) +(defun mm-find-part-by-type (handles type &optional notp recursive) + "Search in HANDLES for part with TYPE. +If NOTP, returns first non-matching part. +If RECURSIVE, search recursively." + (let (handle) + (while handles + (if (and recursive (stringp (caar handles))) + (if (setq handle (mm-find-part-by-type (cdar handles) type + notp recursive)) + (setq handles nil)) + (if (if notp + (not (equal (mm-handle-media-type (car handles)) type)) + (equal (mm-handle-media-type (car handles)) type)) + (setq handle (car handles) + handles nil))) + (setq handles (cdr handles))) + handle)) + +(defun mm-find-raw-part-by-type (ctl type &optional notp) + (goto-char (point-min)) + (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl + 'boundary))) + (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$")) + start + (end (save-excursion + (goto-char (point-max)) + (if (re-search-backward close-delimiter nil t) + (match-beginning 0) + (point-max)))) + result) + (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$")) + (while (and (not result) + (re-search-forward boundary end t)) + (goto-char (match-beginning 0)) + (when start + (save-excursion + (save-restriction + (narrow-to-region start (1- (point))) + (when (let ((ctl (ignore-errors + (mail-header-parse-content-type + (mail-fetch-field "content-type"))))) + (if notp + (not (equal (car ctl) type)) + (equal (car ctl) type))) + (setq result (buffer-substring (point-min) (point-max))))))) + (forward-line 1) + (setq start (point))) + (when (and (not result) start) + (save-excursion + (save-restriction + (narrow-to-region start end) + (when (let ((ctl (ignore-errors + (mail-header-parse-content-type + (mail-fetch-field "content-type"))))) + (if notp + (not (equal (car ctl) type)) + (equal (car ctl) type))) + (setq result (buffer-substring (point-min) (point-max))))))) + result)) + +(defvar mm-security-handle nil) +(defvar mm-security-from nil) + +(defsubst mm-set-handle-multipart-parameter (handle parameter value) + ;; HANDLE could be a CTL. + (if handle + (put-text-property 0 (length (car handle)) parameter value + (car handle)))) + +(defun mm-possibly-verify-or-decrypt (parts ctl) + (let ((subtype (cadr (split-string (car ctl) "/"))) + (mm-security-handle ctl) ;; (car CTL) is the type. + (mm-security-from + (save-restriction + (mail-narrow-to-head) + (cadr (mail-extract-address-components + (or (mail-fetch-field "from") ""))))) + protocol func functest) + (cond + ((equal subtype "signed") + (unless (and (setq protocol + (mm-handle-multipart-ctl-parameter ctl 'protocol)) + (not (equal protocol "multipart/mixed"))) + ;; The message is broken or draft-ietf-openpgp-multsig-01. + (let ((protocols mm-verify-function-alist)) + (while protocols + (if (and (or (not (setq functest (nth 3 (car protocols)))) + (funcall functest parts ctl)) + (mm-find-part-by-type parts (caar protocols) nil t)) + (setq protocol (caar protocols) + protocols nil) + (setq protocols (cdr protocols)))))) + (setq func (nth 1 (assoc protocol mm-verify-function-alist))) + (if (cond + ((eq mm-verify-option 'never) nil) + ((eq mm-verify-option 'always) t) + ((eq mm-verify-option 'known) + (and func + (or (not (setq functest + (nth 3 (assoc protocol + mm-verify-function-alist)))) + (funcall functest parts ctl)))) + (t (y-or-n-p + (format "Verify signed (%s) part? " + (or (nth 2 (assoc protocol mm-verify-function-alist)) + (format "protocol=%s" protocol)))))) + (save-excursion + (if func + (funcall func parts ctl) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (format "Unknown sign protocol (%s)" protocol)))))) + ((equal subtype "encrypted") + (unless (setq protocol + (mm-handle-multipart-ctl-parameter ctl 'protocol)) + ;; The message is broken. + (let ((parts parts)) + (while parts + (if (assoc (mm-handle-media-type (car parts)) + mm-decrypt-function-alist) + (setq protocol (mm-handle-media-type (car parts)) + parts nil) + (setq parts (cdr parts)))))) + (setq func (nth 1 (assoc protocol mm-decrypt-function-alist))) + (if (cond + ((eq mm-decrypt-option 'never) nil) + ((eq mm-decrypt-option 'always) t) + ((eq mm-decrypt-option 'known) + (and func + (or (not (setq functest + (nth 3 (assoc protocol + mm-decrypt-function-alist)))) + (funcall functest parts ctl)))) + (t (y-or-n-p + (format "Decrypt (%s) part? " + (or (nth 2 (assoc protocol mm-decrypt-function-alist)) + (format "protocol=%s" protocol)))))) + (save-excursion + (if func + (setq parts (funcall func parts ctl)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (format "Unknown encrypt protocol (%s)" protocol)))))) + (t nil)) + parts)) + (provide 'mm-decode) -;; mm-decode.el ends here +;;; mm-decode.el ends here diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 766f1ea..3baec82 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,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -24,8 +24,11 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'mail-parse) (require 'gnus-mailcap) +(eval-and-compile + (autoload 'mm-body-7-or-8 "mm-bodies")) (defvar mm-content-transfer-encoding-defaults '(("text/x-patch" 8bit) @@ -38,6 +41,18 @@ If the encoding is `qp-or-base64', then either quoted-printable or base64 will be used, depending on what is more efficient.") +(defvar mm-use-ultra-safe-encoding nil + "If non-nil, use encodings aimed at Procrustean bed survival. + +This means that textual parts are encoded as quoted-printable if they +contain lines longer than 76 characters or starting with \"From \" in +the body. Non-7bit encodings (8bit, binary) are generally disallowed. +This is to reduce the probability that a broken MTA or MDA changes the +message. + +This variable should never be set directly, but bound before a call to +`mml-generate-mime' or similar functions.") + (defun mm-insert-rfc822-headers (charset encoding) "Insert text/plain headers with CHARSET and ENCODING." (insert "MIME-Version: 1.0\n") @@ -50,8 +65,7 @@ or base64 will be used, depending on what is more efficient.") "Insert multipart/mixed headers." (let ((boundary "=-=-=")) (insert "MIME-Version: 1.0\n") - (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" - boundary)) + (insert "Content-Type: multipart/mixed; boundary=\"" boundary "\"\n") boundary)) (defun mm-default-file-encoding (file) @@ -60,6 +74,14 @@ or base64 will be used, depending on what is more efficient.") "application/octet-stream" (mailcap-extension-to-mime (match-string 0 file)))) +(defun mm-safer-encoding (encoding) + "Return a safer but similar encoding." + (cond + ((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable) + ;; The remaing encodings are binary and base64 (and perhaps some + ;; non-standard ones), which are both turned into base64. + (t 'base64))) + (defun mm-encode-content-transfer-encoding (encoding &optional type) (cond ((eq encoding 'quoted-printable) @@ -75,8 +97,10 @@ or base64 will be used, depending on what is more efficient.") (message "Error while decoding: %s" error) nil))) ((memq encoding '(7bit 8bit binary)) + ;; Do nothing. ) ((null encoding) + ;; Do nothing. ) ((functionp encoding) (ignore-errors (funcall encoding (point-min) (point-max)))) @@ -119,9 +143,13 @@ The encoding used is returned." (while rules (when (string-match (caar rules) type) (throw 'found - (if (eq (cadar rules) 'qp-or-base64) - (mm-qp-or-base64) - (cadar rules)))) + (let ((encoding + (if (eq (cadr (car rules)) 'qp-or-base64) + (mm-qp-or-base64) + (cadr (car rules))))) + (if mm-use-ultra-safe-encoding + (mm-safer-encoding encoding) + encoding)))) (pop rules))))) (defun mm-qp-or-base64 () diff --git a/lisp/mm-extern.el b/lisp/mm-extern.el new file mode 100644 index 0000000..5e58a12 --- /dev/null +++ b/lisp/mm-extern.el @@ -0,0 +1,169 @@ +;;; mm-extern.el --- showing message/external-body +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu +;; Keywords: message external-body + +;; 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: + +(eval-when-compile + (require 'cl)) + +(require 'mm-util) +(require 'mm-decode) + +(defvar mm-extern-function-alist + '((local-file . mm-extern-local-file) + (url . mm-extern-url) + (anon-ftp . mm-extern-anon-ftp) + (ftp . mm-extern-ftp) +;;; (tftp . mm-extern-tftp) + (mail-server . mm-extern-mail-server) +;;; (afs . mm-extern-afs)) + )) + +(defvar mm-extern-anonymous "anonymous") + +(defun mm-extern-local-file (handle) + (erase-buffer) + (let ((name (cdr (assq 'name (cdr (mm-handle-type handle))))) + (coding-system-for-read mm-binary-coding-system)) + (unless name + (error "The filename is not specified.")) + (mm-disable-multibyte-mule4) + (if (file-exists-p name) + (mm-insert-file-contents name nil nil nil nil t) + (error (format "File %s is gone." name))))) + +(defun mm-extern-url (handle) + (erase-buffer) + (require 'url) + (let ((url (cdr (assq 'url (cdr (mm-handle-type handle))))) + (name buffer-file-name) + (coding-system-for-read mm-binary-coding-system)) + (unless url + (error "URL is not specified.")) + (mm-with-unibyte-current-buffer-mule4 + (url-insert-file-contents url)) + (mm-disable-multibyte-mule4) + (setq buffer-file-name name))) + +(defun mm-extern-anon-ftp (handle) + (erase-buffer) + (let* ((params (cdr (mm-handle-type handle))) + (name (cdr (assq 'name params))) + (site (cdr (assq 'site params))) + (directory (cdr (assq 'directory params))) + (mode (cdr (assq 'mode params))) + (path (concat "/" (or mm-extern-anonymous + (read-string (format "ID for %s: " site))) + "@" site ":" directory "/" name)) + (coding-system-for-read mm-binary-coding-system)) + (unless name + (error "The filename is not specified.")) + (mm-disable-multibyte-mule4) + (mm-insert-file-contents path nil nil nil nil t))) + +(defun mm-extern-ftp (handle) + (let (mm-extern-anonymous) + (mm-extern-anon-ftp handle))) + +(defun mm-extern-mail-server (handle) + (require 'message) + (let* ((params (cdr (mm-handle-type handle))) + (server (cdr (assq 'server params))) + (subject (or (cdr (assq 'subject params)) "none")) + (buf (current-buffer)) + info) + (if (y-or-n-p (format "Send a request message to %s?" server)) + (save-window-excursion + (message-mail server subject) + (message-goto-body) + (delete-region (point) (point-max)) + (insert-buffer buf) + (message "Requesting external body...") + (message-send-and-exit) + (setq info "Request is sent.") + (message info)) + (setq info "Request is not sent.")) + (goto-char (point-min)) + (insert "[" info "]\n\n"))) + +;;;###autoload +(defun mm-inline-external-body (handle &optional no-display) + "Show the external-body part of HANDLE. +This function replaces the buffer of HANDLE with a buffer contains +the entire message. +If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." + (let* ((access-type (cdr (assq 'access-type + (cdr (mm-handle-type handle))))) + (func (cdr (assq (intern + (downcase + (or access-type + (error "Couldn't find access type.")))) + mm-extern-function-alist))) + gnus-displaying-mime buf + handles) + (unless (mm-handle-cache handle) + (unless func + (error (format "Access type (%s) is not supported." access-type))) + (with-temp-buffer + (mm-insert-part handle) + (goto-char (point-max)) + (insert "\n\n") + (setq handles (mm-dissect-buffer t))) + (unless (bufferp (car handles)) + (mm-destroy-parts handles) + (error "Multipart external body is not supported.")) + (save-excursion ;; single part + (set-buffer (setq buf (mm-handle-buffer handles))) + (let (good) + (unwind-protect + (progn + (funcall func handle) + (setq good t)) + (unless good + (mm-destroy-parts handles)))) + (mm-handle-set-cache handle handles)) + (if (listp (car gnus-article-mime-handles)) + (push handles gnus-article-mime-handles) + (setq gnus-article-mime-handles + (list handles gnus-article-mime-handles)))) + (unless no-display + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (gnus-display-mime (mm-handle-cache handle)) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (condition-case nil + ;; This is only valid on XEmacs. + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) (current-buffer))) + '(background background-pixmap foreground)) + (error nil)) + (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + +;; mm-extern.el ends here diff --git a/lisp/mm-partial.el b/lisp/mm-partial.el new file mode 100644 index 0000000..38986c4 --- /dev/null +++ b/lisp/mm-partial.el @@ -0,0 +1,159 @@ +;;; mm-partial.el --- showing message/partial +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu +;; Keywords: message partial + +;; 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: + +(eval-when-compile + (require 'cl)) + +(require 'gnus-sum) +(require 'mm-util) +(require 'mm-decode) + +(defun mm-partial-find-parts (id &optional art) + (let ((headers (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-headers)) + phandles header) + (while (setq header (pop headers)) + (unless (eq (aref header 0) art) + (mm-with-unibyte-buffer + (gnus-request-article-this-buffer (aref header 0) + gnus-newsgroup-name) + (when (search-forward id nil t) + (let ((nhandles (mm-dissect-buffer)) nid) + (if (consp (car nhandles)) + (mm-destroy-parts nhandles) + (setq nid (cdr (assq 'id + (cdr (mm-handle-type nhandles))))) + (if (not (equal id nid)) + (mm-destroy-parts nhandles) + (push nhandles phandles)))))))) + phandles)) + +;;;###autoload +(defun mm-inline-partial (handle &optional no-display) + "Show the partial part of HANDLE. +This function replaces the buffer of HANDLE with a buffer contains +the entire message. +If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." + (let ((id (cdr (assq 'id (cdr (mm-handle-type handle))))) + phandles + (b (point)) (n 1) total + phandle nn ntotal + gnus-displaying-mime handles buffer) + (unless (mm-handle-cache handle) + (unless id + (error "Can not find message/partial id.")) + (setq phandles + (sort (cons handle + (mm-partial-find-parts + id + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-article-number)))) + #'(lambda (a b) + (let ((anumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type a)))))) + (bnumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type b))))))) + (< anumber bnumber))))) + (setq gnus-article-mime-handles + (append (if (listp (car gnus-article-mime-handles)) + gnus-article-mime-handles + (list gnus-article-mime-handles)) + phandles)) + (save-excursion + (set-buffer (generate-new-buffer " *mm*")) + (while (setq phandle (pop phandles)) + (setq nn (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type phandle)))))) + (setq ntotal (string-to-number + (cdr (assq 'total + (cdr (mm-handle-type phandle)))))) + (if ntotal + (if total + (unless (eq total ntotal) + (error "The numbers of total are different.")) + (setq total ntotal))) + (unless (< nn n) + (unless (eq nn n) + (error "Missing part %d" n)) + (mm-insert-part phandle) + (goto-char (point-max)) + (when (not (eq 0 (skip-chars-backward "\r\n"))) + ;; remove tail blank spaces except one + (if (looking-at "\r?\n") + (goto-char (match-end 0))) + (delete-region (point) (point-max))) + (setq n (+ n 1)))) + (unless total + (error "Don't known the total number of")) + (if (<= n total) + (error "Missing part %d" n)) + (kill-buffer (mm-handle-buffer handle)) + (goto-char (point-min)) + (let ((point (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max)))) + (goto-char (point-min)) + (unless (re-search-forward "^mime-version:" point t) + (insert "MIME-Version: 1.0\n"))) + (setcar handle (current-buffer)) + (mm-handle-set-cache handle t))) + (unless no-display + (save-excursion + (save-restriction + (narrow-to-region b b) + (mm-insert-part handle) + (let (gnus-article-mime-handles) + (run-hooks 'gnus-article-decode-hook) + (gnus-article-prepare-display) + (setq handles gnus-article-mime-handles)) + (when handles + ;; It is in article buffer. + (setq gnus-article-mime-handles + (nconc (if (listp (car gnus-article-mime-handles)) + gnus-article-mime-handles + (list gnus-article-mime-handles)) + (if (listp (car handles)) + handles (list handles))))) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (condition-case nil + ;; This is only valid on XEmacs. + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) (current-buffer))) + '(background background-pixmap foreground)) + (error nil)) + (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + +;; mm-partial.el ends here diff --git a/lisp/mm-util.el b/lisp/mm-util.el index a23a7f6..a9b189e 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,5 @@ ;;; mm-util.el --- Utility functions for MIME things -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -24,6 +24,11 @@ ;;; Code: +(eval-when-compile (require 'static)) + +(eval-when-compile (require 'cl)) +(require 'mail-prsvr) + (defvar mm-mime-mule-charset-alist '((us-ascii ascii) (iso-8859-1 latin-iso8859-1) @@ -31,7 +36,10 @@ (iso-8859-3 latin-iso8859-3) (iso-8859-4 latin-iso8859-4) (iso-8859-5 cyrillic-iso8859-5) - (koi8-r cyrillic-iso8859-5) + ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters. + ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default + ;; charset is koi8-r, not iso-8859-5. + (koi8-r cyrillic-iso8859-5 gnus-koi8-r) (iso-8859-6 arabic-iso8859-6) (iso-8859-7 greek-iso8859-7) (iso-8859-8 hebrew-iso8859-8) @@ -62,10 +70,10 @@ chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7)) + chinese-cns11643-7) + (utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)) "Alist of MIME-charset/MULE-charsets.") - (eval-and-compile (mapcar (lambda (elem) @@ -91,7 +99,36 @@ "Prompt the user for a coding system." (completing-read prompt (mapcar (lambda (s) (list (symbol-name (car s)))) - mm-mime-mule-charset-alist))))))) + mm-mime-mule-charset-alist)))) + (read-charset + . (lambda (prompt) + "Return a charset." + (intern + (completing-read + prompt + (mapcar (lambda (e) (list (symbol-name (car e)))) + mm-mime-mule-charset-alist) + nil t)))) + (subst-char-in-string + . (lambda (from to string) ;; stolen (and renamed) from nnheader.el + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (when (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string))) + ))) + +(eval-and-compile + (defalias 'mm-char-or-char-int-p + (cond + ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) + ((fboundp 'char-valid-p) 'char-valid-p) + (t 'identity)))) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () @@ -99,17 +136,22 @@ (or mm-coding-system-list (setq mm-coding-system-list (mm-coding-system-list)))) -(defvar mm-charset-synonym-alist - '((big5 . cn-big5) - (gb2312 . cn-gb-2312) - (x-ctext . ctext)) - "A mapping from invalid charset names to the real charset names.") - (defun mm-coding-system-p (sym) "Return non-nil if SYM is a coding system." (or (and (fboundp 'coding-system-p) (coding-system-p sym)) (memq sym (mm-get-coding-system-list)))) +(defvar mm-charset-synonym-alist + `((big5 . cn-big5) + (gb2312 . cn-gb-2312) + (cn-gb . cn-gb-2312) + ;; Windows-1252 is actually a superset of Latin-1. See also + ;; `gnus-article-dumbquotes-map'. + ,(unless (mm-coding-system-p 'windows-1252) ; should be defined eventually + '(windows-1252 . iso-8859-1)) + (x-ctext . ctext)) + "A mapping from invalid charset names to the real charset names.") + (defvar mm-binary-coding-system (cond ((mm-coding-system-p 'binary) 'binary) @@ -143,7 +185,7 @@ ;;; Functions: (defun mm-mule-charset-to-mime-charset (charset) - "Return the MIME charset corresponding to MULE CHARSET." + "Return the MIME charset corresponding to the given Mule CHARSET." (let ((alist mm-mime-mule-charset-alist) out) (while alist @@ -172,45 +214,94 @@ used as the line break code type of the coding system." ;; ascii ((eq charset 'us-ascii) 'ascii) - ;; Check to see whether we can handle this charset. + ;; Check to see whether we can handle this charset. (This depends + ;; on there being some coding system matching each `mime-charset' + ;; coding sysytem property defined, as there should be.) ((memq charset (mm-get-coding-system-list)) charset) ;; Nope. (t nil))) -(defun mm-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) +(defsubst mm-replace-chars-in-string (string from to) + (mm-subst-char-in-string from to string)) (defsubst mm-enable-multibyte () - "Enable multibyte in the current buffer." + "Set the multibyte flag of the current buffer. +Only do this if the default value of `enable-multibyte-characters' is +non-nil. This is a no-op in XEmacs." (when (and (fboundp 'set-buffer-multibyte) (boundp 'enable-multibyte-characters) (default-value 'enable-multibyte-characters)) (set-buffer-multibyte t))) (defsubst mm-disable-multibyte () - "Disable multibyte in the current buffer." + "Unset the multibyte flag of in the current buffer. +This is a no-op in XEmacs." (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) +(defsubst mm-enable-multibyte-mule4 () + "Enable multibyte in the current buffer. +Only used in Emacs Mule 4." + (when (and (fboundp 'set-buffer-multibyte) + (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters) + (fboundp 'charsetp) + (not (charsetp 'eight-bit-control))) + (set-buffer-multibyte t))) + +(defsubst mm-disable-multibyte-mule4 () + "Disable multibyte in the current buffer. +Only used in Emacs Mule 4." + (when (and (fboundp 'set-buffer-multibyte) + (fboundp 'charsetp) + (not (charsetp 'eight-bit-control))) + (set-buffer-multibyte nil))) + (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. (or (get-charset-property charset 'prefered-coding-system) (get-charset-property charset 'preferred-coding-system))) +(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. +If POS is out of range, the value is nil. +If the charset is `composition', return the actual one." + (let ((char (char-after pos)) charset) + (if (< (mm-char-int char) 128) + (setq charset 'ascii) + ;; charset-after is fake in some Emacsen. + (setq charset (and (fboundp 'char-charset) (char-charset char))) + (if (eq charset 'composition) + (let ((p (or pos (point)))) + (cadr (find-charset-region p (1+ p)))) + (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))) + 'latin-iso8859-1))) + mail-parse-mule-charset))))))) + (defun mm-mime-charset (charset) "Return the MIME charset corresponding to the MULE CHARSET." - (if (fboundp 'coding-system-get) + (if (eq charset 'unknown) + (error "8-bit characters are found in the message, please specify charset.")) + (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property)) ;; This exists in Emacs 20. (or (and (mm-preferred-coding-system charset) @@ -223,61 +314,104 @@ used as the line break code type of the coding system." ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) +(defun mm-delete-duplicates (list) + "Simple substitute for CL `delete-duplicates', testing with `equal'." + (let (result head) + (while list + (setq head (car list)) + (setq list (delete head list)) + (setq result (cons head result))) + (nreverse result))) + (defun mm-find-mime-charset-region (b e) "Return the MIME charsets needed to encode the region between B and E." - (let ((charsets - (mapcar 'mm-mime-charset - (delq 'ascii - (mm-find-charset-region b e))))) + (let ((charsets (mapcar 'mm-mime-charset + (delq 'ascii + (mm-find-charset-region b e))))) (when (memq 'iso-2022-jp-2 charsets) (setq charsets (delq 'iso-2022-jp charsets))) - (delete-duplicates charsets) + (setq charsets (mm-delete-duplicates charsets)) (if (and (> (length charsets) 1) - (fboundp 'find-coding-systems-for-charsets) - (memq 'utf-8 (find-coding-systems-for-charsets charsets))) + (fboundp 'find-coding-systems-region) + (memq 'utf-8 (find-coding-systems-region b e))) '(utf-8) charsets))) (defsubst mm-multibyte-p () "Say whether multibyte is enabled." - (or (string-match "XEmacs\\|Lucid" emacs-version) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters))) + (if (and (not (featurep 'xemacs)) + (boundp 'enable-multibyte-characters)) + enable-multibyte-characters + (featurep 'mule))) (defmacro mm-with-unibyte-buffer (&rest forms) "Create a temporary buffer, and evaluate FORMS there like `progn'. -See also `with-temp-file' and `with-output-to-string'." - (let ((temp-buffer (make-symbol "temp-buffer")) - (multibyte (make-symbol "multibyte"))) - `(if (or (string-match "XEmacs\\|Lucid" emacs-version) - (not (boundp 'enable-multibyte-characters))) - (with-temp-buffer ,@forms) - (let ((,multibyte (default-value 'enable-multibyte-characters)) - ,temp-buffer) - (unwind-protect - (progn - (setq-default enable-multibyte-characters nil) - (setq ,temp-buffer - (get-buffer-create (generate-new-buffer-name " *temp*"))) - (unwind-protect - (with-current-buffer ,temp-buffer - (let ((buffer-file-coding-system mm-binary-coding-system) - (coding-system-for-read mm-binary-coding-system) - (coding-system-for-write mm-binary-coding-system)) - ,@forms)) - (and (buffer-name ,temp-buffer) - (kill-buffer ,temp-buffer)))) - (setq-default enable-multibyte-characters ,multibyte)))))) +Use unibyte mode for this." + `(let (default-enable-multibyte-characters) + (with-temp-buffer ,@forms))) (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) +(defmacro mm-with-unibyte-current-buffer (&rest forms) + "Evaluate FORMS with current current buffer temporarily made unibyte. +Also bind `default-enable-multibyte-characters' to nil. +Equivalent to `progn' in XEmacs" + (let ((multibyte (make-symbol "multibyte"))) + `(if (fboundp 'set-buffer-multibyte) + (let ((,multibyte enable-multibyte-characters)) + (unwind-protect + (let (default-enable-multibyte-characters) + (set-buffer-multibyte nil) + ,@forms) + (set-buffer-multibyte ,multibyte))) + (progn + ,@forms)))) +(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) +(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) + +(defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms) + "Evaluate FORMS there like `progn' in current buffer. +Mule4 only." + (let ((multibyte (make-symbol "multibyte"))) + `(if (or (featurep 'xemacs) + (not (fboundp 'set-buffer-multibyte)) + (not (fboundp 'charsetp)) + (charsetp 'eight-bit-control)) ;; For Emacs Mule 4 only. + (progn + ,@forms) + (let ((,multibyte (default-value 'enable-multibyte-characters))) + (unwind-protect + (let ((buffer-file-coding-system mm-binary-coding-system) + (coding-system-for-read mm-binary-coding-system) + (coding-system-for-write mm-binary-coding-system)) + (set-buffer-multibyte nil) + (setq-default enable-multibyte-characters nil) + ,@forms) + (setq-default enable-multibyte-characters ,multibyte) + (set-buffer-multibyte ,multibyte)))))) +(put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0) +(put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body)) + +(defmacro mm-with-unibyte (&rest forms) + "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." + `(let (default-enable-multibyte-characters) + ,@forms)) +(put 'mm-with-unibyte 'lisp-indent-function 0) +(put 'mm-with-unibyte 'edebug-form-spec '(body)) + (defun mm-find-charset-region (b e) - "Return a list of charsets in the region." + "Return a list of Emacs charsets in the region B to E." (cond ((and (mm-multibyte-p) (fboundp 'find-charset-region)) - (find-charset-region b e)) - ((not (boundp 'current-language-environment)) + ;; Remove composition since the base charsets have been included. + ;; Remove eight-bit-*, treat them as ascii. + (let ((css (find-charset-region b e))) + (mapcar (lambda (cs) (setq css (delq cs css))) + '(composition eight-bit-control eight-bit-graphic)) + css)) + (t + ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. (save-excursion (save-restriction (narrow-to-region b e) @@ -285,41 +419,33 @@ See also `with-temp-file' and `with-output-to-string'." (skip-chars-forward "\0-\177") (if (eobp) '(ascii) - (delq nil (list 'ascii mail-parse-charset)))))) - (t - ;; We are in a unibyte buffer, so we futz around a bit. - (save-excursion - (save-restriction - (narrow-to-region b e) - (goto-char (point-min)) - (let ((entry (assoc (capitalize current-language-environment) - language-info-alist))) - (skip-chars-forward "\0-\177") - (if (eobp) - '(ascii) - (list 'ascii (car (last (assq 'charset entry))))))))))) - -(defun mm-read-charset (prompt) - "Return a charset." - (intern - (completing-read - prompt - (mapcar (lambda (e) (list (symbol-name (car e)))) - mm-mime-mule-charset-alist) - nil t))) - -(defun mm-quote-arg (arg) - "Return a version of ARG that is safe to evaluate in a shell." - (let ((pos 0) new-pos accum) - ;; *** bug: we don't handle newline characters properly - (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos)) - (push (substring arg pos new-pos) accum) - (push "\\" accum) - (push (list (aref arg new-pos)) accum) - (setq pos (1+ new-pos))) - (if (= pos 0) - arg - (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) + (let (charset) + (setq charset + (and (boundp 'current-language-environment) + (car (last (assq 'charset + (assoc current-language-environment + language-info-alist)))))) + (if (eq charset 'ascii) (setq charset nil)) + (or charset + (setq charset + (car (last (assq mail-parse-charset + mm-mime-mule-charset-alist))))) + (list 'ascii (or charset 'latin-iso8859-1))))))))) + +(static-if (fboundp 'shell-quote-argument) + (defalias 'mm-quote-arg 'shell-quote-argument) + (defun mm-quote-arg (arg) + "Return a version of ARG that is safe to evaluate in a shell." + (let ((pos 0) new-pos accum) + ;; *** bug: we don't handle newline characters properly + (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos)) + (push (substring arg pos new-pos) accum) + (push "\\" accum) + (push (list (aref arg new-pos)) accum) + (setq pos (1+ new-pos))) + (if (= pos 0) + arg + (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))) (defun mm-auto-mode-alist () "Return an `auto-mode-alist' with only the .gz (etc) thingies." diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 4f66013..a2352df 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -1,10 +1,10 @@ -;;; mm-uu.el -- Return uu stuffs as mm handles -;; Copyright (c) 1998,99 by Shenghuo Zhu +;;; mm-uu.el -- Return uu stuff as mm handles +;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; Keywords: postscript uudecode binhex shar forward +;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp -;; This file is part of pgnus. +;; 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 @@ -26,46 +26,28 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'mail-parse) -(require 'message) (require 'nnheader) (require 'mm-decode) (require 'gnus-mailcap) +(require 'mml2015) +(require 'uudecode) +(require 'binhex) -(eval-and-compile - (autoload 'binhex-decode-region "binhex") - (autoload 'binhex-decode-region-external "binhex") - (autoload 'uudecode-decode-region "uudecode") - (autoload 'uudecode-decode-region-external "uudecode")) - -(defun mm-uu-copy-to-buffer (from to) - "Copy the contents of the current buffer to a fresh buffer." - (save-excursion - (let ((obuf (current-buffer))) - (set-buffer (generate-new-buffer " *mm-uu*")) - (insert-buffer-substring obuf from to) - (current-buffer)))) - -;;; postscript - -(defconst mm-uu-postscript-begin-line "^%!PS-") -(defconst mm-uu-postscript-end-line "^%%EOF$") - -(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+") -(defconst mm-uu-uu-end-line "^end[ \t]*$") - +;; This is not the right place for this. uudecode.el should decide +;; whether or not to use a program with a single interface, but I +;; guess it's too late now. Also the default should depend on a test +;; for the program. -- fx (defcustom mm-uu-decode-function 'uudecode-decode-region "*Function to uudecode. -Internal function is done in elisp by default, therefore decoding may -appear to be horribly slow . You can make Gnus use the external Unix +Internal function is done in Lisp by default, therefore decoding may +appear to be horribly slow. You can make Gnus use an external decoder, such as uudecode." - :type '(choice (item :tag "internal" uudecode-decode-region) - (item :tag "external" uudecode-decode-region-external)) - :group 'gnus-article-mime) - -(defconst mm-uu-binhex-begin-line - "^:...............................................................$") -(defconst mm-uu-binhex-end-line ":$") + :type '(choice + (function-item :tag "Internal" uudecode-decode-region) + (function-item :tag "External" uudecode-decode-region-external)) + :group 'gnus-article-mime) (defcustom mm-uu-binhex-decode-function 'binhex-decode-region "*Function to binhex decode. @@ -76,168 +58,357 @@ decoder, such as hexbin." (item :tag "external" binhex-decode-region-external)) :group 'gnus-article-mime) -(defconst mm-uu-shar-begin-line "^#! */bin/sh") -(defconst mm-uu-shar-end-line "^exit 0\\|^$") +(defvar mm-uu-pgp-beginning-signature + "^-----BEGIN PGP SIGNATURE-----") +(defvar mm-uu-beginning-regexp nil) + +(defvar mm-dissect-disposition "inline" + "The default disposition of uu parts. +This can be either \"inline\" or \"attachment\".") + +(defvar mm-uu-type-alist + '((postscript + "^%!PS-" + "^%%EOF$" + mm-uu-postscript-extract + nil) + (uu + "^begin[ \t]+[0-7][0-7][0-7][ \t]+" + "^end[ \t]*$" + mm-uu-uu-extract + mm-uu-uu-filename) + (binhex + "^:...............................................................$" + ":$" + mm-uu-binhex-extract + nil + mm-uu-binhex-filename) + (shar + "^#! */bin/sh" + "^exit 0$" + mm-uu-shar-extract) + (forward ;;; Thanks to Edward J. Sabol and ;;; Peter von der Ah\'e -(defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message") -(defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message") + "^-+ \\(Start of \\)?Forwarded message" + "^-+ End \\(of \\)?forwarded message" + mm-uu-forward-extract + nil + mm-uu-forward-test) + (gnatsweb + "^----gnatsweb-attachment----" + nil + mm-uu-gnatsweb-extract) + (pgp-signed + "^-----BEGIN PGP SIGNED MESSAGE-----" + "^-----END PGP SIGNATURE-----" + mm-uu-pgp-signed-extract + nil + nil) + (pgp-encrypted + "^-----BEGIN PGP MESSAGE-----" + "^-----END PGP MESSAGE-----" + mm-uu-pgp-encrypted-extract + nil + nil) + (pgp-key + "^-----BEGIN PGP PUBLIC KEY BLOCK-----" + "^-----END PGP PUBLIC KEY BLOCK-----" + mm-uu-pgp-key-extract + mm-uu-gpg-key-skip-to-last + nil))) -(defvar mm-uu-begin-line nil) +(defcustom mm-uu-configure-list nil + "A list of mm-uu configuration. +To disable dissecting shar codes, for instance, add +`(shar . disabled)' to this list." + :type `(repeat (cons + ,(cons 'choice + (mapcar + (lambda (entry) + (cons 'item (car entry))) + mm-uu-type-alist)) + (choice (item disabled)))) + :group 'gnus-article-mime) -(defconst mm-uu-identifier-alist - '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar) - (?- . forward))) +;; functions -(defvar mm-dissect-disposition "inline" - "The default disposition of uu parts. -This can be either \"inline\" or \"attachment\".") +(defsubst mm-uu-type (entry) + (car entry)) + +(defsubst mm-uu-beginning-regexp (entry) + (nth 1 entry)) + +(defsubst mm-uu-end-regexp (entry) + (nth 2 entry)) + +(defsubst mm-uu-function-extract (entry) + (nth 3 entry)) + +(defsubst mm-uu-function-1 (entry) + (nth 4 entry)) + +(defsubst mm-uu-function-2 (entry) + (nth 5 entry)) + +(defun mm-uu-copy-to-buffer (&optional from to) + "Copy the contents of the current buffer to a fresh buffer. +Return that buffer." + (save-excursion + (let ((obuf (current-buffer))) + (set-buffer (generate-new-buffer " *mm-uu*")) + (insert-buffer-substring obuf from to) + (current-buffer)))) (defun mm-uu-configure-p (key val) (member (cons key val) mm-uu-configure-list)) (defun mm-uu-configure (&optional symbol value) (if symbol (set-default symbol value)) - (setq mm-uu-begin-line nil) - (mapcar '(lambda (type) - (if (mm-uu-configure-p type 'disabled) + (setq mm-uu-beginning-regexp nil) + (mapcar (lambda (entry) + (if (mm-uu-configure-p (mm-uu-type entry) 'disabled) nil - (setq mm-uu-begin-line - (concat mm-uu-begin-line - (if mm-uu-begin-line "\\|") - (symbol-value - (intern (concat "mm-uu-" (symbol-name type) - "-begin-line"))))))) - '(uu postscript binhex shar forward))) - -(defcustom mm-uu-configure-list nil - "A list of mm-uu configuration. -To disable dissecting shar codes, for instance, add -`(shar . disabled)' to this list." - :type '(repeat (cons - (choice (item postscript) - (item uu) - (item binhex) - (item shar) - (item forward)) - (choice (item disabled)))) - :group 'gnus-article-mime - :set 'mm-uu-configure) + (setq mm-uu-beginning-regexp + (concat mm-uu-beginning-regexp + (if mm-uu-beginning-regexp "\\|") + (mm-uu-beginning-regexp entry))))) + mm-uu-type-alist)) (mm-uu-configure) -;;;### autoload +(eval-when-compile + (defvar file-name) + (defvar start-point) + (defvar end-point) + (defvar entry)) + +(defun mm-uu-uu-filename () + (if (looking-at ".+") + (setq file-name + (let ((nnheader-file-name-translation-alist + '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + (nnheader-translate-file-chars (match-string 0)))))) + +(defun mm-uu-binhex-filename () + (setq file-name + (ignore-errors + (binhex-decode-region start-point end-point t)))) + +(defun mm-uu-forward-test () + (save-excursion + (goto-char start-point) + (forward-line) + (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:"))) + +(defun mm-uu-postscript-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + '("application/postscript"))) + +(defun mm-uu-forward-extract () + (mm-make-handle (mm-uu-copy-to-buffer + (progn (goto-char start-point) (forward-line) (point)) + (progn (goto-char end-point) (forward-line -1) (point))) + '("message/rfc822" (charset . gnus-decoded)))) + +(defun mm-uu-uu-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + (list (or (and file-name + (string-match "\\.[^\\.]+$" + file-name) + (mailcap-extension-to-mime + (match-string 0 file-name))) + "application/octet-stream")) + 'x-uuencode nil + (if (and file-name (not (equal file-name ""))) + (list mm-dissect-disposition + (cons 'filename file-name))))) +(defun mm-uu-binhex-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + (list (or (and file-name + (string-match "\\.[^\\.]+$" file-name) + (mailcap-extension-to-mime + (match-string 0 file-name))) + "application/octet-stream")) + 'x-binhex nil + (if (and file-name (not (equal file-name ""))) + (list mm-dissect-disposition + (cons 'filename file-name))))) + +(defun mm-uu-shar-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + '("application/x-shar"))) + +(defun mm-uu-gnatsweb-extract () + (save-restriction + (goto-char start-point) + (forward-line) + (narrow-to-region (point) end-point) + (mm-dissect-buffer t))) + +(defun mm-uu-pgp-signed-test (&rest rest) + (and + mml2015-use + (mml2015-clear-verify-function) + (cond + ((eq mm-verify-option 'never) nil) + ((eq mm-verify-option 'always) t) + ((eq mm-verify-option 'known) t) + (t (y-or-n-p "Verify pgp signed part?"))))) + +(defun mm-uu-pgp-signed-extract-1 (handles ctl) + (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) + (with-current-buffer buf + (if (mm-uu-pgp-signed-test) + (progn + (mml2015-clean-buffer) + (let ((coding-system-for-write (or gnus-newsgroup-charset + 'iso-8859-1))) + (funcall (mml2015-clear-verify-function)))) + (when (and mml2015-use (null (mml2015-clear-verify-function))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (format "Clear verification not supported by `%s'.\n" mml2015-use)))) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (point-min) (point))) + (if (re-search-forward mm-uu-pgp-beginning-signature nil t) + (delete-region (match-beginning 0) (point-max)))) + (list + (mm-make-handle buf + '("text/plain" (charset . gnus-decoded)))))) + +(defun mm-uu-pgp-signed-extract () + (let ((mm-security-handle (list (format "multipart/signed")))) + (mm-set-handle-multipart-parameter + mm-security-handle 'protocol "application/x-gnus-pgp-signature") + (save-restriction + (narrow-to-region start-point end-point) + (add-text-properties 0 (length (car mm-security-handle)) + (list 'buffer (mm-uu-copy-to-buffer)) + (car mm-security-handle)) + (setcdr mm-security-handle + (mm-uu-pgp-signed-extract-1 nil + mm-security-handle))) + mm-security-handle)) + +(defun mm-uu-pgp-encrypted-test (&rest rest) + (and + mml2015-use + (mml2015-clear-decrypt-function) + (cond + ((eq mm-decrypt-option 'never) nil) + ((eq mm-decrypt-option 'always) t) + ((eq mm-decrypt-option 'known) t) + (t (y-or-n-p "Decrypt pgp encrypted part?"))))) + +(defun mm-uu-pgp-encrypted-extract-1 (handles ctl) + (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) + (if (mm-uu-pgp-encrypted-test) + (with-current-buffer buf + (mml2015-clean-buffer) + (funcall (mml2015-clear-decrypt-function)))) + (list + (mm-make-handle buf + '("text/plain" (charset . gnus-decoded)))))) + +(defun mm-uu-pgp-encrypted-extract () + (let ((mm-security-handle (list (format "multipart/encrypted")))) + (mm-set-handle-multipart-parameter + mm-security-handle 'protocol "application/x-gnus-pgp-encrypted") + (save-restriction + (narrow-to-region start-point end-point) + (add-text-properties 0 (length (car mm-security-handle)) + (list 'buffer (mm-uu-copy-to-buffer)) + (car mm-security-handle)) + (setcdr mm-security-handle + (mm-uu-pgp-encrypted-extract-1 nil + mm-security-handle))) + mm-security-handle)) + +(defun mm-uu-gpg-key-skip-to-last () + (let ((point (point)) + (end-regexp (mm-uu-end-regexp entry)) + (beginning-regexp (mm-uu-beginning-regexp entry))) + (when (and end-regexp + (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))) + (while (re-search-forward end-regexp nil t) + (skip-chars-forward " \t\n\r") + (if (looking-at beginning-regexp) + (setq point (match-end 0))))) + (goto-char point))) + +(defun mm-uu-pgp-key-extract () + (let ((buf (mm-uu-copy-to-buffer start-point end-point))) + (mm-make-handle buf + '("application/pgp-keys")))) + +;;;### autoload (defun mm-uu-dissect () "Dissect the current buffer and return a list of uu handles." - (let (text-start start-char end-char - type file-name end-line result text-plain-type - start-char-1 end-char-1 - (case-fold-search t)) + (let ((case-fold-search t) + text-start start-point end-point file-name result + text-plain-type entry func) (save-excursion - (save-restriction - (mail-narrow-to-head) - (goto-char (point-max))) - (forward-line) + (goto-char (point-min)) + (cond + ((looking-at "\n") + (forward-line)) + ((search-forward "\n\n" nil t) + t) + (t (goto-char (point-max)))) ;;; gnus-decoded is a fake charset, which means no further ;;; decoding. (setq text-start (point) text-plain-type '("text/plain" (charset . gnus-decoded))) - (while (re-search-forward mm-uu-begin-line nil t) - (setq start-char (match-beginning 0)) - (setq type (cdr (assq (aref (match-string 0) 0) - mm-uu-identifier-alist))) - (setq file-name - (if (and (eq type 'uu) - (looking-at "\\(.+\\)$")) - (and (match-string 1) - (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) - (nnheader-translate-file-chars (match-string 1)))))) - (forward-line) ;; in case of failure - (setq start-char-1 (point)) - (setq end-line (symbol-value - (intern (concat "mm-uu-" (symbol-name type) - "-end-line")))) - (when (and (re-search-forward end-line nil t) - (not (eq (match-beginning 0) (match-end 0)))) - (setq end-char-1 (match-beginning 0)) - (forward-line) - (setq end-char (point)) - (when (or (not (eq type 'binhex)) - (setq file-name - (ignore-errors - (binhex-decode-region start-char end-char t)))) - (if (> start-char text-start) - (push - (mm-make-handle (mm-uu-copy-to-buffer text-start start-char) - text-plain-type) - result)) - (push - (cond - ((eq type 'postscript) - (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) - '("application/postscript"))) - ((eq type 'forward) - (mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1) - '("message/rfc822" (charset . gnus-decoded)))) - ((eq type 'uu) - (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) - (list (or (and file-name - (string-match "\\.[^\\.]+$" file-name) - (mailcap-extension-to-mime - (match-string 0 file-name))) - "application/octet-stream")) - 'x-uuencode nil - (if (and file-name (not (equal file-name ""))) - (list mm-dissect-disposition - (cons 'filename file-name))))) - ((eq type 'binhex) - (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) - (list (or (and file-name - (string-match "\\.[^\\.]+$" file-name) - (mailcap-extension-to-mime - (match-string 0 file-name))) - "application/octet-stream")) - 'x-binhex nil - (if (and file-name (not (equal file-name ""))) - (list mm-dissect-disposition - (cons 'filename file-name))))) - ((eq type 'shar) - (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) - '("application/x-shar")))) - result) - (setq text-start end-char)))) + (while (re-search-forward mm-uu-beginning-regexp nil t) + (setq start-point (match-beginning 0)) + (let ((alist mm-uu-type-alist) + (beginning-regexp (match-string 0))) + (while (not entry) + (if (string-match (mm-uu-beginning-regexp (car alist)) + beginning-regexp) + (setq entry (car alist)) + (pop alist)))) + (if (setq func (mm-uu-function-1 entry)) + (funcall func)) + (forward-line);; in case of failure + (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)) + (let ((end-regexp (mm-uu-end-regexp entry))) + (if (not end-regexp) + (or (setq end-point (point-max)) t) + (prog1 + (re-search-forward end-regexp nil t) + (forward-line) + (setq end-point (point))))) + (or (not (setq func (mm-uu-function-2 entry))) + (funcall func))) + (if (and (> start-point text-start) + (progn + (goto-char text-start) + (re-search-forward "." start-point t))) + (push + (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) + text-plain-type) + result)) + (push + (funcall (mm-uu-function-extract entry)) + result) + (goto-char (setq text-start end-point)))) (when result - (if (> (point-max) (1+ text-start)) + (if (and (> (point-max) (1+ text-start)) + (save-excursion + (goto-char text-start) + (re-search-forward "." nil t))) (push (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - text-plain-type) + text-plain-type) result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) -;;;### autoload -(defun mm-uu-test () - "Check whether the current buffer contains uu stuffs." - (save-excursion - (goto-char (point-min)) - (let (type end-line result - (case-fold-search t)) - (while (and mm-uu-begin-line - (not result) (re-search-forward mm-uu-begin-line nil t)) - (forward-line) - (setq type (cdr (assq (aref (match-string 0) 0) - mm-uu-identifier-alist))) - (setq end-line (symbol-value - (intern (concat "mm-uu-" (symbol-name type) - "-end-line")))) - (if (and (re-search-forward end-line nil t) - (not (eq (match-beginning 0) (match-end 0)))) - (setq result t))) - result))) - (provide 'mm-uu) ;;; mm-uu.el ends here diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 7a4851a..d55eb79 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,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -23,6 +23,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'mail-parse) (require 'mailcap) (require 'mm-bodies) @@ -32,16 +33,22 @@ (autoload 'gnus-article-prepare-display "gnus-art") (autoload 'vcard-parse-string "vcard") (autoload 'vcard-format-string "vcard") + (autoload 'fill-flowed "flow-fill") (autoload 'diff-mode "diff-mode")) -;; Avoid byte compile warning. -(defvar gnus-article-mime-handles) - ;;; ;;; Functions for displaying various formats inline ;;; +(defun mm-inline-image-emacs (handle) + (let ((b (point-marker)) + buffer-read-only) + (insert "\n") + (put-image (mm-get-image handle) b) + (mm-handle-set-undisplayer + handle + `(lambda () (remove-images ,b (1+ ,b)))))) -(defun mm-inline-image (handle) +(defun mm-inline-image-xemacs (handle) (let ((b (point)) (annot (make-annotation (mm-get-image handle) nil 'text)) buffer-read-only) @@ -56,6 +63,11 @@ (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) +(eval-and-compile + (if (featurep 'xemacs) + (defalias 'mm-inline-image 'mm-inline-image-xemacs) + (defalias 'mm-inline-image 'mm-inline-image-emacs))) + (defvar mm-w3-setup nil) (defun mm-setup-w3 () (unless mm-w3-setup @@ -91,15 +103,19 @@ (and (boundp 'w3-meta-charset-content-type-regexp) (re-search-forward w3-meta-charset-content-type-regexp nil t))) - (setq charset (w3-coding-system-for-mime-charset - (buffer-substring-no-properties - (match-beginning 2) - (match-end 2))))) + (setq charset (or (w3-coding-system-for-mime-charset + (buffer-substring-no-properties + (match-beginning 2) + (match-end 2))) + charset))) (delete-region (point-min) (point-max)) (insert (mm-decode-string text charset)) (save-window-excursion (save-restriction (let ((w3-strict-width width) + ;; Don't let w3 set the global version of + ;; this variable. + (fill-column fill-column) (url-standalone-mode t)) (condition-case var (w3-region (point-min) (point-max)) @@ -109,10 +125,11 @@ `(lambda () (let (buffer-read-only) (if (functionp 'remove-specifier) - (mapc (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground))) + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) + (current-buffer))) + '(background background-pixmap foreground))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) ((or (equal type "enriched") @@ -128,15 +145,32 @@ (mm-insert-inline handle (concat "\n-- \n" - (vcard-format-string - (vcard-parse-string (mm-get-part handle) - 'vcard-standard-filter))))) + (if (fboundp 'vcard-pretty-print) + (vcard-pretty-print (mm-get-part handle)) + (vcard-format-string + (vcard-parse-string (mm-get-part handle) + 'vcard-standard-filter)))))) (t - (setq text (mm-get-part handle)) (let ((b (point)) (charset (mail-content-type-get (mm-handle-type handle) 'charset))) - (insert (mm-decode-string text charset)) + (if (or (eq charset 'gnus-decoded) + ;; This is probably not entirely correct, but + ;; makes rfc822 parts with embedded multiparts work. + (eq mail-parse-charset 'gnus-decoded)) + (save-restriction + (narrow-to-region (point) (point)) + (mm-insert-part handle) + (goto-char (point-max))) + (insert (mm-decode-string (mm-get-part handle) charset))) + (when (and (equal type "plain") + (equal (cdr (assoc 'format (mm-handle-type handle))) + "flowed")) + (save-restriction + (narrow-to-region b (point)) + (goto-char b) + (fill-flowed) + (goto-char (point-max)))) (save-restriction (narrow-to-region b (point)) (set-text-properties (point-min) (point-max) nil) @@ -173,7 +207,7 @@ (mm-enable-multibyte) (let (handles) (let (gnus-article-mime-handles) - ;; Double decode problem may happen. See mm-inline-message. + ;; Double decode problem may happen. See mm-inline-message. (run-hooks 'gnus-article-decode-hook) (gnus-article-prepare-display) (setq handles gnus-article-mime-handles)) @@ -190,12 +224,20 @@ (charset (mail-content-type-get (mm-handle-type handle) 'charset)) gnus-displaying-mime handles) + (when (and charset + (stringp charset)) + (setq charset (intern (downcase charset))) + (when (eq charset 'us-ascii) + (setq charset nil))) (save-excursion (save-restriction (narrow-to-region b b) (mm-insert-part handle) (let (gnus-article-mime-handles - (gnus-newsgroup-charset (or charset gnus-newsgroup-charset))) + ;; disable prepare hook + gnus-article-prepare-hook + (gnus-newsgroup-charset + (or charset gnus-newsgroup-charset))) (run-hooks 'gnus-article-decode-hook) (gnus-article-prepare-display) (setq handles gnus-article-mime-handles)) @@ -212,19 +254,19 @@ handle `(lambda () (let (buffer-read-only) - (ignore-errors - ;; This is only valid on XEmacs. - (mapc (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground))) + (if (fboundp 'remove-specifier) + ;; This is only valid on XEmacs. + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) (current-buffer))) + '(background background-pixmap foreground))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) -(defun mm-display-patch-inline (handle) +(defun mm-display-inline-fontify (handle mode) (let (text) (with-temp-buffer (mm-insert-part handle) - (diff-mode) + (funcall mode) (font-lock-fontify-buffer) (when (fboundp 'extent-list) (map-extents (lambda (ext ignored) @@ -234,6 +276,12 @@ (setq text (buffer-string))) (mm-insert-inline handle text))) +(defun mm-display-patch-inline (handle) + (mm-display-inline-fontify handle 'diff-mode)) + +(defun mm-display-elisp-inline (handle) + (mm-display-inline-fontify handle 'emacs-lisp-mode)) + (provide 'mm-view) ;; mm-view.el ends here diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el new file mode 100644 index 0000000..cc54995 --- /dev/null +++ b/lisp/mml-sec.el @@ -0,0 +1,112 @@ +;;; mml-sec.el --- A package with security functions for MML documents +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; This file is not part of GNU Emacs, but the same permissions apply. + +;; 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: + +(require 'smime) +(require 'mml2015) +(require 'mml-smime) +(eval-when-compile (require 'cl)) + +(defvar mml-sign-alist + '(("smime" mml-smime-sign-buffer mml-smime-sign-query) + ("pgpmime" mml-pgpmime-sign-buffer list)) + "Alist of MIME signer functions.") + +(defvar mml-default-sign-method (caar mml-sign-alist) + "Default sign method.") + +(defvar mml-encrypt-alist + '(("smime" mml-smime-encrypt-buffer mml-smime-encrypt-query) + ("pgpmime" mml-pgpmime-encrypt-buffer list)) + "Alist of MIME encryption functions.") + +(defvar mml-default-encrypt-method (caar mml-encrypt-alist) + "Default encryption method.") + +;;; Security functions + +(defun mml-smime-sign-buffer (cont) + (or (mml-smime-sign cont) + (error "Signing failed... inspect message logs for errors"))) + +(defun mml-smime-encrypt-buffer (cont) + (or (mml-smime-encrypt cont) + (error "Encryption failed... inspect message logs for errors"))) + +(defun mml-pgpmime-sign-buffer (cont) + (or (mml2015-sign cont) + (error "Signing failed... inspect message logs for errors"))) + +(defun mml-pgpmime-encrypt-buffer (cont) + (or (mml2015-encrypt cont) + (error "Encryption failed... inspect message logs for errors"))) + +(defun mml-secure-part (method &optional sign) + (save-excursion + (let ((tags (funcall (nth 2 (assoc method (if sign mml-sign-alist + mml-encrypt-alist)))))) + (cond ((re-search-backward + "<#\\(multipart\\|part\\|external\\|mml\\)" nil t) + (goto-char (match-end 0)) + (insert (if sign " sign=" " encrypt=") method) + (while tags + (let ((key (pop tags)) + (value (pop tags))) + (when value + ;; Quote VALUE if it contains suspicious characters. + (when (string-match "[\"'\\~/*;() \t\n]" value) + (setq value (prin1-to-string value))) + (insert (format " %s=%s" key value)))))) + ((or (re-search-backward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t)) + (goto-char (match-end 0)) + (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt) + (cons method tags)))) + (t (error "The message is corrupted. No mail header separator.")))))) + +(defun mml-secure-sign-pgpmime () + "Add MML tags to PGP/MIME sign this MML part." + (interactive) + (mml-secure-part "pgpmime" 'sign)) + +(defun mml-secure-sign-smime () + "Add MML tags to S/MIME sign this MML part." + (interactive) + (mml-secure-part "smime" 'sign)) + +(defun mml-secure-encrypt-pgpmime () + "Add MML tags to PGP/MIME encrypt this MML part." + (interactive) + (mml-secure-part "pgpmime")) + +(defun mml-secure-encrypt-smime () + "Add MML tags to S/MIME encrypt this MML part." + (interactive) + (mml-secure-part "smime")) + +(provide 'mml-sec) + +;;; mml-sec.el ends here diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el new file mode 100644 index 0000000..835516a --- /dev/null +++ b/lisp/mml-smime.el @@ -0,0 +1,183 @@ +;;; mml-smime.el --- S/MIME support for MML +;; Copyright (c) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: Gnus, MIME, S/MIME, MML + +;; This file is a 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: + +(require 'smime) +(require 'mm-decode) + +(defun mml-smime-sign (cont) + (smime-sign-buffer (cdr (assq 'keyfile cont)))) + +(defun mml-smime-encrypt (cont) + (let (certnames certfiles tmp file tmpfiles) + ;; xxx tmp files are always an security issue + (while (setq tmp (pop cont)) + (if (and (consp tmp) (eq (car tmp) 'certfile)) + (push (cdr tmp) certnames))) + (while (setq tmp (pop certnames)) + (if (not (and (not (file-exists-p tmp)) + (get-buffer tmp))) + (push tmp certfiles) + (setq file (make-temp-name mm-tmp-directory)) + (with-current-buffer tmp + (write-region (point-min) (point-max) file)) + (push file certfiles) + (push file tmpfiles))) + (if (smime-encrypt-buffer certfiles) + (progn + (while (setq tmp (pop tmpfiles)) + (delete-file tmp)) + t) + (while (setq tmp (pop tmpfiles)) + (delete-file tmp)) + nil))) + +(defun mml-smime-sign-query () + ;; query information (what certificate) from user when MML tag is + ;; added, for use later by the signing process + (when (null smime-keys) + (customize-variable 'smime-keys) + (error "No S/MIME keys configured, use customize to add your key")) + (list 'keyfile + (if (= (length smime-keys) 1) + (cadar smime-keys) + (or (let ((from (cadr (funcall gnus-extract-address-components + (or (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "from"))) + ""))))) + (and from (smime-get-key-by-email from))) + (smime-get-key-by-email + (completing-read "Sign this part with what signature? " + smime-keys nil nil + (and (listp (car-safe smime-keys)) + (caar smime-keys)))))))) + +(defun mml-smime-get-file-cert () + (ignore-errors + (list 'certfile (read-file-name + "File with recipient's S/MIME certificate: " + smime-certificate-directory nil t "")))) + +(defun mml-smime-get-dns-cert () + ;; todo: deal with comma separated multiple recipients + (let (result who bad cert) + (condition-case () + (while (not result) + (setq who (read-from-minibuffer + (format "%sLookup certificate for: " (or bad "")) + (cadr (funcall gnus-extract-address-components + (or (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "to"))) + ""))))) + (if (setq cert (smime-cert-by-dns who)) + (setq result (list 'certfile (buffer-name cert))) + (setq bad (format "`%s' not found. " who)))) + (quit)) + result)) + +(defun mml-smime-encrypt-query () + ;; todo: add ldap support (xemacs ldap api?) + ;; 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)) + (dns (setq certs (append certs + (mml-smime-get-dns-cert)))) + (file (setq certs (append certs + (mml-smime-get-file-cert))))) + (setq done (not (y-or-n-p "Add more recipients? ")))) + certs)) + +(defun mml-smime-verify (handle ctl) + (with-temp-buffer + (insert-buffer (mm-handle-multipart-original-buffer ctl)) + (goto-char (point-min)) + (insert (format "Content-Type: %s; " (mm-handle-media-type ctl))) + (insert (format "protocol=\"%s\"; " + (mm-handle-multipart-ctl-parameter ctl 'protocol))) + (insert (format "micalg=\"%s\"; " + (mm-handle-multipart-ctl-parameter ctl 'micalg))) + (insert (format "boundary=\"%s\"\n\n" + (mm-handle-multipart-ctl-parameter ctl 'boundary))) + (when (get-buffer smime-details-buffer) + (kill-buffer smime-details-buffer)) + (let ((buf (current-buffer)) + (good-signature (smime-verify-buffer)) + addresses openssl-output) + (setq openssl-output (with-current-buffer smime-details-buffer + (buffer-string))) + (if (not good-signature) + (progn + ;; we couldn't verify message, fail with openssl output as message + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (concat "OpenSSL failed to verify message:\n" + "---------------------------------\n" + openssl-output))) + ;; verify mail addresses in mail against those in certificate + (when (and (smime-pkcs7-region (point-min) (point-max)) + (smime-pkcs7-certificates-region (point-min) (point-max))) + (with-temp-buffer + (insert-buffer-substring buf) + (goto-char (point-min)) + (while (re-search-forward "-----END CERTIFICATE-----" nil t) + (smime-pkcs7-email-region (point-min) (point)) + (setq addresses (append (smime-buffer-as-string-region + (point-min) (point)) addresses)) + (delete-region (point-min) (point))))) + (if (not (member mm-security-from addresses)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Sender forged") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK")) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (concat "Sender clamed to be: " mm-security-from "\n" + (if addresses + (concat "Addresses in certificate: " + (mapconcat 'identity addresses ", ")) + "No addresses found in certificate.") + "\n" "\n" + "OpenSSL output:\n" + "---------------\n" openssl-output "\n" + "Certificate(s) inside S/MIME signature:\n" + "---------------------------------------\n" + (buffer-string) "\n"))))) + handle) + +(defun mml-smime-verify-test (handle ctl) + smime-openssl-program) + +(provide 'mml-smime) + +;;; mml-smime.el ends here diff --git a/lisp/mml.el b/lisp/mml.el index e84e955..150e776 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,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -27,19 +27,22 @@ (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) +(require 'gnus-ems) +(require 'mml-sec) +(eval-when-compile (require 'cl)) (eval-and-compile - (autoload 'message-make-message-id "message")) + (autoload 'message-make-message-id "message") + (autoload 'gnus-setup-posting-charset "gnus-msg") + (autoload 'message-fetch-field "message") + (autoload 'message-posting-charset "message")) -(defvar mml-generate-multipart-alist - '(("signed" . rfc2015-generate-signed-multipart) - ("encrypted" . rfc2015-generate-encrypted-multipart)) +(defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. - Each entry has the form (NAME . FUNCTION), where -NAME: is a string containing the name of the part (without the +NAME is a string containing the name of the part (without the leading \"/multipart/\"), -FUNCTION: is a Lisp function which is called to generate the part. +FUNCTION is a Lisp function which is called to generate the part. The Lisp function has to supply the appropriate MIME headers and the contents of this part.") @@ -64,6 +67,27 @@ suggestion each time. The function is called with one parameter, which is a number that says how many times the function has been called for this message.") +(defvar mml-confirmation-set nil + "A list of symbols, each of which disables some warning. +`unknown-encoding': always send messages contain characters with +unknown encoding; `use-ascii': always use ASCII for those characters +with unknown encoding; `multipart': always send messages with more than +one charsets.") + +(defvar mml-generate-default-type "text/plain") + +(defvar mml-buffer-list nil) + +(defun mml-generate-new-buffer (name) + (let ((buf (generate-new-buffer name))) + (push buf mml-buffer-list) + buf)) + +(defun mml-destroy-buffers () + (let (kill-buffer-hook) + (mapcar 'kill-buffer mml-buffer-list) + (setq mml-buffer-list nil))) + (defun mml-parse () "Parse the current buffer as an MML document." (goto-char (point-min)) @@ -76,7 +100,7 @@ called for this message.") (defun mml-parse-1 () "Parse the current buffer as an MML document." - (let (struct tag point contents charsets warn) + (let (struct tag point contents charsets warn use-ascii no-markup-p raw) (while (and (not (eobp)) (not (looking-at "<#/multipart"))) (cond @@ -86,23 +110,44 @@ called for this message.") (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) struct)) (t - (if (looking-at "<#part") - (setq tag (mml-read-tag)) + (if (or (looking-at "<#part") (looking-at "<#mml")) + (setq tag (mml-read-tag) + no-markup-p nil + warn nil) (setq tag (list 'part '(type . "text/plain")) + no-markup-p t warn t)) - (setq point (point) - contents (mml-read-part) - charsets (mm-find-mime-charset-region point (point))) - (if (< (length charsets) 2) - (push (nconc tag (list (cons 'contents contents))) - struct) + (setq raw (cdr (assq 'raw tag)) + point (point) + contents (mml-read-part (eq 'mml (car tag))) + charsets (if raw nil + (mm-find-mime-charset-region point (point)))) + (when (and (not raw) (memq nil charsets)) + (if (or (memq 'unknown-encoding mml-confirmation-set) + (y-or-n-p + "Message contains characters with unknown encoding. Really send?")) + (if (setq use-ascii + (or (memq 'use-ascii mml-confirmation-set) + (y-or-n-p "Use ASCII as charset?"))) + (setq charsets (delq nil charsets)) + (setq warn nil)) + (error "Edit your message to remove those characters"))) + (if (or raw + (eq 'mml (car tag)) + (< (length charsets) 2)) + (if (or (not no-markup-p) + (string-match "[^ \t\r\n]" contents)) + ;; Don't create blank parts. + (push (nconc tag (list (cons 'contents contents))) + struct)) (let ((nstruct (mml-parse-singlepart-with-multiple-charsets - tag point (point)))) + tag point (point) use-ascii))) (when (and warn + (not (memq 'multipart mml-confirmation-set)) (not (y-or-n-p (format - "Warning: Your message contains %d parts. Really send? " + "Warning: Your message contains more than %d parts. Really send? " (length nstruct))))) (error "Edit your message to use only one charset")) (setq struct (nconc nstruct struct))))))) @@ -110,56 +155,63 @@ called for this message.") (forward-line 1)) (nreverse struct))) -(defun mml-parse-singlepart-with-multiple-charsets (orig-tag beg end) +(defun mml-parse-singlepart-with-multiple-charsets + (orig-tag beg end &optional use-ascii) (save-excursion - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((current (mm-mime-charset (char-charset (following-char)))) - charset struct space newline paragraph) - (while (not (eobp)) - (cond - ;; The charset remains the same. - ((or (eq (setq charset (mm-mime-charset - (char-charset (following-char)))) 'us-ascii) - (eq charset current))) - ;; The initial charset was ascii. - ((eq current 'us-ascii) - (setq current charset - space nil - newline nil - paragraph nil)) - ;; We have a change in charsets. - (t - (push (append - orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (or paragraph newline space (point)))))) - struct) - (setq beg (or paragraph newline space (point)) - current charset - space nil - newline nil - paragraph nil))) - ;; Compute places where it might be nice to break the part. - (cond - ((memq (following-char) '(? ?\t)) - (setq space (1+ (point)))) - ((eq (following-char) ?\n) - (setq newline (1+ (point)))) - ((and (eq (following-char) ?\n) - (not (bobp)) - (eq (char-after (1- (point))) ?\n)) - (setq paragraph (point)))) - (forward-char 1)) - ;; Do the final part. - (unless (= beg (point)) - (push (append orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (point))))) - struct)) - struct))) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let ((current (or (mm-mime-charset (mm-charset-after)) + (and use-ascii 'us-ascii))) + charset struct space newline paragraph) + (while (not (eobp)) + (setq charset (mm-mime-charset (mm-charset-after))) + (cond + ;; The charset remains the same. + ((eq charset 'us-ascii)) + ((or (and use-ascii (not charset)) + (eq charset current)) + (setq space nil + newline nil + paragraph nil)) + ;; The initial charset was ascii. + ((eq current 'us-ascii) + (setq current charset + space nil + newline nil + paragraph nil)) + ;; We have a change in charsets. + (t + (push (append + orig-tag + (list (cons 'contents + (buffer-substring-no-properties + beg (or paragraph newline space (point)))))) + struct) + (setq beg (or paragraph newline space (point)) + current charset + space nil + newline nil + paragraph nil))) + ;; Compute places where it might be nice to break the part. + (cond + ((memq (following-char) '(? ?\t)) + (setq space (1+ (point)))) + ((and (eq (following-char) ?\n) + (not (bobp)) + (eq (char-after (1- (point))) ?\n)) + (setq paragraph (point))) + ((eq (following-char) ?\n) + (setq newline (1+ (point))))) + (forward-char 1)) + ;; Do the final part. + (unless (= beg (point)) + (push (append orig-tag + (list (cons 'contents + (buffer-substring-no-properties + beg (point))))) + struct)) + struct)))) (defun mml-read-tag () "Read a tag and return the contents." @@ -168,7 +220,7 @@ called for this message.") (setq name (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point)))) (skip-chars-forward " \t\n") - (while (not (looking-at ">")) + (while (not (looking-at ">[ \t]*\n?")) (setq elem (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point)))) (skip-chars-forward "= \t\n") @@ -178,26 +230,37 @@ called for this message.") (setq val (match-string 1 val))) (push (cons (intern elem) val) contents) (skip-chars-forward " \t\n")) - (forward-char 1) - (skip-chars-forward " \t\n") + (goto-char (match-end 0)) + ;; Don't skip the leading space. + ;;(skip-chars-forward " \t\n") (cons (intern name) (nreverse contents)))) -(defun mml-read-part () - "Return the buffer up till the next part, multipart or closing part or multipart." - (let ((beg (point))) +(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." + (let ((beg (point)) (count 1)) ;; If the tag ended at the end of the line, we go to the next line. (when (looking-at "[ \t]*\n") (forward-line 1)) - (if (re-search-forward - "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t) - (prog1 - (buffer-substring-no-properties 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)))))) + (if mml + (progn + (while (and (> count 0) (not (eobp))) + (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)))) + (if (re-search-forward + "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) + (prog1 + (buffer-substring-no-properties 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))))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") @@ -206,7 +269,7 @@ called for this message.") (defun mml-generate-mime () "Generate a MIME message based on the current MML document." (let ((cont (mml-parse)) - (mml-multipart-number 0)) + (mml-multipart-number mml-multipart-number)) (if (not cont) nil (with-temp-buffer @@ -218,96 +281,148 @@ called for this message.") (buffer-string))))) (defun mml-generate-mime-1 (cont) - (cond - ((eq (car cont) 'part) - (let (coded encoding charset filename type) - (setq type (or (cdr (assq 'type cont)) "text/plain")) - (if (member (car (split-string type "/")) '("text" "message")) - (with-temp-buffer - (cond - ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and (setq filename (cdr (assq 'filename cont))) - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (mm-insert-file-contents filename)) - (t - (save-restriction - (narrow-to-region (point) (point)) - (insert (cdr (assq 'contents cont))) - ;; Remove quotes from quoted tags. - (goto-char (point-min)) - (while (re-search-forward - "<#!+/?\\(part\\|multipart\\|external\\)" nil t) - (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3)))))) - (setq charset (mm-encode-body)) - (setq encoding (mm-body-encoding charset)) - (setq coded (buffer-string))) - (mm-with-unibyte-buffer - (cond - ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and (setq filename (cdr (assq 'filename cont))) - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read mm-binary-coding-system)) - (mm-insert-file-contents filename nil nil nil nil t))) - (t - (insert (cdr (assq 'contents cont))))) - (setq encoding (mm-encode-buffer type) - coded (buffer-string)))) - (mml-insert-mime-headers cont type charset encoding) - (insert "\n") - (insert coded))) - ((eq (car cont) 'external) - (insert "Content-Type: message/external-body") - (let ((parameters (mml-parameter-string - cont '(expiration size permission))) - (name (cdr (assq 'name cont)))) - (when name - (setq name (mml-parse-file-name name)) - (if (stringp name) + (let ((mm-use-ultra-safe-encoding + (or mm-use-ultra-safe-encoding (assq 'sign cont)))) + (save-restriction + (narrow-to-region (point) (point)) + (cond + ((or (eq (car cont) 'part) (eq (car cont) 'mml)) + (let ((raw (cdr (assq 'raw cont))) + coded encoding charset filename type) + (setq type (or (cdr (assq 'type cont)) "text/plain")) + (if (and (not raw) + (member (car (split-string type "/")) '("text" "message"))) + (with-temp-buffer + (setq charset (mm-charset-to-coding-system + (cdr (assq 'charset cont)))) + (if (eq charset 'ascii) (setq charset nil)) + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((and (setq filename (cdr (assq 'filename cont))) + (not (equal (cdr (assq 'nofile cont)) "yes"))) + (let ((coding-system-for-read charset)) + (mm-insert-file-contents filename))) + ((eq 'mml (car cont)) + (insert (cdr (assq 'contents cont)))) + (t + (save-restriction + (narrow-to-region (point) (point)) + (insert (cdr (assq 'contents cont))) + ;; Remove quotes from quoted tags. + (goto-char (point-min)) + (while (re-search-forward + "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t) + (delete-region (+ (match-beginning 0) 2) + (+ (match-beginning 0) 3)))))) + (cond + ((eq (car cont) 'mml) + (let ((mml-boundary (funcall mml-boundary-function + (incf mml-multipart-number))) + (mml-generate-default-type "text/plain")) + (mml-to-mime)) + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + ((string= (car (split-string type "/")) "message") + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + (t + (setq charset (mm-encode-body charset)) + (setq encoding (mm-body-encoding + charset (cdr (assq 'encoding cont)))))) + (setq coded (buffer-string))) + (mm-with-unibyte-buffer + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((and (setq filename (cdr (assq 'filename cont))) + (not (equal (cdr (assq 'nofile cont)) "yes"))) + (let ((coding-system-for-read mm-binary-coding-system)) + (mm-insert-file-contents filename nil nil nil nil t))) + (t + (insert (cdr (assq 'contents cont))))) + (setq encoding (mm-encode-buffer type) + coded (buffer-string)))) + (mml-insert-mime-headers cont type charset encoding) + (insert "\n") + (insert coded))) + ((eq (car cont) 'external) + (insert "Content-Type: message/external-body") + (let ((parameters (mml-parameter-string + cont '(expiration size permission))) + (name (cdr (assq 'name cont))) + (url (cdr (assq 'url cont)))) + (when name + (setq name (mml-parse-file-name name)) + (if (stringp name) + (mml-insert-parameter + (mail-header-encode-parameter "name" name) + "access-type=local-file") + (mml-insert-parameter + (mail-header-encode-parameter + "name" (file-name-nondirectory (nth 2 name))) + (mail-header-encode-parameter "site" (nth 1 name)) + (mail-header-encode-parameter + "directory" (file-name-directory (nth 2 name)))) + (mml-insert-parameter + (concat "access-type=" + (if (member (nth 0 name) '("ftp@" "anonymous@")) + "anon-ftp" + "ftp"))))) + (when url (mml-insert-parameter - (mail-header-encode-parameter "name" name) - "access-type=local-file") - (mml-insert-parameter - (mail-header-encode-parameter - "name" (file-name-nondirectory (nth 2 name))) - (mail-header-encode-parameter "site" (nth 1 name)) - (mail-header-encode-parameter - "directory" (file-name-directory (nth 2 name)))) - (mml-insert-parameter - (concat "access-type=" - (if (member (nth 0 name) '("ftp@" "anonymous@")) - "anon-ftp" - "ftp"))))) - (when parameters - (mml-insert-parameter-string - cont '(expiration size permission)))) - (insert "\n\n") - (insert "Content-Type: " (cdr (assq 'type cont)) "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: " - (or (cdr (assq 'encoding cont)) "binary")) - (insert "\n\n") - (insert (or (cdr (assq 'contents cont)))) - (insert "\n")) - ((eq (car cont) 'multipart) - (let* ((type (or (cdr (assq 'type cont)) "mixed")) - (handler (assoc type mml-generate-multipart-alist))) - (if handler - (funcall (cdr handler) cont) - ;; No specific handler. Use default one. - (let ((mml-boundary (mml-compute-boundary cont))) - (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" - type mml-boundary)) - (insert "\n") - (setq cont (cddr cont)) - (while cont - (insert "\n--" mml-boundary "\n") - (mml-generate-mime-1 (pop cont))) - (insert "\n--" mml-boundary "--\n"))))) - (t - (error "Invalid element: %S" cont)))) + (mail-header-encode-parameter "url" url) + "access-type=url")) + (when parameters + (mml-insert-parameter-string + cont '(expiration size permission)))) + (insert "\n\n") + (insert "Content-Type: " (cdr (assq 'type cont)) "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: " + (or (cdr (assq 'encoding cont)) "binary")) + (insert "\n\n") + (insert (or (cdr (assq 'contents cont)))) + (insert "\n")) + ((eq (car cont) 'multipart) + (let* ((type (or (cdr (assq 'type cont)) "mixed")) + (mml-generate-default-type (if (equal type "digest") + "message/rfc822" + "text/plain")) + (handler (assoc type mml-generate-multipart-alist))) + (if handler + (funcall (cdr handler) cont) + ;; No specific handler. Use default one. + (let ((mml-boundary (mml-compute-boundary cont))) + (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" + type mml-boundary)) + (let ((cont cont) part) + (while (setq part (pop cont)) + ;; Skip `multipart' and attributes. + (when (and (consp part) (consp (cdr part))) + (insert "\n--" mml-boundary "\n") + (mml-generate-mime-1 part)))) + (insert "\n--" mml-boundary "--\n"))))) + (t + (error "Invalid element: %S" cont))) + (let ((item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) + sender recipients) + (when item + (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)) + (funcall (nth 1 item) cont))) + (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) + sender recipients) + (when item + (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)) + (funcall (nth 1 item) cont)))))) (defun mml-compute-boundary (cont) "Return a unique boundary that does not exist in CONT." @@ -349,12 +464,6 @@ called for this message.") "") mml-base-boundary)) -(defun mml-make-string (num string) - (let ((out "")) - (while (not (zerop (decf num))) - (setq out (concat out string))) - out)) - (defun mml-insert-mime-headers (cont type charset encoding) (let (parameters disposition description) (setq parameters @@ -362,7 +471,7 @@ called for this message.") cont '(name access-type expiration size permission))) (when (or charset parameters - (not (equal type "text/plain"))) + (not (equal type mml-generate-default-type))) (when (consp charset) (error "Can't encode a part with several charsets.")) @@ -415,13 +524,14 @@ called for this message.") (mail-header-encode-parameter (symbol-name type) value)))))) -(defvar ange-ftp-path-format) -(defvar efs-path-regexp) +(eval-when-compile + (defvar ange-ftp-name-format) + (defvar efs-path-regexp)) (defun mml-parse-file-name (path) (if (if (boundp 'efs-path-regexp) (string-match efs-path-regexp path) - (if (boundp 'ange-ftp-path-format) - (string-match (car ange-ftp-path-format)))) + (if (boundp 'ange-ftp-name-format) + (string-match (car ange-ftp-name-format) path))) (list (match-string 1 path) (match-string 2 path) (substring path (1+ (match-end 2)))) path)) @@ -438,61 +548,83 @@ called for this message.") ;;; Transforming MIME to MML ;;; -(defun mime-to-mml () - "Translate the current buffer (which should be a message) into MML." +(defun mime-to-mml (&optional handles) + "Translate the current buffer (which should be a message) into MML. +If HANDLES is non-nil, use it instead reparsing the buffer." ;; First decode the head. (save-restriction (message-narrow-to-head) (mail-decode-encoded-word-region (point-min) (point-max))) - (let ((handles (mm-dissect-buffer t))) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (delete-region (point) (point-max)) - (if (stringp (car handles)) - (mml-insert-mime handles) - (mml-insert-mime handles t)) - (mm-destroy-parts handles))) + (unless handles + (setq handles (mm-dissect-buffer t))) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (if (stringp (car handles)) + (mml-insert-mime handles) + (mml-insert-mime handles t)) + (mm-destroy-parts handles) + (save-restriction + (message-narrow-to-head) + ;; Remove them, they are confusing. + (message-remove-header "Content-Type") + (message-remove-header "MIME-Version") + (message-remove-header "Content-Transfer-Encoding"))) (defun mml-to-mime () "Translate the current buffer from MML to MIME." (message-encode-message-body) (save-restriction (message-narrow-to-headers-or-head) - (mail-encode-encoded-word-buffer))) + (let ((mail-parse-charset message-default-charset)) + (mail-encode-encoded-word-buffer)))) (defun mml-insert-mime (handle &optional no-markup) - (let (textp buffer) + (let (textp buffer mmlp) ;; Determine type and stuff. (unless (stringp (car handle)) - (unless (setq textp (equal (mm-handle-media-supertype handle) - "text")) + (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) (save-excursion - (set-buffer (setq buffer (generate-new-buffer " *mml*"))) - (mm-insert-part handle)))) - (unless no-markup - (mml-insert-mml-markup handle buffer textp)) + (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) + (mm-insert-part handle) + (if (setq mmlp (equal (mm-handle-media-type handle) + "message/rfc822")) + (mime-to-mml))))) + (if mmlp + (mml-insert-mml-markup handle nil t t) + (unless (and no-markup + (equal (mm-handle-media-type handle) "text/plain")) + (mml-insert-mml-markup handle buffer textp))) (cond + (mmlp + (insert-buffer buffer) + (goto-char (point-max)) + (insert "<#/mml>\n")) ((stringp (car handle)) (mapcar 'mml-insert-mime (cdr handle)) (insert "<#/multipart>\n")) (textp - (let ((text (mm-get-part handle)) - (charset (mail-content-type-get + (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset))) - (insert (mm-decode-string text charset))) + (if (eq charset 'gnus-decoded) + (mm-insert-part handle) + (insert (mm-decode-string (mm-get-part handle) charset)))) (goto-char (point-max))) (t (insert "<#/part>\n"))))) -(defun mml-insert-mml-markup (handle &optional buffer nofile) +(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp) "Take a MIME handle and insert an MML tag." (if (stringp (car handle)) (insert "<#multipart type=" (mm-handle-media-subtype handle) ">\n") - (insert "<#part type=" (mm-handle-media-type handle)) + (if mmlp + (insert "<#mml type=" (mm-handle-media-type handle)) + (insert "<#part type=" (mm-handle-media-type handle))) (dolist (elem (append (cdr (mm-handle-type handle)) (cdr (mm-handle-disposition handle)))) - (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")) + (unless (symbolp (cdr elem)) + (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))) (when (mm-handle-disposition handle) (insert " disposition=" (car (mm-handle-disposition handle)))) (when buffer @@ -519,8 +651,14 @@ called for this message.") ;;; (defvar mml-mode-map - (let ((map (make-sparse-keymap)) + (let ((sign (make-sparse-keymap)) + (encrypt (make-sparse-keymap)) + (map (make-sparse-keymap)) (main (make-sparse-keymap))) + (define-key sign "p" 'mml-secure-sign-pgpmime) + (define-key sign "s" 'mml-secure-sign-smime) + (define-key encrypt "p" 'mml-secure-encrypt-pgpmime) + (define-key encrypt "s" 'mml-secure-encrypt-smime) (define-key map "f" 'mml-attach-file) (define-key map "b" 'mml-attach-buffer) (define-key map "e" 'mml-attach-external) @@ -529,8 +667,12 @@ called for this message.") (define-key map "p" 'mml-insert-part) (define-key map "v" 'mml-validate) (define-key map "P" 'mml-preview) - (define-key map "n" 'mml-narrow-to-part) - (define-key main "\M-m" map) + (define-key map "s" sign) + (define-key map "c" encrypt) + ;;(define-key map "n" 'mml-narrow-to-part) + ;; `M-m' conflicts with `back-to-indentation'. + ;; (define-key main "\M-m" map) + (define-key main "\C-c\C-m" map) main)) (easy-menu-define @@ -543,7 +685,14 @@ called for this message.") ("Insert" ["Multipart" mml-insert-multipart t] ["Part" mml-insert-part t]) - ["Narrow" mml-narrow-to-part t] + ("Security" + ("Sign" + ["PGP/MIME" mml-secure-sign-pgpmime t] + ["S/MIME" mml-secure-sign-smime t]) + ("Encrypt" + ["PGP/MIME" mml-secure-encrypt-pgpmime t] + ["S/MIME" mml-secure-encrypt-smime t])) + ;;["Narrow" mml-narrow-to-part t] ["Quote" mml-quote-region t] ["Validate" mml-validate t] ["Preview" mml-preview t])) @@ -556,17 +705,12 @@ called for this message.") \\{mml-mode-map}" (interactive "P") - (if (not (set (make-local-variable 'mml-mode) - (if (null arg) (not mml-mode) - (> (prefix-numeric-value arg) 0)))) - nil - (set (make-local-variable 'mml-mode) t) - (unless (assq 'mml-mode minor-mode-alist) - (push `(mml-mode " MML") minor-mode-alist)) - (unless (assq 'mml-mode minor-mode-map-alist) - (push (cons 'mml-mode mml-mode-map) - minor-mode-map-alist))) - (run-hooks 'mml-mode-hook)) + (when (set (make-local-variable 'mml-mode) + (if (null arg) (not mml-mode) + (> (prefix-numeric-value arg) 0))) + (gnus-add-minor-mode 'mml-mode " MML" mml-mode-map) + (easy-menu-add mml-menu mml-mode-map) + (run-hooks 'mml-mode-hook))) ;;; ;;; Helper functions for reading MIME stuff from the minibuffer and @@ -586,6 +730,7 @@ called for this message.") file)) (defun mml-minibuffer-read-type (name &optional default) + (mailcap-parse-mimetypes) (let* ((default (or default (mm-default-file-encoding name) ;; Perhaps here we should check what the file @@ -594,27 +739,7 @@ called for this message.") "application/octet-stream")) (string (completing-read (format "Content type (default %s): " default) - (mapcar - 'list - (delete-duplicates - (nconc - (mapcar (lambda (m) (cdr m)) - mailcap-mime-extensions) - (apply - 'nconc - (mapcar - (lambda (l) - (delq nil - (mapcar - (lambda (m) - (let ((type (cdr (assq 'type (cdr m))))) - (if (equal (cadr (split-string type "/")) - "*") - nil - type))) - (cdr l)))) - mailcap-mime-data))) - :test 'equal))))) + (mapcar 'list (mailcap-mime-types))))) (if (not (equal string "")) string default))) @@ -636,7 +761,7 @@ called for this message.") (goto-char (point-min)) ;; Quote parts. (while (re-search-forward - "<#/?!*\\(multipart\\|part\\|external\\)" nil t) + "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t) ;; Insert ! after the #. (goto-char (+ (match-beginning 0) 2)) (insert "!"))))) @@ -651,10 +776,17 @@ called for this message.") (value (pop plist))) (when value ;; Quote VALUE if it contains suspicious characters. - (when (string-match "[\"\\~/* \t\n]" value) + (when (string-match "[\"'\\~/*;() \t\n]" value) (setq value (prin1-to-string value))) (insert (format " %s=%s" key value))))) - (insert ">\n<#/" name ">\n")) + (insert ">\n")) + +(defun mml-insert-empty-tag (name &rest plist) + "Insert an empty MML tag described by NAME and PLIST." + (when (symbolp name) + (setq name (symbol-name name))) + (apply #'mml-insert-tag name plist) + (insert "<#/" name ">\n")) ;;; Attachment functions. @@ -671,8 +803,8 @@ description of the attachment." (type (mml-minibuffer-read-type file)) (description (mml-minibuffer-read-description))) (list file type description))) - (mml-insert-tag 'part 'type type 'filename file 'disposition "attachment" - 'description description)) + (mml-insert-empty-tag 'part 'type type 'filename file + 'disposition "attachment" 'description description)) (defun mml-attach-buffer (buffer &optional type description) "Attach a buffer to the outgoing MIME message. @@ -682,8 +814,8 @@ See `mml-attach-file' for details of operation." (type (mml-minibuffer-read-type buffer "text/plain")) (description (mml-minibuffer-read-description))) (list buffer type description))) - (mml-insert-tag 'part 'type type 'buffer buffer 'disposition "attachment" - 'description description)) + (mml-insert-empty-tag 'part 'type type 'buffer buffer + 'disposition "attachment" 'description description)) (defun mml-attach-external (file &optional type description) "Attach an external file into the buffer. @@ -694,40 +826,60 @@ TYPE is the MIME type to use." (type (mml-minibuffer-read-type file)) (description (mml-minibuffer-read-description))) (list file type description))) - (mml-insert-tag 'external 'type type 'name file 'disposition "attachment" - 'description description)) + (mml-insert-empty-tag 'external 'type type 'name file + 'disposition "attachment" 'description description)) (defun mml-insert-multipart (&optional type) (interactive (list (completing-read "Multipart type (default mixed): " - '(("mixed") ("alternative") ("digest") ("parallel") - ("signed") ("encrypted")) - nil nil "mixed"))) + '(("mixed") ("alternative") ("digest") ("parallel") + ("signed") ("encrypted")) + nil nil "mixed"))) (or type (setq type "mixed")) - (mml-insert-tag "multipart" 'type type) + (mml-insert-empty-tag "multipart" 'type type) + (forward-line -1)) + +(defun mml-insert-part (&optional type) + (interactive + (list (mml-minibuffer-read-type ""))) + (mml-insert-tag 'part 'type type 'disposition "inline") (forward-line -1)) (defun mml-preview (&optional raw) - "Display current buffer with Gnus, in a new buffer. + "Display current buffer with Gnus, in a new buffer. If RAW, don't highlight the article." - (interactive "P") - (let ((buf (current-buffer))) - (switch-to-buffer (get-buffer-create - (concat (if raw "*Raw MIME preview of " - "*MIME preview of ") (buffer-name)))) - (erase-buffer) - (insert-buffer buf) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (replace-match "\n")) - (mml-to-mime) - (unless raw - (run-hooks 'gnus-article-decode-hook) - (let ((gnus-newsgroup-name "dummy")) - (gnus-article-prepare-display))) - (fundamental-mode) - (setq buffer-read-only t) - (goto-char (point-min)))) + (interactive "P") + (let ((buf (current-buffer)) + (message-options message-options) + (message-posting-charset (or (gnus-setup-posting-charset + (save-restriction + (message-narrow-to-headers-or-head) + (message-fetch-field "Newsgroups"))) + message-posting-charset))) + (message-options-set-recipient) + (switch-to-buffer (generate-new-buffer + (concat (if raw "*Raw MIME preview of " + "*MIME preview of ") (buffer-name)))) + (erase-buffer) + (insert-buffer buf) + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) + (replace-match "\n")) + (mml-to-mime) + (if raw + (when (fboundp 'set-buffer-multibyte) + (let ((s (buffer-string))) + ;; Insert the content into unibyte buffer. + (erase-buffer) + (mm-disable-multibyte) + (insert s))) + (let ((gnus-newsgroup-charset (car message-posting-charset))) + (run-hooks 'gnus-article-decode-hook) + (let ((gnus-newsgroup-name "dummy")) + (gnus-article-prepare-display)))) + (fundamental-mode) + (setq buffer-read-only t) + (goto-char (point-min)))) (defun mml-validate () "Validate the current MML document." diff --git a/lisp/mml2015.el b/lisp/mml2015.el new file mode 100644 index 0000000..126f647 --- /dev/null +++ b/lisp/mml2015.el @@ -0,0 +1,533 @@ +;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu +;; Keywords: PGP MIME MML + +;; 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: + +(eval-when-compile (require 'cl)) +(require 'mm-decode) + +(defvar mml2015-use (or + (progn + (ignore-errors + (require 'gpg)) + (and (fboundp 'gpg-sign-detached) + 'gpg)) + (progn (ignore-errors + (load "mc-toplev")) + (and (fboundp 'mc-encrypt-generic) + (fboundp 'mc-sign-generic) + (fboundp 'mc-cleanup-recipient-headers) + 'mailcrypt))) + "The package used for PGP/MIME.") + +;; Something is not RFC2015. +(defvar mml2015-function-alist + '((mailcrypt mml2015-mailcrypt-sign + mml2015-mailcrypt-encrypt + mml2015-mailcrypt-verify + mml2015-mailcrypt-decrypt + mml2015-mailcrypt-clear-verify + mml2015-mailcrypt-clear-decrypt) + (gpg mml2015-gpg-sign + mml2015-gpg-encrypt + mml2015-gpg-verify + mml2015-gpg-decrypt + mml2015-gpg-clear-verify + mml2015-gpg-clear-decrypt)) + "Alist of PGP/MIME functions.") + +(defvar mml2015-result-buffer nil) + +;;; mailcrypt wrapper + +(eval-and-compile + (autoload 'mailcrypt-decrypt "mailcrypt") + (autoload 'mailcrypt-verify "mailcrypt") + (autoload 'mc-pgp-always-sign "mailcrypt") + (autoload 'mc-encrypt-generic "mc-toplev") + (autoload 'mc-cleanup-recipient-headers "mc-toplev") + (autoload 'mc-sign-generic "mc-toplev")) + +(eval-when-compile + (defvar mc-default-scheme) + (defvar mc-schemes)) + +(defvar mml2015-decrypt-function 'mailcrypt-decrypt) +(defvar mml2015-verify-function 'mailcrypt-verify) + +(defun mml2015-mailcrypt-decrypt (handle ctl) + (catch 'error + (let (child handles result) + (unless (setq child (mm-find-part-by-type + (cdr handle) + "application/octet-stream" nil t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (with-temp-buffer + (mm-insert-part child) + (setq result + (condition-case err + (funcall mml2015-decrypt-function) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil))) + (unless (car result) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (throw 'error handle)) + (setq handles (mm-dissect-buffer t))) + (mm-destroy-parts handle) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (if (listp (car handles)) + handles + (list handles))))) + +(defun mml2015-mailcrypt-clear-decrypt () + (let (result) + (setq result + (condition-case err + (funcall mml2015-decrypt-function) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil))) + (if (car result) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed")))) + +(defun mml2015-fix-micalg (alg) + (and alg + (upcase (if (string-match "^pgp-" alg) + (substring alg (match-end 0)) + alg)))) + +(defun mml2015-mailcrypt-verify (handle ctl) + (catch 'error + (let (part) + (unless (setq part (mm-find-raw-part-by-type + ctl (or (mm-handle-multipart-ctl-parameter + ctl 'protocol) + "application/pgp-signature") + t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (with-temp-buffer + (insert "-----BEGIN PGP SIGNED MESSAGE-----\n") + (insert (format "Hash: %s\n\n" + (or (mml2015-fix-micalg + (mm-handle-multipart-ctl-parameter + ctl 'micalg)) + "SHA1"))) + (save-restriction + (narrow-to-region (point) (point)) + (insert part "\n") + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at "^-") + (insert "- ")) + (forward-line))) + (unless (setq part (mm-find-part-by-type + (cdr handle) "application/pgp-signature" nil t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (save-restriction + (narrow-to-region (point) (point)) + (mm-insert-part part) + (goto-char (point-min)) + (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t) + (replace-match "-----BEGIN PGP SIGNATURE-----" t t)) + (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t) + (replace-match "-----END PGP SIGNATURE-----" t t))) + (unless (condition-case err + (funcall mml2015-verify-function) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (throw 'error handle))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + handle))) + +(defun mml2015-mailcrypt-clear-verify () + (if (condition-case err + (funcall mml2015-verify-function) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed"))) + +(defun mml2015-mailcrypt-sign (cont) + (mc-sign-generic (message-options-get 'message-sender) + nil nil nil nil) + (let ((boundary + (funcall mml-boundary-function (incf mml-multipart-number))) + hash point) + (goto-char (point-min)) + (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t) + (error "Cannot find signed begin line." )) + (goto-char (match-beginning 0)) + (forward-line 1) + (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)") + (error "Cannot not find PGP hash." )) + (setq hash (match-string 1)) + (unless (re-search-forward "^$" nil t) + (error "Cannot not find PGP message." )) + (forward-line 1) + (delete-region (point-min) (point)) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n" + (downcase hash))) + (insert (format "\n--%s\n" boundary)) + (setq point (point)) + (goto-char (point-max)) + (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t) + (error "Cannot find signature part." )) + (replace-match "-----END PGP MESSAGE-----" t t) + (goto-char (match-beginning 0)) + (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$" + nil t) + (error "Cannot find signature part." )) + (replace-match "-----BEGIN PGP MESSAGE-----" t t) + (goto-char (match-beginning 0)) + (save-restriction + (narrow-to-region point (point)) + (goto-char point) + (while (re-search-forward "^- -" nil t) + (replace-match "-" t t)) + (goto-char (point-max))) + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-signature\n\n") + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + +(defun mml2015-mailcrypt-encrypt (cont) + (let ((mc-pgp-always-sign + (or mc-pgp-always-sign + (eq t (or (message-options-get 'message-sign-encrypt) + (message-options-set + 'message-sign-encrypt + (or (y-or-n-p "Sign the message? ") + 'not)))) + 'never))) + (mm-with-unibyte-current-buffer-mule4 + (mc-encrypt-generic + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (mc-cleanup-recipient-headers + (read-string "Recipients: ")))) + nil nil nil + (message-options-get 'message-sender)))) + (goto-char (point-min)) + (unless (looking-at "-----BEGIN PGP MESSAGE-----") + (error "Fail to encrypt the message.")) + (let ((boundary + (funcall mml-boundary-function (incf mml-multipart-number)))) + (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" + boundary)) + (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-encrypted\n\n") + (insert "Version: 1\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/octet-stream\n\n") + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + +;;; gpg wrapper + +(eval-and-compile + (autoload 'gpg-decrypt "gpg") + (autoload 'gpg-verify "gpg") + (autoload 'gpg-verify-cleartext "gpg") + (autoload 'gpg-sign-detached "gpg") + (autoload 'gpg-sign-encrypt "gpg") + (autoload 'gpg-passphrase-read "gpg")) + +(defun mml2015-gpg-passphrase () + (or (message-options-get 'gpg-passphrase) + (message-options-set 'gpg-passphrase (gpg-passphrase-read)))) + +(defun mml2015-gpg-decrypt-1 () + (let ((cipher (current-buffer)) plain result) + (if (with-temp-buffer + (prog1 + (gpg-decrypt cipher (setq plain (current-buffer)) + mml2015-result-buffer nil) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer mml2015-result-buffer + (buffer-string))) + (set-buffer cipher) + (erase-buffer) + (insert-buffer plain))) + '(t) + ;; Some wrong with the return value, check plain text buffer. + (if (> (point-max) (point-min)) + '(t) + nil)))) + +(defun mml2015-gpg-decrypt (handle ctl) + (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1)) + (mml2015-mailcrypt-decrypt handle ctl))) + +(defun mml2015-gpg-clear-decrypt () + (let (result) + (setq result (mml2015-gpg-decrypt-1)) + (if (car result) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed")))) + +(defun mml2015-gpg-verify (handle ctl) + (catch 'error + (let (part message signature) + (unless (setq part (mm-find-raw-part-by-type + ctl (or (mm-handle-multipart-ctl-parameter + ctl 'protocol) + "application/pgp-signature") + t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (with-temp-buffer + (setq message (current-buffer)) + (insert part) + (with-temp-buffer + (setq signature (current-buffer)) + (unless (setq part (mm-find-part-by-type + (cdr handle) "application/pgp-signature" nil t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (mm-insert-part part) + (unless (condition-case err + (prog1 + (gpg-verify message signature mml2015-result-buffer) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer mml2015-result-buffer + (buffer-string)))) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (throw 'error handle))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK")) + handle))) + +(defun mml2015-gpg-clear-verify () + (if (condition-case err + (prog1 + (gpg-verify-cleartext (current-buffer) mml2015-result-buffer) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer mml2015-result-buffer + (buffer-string)))) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed"))) + +(defun mml2015-gpg-sign (cont) + (let ((boundary + (funcall mml-boundary-function (incf mml-multipart-number))) + (text (current-buffer)) signature) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (with-temp-buffer + (unless (gpg-sign-detached text (setq signature (current-buffer)) + mml2015-result-buffer + nil + (message-options-get 'message-sender) + t t) ; armor & textmode + (unless (> (point-max) (point-min)) + (pop-to-buffer mml2015-result-buffer) + (error "Sign error."))) + (set-buffer text) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + ;;; FIXME: what is the micalg? + (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n") + (insert (format "\n--%s\n" boundary)) + (goto-char (point-max)) + (insert (format "\n--%s\n" boundary)) + (insert "Content-Type: application/pgp-signature\n\n") + (insert-buffer signature) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max))))) + +(defun mml2015-gpg-encrypt (cont) + (let ((boundary + (funcall mml-boundary-function (incf mml-multipart-number))) + (text (current-buffer)) + cipher) + (mm-with-unibyte-current-buffer-mule4 + (with-temp-buffer + (unless (gpg-sign-encrypt + text (setq cipher (current-buffer)) + mml2015-result-buffer + (split-string + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+") + nil + (message-options-get 'message-sender) + t t) ; armor & textmode + (unless (> (point-max) (point-min)) + (pop-to-buffer mml2015-result-buffer) + (error "Encrypt error."))) + (set-buffer text) + (delete-region (point-min) (point-max)) + (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" + boundary)) + (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-encrypted\n\n") + (insert "Version: 1\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/octet-stream\n\n") + (insert-buffer cipher) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))))) + +;;; General wrapper + +(defun mml2015-clean-buffer () + (if (gnus-buffer-live-p mml2015-result-buffer) + (with-current-buffer mml2015-result-buffer + (erase-buffer) + t) + (setq mml2015-result-buffer + (gnus-get-buffer-create "*MML2015 Result*")) + nil)) + +(defsubst mml2015-clear-decrypt-function () + (nth 6 (assq mml2015-use mml2015-function-alist))) + +(defsubst mml2015-clear-verify-function () + (nth 5 (assq mml2015-use mml2015-function-alist))) + +;;;###autoload +(defun mml2015-decrypt (handle ctl) + (mml2015-clean-buffer) + (let ((func (nth 4 (assq mml2015-use mml2015-function-alist)))) + (if func + (funcall func handle ctl) + handle))) + +;;;###autoload +(defun mml2015-decrypt-test (handle ctl) + mml2015-use) + +;;;###autoload +(defun mml2015-verify (handle ctl) + (mml2015-clean-buffer) + (let ((func (nth 3 (assq mml2015-use mml2015-function-alist)))) + (if func + (funcall func handle ctl) + handle))) + +;;;###autoload +(defun mml2015-verify-test (handle ctl) + mml2015-use) + +;;;###autoload +(defun mml2015-encrypt (cont) + (mml2015-clean-buffer) + (let ((func (nth 2 (assq mml2015-use mml2015-function-alist)))) + (if func + (funcall func cont) + (error "Cannot find encrypt function.")))) + +;;;###autoload +(defun mml2015-sign (cont) + (mml2015-clean-buffer) + (let ((func (nth 1 (assq mml2015-use mml2015-function-alist)))) + (if func + (funcall func cont) + (error "Cannot find sign function.")))) + +;;;###autoload +(defun mml2015-self-encrypt () + (mml2015-encrypt nil)) + +(provide 'mml2015) + +;;; mml2015.el ends here diff --git a/lisp/next-ur.pbm b/lisp/next-ur.pbm new file mode 100644 index 0000000000000000000000000000000000000000..678bbb09f8bb27ac63913086163e3b41e264bc5d GIT binary patch literal 81 zcmWGA;W9E&Ff!p1WE5avU}69QK8C*v$E&(A-7Zex;1h_N| j1Y86h8aNzSB-EKV1h_Z|cqj-2C`fQ9xUybhVQ>Hd!Ws;4 literal 0 HcmV?d00001 diff --git a/lisp/next-ur.xpm b/lisp/next-ur.xpm new file mode 100644 index 0000000..8c823f2 --- /dev/null +++ b/lisp/next-ur.xpm @@ -0,0 +1,66 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 36 1", +" c Gray0", +". c Gray6", +"X c Gray9", +"o c Gray12", +"O c #23f323f323f3", +"+ c Gray15", +"@ c #2ff32ff32ff3", +"# c #399939993999", +"$ c #3fff3fff3fff", +"% c #433243324332", +"& c Gray28", +"* c #4ccc4ccc4ccc", +"= c #53ed53ed53ed", +"- c #5ff05ff05ff0", +"; c Gray40", +": c #67e767e767e7", +"> c #6ccc6ccc6ccc", +", c #6fff6fff6fff", +"< c Gray45", +"1 c #77f277f277f2", +"2 c #7bdb7bdb7bdb", +"3 c #7ccc7ccc7ccc", +"4 c Gray50", +"5 c #866586658665", +"6 c Gray56", +"7 c Gray60", +"8 c #9bd39bd39bd3", +"9 c #9fff9fff9fff", +"0 c Gray65", +"q c #a7c7a7c7a7c7", +"w c Gray70", +"e c Gray75", +"r c Gray81", +"t c #dfffdfffdfff", +"y c #efffefffefff", +"u c Gray100", +/* pixels */ +"wqewqewqewqewqewqewqewqe", +"q6eq6eq6eq6eq6eq6eq6eq6e", +"eeeeeeeeeeeeeeeeeeeeeeee", +"wqewqewqewq82$.wqewqewqe", +"q6eq6eq6e6@19u$-6eq6eq6e", +"eeeeeeee==eyr$9@eeeeeeee", +"wqewq82$ruuu or=qewqewqe", +"q6e6@19uuuu94eue-eq6eq6e", +"eeew&euuuuuruuuy18eeeeee", +"wqew-8uuuuuuuuuu92wqewqe", +"q6eq619uut44uuuuu$q6eq6e", +"eeeeee29,-e@uuuuur=eeeee", +"wqeee82$rye-$uuuuu=qewqe", +"q6eq-19uu- e$uuuuue-eq6e", +"ee==eyuuu -y99uuuuy18eee", +"w&euuuuu,uuue4uuuuu92wqe", +"q@euuuuuuuuut4tuuuueoq6e", +"eq=u9$$$ruuuu4@$$r$;6eee", +"wq=8,988%ruu8,98-+6qewqe", +"q6e+wq888$et+wq888X6eq6e", +"eee+88888.4-+88888@eeeee", +"wqeO#6884,uu*5885<&qewqe", +"q6eq@#** ;; Keywords: news, mail @@ -58,13 +58,18 @@ (nnoo-define-basics nnagent) +(defun nnagent-server (server) + (and server (format "%s+%s" (car gnus-command-method) server))) + (deffoo nnagent-open-server (server &optional defs) (setq defs `((nnagent-directory ,(gnus-agent-directory)) (nnagent-active-file ,(gnus-agent-lib-file "active")) (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups")) (nnagent-get-new-mail nil))) - (nnoo-change-server 'nnagent server defs) + (nnoo-change-server 'nnagent + (nnagent-server server) + defs) (let ((dir (gnus-agent-directory)) err) (cond @@ -121,6 +126,72 @@ (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) nil) +(deffoo nnagent-request-group (group &optional server dont-check) + (nnoo-parent-function 'nnagent 'nnml-request-group + (list group (nnagent-server server) dont-check))) + +(deffoo nnagent-close-group (group &optional server) + (nnoo-parent-function 'nnagent 'nnml-close-group + (list group (nnagent-server server)))) + +(deffoo nnagent-request-accept-article (group &optional server last) + (nnoo-parent-function 'nnagent 'nnml-request-accept-article + (list group (nnagent-server server) last))) + +(deffoo nnagent-request-article (id &optional group server buffer) + (nnoo-parent-function 'nnagent 'nnml-request-article + (list id group (nnagent-server server) buffer))) + +(deffoo nnagent-request-create-group (group &optional server args) + (nnoo-parent-function 'nnagent 'nnml-request-create-group + (list group (nnagent-server server) args))) + +(deffoo nnagent-request-delete-group (group &optional force server) + (nnoo-parent-function 'nnagent 'nnml-request-delete-group + (list group force (nnagent-server server)))) + +(deffoo nnagent-request-expire-articles (articles group &optional server force) + (nnoo-parent-function 'nnagent 'nnml-request-expire-articles + (list articles group (nnagent-server server) force))) + +(deffoo nnagent-request-list (&optional server) + (nnoo-parent-function 'nnagent 'nnml-request-list + (list (nnagent-server server)))) + +(deffoo nnagent-request-list-newsgroups (&optional server) + (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups + (list (nnagent-server server)))) + +(deffoo nnagent-request-move-article + (article group server accept-form &optional last) + (nnoo-parent-function 'nnagent 'nnml-request-move-article + (list article group (nnagent-server server) + accept-form last))) + +(deffoo nnagent-request-rename-group (group new-name &optional server) + (nnoo-parent-function 'nnagent 'nnml-request-rename-group + (list group new-name (nnagent-server server)))) + +(deffoo nnagent-request-scan (&optional group server) + (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)))) + +(deffoo nnagent-server-opened (&optional server) + (nnoo-parent-function 'nnagent 'nnml-server-opened + (list (nnagent-server server)))) + +(deffoo nnagent-status-message (&optional server) + (nnoo-parent-function 'nnagent 'nnml-status-message + (list (nnagent-server server)))) + ;; Use nnml functions for just about everything. (nnoo-import nnagent (nnml)) diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 3d5c5b9..dbb2484 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -1,5 +1,7 @@ ;;; nnbabyl.el --- rmail mbox access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -30,6 +32,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nnheader) (condition-case nil (require 'rmail) @@ -260,7 +263,7 @@ (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) (deffoo nnbabyl-request-expire-articles - (articles newsgroup &optional server force) + (articles newsgroup &optional server force) (nnbabyl-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) @@ -278,6 +281,14 @@ (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnbabyl-request-article (car articles) + newsgroup server + (current-buffer)) + (let ((nnml-current-directory nil)) + (nnmail-expiry-target-group + nnmail-expiry-target newsgroup)))) (nnheader-message 5 "Deleting article %d in %s..." (car articles) newsgroup) (nnbabyl-delete-mail)) @@ -296,7 +307,7 @@ (nconc rest articles)))) (deffoo nnbabyl-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnbabyl move*")) result) (and @@ -432,9 +443,9 @@ (widen) (narrow-to-region (save-excursion - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) + (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) + (goto-char (point-min)) + (end-of-line)) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn @@ -558,10 +569,10 @@ (nnbabyl-create-mbox) (unless (and nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) + (buffer-name nnbabyl-mbox-buffer) + (save-excursion + (set-buffer nnbabyl-mbox-buffer) + (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) ;; This buffer has changed since we read it last. Possibly. (save-excursion (let ((delim (concat "^" nnbabyl-mail-delimiter)) diff --git a/lisp/nndb.el b/lisp/nndb.el index 8b71f5d..4868f01 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -77,7 +77,7 @@ "*The program used to put a message in an NNDB group.") (defvoo nndb-server-side-expiry nil - "If t, expiry calculation will occur on the server side") + "If t, expiry calculation will occur on the server side.") (defvoo nndb-set-expire-date-on-mark nil "If t, the expiry date for a given article will be set to the time @@ -146,7 +146,7 @@ article was posted to nndb") (nntp-send-command nil "X-TOUCH" article)) (deffoo nndb-request-update-mark - (group article mark) + (group article mark) "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) (nndb-touch-article group article)) @@ -293,8 +293,7 @@ Optional LAST is ignored." (list art))) (deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced -with the contents of the BUFFER." + "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." (set-buffer buffer) (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) (nnheader-insert "") diff --git a/lisp/nndir.el b/lisp/nndir.el index a46ad74..f1a6635 100644 --- a/lisp/nndir.el +++ b/lisp/nndir.el @@ -1,5 +1,7 @@ ;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 180d03c..3833395 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -1,5 +1,6 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -27,6 +28,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nnheader) (require 'message) (require 'nnmail) @@ -69,8 +71,8 @@ from the document.") (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) (forward - (article-begin . "^-+ Start of forwarded message -+\n+") - (body-end . "^-+ End of forwarded message -+$") + (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+") + (body-end . "^-+ End \\(of \\)?forwarded message.*$") (prepare-body-function . nndoc-unquote-dashes)) (rfc934 (article-begin . "^--.*\n+") @@ -85,6 +87,7 @@ from the document.") (article-transform-function . nndoc-transform-clari-briefs)) (mime-digest (article-begin . "") + (head-begin . "^ ?\n") (head-end . "^ ?$") (body-end . "") (file-end . "") @@ -122,6 +125,9 @@ from the document.") (rfc822-forward (article-begin . "^\n") (body-end-function . nndoc-rfc822-forward-body-end-function)) + (outlook + (article-begin-function . nndoc-outlook-article-begin) + (body-end . "\0")) (guess (guess . t) (subtype nil)) @@ -430,7 +436,8 @@ from the document.") t)) (defun nndoc-forward-type-p () - (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) + (when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+" + nil t) (not (re-search-forward "^Subject:.*digest" nil t)) (not (re-search-backward "^From:" nil t 2)) (not (re-search-forward "^From:" nil t 2))) @@ -524,10 +531,11 @@ from the document.") nil t) (match-beginning 1)) (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[\n \t]+")) + b-delimiter (concat "\n--" boundary-id "[ \t]*$")) (setq entry (assq 'mime-digest nndoc-type-alist)) (setcdr entry (list + (cons 'head-begin "^ ?\n") (cons 'head-end "^ ?$") (cons 'body-begin "^ ?\n") (cons 'article-begin b-delimiter) @@ -556,10 +564,7 @@ from the document.") (defun nndoc-transform-lanl-gov-announce (article) (goto-char (point-max)) (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t) - (replace-match "\n\nGet it at \\1 (\\2)" t nil)) - ;; (when (re-search-backward "^\\\\\\\\$" nil t) - ;; (replace-match "" t t)) - ) + (replace-match "\n\nGet it at \\1 (\\2)" t nil))) (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) @@ -577,8 +582,7 @@ from the document.") (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" nil t) (setq subject (concat (match-string 1) subject)) - (setq from (concat (match-string 2) " <" e-mail ">")))) - )) + (setq from (concat (match-string 2) " <" e-mail ">")))))) (while (and from (string-match "(\[^)\]*)" from)) (setq from (replace-match "" t t from))) (insert "From: " (or from "unknown") @@ -588,6 +592,14 @@ from the document.") (when (looking-at "From - ") t)) +(defun nndoc-outlook-article-begin () + (prog1 (re-search-forward "From:\\|Received:" nil t) + (goto-char (match-beginning 0)))) + +(defun nndoc-outlook-type-p () + ;; FIXME: Is JMF the magic of outlook mailbox? -- ShengHuo. + (looking-at "JMF")) + (deffoo nndoc-request-accept-article (group &optional server last) nil) @@ -689,7 +701,8 @@ PARENT is the message-ID of the parent summary line, or nil for none." subject content-type type subtype boundary-regexp) ;; Gracefully handle a missing body. (goto-char head-begin) - (if (search-forward "\n\n" body-end t) + (if (or (and (eq (char-after) ?\n) (or (forward-char 1) t)) + (search-forward "\n\n" body-end t)) (setq head-end (1- (point)) body-begin (point)) (setq head-end body-end @@ -771,7 +784,7 @@ PARENT is the message-ID of the parent summary line, or nil for none." (let ((part-counter 0) part-begin part-end eof-flag) (while (string-match "\ -^\\(Lines\\|Content-\\(Type\\|Transfer-Encoding\\)\\):.*\n\\([ \t].*\n\\)*" +^\\(Lines\\|Content-\\(Type\\|Transfer-Encoding\\|Disposition\\)\\):.*\n\\([ \t].*\n\\)*" article-insert) (setq article-insert (replace-match "" t t article-insert))) (let ((case-fold-search nil)) diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 0e765fc..71531ee 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -1,5 +1,6 @@ ;;; nndraft.el --- draft article access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -26,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nnheader) (require 'nnmail) (require 'gnus-start) @@ -33,7 +35,7 @@ (require 'nnoo) (eval-when-compile ;; This is just to shut up the byte-compiler. - (fset 'nndraft-request-group 'ignore)) + (defalias 'nndraft-request-group 'ignore)) (nnoo-declare nndraft nnmh) @@ -109,7 +111,8 @@ (newest (if (file-newer-than-file-p file auto) file auto)) (nntp-server-buffer (or buffer nntp-server-buffer))) (when (and (file-exists-p newest) - (nnmail-find-file newest)) + (let ((nnmail-file-coding-system nnheader-text-coding-system)) + (nnmail-find-file newest))) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) @@ -126,6 +129,7 @@ (when (nndraft-request-article article group server (current-buffer)) (message-remove-header "xref") (message-remove-header "lines") + (message-remove-header "date") t)) (deffoo nndraft-request-update-info (group info &optional server) @@ -134,8 +138,9 @@ info (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft "")) (nndraft-articles) t)) - (let (marks) - (when (setq marks (nth 3 info)) + (let ((marks (nth 3 info))) + (when marks + ;; Nix out all marks except the `unsend'-able article marks. (setcar (nthcdr 3 info) (if (assq 'unsend marks) (list (assq 'unsend marks)) @@ -149,7 +154,7 @@ (nndraft-possibly-change-group group) (let ((gnus-verbose-backends nil) (buf (current-buffer)) - article file) + article file) (with-temp-buffer (insert-buffer-substring buf) (setq article (nndraft-request-accept-article @@ -189,6 +194,12 @@ (nnoo-parent-function 'nndraft 'nnmh-request-accept-article (list group server last noinsert)))) +(deffoo nndraft-request-replace-article (article group buffer) + (nndraft-possibly-change-group group) + (let ((nnmail-file-coding-system nnheader-text-coding-system)) + (nnoo-parent-function 'nndraft 'nnmh-request-replace-article + (list article group buffer)))) + (deffoo nndraft-request-create-group (group &optional server args) (nndraft-possibly-change-group group) (if (file-exists-p nndraft-current-directory) @@ -242,8 +253,7 @@ nnmh-close-group nnmh-request-list nnmh-request-newsgroups - nnmh-request-move-article - nnmh-request-replace-article)) + nnmh-request-move-article)) (provide 'nndraft) diff --git a/lisp/nneething.el b/lisp/nneething.el index 3caee7b..a9c3bb6 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -1,5 +1,7 @@ ;;; nneething.el --- arbitrary file access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -27,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nnheader) (require 'nnmail) (require 'nnoo) @@ -106,7 +109,7 @@ included.") (and large (zerop (% count 20)) (nnheader-message 5 "nneething: Receiving headers... %d%%" - (/ (* count 100) number)))) + (/ (* count 100) number)))) (when large (nnheader-message 5 "nneething: Receiving headers...done")) @@ -230,13 +233,13 @@ included.") (let ((map nneething-map) prev) (while map - (if (and (member (cadar map) files) + (if (and (member (cadr (car map)) files) ;; We also remove files that have changed mod times. (equal (nth 5 (file-attributes - (nneething-file-name (cadar map)))) - (caddar map))) + (nneething-file-name (cadr (car map))))) + (cadr (cdar map)))) (progn - (push (cadar map) map-files) + (push (cadr (car map)) map-files) (setq prev map)) (setq touched t) (if prev @@ -294,8 +297,7 @@ included.") (concat "Lines: " (int-to-string (count-lines (point-min) (point-max))) "\n")) - "") - ))) + "")))) (defun nneething-from-line (uid &optional file) "Return a From header based of UID." @@ -362,9 +364,9 @@ included.") fname) (if (numberp article) (if (setq fname (cadr (assq article nneething-map))) - (concat dir fname) - (make-temp-name (concat dir "nneething"))) - (concat dir article)))) + (expand-file-name fname dir) + (make-temp-name (expand-file-name "nneething" dir))) + (expand-file-name article dir)))) (provide 'nneething) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 3146e54..fb18a1c 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1,7 +1,9 @@ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. -;; Author: Scott Byer +;; Author: ShengHuo Zhu (adding NOV) +;; Scott Byer ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: mail @@ -33,34 +35,41 @@ (require 'nnoo) (eval-when-compile (require 'cl)) (require 'gnus-util) +(require 'gnus-range) (nnoo-declare nnfolder) (defvoo nnfolder-directory (expand-file-name message-directory) "The name of the nnfolder directory.") +(defvoo nnfolder-nov-directory nil + "The name of the nnfolder NOV directory. +If nil, `nnfolder-directory' is used.") + (defvoo nnfolder-active-file - (nnheader-concat nnfolder-directory "active") + (nnheader-concat nnfolder-directory "active") "The name of the active file.") ;; I renamed this variable to something more in keeping with the general GNU ;; style. -SLB (defvoo nnfolder-ignore-active-file nil - "If non-nil, causes nnfolder to do some extra work in order to determine -the true active ranges of an mbox file. Note that the active file is still -saved, but it's values are not used. This costs some extra time when -scanning an mbox when opening it.") + "If non-nil, the active file is ignored. +This causes nnfolder to do some extra work in order to determine the +true active ranges of an mbox file. Note that the active file is +still saved, but its values are not used. This costs some extra time +when scanning an mbox when opening it.") (defvoo nnfolder-distrust-mbox nil - "If non-nil, causes nnfolder to not trust the user with respect to -inserting unaccounted for mail in the middle of an mbox file. This can greatly -slow down scans, which now must scan the entire file for unmarked messages. -When nil, scans occur forward from the last marked message, a huge -time saver for large mailboxes.") + "If non-nil, the folder will be distrusted. +This means that nnfolder will not trust the user with respect to +inserting unaccounted for mail in the middle of an mbox file. This +can greatly slow down scans, which now must scan the entire file for +unmarked messages. When nil, scans occur forward from the last marked +message, a huge time saver for large mailboxes.") (defvoo nnfolder-newsgroups-file - (concat (file-name-as-directory nnfolder-directory) "newsgroups") + (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") (defvoo nnfolder-get-new-mail t @@ -77,7 +86,7 @@ time saver for large mailboxes.") -(defconst nnfolder-version "nnfolder 1.0" +(defconst nnfolder-version "nnfolder 2.0" "nnfolder version.") (defconst nnfolder-article-marker "X-Gnus-Article-Number: " @@ -90,16 +99,29 @@ time saver for large mailboxes.") (defvoo nnfolder-buffer-alist nil) (defvoo nnfolder-scantime-alist nil) (defvoo nnfolder-active-timestamp nil) -(defvoo nnfolder-active-file-coding-system - (if (memq system-type '(windows-nt ms-dos ms-windows)) - 'raw-text-dos 'raw-text)) +(defvoo nnfolder-active-file-coding-system nnheader-text-coding-system) (defvoo nnfolder-active-file-coding-system-for-write nnmail-active-file-coding-system) -(defvoo nnfolder-file-coding-system nnfolder-active-file-coding-system) +(defvoo nnfolder-file-coding-system nnheader-text-coding-system) (defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system "Coding system for save nnfolder file. If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") +(defvoo nnfolder-nov-is-evil nil + "If non-nil, Gnus will never generate and use nov databases for mail groups. +Using nov databases will speed up header fetching considerably. +This variable shouldn't be flipped much. If you have, for some reason, +set this to t, and want to set it to nil again, you should always run +the `nnfolder-generate-active-file' command. The function will go +through all nnfolder directories and generate nov databases for them +all. This may very well take some time.") + +(defvoo nnfolder-nov-file-suffix ".nov") + +(defvoo nnfolder-nov-buffer-alist nil) + +(defvar nnfolder-nov-buffer-file-name nil) + ;;; Interface functions @@ -117,27 +139,31 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (goto-char (point-min)) (if (stringp (car articles)) 'headers - (while (setq article (pop articles)) - (set-buffer nnfolder-current-buffer) - (when (nnfolder-goto-article article) - (setq start (point)) - (setq stop (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-max)) - (insert ".\n"))) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))))) + (if (nnfolder-retrieve-headers-with-nov articles fetch-old) + 'nov + (while (setq article (pop articles)) + (set-buffer nnfolder-current-buffer) + (when (nnfolder-goto-article article) + (setq start (point)) + (setq stop (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (set-buffer nntp-server-buffer) + (insert (format "221 %d Article retrieved.\n" article)) + (insert-buffer-substring nnfolder-current-buffer start stop) + (goto-char (point-max)) + (insert ".\n"))) + (set-buffer nntp-server-buffer) + (nnheader-fold-continuation-lines) + 'headers)))))) (deffoo nnfolder-open-server (server &optional defs) (nnoo-change-server 'nnfolder server defs) (nnmail-activate 'nnfolder t) (gnus-make-directory nnfolder-directory) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (and nnfolder-nov-directory + (gnus-make-directory nnfolder-nov-directory))) (cond ((not (file-exists-p nnfolder-directory)) (nnfolder-close-server) @@ -186,11 +212,13 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (if (numberp article) (cons nnfolder-current-group article) (goto-char (point-min)) - (search-forward (concat "\n" nnfolder-article-marker)) (cons nnfolder-current-group - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point))))))))))) + (if (search-forward (concat "\n" nnfolder-article-marker) + nil t) + (string-to-int + (buffer-substring + (point) (progn (end-of-line) (point)))) + -1)))))))) (deffoo nnfolder-request-group (group &optional server dont-check) (nnfolder-possibly-change-group group server t) @@ -318,7 +346,7 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") numbers)))) (deffoo nnfolder-request-expire-articles - (articles newsgroup &optional server force) + (articles newsgroup &optional server force) (nnfolder-possibly-change-group newsgroup server) (let* ((is-old t) ;; The articles we have deleted so far. @@ -341,14 +369,23 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") nil t)) (forward-sexp) (when (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) - force nnfolder-inhibit-expiry)) - (nnheader-message 5 "Deleting article %d..." + (nnmail-expired-article-p + newsgroup + (buffer-substring + (point) (progn (end-of-line) (point))) + force nnfolder-inhibit-expiry)) + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnfolder-request-article (car maybe-expirable) + newsgroup server (current-buffer)) + (let ((nnml-current-directory nil)) + (nnmail-expiry-target-group + nnmail-expiry-target newsgroup)))) + (nnheader-message 5 "Deleting article %d in %s..." (car maybe-expirable) newsgroup) (nnfolder-delete-mail) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (nnfolder-nov-delete-article newsgroup (car maybe-expirable))) ;; Must remember which articles were actually deleted (push (car maybe-expirable) deleted-articles))) (setq maybe-expirable (cdr maybe-expirable))) @@ -386,6 +423,8 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (goto-char (point-min)) (when (nnfolder-goto-article article) (nnfolder-delete-mail)) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (nnfolder-nov-delete-article group article)) (when last (nnfolder-save-buffer) (nnfolder-adjust-min-active group) @@ -454,6 +493,15 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") nil (nnfolder-delete-mail) (insert-buffer-substring buffer) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (save-excursion + (set-buffer buffer) + (let ((headers (nnfolder-parse-head article + (point-min) (point-max)))) + (with-current-buffer (nnfolder-open-nov group) + (if (nnheader-find-nov-line article) + (delete-region (point) (progn (forward-line 1) (point)))) + (nnheader-insert-nov headers))))) (nnfolder-save-buffer) t))) @@ -464,7 +512,8 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") () ; Don't delete the articles. ;; Delete the file that holds the group. (ignore-errors - (delete-file (nnfolder-group-pathname group)))) + (delete-file (nnfolder-group-pathname group)) + (delete-file (nnfolder-group-nov-pathname group)))) ;; Remove the group from all structures. (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) @@ -480,11 +529,12 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (set-buffer nnfolder-current-buffer) (and (file-writable-p buffer-file-name) (ignore-errors - (rename-file - buffer-file-name - (let ((new-file (nnfolder-group-pathname new-name))) - (gnus-make-directory (file-name-directory new-file)) - new-file)) + (let ((new-file (nnfolder-group-pathname new-name))) + (gnus-make-directory (file-name-directory new-file)) + (rename-file buffer-file-name new-file) + (setq new-file (nnfolder-group-nov-pathname new-name)) + (rename-file (nnfolder-group-nov-pathname group) + new-file)) t) ;; That went ok, so we change the internal structures. (let ((entry (assoc group nnfolder-group-alist))) @@ -581,33 +631,52 @@ deleted. Point is left where the deleted region was." ;; Change group. (when (and group (not (equal group nnfolder-current-group))) - (nnmail-activate 'nnfolder) - (if dont-check - (setq nnfolder-current-group group - nnfolder-current-buffer nil) - ;; If we have to change groups, see if we don't already have the - ;; folder in memory. If we do, verify the modtime and destroy - ;; the folder if needed so we can rescan it. - (setq nnfolder-current-buffer - (nth 1 (assoc group nnfolder-buffer-alist))) - - ;; If the buffer is not live, make sure it isn't in the alist. If it - ;; is live, verify that nobody else has touched the file since last - ;; time. - (when (and nnfolder-current-buffer - (not (gnus-buffer-live-p nnfolder-current-buffer))) - (setq nnfolder-current-buffer nil)) - - (setq nnfolder-current-group group) - - (when (or (not nnfolder-current-buffer) - (not (verify-visited-file-modtime - nnfolder-current-buffer))) - (save-excursion - (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) - (set-buffer nnfolder-current-buffer) - (push (list group nnfolder-current-buffer) - nnfolder-buffer-alist))))))) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (nnmail-activate 'nnfolder) + (when (and (not (assoc group nnfolder-group-alist)) + (not (file-exists-p + (nnfolder-group-pathname group)))) + ;; The group doesn't exist, so we create a new entry for it. + (push (list group (cons 1 0)) nnfolder-group-alist) + (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)) + + (if dont-check + (setq nnfolder-current-group group + nnfolder-current-buffer nil) + (let (inf file) + ;; If we have to change groups, see if we don't already have the + ;; folder in memory. If we do, verify the modtime and destroy + ;; the folder if needed so we can rescan it. + (setq nnfolder-current-buffer + (nth 1 (assoc group nnfolder-buffer-alist))) + + ;; If the buffer is not live, make sure it isn't in the alist. If it + ;; is live, verify that nobody else has touched the file since last + ;; time. + (when (and nnfolder-current-buffer + (not (gnus-buffer-live-p nnfolder-current-buffer))) + (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) + nnfolder-current-buffer nil)) + + (setq nnfolder-current-group group) + + (when (or (not nnfolder-current-buffer) + (not (verify-visited-file-modtime + nnfolder-current-buffer))) + (save-excursion + (setq file (nnfolder-group-pathname group)) + ;; See whether we need to create the new file. + (unless (file-exists-p file) + (gnus-make-directory (file-name-directory file)) + (let ((nnmail-file-coding-system + (or nnfolder-file-coding-system-for-write + nnfolder-file-coding-system-for-write))) + (nnmail-write-region 1 1 file t 'nomesg))) + (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) + (set-buffer nnfolder-current-buffer) + (push (list group nnfolder-current-buffer) + nnfolder-buffer-alist))))))))) (defun nnfolder-save-mail (group-art-list) "Called narrowed to an article." @@ -652,7 +721,11 @@ deleted. Point is left where the deleted region was." (nnfolder-possibly-change-folder (car group-art)) (let ((buffer-read-only nil)) (nnfolder-normalize-buffer) - (insert-buffer-substring obuf beg end))))) + (insert-buffer-substring obuf beg end)) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (set-buffer obuf) + (nnfolder-add-nov (car group-art) (cdr group-art) + (nnfolder-parse-head nil beg end)))))) ;; Did we save it anywhere? save-list)) @@ -715,6 +788,7 @@ deleted. Point is left where the deleted region was." (defun nnfolder-read-folder (group) (let* ((file (nnfolder-group-pathname group)) + (nov (nnfolder-group-nov-pathname group)) (buffer (set-buffer (let ((nnheader-file-coding-system nnfolder-file-coding-system)) @@ -726,7 +800,7 @@ deleted. Point is left where the deleted region was." buffer (push (list group buffer) nnfolder-buffer-alist) (set-buffer-modified-p t) - (save-buffer)) + (nnfolder-save-buffer)) ;; Parse the damn thing. (save-excursion (goto-char (point-min)) @@ -743,9 +817,23 @@ deleted. Point is left where the deleted region was." (scantime (assoc group nnfolder-scantime-alist)) (minid (lsh -1 -1)) maxid start end newscantime + novbuf articles newnum buffer-read-only) (buffer-disable-undo) (setq maxid (cdr active)) + + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil + (and (file-exists-p nov) + (file-newer-than-file-p nov file))) + (unless (file-exists-p nov) + (gnus-make-directory (file-name-directory nov))) + (with-current-buffer + (setq novbuf (nnfolder-open-nov group)) + (goto-char (point-min)) + (while (not (eobp)) + (push (read novbuf) articles) + (forward-line 1)) + (setq articles (nreverse articles)))) (goto-char (point-min)) ;; Anytime the active number is 1 or 0, it is suspect. In that @@ -755,13 +843,27 @@ deleted. Point is left where the deleted region was." ;; expunge lists, etc., if we ever desired to abandon the active ;; file entirely for mboxes.) (when (or nnfolder-ignore-active-file + novbuf (< maxid 2)) (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (let ((newnum (string-to-number (match-string 0)))) - (if (nnmail-within-headers-p) - (setq maxid (max maxid newnum) - minid (min minid newnum))))) + (looking-at number)) + (setq newnum (string-to-number (match-string 0))) + (when (nnmail-within-headers-p) + (setq maxid (max maxid newnum) + minid (min minid newnum)) + (when novbuf + (if (memq newnum articles) + (setq articles (delq newnum articles)) + (let ((headers (nnfolder-parse-head newnum))) + (with-current-buffer novbuf + (nnheader-find-nov-line newnum) + (nnheader-insert-nov headers))))))) + (when (and novbuf articles) + (with-current-buffer novbuf + (dolist (article articles) + (when (nnheader-find-nov-line article) + (delete-region (point) + (progn (forward-line 1) (point))))))) (setcar active (max 1 (min minid maxid))) (setcdr active (max maxid (cdr active))) (goto-char (point-min))) @@ -775,8 +877,9 @@ deleted. Point is left where the deleted region was." (goto-char (point-max)) (unless (re-search-backward marker nil t) (goto-char (point-min))) - (when (nnmail-search-unix-mail-delim) - (goto-char (point-min)))) + ;;(when (nnmail-search-unix-mail-delim) + ;; (goto-char (point-min))) + ) ;; Keep track of the active number on our own, and insert it back ;; into the active list when we're done. Also, prime the pump to @@ -799,18 +902,30 @@ deleted. Point is left where the deleted region was." (narrow-to-region start end) (nnmail-insert-lines) (nnfolder-insert-newsgroup-line - (cons nil (nnfolder-active-number nnfolder-current-group))) + (cons nil + (setq newnum + (nnfolder-active-number nnfolder-current-group)))) + (when novbuf + (let ((headers (nnfolder-parse-head newnum (point-min) + (point-max)))) + (with-current-buffer novbuf + (goto-char (point-max)) + (nnheader-insert-nov headers)))) (widen))) (set-marker end nil) ;; Make absolutely sure that the active list reflects reality! (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) + ;; Set the scantime for this group. (setq newscantime (visited-file-modtime)) (if scantime (setcdr scantime (list newscantime)) (push (list nnfolder-current-group newscantime) nnfolder-scantime-alist)) + ;; Save nov. + (when novbuf + (nnfolder-save-nov)) (current-buffer)))))) ;;;###autoload @@ -819,6 +934,16 @@ deleted. Point is left where the deleted region was." This command does not work if you use short group names." (interactive) (nnmail-activate 'nnfolder) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (dolist (file (directory-files (or nnfolder-nov-directory + nnfolder-directory) + t + (concat + (regexp-quote nnfolder-nov-file-suffix) + "$"))) + (when (not (message-mail-file-mbox-p file)) + (ignore-errors + (delete-file file))))) (let ((files (directory-files nnfolder-directory)) file) (while (setq file (pop files)) @@ -850,6 +975,12 @@ This command does not work if you use short group names." ;; If not, we translate dots into slashes. (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) +(defun nnfolder-group-nov-pathname (group) + "Make pathname for GROUP NOV." + (let ((nnfolder-directory + (or nnfolder-nov-directory nnfolder-directory))) + (concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix))) + (defun nnfolder-save-buffer () "Save the buffer." (when (buffer-modified-p) @@ -859,7 +990,9 @@ This command does not work if you use short group names." (or nnfolder-file-coding-system-for-write nnfolder-file-coding-system)) (output-coding-system coding-system-for-write)) - (save-buffer)))) + (save-buffer))) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (nnfolder-save-nov))) (defun nnfolder-save-active (group-alist active-file) (let ((nnmail-active-file-coding-system @@ -867,6 +1000,94 @@ This command does not work if you use short group names." nnfolder-active-file-coding-system))) (nnmail-save-active group-alist active-file))) +(defun nnfolder-open-nov (group) + (or (cdr (assoc group nnfolder-nov-buffer-alist)) + (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group)))) + (save-excursion + (set-buffer buffer) + (set (make-local-variable 'nnfolder-nov-buffer-file-name) + (nnfolder-group-nov-pathname group)) + (erase-buffer) + (when (file-exists-p nnfolder-nov-buffer-file-name) + (nnheader-insert-file-contents nnfolder-nov-buffer-file-name))) + (push (cons group buffer) nnfolder-nov-buffer-alist) + buffer))) + +(defun nnfolder-save-nov () + (save-excursion + (while nnfolder-nov-buffer-alist + (when (buffer-name (cdar nnfolder-nov-buffer-alist)) + (set-buffer (cdar nnfolder-nov-buffer-alist)) + (when (buffer-modified-p) + (gnus-make-directory (file-name-directory + nnfolder-nov-buffer-file-name)) + (nnmail-write-region 1 (point-max) nnfolder-nov-buffer-file-name + nil 'nomesg)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (setq nnfolder-nov-buffer-alist (cdr nnfolder-nov-buffer-alist))))) + +(defun nnfolder-nov-delete-article (group article) + (save-excursion + (set-buffer (nnfolder-open-nov group)) + (when (nnheader-find-nov-line article) + (delete-region (point) (progn (forward-line 1) (point)))) + t)) + +(defun nnfolder-retrieve-headers-with-nov (articles &optional fetch-old) + (if (or gnus-nov-is-evil nnfolder-nov-is-evil) + nil + (let ((nov (nnfolder-group-nov-pathname nnfolder-current-group))) + (when (file-exists-p nov) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents nov) + (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)))))) + +(defun nnfolder-parse-head (&optional number b e) + "Parse the head of the current buffer." + (let ((buf (current-buffer)) + chars) + (save-excursion + (unless b + (setq b (if (nnmail-search-unix-mail-delim-backward) + (point) (point-min))) + (forward-line 1) + (setq e (if (nnmail-search-unix-mail-delim) + (point) (point-max)))) + (setq chars (- e b)) + (unless (zerop chars) + (goto-char b) + (if (search-forward "\n\n" e t) (setq e (1- (point))))) + (with-temp-buffer + (insert-buffer-substring buf b e) + ;; Fold continuation lines. + (goto-char (point-min)) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t)) + ;; Remove any tabs; they are too confusing. + (subst-char-in-region (point-min) (point-max) ?\t ? ) + (let ((headers (nnheader-parse-head t))) + (mail-header-set-chars headers chars) + (mail-header-set-number headers number) + headers))))) + +(defun nnfolder-add-nov (group article headers) + "Add a nov line for the GROUP base." + (save-excursion + (set-buffer (nnfolder-open-nov group)) + (goto-char (point-max)) + (mail-header-set-number headers article) + (nnheader-insert-nov headers))) + (provide 'nnfolder) ;;; nnfolder.el ends here diff --git a/lisp/nngateway.el b/lisp/nngateway.el index 74c556c..65bd2cc 100644 --- a/lisp/nngateway.el +++ b/lisp/nngateway.el @@ -1,5 +1,7 @@ ;;; nngateway.el --- posting news via mail gateways -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 24a31ae..a65a560 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,5 +1,8 @@ ;;; nnheader.el --- header access macros for Semi-gnus and its backends -;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. + +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -29,8 +32,13 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'static)) + (require 'mail-utils) (require 'mime) +(eval-and-compile + (autoload 'gnus-intersection "gnus-range") + (autoload 'gnus-sorted-complement "gnus-range")) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") @@ -45,14 +53,24 @@ on your system, you could say something like: \(setq nnheader-file-name-translation-alist '((?: . ?_)))") +(defvar nnheader-text-coding-system + (if (memq system-type '(windows-nt ms-dos ms-windows)) + 'raw-text-dos + 'raw-text) + "Text-safe coding system (For removing ^M). +This variable is a substitute for `mm-text-coding-system'.") + +(defvar nnheader-text-coding-system-for-write nil + "Text coding system for write. +This variable is a substitute for `mm-text-coding-system-for-write'.") + (eval-and-compile - (autoload 'nnmail-message-id "nnmail") - (autoload 'mail-position-on-field "sendmail") - (autoload 'message-remove-header "message") - (autoload 'cancel-function-timers "timers") - (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-delete-line "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util")) + (autoload 'nnmail-message-id "nnmail") + (autoload 'mail-position-on-field "sendmail") + (autoload 'message-remove-header "message") + (autoload 'gnus-point-at-eol "gnus-util") + (autoload 'gnus-delete-line "gnus-util") + (autoload 'gnus-buffer-live-p "gnus-util")) ;;; Header access macros. @@ -174,7 +192,10 @@ on your system, you could say something like: ;; Parsing headers and NOV lines. (defsubst nnheader-header-value () - (buffer-substring (match-end 0) (gnus-point-at-eol))) + (let ((pt (point))) + (prog1 + (buffer-substring (match-end 0) (std11-field-end)) + (goto-char pt)))) (defun nnheader-parse-head (&optional naked) (let ((case-fold-search t) @@ -216,7 +237,8 @@ on your system, you could say something like: ;; From. (progn (goto-char p) - (if (search-forward "\nfrom: " nil t) + (if (or (search-forward "\nfrom: " nil t) + (search-forward "\nfrom:" nil t)) (nnheader-header-value) "(nobody)")) ;; Date. (progn @@ -297,7 +319,9 @@ on your system, you could say something like: '(prog1 (if (eq (char-after) ?\t) 0 - (let ((num (ignore-errors (read (current-buffer))))) + (let ((num (condition-case nil + (read (current-buffer)) + (error nil)))) (if (numberp num) num 0))) (unless (eobp) (search-forward "\t" eol 'move)))) @@ -331,36 +355,43 @@ on your system, you could say something like: (nnheader-nov-read-integer) ; lines (if (eq (char-after) ?\n) nil - (nnheader-nov-field)) ; misc + (if (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field)) ; Xref (nnheader-nov-parse-extra)))) ; extra (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) - (insert - "\t" - (or (mime-fetch-field 'Subject header) "(none)") "\t" - (or (mime-fetch-field 'From header) "(nobody)") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) - (nnmail-message-id)) - "\t" - (or (mail-header-references header) "") "\t") - (princ (or (mail-header-chars header) 0) (current-buffer)) - (insert "\t") - (princ (or (mail-header-lines header) 0) (current-buffer)) - (insert "\t") - (when (mail-header-xref header) - (insert "Xref: " (mail-header-xref header))) - (when (or (mail-header-xref header) - (mail-header-extra header)) - (insert "\t")) - (when (mail-header-extra header) - (let ((extra (mail-header-extra header))) - (while extra - (insert (symbol-name (caar extra)) - ": " (cdar extra) "\t") - (pop extra)))) - (insert "\n")) + (let ((p (point))) + (insert + "\t" + (or (mime-entity-fetch-field header 'Subject) "(none)") "\t" + (or (mime-entity-fetch-field header 'From) "(nobody)") "\t" + (or (mail-header-date header) "") "\t" + (or (mail-header-id header) + (nnmail-message-id)) + "\t" + (or (mail-header-references header) "") "\t") + (princ (or (mail-header-chars header) 0) (current-buffer)) + (insert "\t") + (princ (or (mail-header-lines header) 0) (current-buffer)) + (insert "\t") + (when (mail-header-xref header) + (insert "Xref: " (mail-header-xref header))) + (when (or (mail-header-xref header) + (mail-header-extra header)) + (insert "\t")) + (when (mail-header-extra header) + (let ((extra (mail-header-extra header))) + (while extra + (insert (symbol-name (caar extra)) + ": " (cdar extra) "\t") + (pop extra)))) + (insert "\n") + (backward-char 1) + (while (search-backward "\n" p t) + (delete-char 1)) + (forward-line 1))) (defun nnheader-insert-header (header) (insert @@ -450,6 +481,7 @@ the line could be found." (let* ((file nil) (number (length articles)) (count 0) + (file-name-coding-system 'binary) (pathname-coding-system 'binary) (case-fold-search t) (cur (current-buffer)) @@ -745,7 +777,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (erase-buffer)) (current-buffer)) -(defvar jka-compr-compression-info-list) +(eval-when-compile (defvar jka-compr-compression-info-list)) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) (concat "\\([0-9]+\\)\\(" @@ -762,17 +794,20 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." "Regexp that matches numerical full file paths.") (defsubst nnheader-file-to-number (file) - "Take a file name and return the article number." + "Take a FILE name and return the article number." (if (string= nnheader-numerical-short-files "^[0-9]+$") (string-to-int file) (string-match nnheader-numerical-short-files file) (string-to-int (match-string 0 file)))) +(defvar nnheader-directory-files-is-safe nil + "If non-nil, Gnus believes `directory-files' is safe. +It has been reported numerous times that `directory-files' fails with +an alarming frequency on NFS mounted file systems. If it is nil, +`nnheader-directory-files-safe' is used.") + (defun nnheader-directory-files-safe (&rest args) - ;; It has been reported numerous times that `directory-files' - ;; fails with an alarming frequency on NFS mounted file systems. - ;; This function executes that function twice and returns - ;; the longest result. + "Execute `directory-files' twice and returns the longer result." (let ((first (apply 'directory-files args)) (second (apply 'directory-files args))) (if (> (length first) (length second)) @@ -780,16 +815,22 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." second))) (defun nnheader-directory-articles (dir) - "Return a list of all article files in a directory." + "Return a list of all article files in directory DIR." (mapcar 'nnheader-file-to-number - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) + (if nnheader-directory-files-is-safe + (directory-files + dir nil nnheader-numerical-short-files t) + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t)))) (defun nnheader-article-to-file-alist (dir) "Return an alist of article/file pairs in DIR." (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) + (if nnheader-directory-files-is-safe + (directory-files + dir nil nnheader-numerical-short-files t) + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t)))) (defun nnheader-fold-continuation-lines () "Fold continuation lines in the current buffer." @@ -806,14 +847,31 @@ If FULL, translate everything." (if full ;; Do complete translation. (setq leaf (copy-sequence file) - path "") + path "" + i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1))) + 2 0)) ;; We translate -- but only the file name. We leave the directory ;; alone. - (if (string-match "/[^/]+\\'" file) - ;; This is needed on NT's and stuff. - (setq leaf (substring file (1+ (match-beginning 0))) - path (substring file 0 (1+ (match-beginning 0)))) - ;; Fall back on this. + (if (and (featurep 'xemacs) + (memq system-type '(win32 w32 mswindows windows-nt))) + ;; This is needed on NT and stuff, because + ;; file-name-nondirectory is not enough to split + ;; file names, containing ':', e.g. + ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE" + ;; + ;; we are trying to correctly split such names: + ;; "d:file.name" -> "a:" "file.name" + ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc" + ;; "d:aaa\\bbb:ccc" -> "d:aaa\\" "bbb:ccc" + ;; etc. + ;; to translate then only the file name part. + (progn + (setq leaf file + path "") + (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file) + (setq leaf (substring file (match-beginning 2)) + path (substring file 0 (match-beginning 2))))) + ;; Emacs DTRT, says andrewi. (setq leaf (file-name-nondirectory file) path (file-name-directory file)))) (setq len (length leaf)) @@ -837,7 +895,7 @@ The first string in ARGS can be a format string." "Get the most recent report from BACKEND." (condition-case () (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" - backend)))) + backend)))) (error (nnheader-message 5 "")))) (defun nnheader-insert (format &rest args) @@ -852,17 +910,20 @@ without formatting." (apply 'insert format args)) t)) -(defun nnheader-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) +(static-if (fboundp 'subst-char-in-string) + (defsubst nnheader-replace-chars-in-string (string from to) + (subst-char-in-string from to string)) + (defun nnheader-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (when (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string))) (defun nnheader-replace-duplicate-chars-in-string (string from to) "Replace characters in STRING from FROM to TO." @@ -912,14 +973,14 @@ without formatting." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) ;; If this directory exists, we use it directly. - (if (file-directory-p (concat dir group)) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir - (encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnheader-pathname-coding-system) - "/"))) + (file-name-as-directory + (if (file-directory-p (concat dir group)) + (expand-file-name group dir) + ;; If not, we translate dots into slashes. + (expand-file-name (encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnheader-pathname-coding-system) + dir)))) (cond ((null file) "") ((numberp file) (int-to-string file)) (t file)))) @@ -930,7 +991,7 @@ without formatting." (and (listp form) (eq (car form) 'lambda)))) (defun nnheader-concat (dir &rest files) - "Concat DIR as directory to FILE." + "Concat DIR as directory to FILES." (apply 'concat (file-name-as-directory dir) files)) (defun nnheader-ms-strip-cr () @@ -965,8 +1026,9 @@ If FILE, find the \".../etc/PACKAGE\" file instead." (setq path (cdr path)))) result)) -(defvar ange-ftp-path-format) -(defvar efs-path-regexp) +(eval-when-compile + (defvar ange-ftp-path-format) + (defvar efs-path-regexp)) (defun nnheader-re-read-dir (path) "Re-read directory PATH if PATH is on a remote system." (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp)) @@ -1057,20 +1119,20 @@ find-file-hooks, etc. (set-buffer cur))) (defun nnheader-replace-string (from to) - "Do a fast replacement of FROM to TO from point to point-max." + "Do a fast replacement of FROM to TO from point to `point-max'." (nnheader-skeleton-replace from to)) (defun nnheader-replace-regexp (from to) - "Do a fast regexp replacement of FROM to TO from point to point-max." + "Do a fast regexp replacement of FROM to TO from point to `point-max'." (nnheader-skeleton-replace from to t)) (defun nnheader-strip-cr () "Strip all \r's from the current buffer." (nnheader-skeleton-replace "\r")) -(fset 'nnheader-run-at-time 'run-at-time) -(fset 'nnheader-cancel-timer 'cancel-timer) -(fset 'nnheader-cancel-function-timers 'cancel-function-timers) +(defalias 'nnheader-run-at-time 'run-at-time) +(defalias 'nnheader-cancel-timer 'cancel-timer) +(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) (defun nnheader-Y-or-n-p (prompt) "Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"." @@ -1089,7 +1151,7 @@ find-file-hooks, etc. (message "%s(Y/n) Yes" prompt) t))) -(when (string-match "XEmacs\\|Lucid" emacs-version) +(when (featurep 'xemacs) (require 'nnheaderxm)) (run-hooks 'nnheader-load-hook) diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index c77c11d..7ec301a 100644 --- a/lisp/nnheaderxm.el +++ b/lisp/nnheaderxm.el @@ -53,10 +53,10 @@ (message "%s(Y/n) Yes" prompt) t)))) -(fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time) -(fset 'nnheader-cancel-timer 'delete-itimer) -(fset 'nnheader-cancel-function-timers 'ignore) -(fset 'nnheader-Y-or-n-p 'nnheader-xmas-Y-or-n-p) +(defalias 'nnheader-run-at-time 'nnheader-xmas-run-at-time) +(defalias 'nnheader-cancel-timer 'delete-itimer) +(defalias 'nnheader-cancel-function-timers 'ignore) +(defalias 'nnheader-Y-or-n-p 'nnheader-xmas-Y-or-n-p) (provide 'nnheaderxm) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 9f027fb..b402c3a 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -1,5 +1,5 @@ ;;; nnimap.el --- imap backend for Gnus -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Jim Radford @@ -36,9 +36,7 @@ ;; ;; Todo, minor things: ;; -;; o Support escape characters in `message-tokenize-header' -;; o Split-fancy. -;; o Support NOV nnmail-extra-headers. +;; o Don't require half of Gnus -- backends should be standalone ;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B) ;; o Dont uid fetch 1,* in nnimap-retrive-groups (slow) ;; o Split up big fetches (1,* header especially) in smaller chunks @@ -54,19 +52,20 @@ ;; o IMAP2BIS compatibility? (RFC2061) ;; o ACAP stuff (perhaps a different project, would be nice to ACAPify ;; .newsrc.eld) -;; o What about Gnus's article editing, can we support it? +;; o What about Gnus's article editing, can we support it? NO! ;; o Use \Draft to support the draft group?? +;; o Duplicate suppression ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (eval-and-compile (require 'imap)) (require 'nnoo) (require 'nnmail) (require 'nnheader) (require 'gnus) -(require 'gnus-async) (require 'gnus-range) (require 'gnus-start) (require 'gnus-int) @@ -92,7 +91,7 @@ If nil, the first match found will be used.") "*Name of mailbox to split mail from. Mail is read from this mailbox and split according to rules in -`nnimap-split-rules'. +`nnimap-split-rule'. This can be a string or a list of strings.") @@ -114,14 +113,42 @@ element in each \"rule\" is the name of the IMAP mailbox, and the second is a regexp that nnimap will try to match on the header to find a fit. -The first element can also be a list. In that case, the first element -is the server the second element is the group on that server in which -the matching article will be stored. - The second element can also be a function. In that case, it will be called narrowed to the headers with the first element of the rule as the argument. It should return a non-nil value if it thinks that the -mail belongs in that group.") +mail belongs in that group. + +This variable can also have a function as its value, the function will +be called with the headers narrowed and should return a group where it +thinks the article should be splitted to. See `nnimap-split-fancy'. + +To allow for different split rules on different virtual servers, and +even different split rules in different inboxes on the same server, +the syntax of this variable have been extended along the lines of: + +(setq nnimap-split-rule + '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\") + (\"junk\" \"From:.*Simon\"))) + (\"my2server\" (\"INBOX\" nnimap-split-fancy)) + (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\") + (\"junk\" my-junk-func))))) + +The virtual server name is in fact a regexp, so that the same rules +may apply to several servers. In the example, the servers +\"my3server\" and \"my4server\" both use the same rules. Similarly, +the inbox string is also a regexp. The actual splitting rules are as +before, either a function, or a list with group/regexp or +group/function elements.") + +(defvar nnimap-split-predicate "UNSEEN UNDELETED" + "The predicate used to find articles to split. +If you use another IMAP client to peek on articles but always would +like nnimap to split them once it's started, you could change this to +\"UNDELETED\". Other available predicates are available in +RFC2060 section 6.4.4.") + +(defvar nnimap-split-fancy nil + "Like `nnmail-split-fancy', which see.") ;; Authorization / Privacy variables @@ -136,7 +163,7 @@ handle. Change this if -1) you want to connect with SSL. The SSL integration with IMAP is +1) you want to connect with SSL. The SSL integration with IMAP is brain-dead so you'll have to tell it specifically. 2) your server is more capable than your environment -- i.e. your @@ -160,13 +187,14 @@ Kerberos. Possible choices: kerberos4, cram-md5, login, anonymous.") (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/") - "Directory to keep NOV cache files for nnimap groups. See also -`nnimap-nov-file-name'.") + "Directory to keep NOV cache files for nnimap groups. +See also `nnimap-nov-file-name'.") (defvoo nnimap-nov-file-name "nnimap." - "NOV cache base filename. The group name and -`nnimap-nov-file-name-suffix' will be appended. A typical complete -file name would be ~/News/overview/nnimap.pdc.INBOX.ding.nov, or + "NOV cache base filename. +The group name and `nnimap-nov-file-name-suffix' will be appended. A +typical complete file name would be +~/News/overview/nnimap.pdc.INBOX.ding.nov, or ~/News/overview/nnimap/pdc/INBOX/ding/nov if `nnmail-use-long-file-names' is nil") @@ -174,13 +202,14 @@ file name would be ~/News/overview/nnimap.pdc.INBOX.ding.nov, or "Suffix for NOV cache base filename.") (defvoo nnimap-nov-is-evil nil - "If non-nil, nnimap will never generate or use a local nov database -for this backend. Using nov databases will speed up header fetching -considerably. Unlike other backends, you do not need to take special -care if you flip this variable.") + "If non-nil, nnimap will never generate or use a local nov database for this backend. +Using nov databases will speed up header fetching considerably. +Unlike other backends, you do not need to take special care if you +flip this variable.") (defvoo nnimap-expunge-on-close 'always ; 'ask, 'never - "When a IMAP group with articles marked for deletion is closed, this + "Whether to expunge a group when it is closed. +When a IMAP group with articles marked for deletion is closed, this variable determine if nnimap should actually remove the articles or not. @@ -192,11 +221,11 @@ When setting this variable to `never', you can only expunge articles by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.") (defvoo nnimap-list-pattern "*" - "A string LIMIT or list of strings with mailbox wildcards used to -limit available groups. Se below for available wildcards. + "A string LIMIT or list of strings with mailbox wildcards used to limit available groups. +See below for available wildcards. The LIMIT string can be a cons cell (REFERENCE . LIMIT), where -REFERENCE will be passed as the first parameter to LIST/LSUB. The +REFERENCE will be passed as the first parameter to LIST/LSUB. The semantics of this are server specific, on the University of Washington server you can specify a directory. @@ -207,8 +236,7 @@ There are two wildcards * and %. * matches everything, % matches everything in the current hierarchy.") (defvoo nnimap-news-groups nil - "IMAP support a news-like mode, also known as bulletin board mode, -where replies is sent via IMAP instead of SMTP. + "IMAP support a news-like mode, also known as bulletin board mode, where replies is sent via IMAP instead of SMTP. This variable should contain a regexp matching groups where you wish replies to be stored to the mailbox directly. @@ -219,12 +247,12 @@ Example: This will match all groups not beginning with \"INBOX\". Note that there is nothing technically different between mail-like and -news-like mailboxes. If you wish to have a group with todo items or +news-like mailboxes. If you wish to have a group with todo items or similar which you wouldn't want to set up a mailing list for, you can use this to make replies go directly to the group.") (defvoo nnimap-server-address nil - "Obsolete. Use `nnimap-address'.") + "Obsolete. Use `nnimap-address'.") (defcustom nnimap-authinfo-file "~/.authinfo" "Authorization information for IMAP servers. In .netrc format." @@ -244,8 +272,7 @@ use this to make replies go directly to the group.") (string :format "Password: %v"))))))) (defcustom nnimap-prune-cache t - "If non-nil, nnimap check wheter articles still exist on server -before using data stored in NOV cache." + "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache." :type 'boolean) (defvar nnimap-request-list-method 'imap-mailbox-list @@ -255,7 +282,9 @@ restrict visible folders.") ;; Internal variables: -(defvar nnimap-debug nil) ;; "*nnimap-debug*") +(defvar nnimap-debug nil + "Name of buffer to record debugging info. +For example: (setq nnimap-debug \"*nnimap-debug*\")") (defvar nnimap-current-move-server nil) (defvar nnimap-current-move-group nil) (defvar nnimap-current-move-article nil) @@ -267,28 +296,16 @@ restrict visible folders.") "Gnus callback the nnimap asynchronous callback should call.") (defvar nnimap-callback-buffer nil "Which buffer the asynchronous article prefetch callback should work in.") - -;; Various server variables. +(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers. +(defvar nnimap-current-server nil) ;; Current server +(defvar nnimap-server-buffer nil) ;; Current servers' buffer -;; Internal variables. -(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers. -(defvar nnimap-current-server nil) ;; Current server -(defvar nnimap-server-buffer nil) ;; Current servers' buffer (nnoo-define-basics nnimap) ;; Utility functions: -(defun nnimap-replace-in-string (string regexp to) - "Replace substrings in STRING matching REGEXP with TO." - (if (string-match regexp string) - (concat (substring string 0 (match-beginning 0)) - to - (nnimap-replace-in-string (substring string (match-end 0)) - regexp to)) - string)) - (defsubst nnimap-get-server-buffer (server) "Return buffer for SERVER, if nil use current server." (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist))) @@ -305,15 +322,39 @@ If SERVER is nil, uses the current server." group (gnus-server-to-method (format "nnimap:%s" server)))) (new-uidvalidity (imap-mailbox-get 'uidvalidity)) - (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))) + (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)) + (dir (file-name-as-directory (expand-file-name nnimap-directory))) + (nameuid (nnheader-translate-file-chars + (concat nnimap-nov-file-name + (if (equal server "") + "unnamed" + server) "." group "." old-uidvalidity + nnimap-nov-file-name-suffix) t)) + (file (if (or nnmail-use-long-file-names + (file-exists-p (expand-file-name nameuid dir))) + (expand-file-name nameuid dir) + (expand-file-name + (encode-coding-string + (nnheader-replace-chars-in-string nameuid ?. ?/) + nnmail-pathname-coding-system) + dir)))) (if old-uidvalidity (if (not (equal old-uidvalidity new-uidvalidity)) - nil ;; uidvalidity clash + ;; uidvalidity clash + (gnus-delete-file file) (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity) t) (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity)) t))) +(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))) + (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." @@ -340,7 +381,7 @@ If EXAMINE is non-nil the group is selected read-only." (zerop (imap-mailbox-get 'exists group)) (yes-or-no-p (format - "nnimap: Group %s is not uidvalid. Continue? " group))) + "nnimap: Group %s is not uidvalid. Continue? " group))) imap-current-mailbox (imap-mailbox-unselect) (error "nnimap: Group %s is not uid-valid." group)) @@ -367,39 +408,34 @@ If EXAMINE is non-nil the group is selected read-only." nnimap-progress-how-often) nnimap-progress-chars))) (with-current-buffer nntp-server-buffer - (nnheader-insert-nov - (with-current-buffer nnimap-server-buffer - (make-full-mail-header - imap-current-message - (or (nnimap-replace-whitespace - (imap-message-envelope-subject imap-current-message)) - "(none)") - (nnimap-replace-whitespace - (imap-envelope-from - (car-safe (imap-message-envelope-from - imap-current-message)))) - (nnimap-replace-whitespace - (imap-message-envelope-date imap-current-message)) - (nnimap-replace-whitespace - (imap-message-envelope-message-id imap-current-message)) - (nnimap-replace-whitespace - (let ((str (if (imap-capability 'IMAP4rev1) - (nth 2 (assoc - "HEADER.FIELDS REFERENCES" - (imap-message-get - imap-current-message 'BODYDETAIL))) - (imap-message-get imap-current-message - 'RFC822.HEADER)))) - (if (> (length str) (length "References: ")) - (substring str (length "References: ")) - (if (and (setq str (imap-message-envelope-in-reply-to - imap-current-message)) - (string-match "<[^>]+>" str)) - (substring str (match-beginning 0) (match-end 0)))))) - (imap-message-get imap-current-message 'RFC822.SIZE) - (imap-body-lines (imap-message-body imap-current-message)) - nil ;; xref - nil))))) ;; extra-headers + (let (headers lines chars uid mbx) + (with-current-buffer nnimap-server-buffer + (setq uid imap-current-message + mbx imap-current-mailbox + headers (nnimap-demule + (if (imap-capability 'IMAP4rev1) + ;; xxx don't just use car? alist doesn't contain + ;; anything else now, but it might... + (nth 2 (car (imap-message-get uid 'BODYDETAIL))) + (imap-message-get uid 'RFC822.HEADER))) + lines (imap-body-lines (imap-message-body imap-current-message)) + chars (imap-message-get imap-current-message 'RFC822.SIZE))) + (nnheader-insert-nov + (with-temp-buffer + (buffer-disable-undo) + (insert headers) + (nnheader-fold-continuation-lines) + (subst-char-in-region (point-min) (point-max) ?\t ? ) + (nnheader-ms-strip-cr) + (nnheader-fold-continuation-lines) + (subst-char-in-region (point-min) (point-max) ?\t ? ) + (let ((head (nnheader-parse-head 'naked))) + (mail-header-set-number head uid) + (mail-header-set-chars head chars) + (mail-header-set-lines head lines) + (mail-header-set-xref + head (format "%s %s:%d" (system-name) mbx uid)) + head)))))) (defun nnimap-retrieve-which-headers (articles fetch-old) "Get a range of articles to fetch based on ARTICLES and FETCH-OLD." @@ -407,7 +443,7 @@ If EXAMINE is non-nil the group is selected read-only." (if (numberp (car-safe articles)) (imap-search (concat "UID " - (nnimap-range-to-string + (imap-range-to-message-set (gnus-compress-sequence (append (gnus-uncompress-sequence (and fetch-old @@ -418,23 +454,53 @@ If EXAMINE is non-nil the group is selected read-only." articles))))) (mapcar (lambda (msgid) (imap-search - (format "HEADER Message-Id %s" msgid))) + (format "HEADER Message-Id \"%s\"" msgid))) articles)))) (defun nnimap-group-overview-filename (group server) "Make pathname for GROUP on SERVER." - (let ((dir (file-name-as-directory (expand-file-name nnimap-directory))) - (file (nnheader-translate-file-chars - (concat nnimap-nov-file-name - (if (equal server "") - "unnamed" - server) "." group nnimap-nov-file-name-suffix) t))) - (if (or nnmail-use-long-file-names - (file-exists-p (concat dir file))) - (concat dir file) - (concat dir (encode-coding-string - (nnheader-replace-chars-in-string file ?. ?/) - nnmail-pathname-coding-system))))) + (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) + (uidvalidity (gnus-group-get-parameter + (gnus-group-prefixed-name + group (gnus-server-to-method + (format "nnimap:%s" server))) + 'uidvalidity)) + (name (nnheader-translate-file-chars + (concat nnimap-nov-file-name + (if (equal server "") + "unnamed" + server) "." group nnimap-nov-file-name-suffix) t)) + (nameuid (nnheader-translate-file-chars + (concat nnimap-nov-file-name + (if (equal server "") + "unnamed" + server) "." group "." uidvalidity + nnimap-nov-file-name-suffix) t)) + (oldfile (if (or nnmail-use-long-file-names + (file-exists-p (expand-file-name name dir))) + (expand-file-name name dir) + (expand-file-name + (encode-coding-string + (nnheader-replace-chars-in-string name ?. ?/) + nnmail-pathname-coding-system) + dir))) + (newfile (if (or nnmail-use-long-file-names + (file-exists-p (expand-file-name nameuid dir))) + (expand-file-name nameuid dir) + (expand-file-name + (encode-coding-string + (nnheader-replace-chars-in-string nameuid ?. ?/) + nnmail-pathname-coding-system) + dir)))) + (when (and (file-exists-p oldfile) (not (file-exists-p newfile))) + (message "nnimap: Upgrading novcache filename...") + (sit-for 1) + (gnus-make-directory (file-name-directory newfile)) + (unless (ignore-errors (rename-file oldfile newfile) t) + (if (ignore-errors (copy-file oldfile newfile) t) + (delete-file oldfile) + (error "Can't rename `%s' to `%s'" oldfile newfile)))) + newfile)) (defun nnimap-retrieve-headers-from-file (group server) (with-current-buffer nntp-server-buffer @@ -442,13 +508,11 @@ If EXAMINE is non-nil the group is selected read-only." (when (file-exists-p nov) (nnheader-insert-file-contents nov) (set-buffer-modified-p nil) - (let ((min (progn (goto-char (point-min)) - (when (not (eobp)) - (read (current-buffer))))) - (max (progn (goto-char (point-max)) - (forward-line -1) - (when (not (bobp)) - (read (current-buffer)))))) + (let ((min (ignore-errors (goto-char (point-min)) + (read (current-buffer)))) + (max (ignore-errors (goto-char (point-max)) + (forward-line -1) + (read (current-buffer))))) (if (and (numberp min) (numberp max)) (cons min max) ;; junk, remove it, it's saved later @@ -460,11 +524,16 @@ If EXAMINE is non-nil the group is selected read-only." (let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress)) (nnimap-length (gnus-range-length articles)) (nnimap-counter 0)) - (imap-fetch (nnimap-range-to-string articles) - (concat "(UID RFC822.SIZE ENVELOPE BODY " - (if (imap-capability 'IMAP4rev1) - "BODY.PEEK[HEADER.FIELDS (References)])" - "RFC822.HEADER.LINES (References))"))) + (imap-fetch (imap-range-to-message-set articles) + (concat "(UID RFC822.SIZE BODY " + (let ((headers + (append '(Subject From Date Message-Id + References In-Reply-To Xref) + (copy-sequence + nnmail-extra-headers)))) + (if (imap-capability 'IMAP4rev1) + (format "BODY.PEEK[HEADER.FIELDS %s])" headers) + (format "RFC822.HEADER.LINES %s)" headers))))) (and (numberp nnmail-large-newsgroup) (> nnimap-length nnmail-large-newsgroup) (nnheader-message 6 "nnimap: Retrieving headers...done"))))) @@ -506,8 +575,8 @@ If EXAMINE is non-nil the group is selected read-only." ;; remove nov's for articles which has expired on server (goto-char (point-min)) (dolist (uid (gnus-set-difference articles uids)) - (when (re-search-forward (format "^%d\t" uid) nil t) - (gnus-delete-line))))) + (when (re-search-forward (format "^%d\t" uid) nil t) + (gnus-delete-line))))) ;; nothing cached, fetch whole range from server (nnimap-retrieve-headers-from-server (cons low high) group server)) @@ -526,15 +595,15 @@ If EXAMINE is non-nil the group is selected read-only." (imap-capability 'IMAP4rev1 nnimap-server-buffer)) (imap-close nnimap-server-buffer) (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server)) - (let (list alist user passwd) - (and (fboundp 'gnus-parse-netrc) - (setq list (gnus-parse-netrc nnimap-authinfo-file) - alist (or (and (gnus-netrc-get - (gnus-netrc-machine list server) "machine") - (gnus-netrc-machine list server)) - (gnus-netrc-machine list nnimap-address)) - user (gnus-netrc-get alist "login") - passwd (gnus-netrc-get alist "password"))) + (let* ((list (gnus-parse-netrc nnimap-authinfo-file)) + (port (if nnimap-server-port + (int-to-string nnimap-server-port) + "imap")) + (alist (gnus-netrc-machine list (or nnimap-server-address + nnimap-address server) + port "imap")) + (user (gnus-netrc-get alist "login")) + (passwd (gnus-netrc-get alist "password"))) (if (imap-authenticate user passwd nnimap-server-buffer) (prog1 (push (list server nnimap-server-buffer) @@ -558,13 +627,16 @@ If EXAMINE is non-nil the group is selected read-only." (cadr (assq 'nnimap-server-address defs))) defs) (push (list 'nnimap-address server) defs))) (nnoo-change-server 'nnimap server defs) + (with-current-buffer (get-buffer-create nnimap-server-buffer) + (nnoo-change-server 'nnimap server defs)) (or (and nnimap-server-buffer (imap-opened nnimap-server-buffer)) (nnimap-open-connection server)))) (deffoo nnimap-server-opened (&optional server) - "If SERVER is the current virtual server, and the connection to the -physical server is alive, this function return a non-nil value. If + "Whether SERVER is opened. +If SERVER is the current virtual server, and the connection to the +physical server is alive, this function return a non-nil value. If SERVER is nil, it is treated as the current server." ;; clean up autologouts?? (and (or server nnimap-current-server) @@ -572,8 +644,8 @@ SERVER is nil, it is treated as the current server." (imap-opened (nnimap-get-server-buffer server)))) (deffoo nnimap-close-server (&optional server) - "Close connection to server and free all resources connected to -it. Return nil if the server couldn't be closed for some reason." + "Close connection to server and free all resources connected to it. +Return nil if the server couldn't be closed for some reason." (let ((server (or server nnimap-current-server))) (when (or (nnimap-server-opened server) (imap-opened (nnimap-get-server-buffer server))) @@ -586,9 +658,9 @@ it. Return nil if the server couldn't be closed for some reason." (nnoo-close-server 'nnimap server))) (deffoo nnimap-request-close () - "Close connection to all servers and free all resources that the -backend have reserved. All buffers that have been created by that -backend should be killed. (Not the nntp-server-buffer, though.) This + "Close connection to all servers and free all resources that the backend have reserved. +All buffers that have been created by that +backend should be killed. (Not the nntp-server-buffer, though.) This function is generally only called when Gnus is shutting down." (mapcar (lambda (server) (nnimap-close-server (car server))) nnimap-server-buffer-alist) @@ -611,32 +683,39 @@ function is generally only called when Gnus is shutting down." (with-current-buffer nnimap-callback-buffer (insert (with-current-buffer nnimap-server-buffer - (nnimap-demule (imap-message-get (imap-current-message) 'RFC822)))) ;xxx + (if (imap-capability 'IMAP4rev1) + ;; xxx don't just use car? alist doesn't contain + ;; anything else now, but it might... + (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL))) + (imap-message-get (imap-current-message) 'RFC822)))) (nnheader-ms-strip-cr) (funcall nnimap-callback-callback-function t))) -(defun nnimap-request-article-part (article part prop - &optional group server to-buffer) +(defun nnimap-request-article-part (article part prop &optional + group server to-buffer detail) (when (nnimap-possibly-change-group group server) (let ((article (if (stringp article) (car-safe (imap-search - (format "HEADER Message-Id %s" article) + (format "HEADER Message-Id \"%s\"" article) nnimap-server-buffer)) article))) (when article - (gnus-message 9 "nnimap: Fetching (part of) article %d..." article) + (gnus-message 10 "nnimap: Fetching (part of) article %d..." article) (if (not nnheader-callback-function) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) - (insert (nnimap-demule (imap-fetch article part prop nil - nnimap-server-buffer))) - (nnheader-ms-strip-cr) - (gnus-message 9 "nnimap: Fetching (part of) article %d...done" - article) - (if (bobp) - (nnheader-report 'nnimap "No such article: %s" - (imap-error-text nnimap-server-buffer)) - (cons group article))) + (let ((data (imap-fetch article part prop nil + nnimap-server-buffer))) + (when data + (insert (if detail (nth 2 (car data)) data)) + (nnheader-ms-strip-cr) + (gnus-message 10 + "nnimap: Fetching (part of) article %d...done" + article) + (if (bobp) + (nnheader-report 'nnimap "No such article: %s" + (imap-error-text nnimap-server-buffer)) + (cons group article))))) (add-hook 'imap-fetch-data-hook 'nnimap-callback) (setq nnimap-callback-callback-function nnheader-callback-function nnimap-callback-buffer nntp-server-buffer) @@ -647,16 +726,25 @@ function is generally only called when Gnus is shutting down." t) (deffoo nnimap-request-article (article &optional group server to-buffer) - (nnimap-request-article-part - article "RFC822.PEEK" 'RFC822 group server to-buffer)) + (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) + (nnimap-request-article-part + article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer 'detail) + (nnimap-request-article-part + article "RFC822.PEEK" 'RFC822 group server to-buffer))) (deffoo nnimap-request-head (article &optional group server to-buffer) - (nnimap-request-article-part - article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer)) + (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) + (nnimap-request-article-part + article "BODY.PEEK[HEADER]" 'BODYDETAIL group server to-buffer 'detail) + (nnimap-request-article-part + article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer))) (deffoo nnimap-request-body (article &optional group server to-buffer) - (nnimap-request-article-part - article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer)) + (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) + (nnimap-request-article-part + article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer 'detail) + (nnimap-request-article-part + article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer))) (deffoo nnimap-request-group (group &optional server fast) (nnimap-request-update-info-internal @@ -665,6 +753,7 @@ function is generally only called when Gnus is shutting down." group (gnus-server-to-method (format "nnimap:%s" server)))) server) (when (nnimap-possibly-change-group group server) + (nnimap-before-find-minmax-bugworkaround) (let (info) (cond (fast group) ((null (setq info (nnimap-find-minmax-uid group t))) @@ -708,6 +797,7 @@ function is generally only called when Gnus is shutting down." (erase-buffer)) (gnus-message 5 "nnimap: Generating active list%s..." (if (> (length server) 0) (concat " for " server) "")) + (nnimap-before-find-minmax-bugworkaround) (with-current-buffer nnimap-server-buffer (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) (dolist (mbx (funcall nnimap-request-list-method @@ -715,20 +805,19 @@ function is generally only called when Gnus is shutting down." (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) (let ((info (nnimap-find-minmax-uid mbx 'examine))) (when info - ;; Escape SPC in mailboxes xxx relies on gnus internals (with-current-buffer nntp-server-buffer - (insert (format "%s %d %d y\n" - (nnimap-replace-in-string mbx " " "\\ ") - (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))))))))) + (insert (format "\"%s\" %d %d y\n" + mbx (or (nth 2 info) 0) + (max 1 (or (nth 1 info) 1))))))))))) (gnus-message 5 "nnimap: Generating active list%s...done" (if (> (length server) 0) (concat " for " server) "")) t)) (deffoo nnimap-request-post (&optional server) (let ((success t)) - (dolist (mbx (message-tokenize-header - (message-fetch-field "Newsgroups")) success) + (dolist (mbx (message-unquote-tokens + (message-tokenize-header + (message-fetch-field "Newsgroups") ", ")) success) (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) @@ -750,22 +839,21 @@ function is generally only called when Gnus is shutting down." (gnus-message 5 "nnimap: Checking mailboxes...") (with-current-buffer nntp-server-buffer (erase-buffer) + (nnimap-before-find-minmax-bugworkaround) (dolist (group groups) (gnus-message 7 "nnimap: Checking mailbox %s" group) (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group nnimap-server-buffer)) (let ((info (nnimap-find-minmax-uid group 'examine))) - ;; Escape SPC in mailboxes xxx relies on gnus internals - (insert (format "211 %d %d %d %s\n" (or (nth 0 info) 0) - (max 1 (or (nth 1 info) 1)) + (insert (format "\"%s\" %d %d y\n" group (or (nth 2 info) 0) - (nnimap-replace-in-string group " " "\\ "))))))) + (max 1 (or (nth 1 info) 1)))))))) (gnus-message 5 "nnimap: Checking mailboxes...done") - 'groups)) + 'active)) (deffoo nnimap-request-update-info-internal (group info &optional server) (when (nnimap-possibly-change-group group server) - (when info ;; xxx what does this mean? should we create a info? + (when info;; xxx what does this mean? should we create a info? (with-current-buffer nnimap-server-buffer (gnus-message 5 "nnimap: Updating info for %s..." (gnus-info-group info)) @@ -792,19 +880,31 @@ function is generally only called when Gnus is shutting down." seen)) (gnus-info-set-read info seen))) - (mapc (lambda (pred) - (when (and (nnimap-mark-permanent-p (cdr pred)) - (member (nnimap-mark-to-flag (cdr pred)) - (imap-mailbox-get 'flags))) - (gnus-info-set-marks - info - (nnimap-update-alist-soft - (cdr pred) - (gnus-compress-sequence - (imap-search (nnimap-mark-to-predicate (cdr pred)))) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) + (mapcar (lambda (pred) + (when (and (nnimap-mark-permanent-p (cdr pred)) + (member (nnimap-mark-to-flag (cdr pred)) + (imap-mailbox-get 'flags))) + (gnus-info-set-marks + info + (nnimap-update-alist-soft + (cdr pred) + (gnus-compress-sequence + (imap-search (nnimap-mark-to-predicate (cdr pred)))) + (gnus-info-marks info)) + t))) + gnus-article-mark-lists) + + ;; nnimap mark dormant article as ticked too (for other clients) + ;; so we remove that mark for gnus since we support dormant + (gnus-info-set-marks + info + (nnimap-update-alist-soft + 'tick + (gnus-remove-from-range + (cdr-safe (assoc 'tick (gnus-info-marks info))) + (cdr-safe (assoc 'dormant (gnus-info-marks info)))) + (gnus-info-marks info)) + t) (gnus-message 5 "nnimap: Updating info for %s...done" (gnus-info-group info)) @@ -840,19 +940,24 @@ function is generally only called when Gnus is shutting down." (when (and range marks) (cond ((eq what 'del) (imap-message-flags-del - (nnimap-range-to-string range) + (imap-range-to-message-set range) (nnimap-mark-to-flag marks nil t))) ((eq what 'add) (imap-message-flags-add - (nnimap-range-to-string range) + (imap-range-to-message-set range) (nnimap-mark-to-flag marks nil t))) ((eq what 'set) (imap-message-flags-set - (nnimap-range-to-string range) + (imap-range-to-message-set range) (nnimap-mark-to-flag marks nil t))))))) (gnus-message 7 "nnimap: Setting marks in %s...done" group)))) nil) +(defun nnimap-split-fancy () + "Like nnmail-split-fancy, but uses nnimap-split-fancy." + (let ((nnmail-split-fancy nnimap-split-fancy)) + (nnmail-split-fancy))) + (defun nnimap-split-to-groups (rules) ;; tries to match all rules in nnimap-split-rule against content of ;; nntp-server-buffer, returns a list of groups that matched. @@ -883,8 +988,21 @@ function is generally only called when Gnus is shutting down." (or nnimap-split-crosspost (throw 'split-done to-groups)))))))))) +(defun nnimap-assoc-match (key alist) + (let (element) + (while (and alist (not element)) + (if (string-match (car (car alist)) key) + (setq element (car alist))) + (setq alist (cdr alist))) + element)) + (defun nnimap-split-find-rule (server inbox) - nnimap-split-rule) + (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule)) + (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) + ;; extended format + (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match + server nnimap-split-rule)))) + nnimap-split-rule)) (defun nnimap-split-find-inbox (server) (if (listp nnimap-split-inbox) @@ -897,11 +1015,11 @@ function is generally only called when Gnus is shutting down." (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server))) ;; iterate over inboxes (while (and (setq inbox (pop inboxes)) - (nnimap-possibly-change-group inbox)) ;; SELECT + (nnimap-possibly-change-group inbox));; SELECT ;; find split rule for this server / inbox (when (setq rule (nnimap-split-find-rule server inbox)) ;; iterate over articles - (dolist (article (imap-search "UNSEEN UNDELETED")) + (dolist (article (imap-search nnimap-split-predicate)) (when (nnimap-request-head article) ;; copy article to right group(s) (setq removeorig nil) @@ -920,7 +1038,7 @@ function is generally only called when Gnus is shutting down." (and removeorig (imap-message-flags-add (format "%d" article) "\\Seen \\Deleted"))))) - (when (imap-mailbox-select inbox) ;; just in case + (when (imap-mailbox-select inbox);; just in case ;; todo: UID EXPUNGE (if available) to remove splitted articles (imap-mailbox-expunge) (imap-mailbox-close))) @@ -935,23 +1053,21 @@ function is generally only called when Gnus is shutting down." (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..." (if (> (length server) 0) " on " "") server) (erase-buffer) + (nnimap-before-find-minmax-bugworkaround) (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) - (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil + (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil nnimap-server-buffer)) - (or (let ((mailboxes (imap-mailbox-get 'list-flags mbx - nnimap-server-buffer))) - (while (and mailboxes - (not (string-equal (downcase (car mailboxes)) - "\\noselect"))) - (pop mailboxes)) - mailboxes) - ;; Escape SPC in mailboxes xxx relies on gnus internals + (or (catch 'found + (dolist (mailbox (imap-mailbox-get 'list-flags mbx + nnimap-server-buffer)) + (if (string= (downcase mailbox) "\\noselect") + (throw 'found t))) + nil) (let ((info (nnimap-find-minmax-uid mbx 'examine))) (when info - (insert (format "%s %d %d y\n" - (nnimap-replace-in-string mbx " " "\\ ") - (or (nth 2 info) 0) + (insert (format "\"%s\" %d %d y\n" + mbx (or (nth 2 info) 0) (max 1 (or (nth 1 info) 1))))))))) (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" (if (> (length server) 0) " on " "") server)) @@ -991,25 +1107,25 @@ function is generally only called when Gnus is shutting down." (with-current-buffer nnimap-server-buffer (if force (and (imap-message-flags-add - (nnimap-range-to-string artseq) "\\Deleted") + (imap-range-to-message-set artseq) "\\Deleted") (setq articles nil)) (let ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function group)) nnmail-expiry-wait))) (cond ((eq days 'immediate) (and (imap-message-flags-add - (nnimap-range-to-string artseq) "\\Deleted") + (imap-range-to-message-set artseq) "\\Deleted") (setq articles nil))) ((numberp days) (let ((oldarts (imap-search (format "UID %s NOT SINCE %s" - (nnimap-range-to-string artseq) + (imap-range-to-message-set artseq) (nnimap-date-days-ago days)))) (imap-fetch-data-hook '(nnimap-request-expire-articles-progress))) (and oldarts (imap-message-flags-add - (nnimap-range-to-string + (imap-range-to-message-set (gnus-compress-sequence oldarts)) "\\Deleted") (setq articles (gnus-set-difference @@ -1049,13 +1165,18 @@ function is generally only called when Gnus is shutting down." nnimap-current-move-article) group 'dontcreate nil nnimap-server-buffer)) - ;; turn into rfc822 format (\r\n eol's) (with-current-buffer (current-buffer) (goto-char (point-min)) + ;; remove any 'From blabla' lines, some IMAP servers + ;; reject the entire message otherwise. + (when (looking-at "^From[^:]") + (kill-region (point) (progn (forward-line) (point)))) + ;; turn into rfc822 format (\r\n eol's) (while (search-forward "\n" nil t) (replace-match "\r\n"))) - ;; next line for Cyrus server bug - (imap-mailbox-unselect nnimap-server-buffer) + ;; this 'or' is for Cyrus server bug + (or (null (imap-current-mailbox nnimap-server-buffer)) + (imap-mailbox-unselect nnimap-server-buffer)) (imap-message-append group (current-buffer) nil nil nnimap-server-buffer))) (cons group (nth 1 uid)) @@ -1080,7 +1201,8 @@ function is generally only called when Gnus is shutting down." (defun nnimap-acl-get (mailbox server) (when (nnimap-possibly-change-server server) - (imap-mailbox-acl-get mailbox nnimap-server-buffer))) + (and (imap-capability 'ACL nnimap-server-buffer) + (imap-mailbox-acl-get mailbox nnimap-server-buffer)))) (defun nnimap-acl-edit (mailbox method old-acls new-acls) (when (nnimap-possibly-change-server (cadr method)) @@ -1090,18 +1212,18 @@ function is generally only called when Gnus is shutting down." ;; delete all removed identifiers (mapcar (lambda (old-acl) (unless (assoc (car old-acl) new-acls) - (or (imap-mailbox-acl-delete (car old-acl) mailbox) - (error "Can't delete ACL for %s" (car old-acl))))) + (or (imap-mailbox-acl-delete (car old-acl) mailbox) + (error "Can't delete ACL for %s" (car old-acl))))) old-acls) ;; set all changed acl's (mapcar (lambda (new-acl) (let ((new-rights (cdr new-acl)) (old-rights (cdr (assoc (car new-acl) old-acls)))) - (unless (and old-rights new-rights - (string= old-rights new-rights)) - (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) - (error "Can't set ACL for %s to %s" (car new-acl) - new-rights))))) + (unless (and old-rights new-rights + (string= old-rights new-rights)) + (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) + (error "Can't set ACL for %s to %s" (car new-acl) + new-rights))))) new-acls) t))) @@ -1116,12 +1238,12 @@ function is generally only called when Gnus is shutting down." ;; predicate => "SEEN", "FLAGGED", "DRAFT", "KEYWORD gnus-expire" etc ;; ;; Mark should not really contain 'read since it's not a "mark" in the Gnus -;; world, but we cheat. Mark == gnus-article-mark-lists + '(read . read). +;; world, but we cheat. Mark == gnus-article-mark-lists + '(read . read). ;; (defconst nnimap-mark-to-predicate-alist (mapcar - (lambda (pair) ; cdr is the mark + (lambda (pair) ; cdr is the mark (or (assoc (cdr pair) '((read . "SEEN") (tick . "FLAGGED") @@ -1132,9 +1254,9 @@ function is generally only called when Gnus is shutting down." (cons '(read . read) gnus-article-mark-lists))) (defun nnimap-mark-to-predicate (pred) - "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP -predicate (a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD -gnus-expire\") to be used within a IMAP SEARCH query." + "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP predicate. +This is a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD gnus-expire\", +to be used within a IMAP SEARCH query." (cdr (assq pred nnimap-mark-to-predicate-alist))) (defconst nnimap-mark-to-flag-alist @@ -1156,8 +1278,8 @@ gnus-expire\") to be used within a IMAP SEARCH query." (cdr (assoc preds nnimap-mark-to-flag-alist)))) (defun nnimap-mark-to-flag (preds &optional always-list make-string) - "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP -flag (a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\") to + "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP flag. +This is a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\", to be used in a STORE FLAGS command." (let ((result (nnimap-mark-to-flag-1 preds))) (setq result (if (and (or make-string always-list) @@ -1173,13 +1295,12 @@ be used in a STORE FLAGS command." result))) (defun nnimap-mark-permanent-p (mark &optional group) - "Return t iff MARK can be permanently (between IMAP sessions) saved -on articles, in GROUP." + "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP." (imap-message-flag-permanent-p (nnimap-mark-to-flag mark))) (defun nnimap-remassoc (key alist) - "Delete by side effect any elements of LIST whose car is -`equal' to KEY. The modified LIST is returned. If the first member + "Delete by side effect any elements of LIST whose car is `equal' to KEY. +The modified LIST is returned. If the first member of LIST has a car that is `equal' to KEY, there is no way to remove it by side effect; therefore, write `(setq foo (remassoc key foo))' to be sure of changing the value of `foo'." @@ -1194,81 +1315,68 @@ sure of changing the value of `foo'." (cons (cons key value) (nnimap-remassoc key alist)) (nnimap-remassoc key alist))) -(defun nnimap-range-to-string (range) - (mapconcat - (lambda (item) - (if (consp item) - (format "%d:%d" - (car item) (cdr item)) - (format "%d" item))) - (if (and (listp range) (not (listp (cdr range)))) - (list range) ;; make (1 . 2) into ((1 . 2)) - range) - ",")) - (when nnimap-debug (require 'trace) (buffer-disable-undo (get-buffer-create nnimap-debug)) - (mapc (lambda (f) (trace-function-background f nnimap-debug)) + (mapcar (lambda (f) (trace-function-background f nnimap-debug)) '( -nnimap-replace-in-string -nnimap-possibly-change-server -nnimap-verify-uidvalidity -nnimap-find-minmax-uid -nnimap-possibly-change-group -;nnimap-replace-whitespace -nnimap-retrieve-headers-progress -nnimap-retrieve-which-headers -nnimap-group-overview-filename -nnimap-retrieve-headers-from-file -nnimap-retrieve-headers-from-server -nnimap-retrieve-headers -nnimap-open-connection -nnimap-open-server -nnimap-server-opened -nnimap-close-server -nnimap-request-close -nnimap-status-message -;nnimap-demule -nnimap-request-article-part -nnimap-request-article -nnimap-request-head -nnimap-request-body -nnimap-request-group -nnimap-close-group -nnimap-pattern-to-list-arguments -nnimap-request-list -nnimap-request-post -nnimap-retrieve-groups -nnimap-request-update-info-internal -nnimap-request-type -nnimap-request-set-mark -nnimap-split-to-groups -nnimap-split-find-rule -nnimap-split-find-inbox -nnimap-split-articles -nnimap-request-scan -nnimap-request-newgroups -nnimap-request-create-group -nnimap-time-substract -nnimap-date-days-ago -nnimap-request-expire-articles-progress -nnimap-request-expire-articles -nnimap-request-move-article -nnimap-request-accept-article -nnimap-request-delete-group -nnimap-request-rename-group -gnus-group-nnimap-expunge -gnus-group-nnimap-edit-acl -gnus-group-nnimap-edit-acl-done -nnimap-group-mode-hook -nnimap-mark-to-predicate -nnimap-mark-to-flag-1 -nnimap-mark-to-flag -nnimap-mark-permanent-p -nnimap-remassoc -nnimap-update-alist-soft -nnimap-range-to-string + nnimap-possibly-change-server + nnimap-verify-uidvalidity + nnimap-find-minmax-uid + nnimap-before-find-minmax-bugworkaround + nnimap-possibly-change-group + ;;nnimap-replace-whitespace + nnimap-retrieve-headers-progress + nnimap-retrieve-which-headers + nnimap-group-overview-filename + nnimap-retrieve-headers-from-file + nnimap-retrieve-headers-from-server + nnimap-retrieve-headers + nnimap-open-connection + nnimap-open-server + nnimap-server-opened + nnimap-close-server + nnimap-request-close + nnimap-status-message + ;;nnimap-demule + nnimap-request-article-part + nnimap-request-article + nnimap-request-head + nnimap-request-body + nnimap-request-group + nnimap-close-group + nnimap-pattern-to-list-arguments + nnimap-request-list + nnimap-request-post + nnimap-retrieve-groups + nnimap-request-update-info-internal + nnimap-request-type + nnimap-request-set-mark + nnimap-split-to-groups + nnimap-split-find-rule + nnimap-split-find-inbox + nnimap-split-articles + nnimap-request-scan + nnimap-request-newgroups + nnimap-request-create-group + nnimap-time-substract + nnimap-date-days-ago + nnimap-request-expire-articles-progress + nnimap-request-expire-articles + nnimap-request-move-article + nnimap-request-accept-article + nnimap-request-delete-group + nnimap-request-rename-group + gnus-group-nnimap-expunge + gnus-group-nnimap-edit-acl + gnus-group-nnimap-edit-acl-done + nnimap-group-mode-hook + nnimap-mark-to-predicate + nnimap-mark-to-flag-1 + nnimap-mark-to-flag + nnimap-mark-permanent-p + nnimap-remassoc + nnimap-update-alist-soft ))) (provide 'nnimap) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index e6d7ff0..8fb0b6c 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -1,5 +1,7 @@ ;;; nnkiboze.el --- select virtual news access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -29,12 +31,14 @@ ;;; Code: +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'nntp) (require 'nnheader) (require 'gnus) (require 'gnus-score) (require 'nnoo) -(eval-when-compile (require 'cl)) (nnoo-declare nnkiboze) (defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") @@ -55,6 +59,9 @@ (defvoo nnkiboze-regexp nil "Regexp for matching component groups.") +(defvoo nnkiboze-file-coding-system nnheader-text-coding-system + "Coding system for nnkiboze files.") + (defconst nnkiboze-version "nnkiboze 1.0") @@ -80,7 +87,8 @@ (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-file-contents nov) + (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) + (nnheader-insert-file-contents nov)) (nnheader-nov-delete-outside-range (car articles) (car (last articles))) 'nov)))))) @@ -93,14 +101,17 @@ ;; article fetching by message-id at all. (nntp-request-article article newsgroup gnus-nntp-server buffer) (let* ((header (gnus-summary-article-header article)) - (xref (mail-header-xref header))) + (xref (mail-header-xref header)) + num group) (unless xref (error "nnkiboze: No xref")) (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) (error "nnkiboze: Malformed xref")) - (gnus-request-article (string-to-int (match-string 2 xref)) - (match-string 1 xref) - buffer)))) + (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)) + (gnus-request-article num group buffer))))) (deffoo nnkiboze-request-scan (&optional group server) (nnkiboze-generate-group (concat "nnkiboze:" group))) @@ -119,7 +130,8 @@ (nnkiboze-request-scan group)) (if (not (file-exists-p nov-file)) (nnheader-report 'nnkiboze "Can't select group %s" group) - (nnheader-insert-file-contents nov-file) + (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) + (nnheader-insert-file-contents nov-file)) (if (zerop (buffer-size)) (nnheader-insert "211 0 0 0 %s\n" group) (goto-char (point-min)) @@ -136,15 +148,18 @@ ;; Remove NOV lines of articles that are marked as read. (when (and (file-exists-p (nnkiboze-nov-file-name)) nnkiboze-remove-read-articles) - (with-temp-file (nnkiboze-nov-file-name) - (let ((cur (current-buffer))) - (nnheader-insert-file-contents (nnkiboze-nov-file-name)) - (goto-char (point-min)) - (while (not (eobp)) - (if (not (gnus-article-read-p (read cur))) - (forward-line 1) - (gnus-delete-line)))))) - (setq nnkiboze-current-group nil)) + (let ((coding-system-for-write nnkiboze-file-coding-system) + (output-coding-system nnkiboze-file-coding-system)) + (with-temp-file (nnkiboze-nov-file-name) + (let ((cur (current-buffer)) + (nnheader-file-coding-system nnkiboze-file-coding-system)) + (nnheader-insert-file-contents (nnkiboze-nov-file-name)) + (goto-char (point-min)) + (while (not (eobp)) + (if (not (gnus-article-read-p (read cur))) + (forward-line 1) + (gnus-delete-line)))))) + (setq nnkiboze-current-group nil))) (deffoo nnkiboze-open-server (server &optional defs) (unless (assq 'nnkiboze-regexp defs) @@ -155,15 +170,15 @@ (deffoo nnkiboze-request-delete-group (group &optional force server) (nnkiboze-possibly-change-group group) (when force - (let ((files (nconc - (nnkiboze-score-file group) - (list (nnkiboze-nov-file-name) - (nnkiboze-nov-file-name ".newsrc"))))) - (while files - (and (file-exists-p (car files)) - (file-writable-p (car files)) - (delete-file (car files))) - (setq files (cdr files))))) + (let ((files (nconc + (nnkiboze-score-file group) + (list (nnkiboze-nov-file-name) + (nnkiboze-nov-file-name ".newsrc"))))) + (while files + (and (file-exists-p (car files)) + (file-writable-p (car files)) + (delete-file (car files))) + (setq files (cdr files))))) (setq nnkiboze-current-group nil) t) @@ -184,6 +199,7 @@ Finds out what articles are to be part of the nnkiboze groups." (interactive) (let ((nnmail-spool-file nil) + (mail-sources nil) (gnus-use-dribble-file nil) (gnus-read-active-file t) (gnus-expert-user t)) @@ -198,7 +214,10 @@ Finds out what articles are to be part of the nnkiboze groups." (when (string-match "nnkiboze" (gnus-info-group info)) ;; For each kiboze group, we call this function to generate ;; it. - (nnkiboze-generate-group (gnus-info-group info)))))) + (nnkiboze-generate-group (gnus-info-group info) t)))) + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-group-list-groups))) (defun nnkiboze-score-file (group) (list (expand-file-name @@ -207,7 +226,7 @@ Finds out what articles are to be part of the nnkiboze groups." (concat (nnkiboze-prefixed-name nnkiboze-current-group) "." gnus-score-file-suffix)))))) -(defun nnkiboze-generate-group (group) +(defun nnkiboze-generate-group (group &optional inhibit-list-groups) (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (newsrc-file (concat nnkiboze-directory (nnheader-translate-file-chars @@ -221,6 +240,9 @@ Finds out what articles are to be part of the nnkiboze groups." (gnus-expert-user t) (gnus-large-newsgroup nil) (gnus-score-find-score-files-function 'nnkiboze-score-file) + ;; Use only nnkiboze-score-file! + (gnus-score-use-all-scores nil) + (gnus-use-scoring t) (gnus-verbose (min gnus-verbose 3)) gnus-select-group-hook gnus-summary-prepare-hook gnus-thread-sort-functions gnus-show-threads @@ -230,101 +252,104 @@ Finds out what articles are to be part of the nnkiboze groups." ;; Load the kiboze newsrc file for this group. (when (file-exists-p newsrc-file) (load newsrc-file)) - (with-temp-file nov-file - (when (file-exists-p nov-file) - (nnheader-insert-file-contents nov-file)) - (setq nov-buffer (current-buffer)) - ;; Go through the active hashtb and add new all groups that match the - ;; kiboze regexp. - (mapatoms - (lambda (group) - (and (string-match nnkiboze-regexp - (setq gname (symbol-name group))) ; Match - (not (assoc gname nnkiboze-newsrc)) ; It isn't registered - (numberp (car (symbol-value group))) ; It is active - (or (> nnkiboze-level 7) - (and (setq glevel (nth 1 (nth 2 (gnus-gethash - gname gnus-newsrc-hashtb)))) - (>= nnkiboze-level glevel))) - (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes - (push (cons gname (1- (car (symbol-value group)))) - 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 - ;; 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) - (while newsrc - (if (not (setq active (gnus-gethash - (caar newsrc) gnus-active-hashtb))) - ;; This group isn't active after all, so we remove it from - ;; the list of component groups. - (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) - (setq lowest (cdar newsrc)) - ;; Ok, we have a valid component group, so we jump to it. - (switch-to-buffer gnus-group-buffer) - (gnus-group-jump-to-group (caar newsrc)) - (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) - (setq ginfo (gnus-get-info (gnus-group-group-name)) - orig-info (gnus-copy-sequence ginfo) - num-unread (car (gnus-gethash (caar newsrc) - 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 - ;; 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)'. - (when ginfo - (setcar (nthcdr 2 ginfo) - (and (not (= lowest 1)) (cons 1 lowest)))) - (when (and (or (not ginfo) - (> (length (gnus-list-of-unread-articles - (car ginfo))) - 0)) - (progn - (ignore-errors - (gnus-group-select-group nil)) - (eq major-mode 'gnus-summary-mode))) - ;; We are now in the group where we want to be. - (setq method (gnus-find-method-for-group - gnus-newsgroup-name)) - (when (eq method gnus-select-method) - (setq method nil)) - ;; 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 - ;; into the kiboze group. - (nnkiboze-enter-nov - nov-buffer - (gnus-summary-article-header - (caar gnus-newsgroup-scored)) - gnus-newsgroup-name)) - (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) - ;; That's it. We exit this group. - (when (eq major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))))) - ;; Restore the proper info. - (when ginfo - (setcdr ginfo (cdr orig-info))) - (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb) - num-unread))) - (setcdr (car newsrc) (car active)) - (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) - (setq newsrc (cdr newsrc)))) + (let ((coding-system-for-write nnkiboze-file-coding-system) + (output-coding-system nnkiboze-file-coding-system)) + (with-temp-file nov-file + (when (file-exists-p nov-file) + (nnheader-insert-file-contents nov-file)) + (setq nov-buffer (current-buffer)) + ;; Go through the active hashtb and add new all groups that match the + ;; kiboze regexp. + (mapatoms + (lambda (group) + (and (string-match nnkiboze-regexp + (setq gname (symbol-name group))) ; Match + (not (assoc gname nnkiboze-newsrc)) ; It isn't registered + (numberp (car (symbol-value group))) ; It is active + (or (> nnkiboze-level 7) + (and (setq glevel (nth 1 (nth 2 (gnus-gethash + gname gnus-newsrc-hashtb)))) + (>= nnkiboze-level glevel))) + (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes + (push (cons gname (1- (car (symbol-value group)))) + 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 + ;; 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) + (while newsrc + (if (not (setq active (gnus-gethash + (caar newsrc) gnus-active-hashtb))) + ;; This group isn't active after all, so we remove it from + ;; the list of component groups. + (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) + (setq lowest (cdar newsrc)) + ;; Ok, we have a valid component group, so we jump to it. + (switch-to-buffer gnus-group-buffer) + (gnus-group-jump-to-group (caar newsrc)) + (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) + (setq ginfo (gnus-get-info (gnus-group-group-name)) + orig-info (gnus-copy-sequence ginfo) + num-unread (car (gnus-gethash (caar newsrc) + 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 + ;; 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)'. + (when ginfo + (setcar (nthcdr 2 ginfo) + (and (not (= lowest 1)) (cons 1 lowest)))) + (when (and (or (not ginfo) + (> (length (gnus-list-of-unread-articles + (car ginfo))) + 0)) + (progn + (ignore-errors + (gnus-group-select-group nil)) + (eq major-mode 'gnus-summary-mode))) + ;; We are now in the group where we want to be. + (setq method (gnus-find-method-for-group + gnus-newsgroup-name)) + (when (eq method gnus-select-method) + (setq method nil)) + ;; 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 + ;; into the kiboze group. + (nnkiboze-enter-nov + nov-buffer + (gnus-summary-article-header + (caar gnus-newsgroup-scored)) + gnus-newsgroup-name)) + (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) + ;; That's it. We exit this group. + (when (eq major-mode 'gnus-summary-mode) + (kill-buffer (current-buffer))))) + ;; Restore the proper info. + (when ginfo + (setcdr ginfo (cdr orig-info))) + (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb) + num-unread))) + (setcdr (car newsrc) (car active)) + (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) + (setq newsrc (cdr newsrc))))) ;; We save the kiboze newsrc for this group. (with-temp-file newsrc-file (insert "(setq nnkiboze-newsrc '") (gnus-prin1 nnkiboze-newsrc) (insert ")\n"))) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups)) + (unless inhibit-list-groups + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-group-list-groups))) t) (defun nnkiboze-enter-nov (buffer header group) @@ -340,19 +365,22 @@ Finds out what articles are to be part of the nnkiboze groups." (forward-line 1)) (setq article 1)) (mail-header-set-number oheader article) - (nnheader-insert-nov oheader) - (search-backward "\t" nil t 2) - (if (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (match-beginning 0)) - (forward-char 1)) - ;; The first Xref has to be the group this article - ;; really came for - this is the article nnkiboze - ;; will request when it is asked for the article. - (insert " " group ":" - (int-to-string (mail-header-number header)) " ") - (while (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (1+ (match-beginning 0))) - (insert prefix))))) + (with-temp-buffer + (insert (or (mail-header-xref oheader) "")) + (goto-char (point-min)) + (if (re-search-forward " [^ ]+:[0-9]+" nil t) + (goto-char (match-beginning 0)) + (or (eobp) (forward-char 1))) + ;; The first Xref has to be the group this article + ;; really came for - this is the article nnkiboze + ;; will request when it is asked for the article. + (insert " " group ":" + (int-to-string (mail-header-number header)) " ") + (while (re-search-forward " [^ ]+:[0-9]+" nil t) + (goto-char (1+ (match-beginning 0))) + (insert prefix)) + (mail-header-set-xref oheader (buffer-string))) + (nnheader-insert-nov oheader)))) (defun nnkiboze-nov-file-name (&optional suffix) (concat (file-name-as-directory nnkiboze-directory) diff --git a/lisp/nnlistserv.el b/lisp/nnlistserv.el index a226328..666cd70 100644 --- a/lisp/nnlistserv.el +++ b/lisp/nnlistserv.el @@ -1,5 +1,6 @@ ;;; nnlistserv.el --- retrieving articles via web mailing list archives -;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -29,8 +30,12 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nnoo) -(require 'nnweb) +(eval-when-compile + (ignore-errors + (require 'nnweb)) ; requires W3 + (autoload 'url-insert-file-contents "nnweb")) (nnoo-declare nnlistserv nnweb) @@ -44,15 +49,15 @@ nnweb-type) (defvoo nnlistserv-type-definition - '((kk - (article . nnlistserv-kk-wash-article) - (map . nnlistserv-kk-create-mapping) - (search . nnlistserv-kk-search) - (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") - (pages "fra160396" "fra160796" "fra061196" "fra160197" - "fra090997" "fra040797" "fra130397" "nye") - (index . "date.html") - (identifier . nnlistserv-kk-identity))) + '((kk + (article . nnlistserv-kk-wash-article) + (map . nnlistserv-kk-create-mapping) + (search . nnlistserv-kk-search) + (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") + (pages "fra160396" "fra160796" "fra061196" "fra160197" + "fra090997" "fra040797" "fra130397" "nye") + (index . "date.html") + (identifier . nnlistserv-kk-identity))) "Type-definition alist." nnweb-type-definition) @@ -110,8 +115,7 @@ nil 0 0 url)) map) (nnweb-set-hashtb (cadar map) (car map)) - (nnheader-message 5 "%s %s %s" (cdr active) (point) pages) - )))) + (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) ;; Return the articles in the right order. (setq nnweb-articles (sort (nconc nnweb-articles map) 'car-less-than-car))))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index baa18b1..f2bf49d 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,6 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -26,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nnheader) (require 'message) (require 'custom) @@ -173,8 +175,23 @@ Eg.: :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) +(defcustom nnmail-expiry-target 'delete + "*Variable that says where expired messages should end up. +The default value is `delete' (which says to delete the messages), +but it can also be a string or a function. If it is a string, expired +messages end up in that group. If it is a function, the function is +called in a buffer narrowed to the message in question. The function +receives one argument, the name of the group the message comes from. +The return value should be `delete' or a group name (a string)." + :version "21.1" + :group 'nnmail-expire + :type '(choice (const delete) + (function :format "%v" nnmail-) + string)) + (defcustom nnmail-cache-accepted-message-ids nil - "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." + "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache. +If non-nil, also update the cache when copy or move articles." :group 'nnmail :type 'boolean) @@ -190,6 +207,13 @@ This variable is obsolete; `mail-sources' should be used instead." :group 'nnmail-procmail :type 'boolean) +(defcustom nnmail-scan-directory-mail-source-once nil + "*If non-nil, scan all incoming procmail sorted mails once. +It scans low-level sorted spools even when not required." + :version "21.1" + :group 'nnmail-procmail + :type 'boolean) + (defcustom nnmail-delete-file-function 'delete-file "Function called to delete files in some mail backends." :group 'nnmail-files @@ -213,7 +237,7 @@ links, you could set this variable to `copy-file' instead." '(nnheader-ms-strip-cr) nil) "*Hook that will be run after the incoming mail has been transferred. -The incoming mail is moved from `nnmail-spool-file' (which normally is +The incoming mail is moved from the specified spool file (which normally is something like \"/usr/spool/mail/$user\") to the user's home directory. This hook is called after the incoming mail box has been emptied, and can be used to call any mail box programs you have @@ -222,9 +246,9 @@ running (\"xwatch\", etc.) Eg. \(add-hook 'nnmail-read-incoming-hook - (lambda () - (start-process \"mailsend\" nil - \"/local/bin/mailsend\" \"read\" \"mbox\"))) + (lambda () + (call-process \"/local/bin/mailsend\" nil nil nil + \"read\" nnmail-spool-file))) If you have xwatch running, this will alert it that mail has been read. @@ -405,11 +429,13 @@ parameter. It should return nil, `warn' or `delete'." (defcustom nnmail-extra-headers nil "*Extra headers to parse." + :version "21.1" :group 'nnmail :type '(repeat symbol)) (defcustom nnmail-split-header-length-limit 512 "Header lines longer than this limit are excluded from the split function." + :version "21.1" :group 'nnmail :type 'integer) @@ -445,7 +471,8 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-file-coding-system 'raw-text "Coding system used in nnmail.") -(defvar nnmail-incoming-coding-system 'raw-text +(defvar nnmail-incoming-coding-system + nnheader-text-coding-system "Coding system used in reading inbox") (defvar nnmail-pathname-coding-system 'binary @@ -456,9 +483,10 @@ parameter. It should return nil, `warn' or `delete'." (set-buffer nntp-server-buffer) (delete-region (point-min) (point-max)) (let ((format-alist nil) - (after-insert-file-functions nil)) + (after-insert-file-functions nil)) (condition-case () (let ((auto-mode-alist (nnheader-auto-mode-alist)) + (file-name-coding-system nnmail-pathname-coding-system) (pathname-coding-system nnmail-pathname-coding-system)) (insert-file-contents-as-coding-system nnmail-file-coding-system file) @@ -474,32 +502,50 @@ parameter. It should return nil, `warn' or `delete'." ?. ?_)) (setq group (nnheader-translate-file-chars group)) ;; If this directory exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-directory-p (concat dir group))) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir - (encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system) - "/"))) + (file-name-as-directory + (if (or nnmail-use-long-file-names + (file-directory-p (concat dir group))) + (expand-file-name group dir) + ;; If not, we translate dots into slashes. + (expand-file-name + (encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnmail-pathname-coding-system) + dir)))) (or file ""))) (defun nnmail-get-active () "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." - (let (group-assoc) - ;; Go through all groups from the active list. - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) - ;; We create an alist with `(GROUP (LOW . HIGH))' elements. - (push (list (match-string 1) - (cons (string-to-int (match-string 3)) - (string-to-int (match-string 2)))) - group-assoc))) + ;; Go through all groups from the active list. + (save-excursion + (set-buffer nntp-server-buffer) + (nnmail-parse-active))) + +(defun nnmail-parse-active () + "Parse the active file in the current buffer and return an alist." + (goto-char (point-min)) + (unless (re-search-forward "[\\\"]" nil t) + (goto-char (point-max)) + (while (re-search-backward "[][';?()#]" nil t) + (insert ?\\))) + (goto-char (point-min)) + (let ((buffer (current-buffer)) + group-assoc group max min) + (while (not (eobp)) + (condition-case err + (progn + (narrow-to-region (point) (gnus-point-at-eol)) + (setq group (read buffer)) + (unless (stringp group) + (setq group (symbol-name group))) + (if (and (numberp (setq max (read nntp-server-buffer))) + (numberp (setq min (read nntp-server-buffer)))) + (push (list group (cons min max)) + group-assoc))) + (error nil)) + (widen) + (forward-line 1)) group-assoc)) (defvar nnmail-active-file-coding-system 'raw-text @@ -518,8 +564,11 @@ nn*-request-list should have been called before calling this function." (erase-buffer) (let (group) (while (setq group (pop alist)) - (insert (format "%s %d %d y\n" (car group) (cdadr group) - (caadr group)))))) + (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group) + (caadr group)))) + (goto-char (point-max)) + (while (search-backward "\\." nil t) + (delete-char 1)))) (defun nnmail-get-split-group (file source) "Find out whether this FILE is to be split into GROUP only. @@ -934,7 +983,7 @@ FUNC will be called with the group name to determine the article number." '("bogus")) (error (nnheader-message 5 - "Error in `nnmail-split-methods'; using `bogus' mail group") + "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (setq split (gnus-remove-duplicates split)) @@ -1073,7 +1122,10 @@ Return the number of characters in the body." (goto-char (point-min)) (when (re-search-forward "^References:" nil t) (beginning-of-line) - (insert "X-Gnus-Broken-Eudora-")))) + (insert "X-Gnus-Broken-Eudora-")) + (goto-char (point-min)) + (when (re-search-forward "^In-Reply-To:[^\n]+\\(\n[ \t]+\\)" nil t) + (replace-match "" t t nil 1)))) (custom-add-option 'nnmail-prepare-incoming-header-hook 'nnmail-fix-eudora-headers) @@ -1316,14 +1368,84 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq nnmail-cache-buffer nil) (kill-buffer (current-buffer))))) +;; Compiler directives. +(defvar group) +(defvar group-art-list) +(defvar group-art) (defun nnmail-cache-insert (id) (when nnmail-treat-duplicates - (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) + ;; Store some information about the group this message is written + ;; to. This function might have been called from various places. + ;; Sometimes, a function up in the calling sequence has an + ;; argument GROUP which is bound to a string, the group name. At + ;; other times, there is a function up in the calling sequence + ;; which has an argument GROUP-ART which is a list of pairs, and + ;; the car of a pair is a group name. Should we check that the + ;; length of the list is equal to 1? -- kai + (let ((g nil)) + (cond ((and (boundp 'group) group) + (setq g group)) + ((and (boundp 'group-art-list) group-art-list + (listp group-art-list)) + (setq g (caar group-art-list))) + ((and (boundp 'group-art) group-art (listp group-art)) + (setq g (caar group-art))) + (t (setq g ""))) + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) + (save-excursion + (set-buffer nnmail-cache-buffer) + (goto-char (point-max)) + (if (and g (not (string= "" g)) + (gnus-methods-equal-p gnus-command-method + (nnmail-cache-primary-mail-backend))) + (insert id "\t" g "\n") + (insert id "\n")))))) + +(defun nnmail-cache-primary-mail-backend () + (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) + (be nil) + (res nil)) + (while (and (null res) be-list) + (setq be (car be-list)) + (setq be-list (cdr be-list)) + (when (and (gnus-method-option-p be 'respool) + (eval (intern (format "%s-get-new-mail" (car be))))) + (setq res be))) + res)) + +;; Fetch the group name corresponding to the message id stored in the +;; cache. +(defun nnmail-cache-fetch-group (id) + (when (and nnmail-treat-duplicates nnmail-cache-buffer) (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) - (insert id "\n")))) + (when (search-backward id nil t) + (beginning-of-line) + (skip-chars-forward "^\n\r\t") + (unless (eolp) + (forward-char 1) + (buffer-substring (point) + (progn (end-of-line) (point)))))))) + +;; Function for nnmail-split-fancy: look up all references in the +;; cache and if a match is found, return that group. +(defun nnmail-split-fancy-with-parent () + (let* ((refstr (or (message-fetch-field "references") + (message-fetch-field "in-reply-to"))) + (references nil) + (res nil)) + (when refstr + (setq references (nreverse (gnus-split-references refstr))) + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) + (mapcar (lambda (x) + (setq res (or (nnmail-cache-fetch-group x) res)) + (when (string= "drafts" res) + (setq res nil))) + references) + res))) (defun nnmail-cache-id-exists-p (id) (when nnmail-treat-duplicates @@ -1400,21 +1522,14 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (let* ((sources (or mail-sources (if (listp nnmail-spool-file) nnmail-spool-file (list nnmail-spool-file)))) + fetching-sources (group-in group) (i 0) (new 0) (total 0) incoming incomings source) (when (and (nnmail-get-value "%s-get-new-mail" method) - nnmail-spool-file) - ;; We first activate all the groups. - (nnmail-activate method) - ;; Allow the user to hook. - (run-hooks 'nnmail-pre-get-new-mail-hook) - ;; Open the message-id cache. - (nnmail-cache-open) - ;; The we go through all the existing mail source specification - ;; and fetch the mail from each. + sources) (while (setq source (pop sources)) ;; Be compatible with old values. (cond @@ -1432,6 +1547,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." nil)) ;; Hack to only fetch the contents of a single group's spool file. (when (and (eq (car source) 'directory) + (null nnmail-scan-directory-mail-source-once) group) (mail-source-bind (directory source) (setq source (append source @@ -1446,21 +1562,31 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (when nnmail-fetched-sources (if (member source nnmail-fetched-sources) (setq source nil) - (push source nnmail-fetched-sources))) - (when source - (nnheader-message 4 "%s: Reading incoming mail from %s..." - method (car source)) - (when (setq new - (mail-source-fetch - source - `(lambda (file orig-file) - (nnmail-split-incoming - file ',(intern (format "%s-save-mail" method)) - ',spool-func - (nnmail-get-split-group orig-file source) - ',(intern (format "%s-active-number" method)))))) - (incf total new) - (incf i)))) + (push source nnmail-fetched-sources) + (push source fetching-sources))))) + (when fetching-sources + ;; We first activate all the groups. + (nnmail-activate method) + ;; Allow the user to hook. + (run-hooks 'nnmail-pre-get-new-mail-hook) + ;; Open the message-id cache. + (nnmail-cache-open) + ;; The we go through all the existing mail source specification + ;; and fetch the mail from each. + (while (setq source (pop fetching-sources)) + (nnheader-message 4 "%s: Reading incoming mail from %s..." + method (car source)) + (when (setq new + (mail-source-fetch + source + `(lambda (file orig-file) + (nnmail-split-incoming + file ',(intern (format "%s-save-mail" method)) + ',spool-func + (nnmail-get-split-group orig-file source) + ',(intern (format "%s-active-number" method)))))) + (incf total new) + (incf i))) ;; If we did indeed read any incoming spools, we save all info. (if (zerop total) (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" @@ -1501,6 +1627,12 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; Compare the time with the current time. (ignore-errors (time-less-p days (time-since time)))))))) +(defun nnmail-expiry-target-group (target group) + (when (nnheader-functionp target) + (setq target (funcall target group))) + (unless (eq target 'delete) + (gnus-request-accept-article target nil nil t))) + (defun nnmail-check-syntax () "Check (and modify) the syntax of the message in the current buffer." (save-restriction @@ -1511,8 +1643,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-write-region (start end filename &optional append visit lockname) "Do a `write-region', and then set the file modes." - (let ((pathname-coding-system nnmail-pathname-coding-system)) - + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) (write-region-as-coding-system nnmail-file-coding-system start end filename append visit lockname) (set-file-modes filename nnmail-default-file-modes))) @@ -1582,6 +1714,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (unless nnmail-split-history (error "No current split history")) (with-output-to-temp-buffer "*nnmail split history*" + (with-current-buffer standard-output + (fundamental-mode)) ; for Emacs 20.4+ (let ((history nnmail-split-history) elem) (while (setq elem (pop history)) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 2dd8311..4b453b8 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -1,5 +1,7 @@ ;;; nnmbox.el --- mail mbox access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -26,10 +28,12 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) + (require 'nnheader) (require 'message) (require 'nnmail) (require 'nnoo) +(require 'gnus-range) (nnoo-declare nnmbox) @@ -60,13 +64,13 @@ (defvoo nnmbox-group-alist nil) (defvoo nnmbox-active-timestamp nil) -(defvoo nnmbox-file-coding-system - (if (memq system-type '(windows-nt ms-dos ms-windows)) - 'raw-text-dos 'raw-text)) +(defvoo nnmbox-file-coding-system 'binary) (defvoo nnmbox-file-coding-system-for-write nil) -(defvoo nnmbox-active-file-coding-system nnmbox-file-coding-system) +(defvoo nnmbox-active-file-coding-system 'binary) (defvoo nnmbox-active-file-coding-system-for-write nil) +(defvar nnmbox-group-building-active-articles nil) +(defvar nnmbox-group-active-articles nil) ;;; Interface functions @@ -79,15 +83,12 @@ (erase-buffer) (let ((number (length sequence)) (count 0) - article art-string start stop) + article start stop) (nnmbox-possibly-change-newsgroup newsgroup server) (while sequence (setq article (car sequence)) - (setq art-string (nnmbox-article-string article)) (set-buffer nnmbox-mbox-buffer) - (when (or (search-forward art-string nil t) - (progn (goto-char (point-min)) - (search-forward art-string nil t))) + (when (nnmbox-find-article article) (setq start (save-excursion (re-search-backward @@ -149,8 +150,7 @@ (nnmbox-possibly-change-newsgroup newsgroup server) (save-excursion (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnmbox-article-string article) nil t) + (when (nnmbox-find-article article) (let (start stop) (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq start (point)) @@ -171,7 +171,7 @@ (forward-line 1)) (if (numberp article) (cons nnmbox-current-group article) - (nnmbox-article-group-number))))))) + (nnmbox-article-group-number nil))))))) (deffoo nnmbox-request-group (group &optional server dont-check) (nnmbox-possibly-change-newsgroup nil server) @@ -253,7 +253,7 @@ (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) (deffoo nnmbox-request-expire-articles - (articles newsgroup &optional server force) + (articles newsgroup &optional server force) (nnmbox-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) @@ -262,14 +262,21 @@ (save-excursion (set-buffer nnmbox-mbox-buffer) (while (and articles is-old) - (goto-char (point-min)) - (when (search-forward (nnmbox-article-string (car articles)) nil t) + (when (nnmbox-find-article (car articles)) (if (setq is-old (nnmail-expired-article-p newsgroup (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnmbox-request-article (car articles) + newsgroup server + (current-buffer)) + (let ((nnml-current-directory nil)) + (nnmail-expiry-target-group + nnmail-expiry-target newsgroup)))) (nnheader-message 5 "Deleting article %d in %s..." (car articles) newsgroup) (nnmbox-delete-mail)) @@ -278,17 +285,14 @@ (nnmbox-save-buffer) ;; Find the lowest active article in this group. (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist)))) - (goto-char (point-min)) - (while (and (not (search-forward - (nnmbox-article-string (car active)) nil t)) + (while (and (not (nnmbox-find-article (car active))) (<= (car active) (cdr active))) - (setcar active (1+ (car active))) - (goto-char (point-min)))) + (setcar active (1+ (car active))))) (nnmbox-save-active nnmbox-group-alist nnmbox-active-file) (nconc rest articles)))) (deffoo nnmbox-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmbox move*")) result) (and @@ -309,8 +313,7 @@ (save-excursion (nnmbox-possibly-change-newsgroup group server) (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnmbox-article-string article) nil t) + (when (nnmbox-find-article article) (nnmbox-delete-mail)) (and last (nnmbox-save-buffer)))) result)) @@ -360,8 +363,7 @@ (nnmbox-possibly-change-newsgroup group) (save-excursion (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnmbox-article-string article) nil t)) + (if (not (nnmbox-find-article article)) nil (nnmbox-delete-mail t t) (insert-buffer-substring buffer) @@ -405,6 +407,9 @@ (setq found t)) (when found (nnmbox-save-buffer)))) + (let ((entry (assoc group nnmbox-group-active-articles))) + (when entry + (setcar entry new-name))) (let ((entry (assoc group nnmbox-group-alist))) (when entry (setcar entry new-name)) @@ -421,6 +426,10 @@ ;; delimiter line. (defun nnmbox-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. + ;; First delete record of active article, unless the article is being + ;; replaced, indicated by FORCE being non-nil. + (if (not force) + (nnmbox-record-deleted-article (nnmbox-article-group-number t))) (or force (delete-region (progn (beginning-of-line) (point)) @@ -442,7 +451,7 @@ (match-beginning 0))) (point-max)))) (goto-char (point-min)) - ;; Only delete the article if no other groups owns it as well. + ;; Only delete the article if no other group owns it as well. (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) (delete-region (point-min) (point-max)))))) @@ -452,13 +461,7 @@ (nnmbox-open-server server)) (when (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) - (save-excursion - (set-buffer (setq nnmbox-mbox-buffer - (let ((nnheader-file-coding-system - nnmbox-file-coding-system)) - (nnheader-find-file-noselect - nnmbox-mbox-file nil t)))) - (buffer-disable-undo))) + (nnmbox-read-mbox)) (when (not nnmbox-group-alist) (nnmail-activate 'nnmbox)) (if newsgroup @@ -472,15 +475,86 @@ (int-to-string article) " ") (concat "\nMessage-ID: " article))) -(defun nnmbox-article-group-number () +(defun nnmbox-article-group-number (this-line) (save-excursion - (goto-char (point-min)) + (if this-line + (beginning-of-line) + (goto-char (point-min))) (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " nil t) (cons (buffer-substring (match-beginning 1) (match-end 1)) (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))))) +(defun nnmbox-in-header-p (pos) + "Return non-nil if POS is in the header of an article." + (save-excursion + (goto-char pos) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (search-forward "\n\n" nil t) + (< pos (point)))) + +(defun nnmbox-find-article (article) + "Leaves point on the relevant X-Gnus-Newsgroup line if found." + ;; Check that article is in the active range first, to avoid an + ;; expensive exhaustive search if it isn't. + (if (and (numberp article) + (not (nnmbox-is-article-active-p article))) + nil + (let ((art-string (nnmbox-article-string article)) + (found nil)) + ;; There is the possibility that the X-Gnus-Newsgroup line appears + ;; in the body of an article (for instance, if an article has been + ;; forwarded from someone using Gnus as their mailer), so check + ;; that the line is actually part of the article header. + (or (and (search-forward art-string nil t) + (nnmbox-in-header-p (point))) + (progn + (goto-char (point-min)) + (while (not found) + (setq found (and (search-forward art-string nil t) + (nnmbox-in-header-p (point))))) + found))))) + +(defun nnmbox-record-active-article (group-art) + (let* ((group (car group-art)) + (article (cdr group-art)) + (entry + (or (assoc group nnmbox-group-active-articles) + (progn + (push (list group) + nnmbox-group-active-articles) + (car nnmbox-group-active-articles))))) + ;; add article to index, either by building complete list + ;; in reverse order, or as a list of ranges. + (if (not nnmbox-group-building-active-articles) + (setcdr entry (gnus-add-to-range (cdr entry) (list article))) + (when (memq article (cdr entry)) + (switch-to-buffer nnmbox-mbox-buffer) + (error "Article %s:%d already exists!" group article)) + (when (and (cadr entry) (< article (cadr entry))) + (switch-to-buffer nnmbox-mbox-buffer) + (error "Article %s:%d out of order" group article)) + (setcdr entry (cons article (cdr entry)))))) + +(defun nnmbox-record-deleted-article (group-art) + (let* ((group (car group-art)) + (article (cdr group-art)) + (entry + (or (assoc group nnmbox-group-active-articles) + (progn + (push (list group) + nnmbox-group-active-articles) + (car nnmbox-group-active-articles))))) + ;; remove article from index + (setcdr entry (gnus-remove-from-range (cdr entry) (list article))))) + +(defun nnmbox-is-article-active-p (article) + (gnus-member-of-range + article + (cdr (assoc nnmbox-current-group + nnmbox-group-active-articles)))) + (defun nnmbox-save-mail (group-art) "Called narrowed to an article." (let ((delim (concat "^" message-unix-mail-delimiter))) @@ -497,6 +571,10 @@ (nnmail-insert-lines) (nnmail-insert-xref group-art) (nnmbox-insert-newsgroup-line group-art) + (let ((alist group-art)) + (while alist + (nnmbox-record-active-article (car alist)) + (setq alist (cdr alist)))) (run-hooks 'nnmail-prepare-save-mail-hook) (run-hooks 'nnmbox-prepare-save-mail-hook) group-art)) @@ -528,7 +606,8 @@ (defun nnmbox-create-mbox () (when (not (file-exists-p nnmbox-mbox-file)) (let ((nnmail-file-coding-system - nnmbox-file-coding-system-for-write)) + (or nnmbox-file-coding-system-for-write + nnmbox-file-coding-system))) (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)))) (defun nnmbox-read-mbox () @@ -543,7 +622,8 @@ (save-excursion (let ((delim (concat "^" message-unix-mail-delimiter)) (alist nnmbox-group-alist) - start end number) + (nnmbox-group-building-active-articles t) + start end end-header number) (set-buffer (setq nnmbox-mbox-buffer (let ((nnheader-file-coding-system nnmbox-file-coding-system)) @@ -551,39 +631,71 @@ nnmbox-mbox-file nil t)))) (buffer-disable-undo) - ;; Go through the group alist and compare against - ;; the mbox file. + ;; Go through the group alist and compare against the mbox file. (while alist (goto-char (point-max)) (when (and (re-search-backward (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " (caar alist)) nil t) - (>= (setq number - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (cdadar alist))) - (setcdr (cadar alist) (1+ number))) + (> (setq number + (string-to-number + (buffer-substring + (match-beginning 1) (match-end 1)))) + (cdadar alist))) + (setcdr (cadar alist) number)) (setq alist (cdr alist))) + ;; Examine all articles for our private X-Gnus-Newsgroup + ;; headers. This is done primarily as a consistency check, but + ;; it is convenient for building an index of the articles + ;; present, to avoid costly searches for missing articles + ;; (eg. when expiring articles). (goto-char (point-min)) + (setq nnmbox-group-active-articles nil) (while (re-search-forward delim nil t) (setq start (match-beginning 0)) - (when (not (search-forward "\nX-Gnus-Newsgroup: " - (save-excursion - (setq end - (or - (and - (re-search-forward delim nil t) - (match-beginning 0)) - (point-max)))) - t)) + (save-excursion + (search-forward "\n\n" nil t) + (setq end-header (point)) + (setq end (or (and + (re-search-forward delim nil t) + (match-beginning 0)) + (point-max)))) + (if (search-forward "\nX-Gnus-Newsgroup: " end-header t) + ;; Build a list of articles in each group, remembering + ;; that each article may be in more than one group. + (progn + (nnmbox-record-active-article (nnmbox-article-group-number t)) + (while (search-forward "\nX-Gnus-Newsgroup: " end-header t) + (nnmbox-record-active-article (nnmbox-article-group-number t)))) + ;; The article is either new, or for some other reason + ;; hasn't got our private headers, so add them now. The + ;; only situation I've encountered when the X-Gnus-Newsgroup + ;; header is missing is if the article contains a forwarded + ;; message which does contain that header line (earlier + ;; versions of Gnus didn't restrict their search to the + ;; headers). In this case, there is an Xref line which + ;; provides the relevant information to construct the + ;; missing header(s). (save-excursion (save-restriction (narrow-to-region start end) - (nnmbox-save-mail - (nnmail-article-group 'nnmbox-active-number))))) - (goto-char end)))))) + (if (re-search-forward "\nXref: [^ ]+" end-header t) + ;; generate headers from Xref: + (let (alist) + (while (re-search-forward " \\([^:]+\\):\\([0-9]+\\)" end-header t) + (push (cons (match-string 1) + (string-to-int (match-string 2))) alist)) + (nnmbox-insert-newsgroup-line alist)) + ;; this is really a new article + (nnmbox-save-mail + (nnmail-article-group 'nnmbox-active-number)))))) + (goto-char end)) + ;; put article lists in order + (setq alist nnmbox-group-active-articles) + (while alist + (setcdr (car alist) (gnus-compress-sequence (nreverse (cdar alist)))) + (setq alist (cdr alist))))))) (provide 'nnmbox) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 37415e5..1b660f9 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -1,5 +1,7 @@ ;;; nnmh.el --- mhspool access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -32,6 +34,8 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'nnheader) (require 'nnmail) (require 'gnus-start) @@ -49,7 +53,10 @@ "*Hook run narrowed to an article before saving.") (defvoo nnmh-be-safe nil - "*If non-nil, nnmh will check all articles to make sure whether they are new or not.") + "*If non-nil, nnmh will check all articles to make sure whether they are new or not. +Go through the .nnmh-articles file and compare with the actual +articles in this folder. The articles that are \"new\" will be marked +as unread by Gnus.") @@ -61,7 +68,10 @@ (defvoo nnmh-status-string "") (defvoo nnmh-group-alist nil) -(defvoo nnmh-allow-delete-final nil) +;; Don't even think about setting this variable. It does not exist. +;; Forget about it. Uh-huh. Nope. Nobody here. It's only bound +;; dynamically by certain functions in nndraft. +(defvar nnmh-allow-delete-final nil) @@ -78,7 +88,8 @@ (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) (count 0) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) beg article) (nnmh-possibly-change-directory newsgroup server) ;; We don't support fetching by Message-ID. @@ -106,7 +117,7 @@ (and large (zerop (% count 20)) (nnheader-message 5 "nnmh: Receiving headers... %d%%" - (/ (* count 100) number)))) + (/ (* count 100) number)))) (when large (nnheader-message 5 "nnmh: Receiving headers...done")) @@ -125,6 +136,7 @@ (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) (count 0) + (file-name-coding-system 'binary) (pathname-coding-system 'binary) (case-fold-search t) ;;beg @@ -161,7 +173,8 @@ (let ((file (if (stringp id) nil (concat nnmh-current-directory (int-to-string id)))) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) (nntp-server-buffer (or buffer nntp-server-buffer))) (and (stringp file) (file-exists-p file) @@ -173,7 +186,8 @@ (nnheader-init-server-buffer) (nnmh-possibly-change-directory group server) (let ((pathname (nnmail-group-pathname group nnmh-directory)) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) dir) (cond ((not (file-directory-p pathname)) @@ -196,19 +210,19 @@ (mapcar (lambda (name) (string-to-int name)) (directory-files pathname nil "^[0-9]+$" t)) '<)) - (cond - (dir - (setq nnmh-group-alist - (delq (assoc group nnmh-group-alist) nnmh-group-alist)) - (push (list group (cons (car dir) (car (last dir)))) - nnmh-group-alist) - (nnheader-report 'nnmh "Selected group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (length dir) (car dir) - (car (last dir)) group)) - (t - (nnheader-report 'nnmh "Empty group %s" group) - (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) + (cond + (dir + (setq nnmh-group-alist + (delq (assoc group nnmh-group-alist) nnmh-group-alist)) + (push (list group (cons (car dir) (car (last dir)))) + nnmh-group-alist) + (nnheader-report 'nnmh "Selected group %s" group) + (nnheader-insert + "211 %d %d %d %s\n" (length dir) (car dir) + (car (last dir)) group)) + (t + (nnheader-report 'nnmh "Empty group %s" group) + (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) (deffoo nnmh-request-scan (&optional group server) (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) @@ -216,7 +230,8 @@ (deffoo nnmh-request-list (&optional server dir) (nnheader-insert "") (nnmh-possibly-change-directory nil server) - (let ((pathname-coding-system 'binary) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) (nnmh-toplev (file-truename (or dir (file-name-as-directory nnmh-directory))))) (nnmh-request-list-1 nnmh-toplev)) @@ -282,6 +297,13 @@ (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn + ;; Allow a special target group. -- jcn + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnmh-request-article (car articles) + newsgroup server (current-buffer)) + (nnmail-expiry-target-group + nnmail-expiry-target newsgroup))) (nnheader-message 5 "Deleting article %s in %s..." article newsgroup) (condition-case () @@ -299,7 +321,7 @@ t) (deffoo nnmh-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) (and @@ -431,7 +453,8 @@ (nnmh-open-server server)) (when newsgroup (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory)) - (pathname-coding-system 'binary)) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) (if (file-directory-p pathname) (setq nnmh-current-directory pathname) (error "No such newsgroup: %s" newsgroup))))) @@ -480,7 +503,8 @@ "Compute the next article number in GROUP." (let ((active (cadr (assoc group nnmh-group-alist))) (dir (nnmail-group-pathname group nnmh-directory)) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) file) (unless active ;; The group wasn't known to nnmh, so we just create an active diff --git a/lisp/nnml.el b/lisp/nnml.el index 23b1401..481d678 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -1,5 +1,6 @@ ;;; nnml.el --- mail spool access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -31,9 +32,13 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'nnheader) (require 'nnmail) (require 'nnoo) +(eval-and-compile + (autoload 'gnus-sorted-intersection "gnus-range")) (nnoo-declare nnml) @@ -41,11 +46,11 @@ "Spool directory for the nnml mail backend.") (defvoo nnml-active-file - (concat (file-name-as-directory nnml-directory) "active") + (expand-file-name "active" nnml-directory) "Mail active file.") (defvoo nnml-newsgroups-file - (concat (file-name-as-directory nnml-directory) "newsgroups") + (expand-file-name "newsgroups" nnml-directory) "Mail newsgroups description file.") (defvoo nnml-get-new-mail t @@ -102,7 +107,8 @@ all. This may very well take some time.") (let ((file nil) (number (length sequence)) (count 0) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) beg article) (if (stringp (car sequence)) 'headers @@ -163,7 +169,8 @@ all. This may very well take some time.") (deffoo nnml-request-article (id &optional group server buffer) (nnml-possibly-change-directory group server) (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) path gpath group-num) (if (stringp id) (when (and (setq group-num (nnml-find-group-number id)) @@ -194,7 +201,8 @@ all. This may very well take some time.") (string-to-int (file-name-nondirectory path))))))) (deffoo nnml-request-group (group &optional server dont-check) - (let ((pathname-coding-system 'binary)) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) (cond ((not (nnml-possibly-change-directory group server)) (nnheader-report 'nnml "Invalid group (no such directory)")) @@ -252,7 +260,8 @@ all. This may very well take some time.") (deffoo nnml-request-list (&optional server) (save-excursion (let ((nnmail-file-coding-system nnmail-active-file-coding-system) - (pathname-coding-system 'binary)) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) (nnmail-find-file nnml-active-file)) (setq nnml-group-alist (nnmail-get-active)) t)) @@ -285,8 +294,16 @@ all. This may very well take some time.") (nnmail-expired-article-p group mod-time force nnml-inhibit-expiry))) (progn + ;; Allow a special target group. + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnml-request-article number group server + (current-buffer)) + (let ((nnml-current-directory nil)) + (nnmail-expiry-target-group + nnmail-expiry-target group)))) (nnheader-message 5 "Deleting article %s in %s" - article group) + number group) (condition-case () (funcall nnmail-delete-file-function article) (file-error @@ -304,7 +321,7 @@ all. This may very well take some time.") (nconc rest articles))) (deffoo nnml-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnml move*")) result) (nnml-possibly-change-directory group server) @@ -312,12 +329,15 @@ all. This may very well take some time.") (and (nnml-deletable-article-p group article) (nnml-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) + (let (nnml-current-directory + nnml-current-group + nnml-article-file-alist) + (save-excursion + (set-buffer buf) + (insert-buffer-substring nntp-server-buffer) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result)) (progn (nnml-possibly-change-directory group server) (condition-case () @@ -369,8 +389,8 @@ all. This may very well take some time.") (nnmail-write-region (point-min) (point-max) (or (nnml-article-to-file article) - (concat nnml-current-directory - (int-to-string article))) + (expand-file-name (int-to-string article) + nnml-current-directory)) nil (if (nnheader-be-verbose 5) nil 'nomesg)) t) (setq headers (nnml-parse-head chars article)) @@ -474,7 +494,7 @@ all. This may very well take some time.") (nnml-update-file-alist) (let (file) (if (setq file (cdr (assq article nnml-article-file-alist))) - (concat nnml-current-directory file) + (expand-file-name file nnml-current-directory) ;; Just to make sure nothing went wrong when reading over NFS -- ;; check once more. (when (file-exists-p @@ -515,8 +535,8 @@ all. This may very well take some time.") (defun nnml-find-id (group id) (erase-buffer) - (let ((nov (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) + (let ((nov (expand-file-name nnml-nov-file-name + (nnmail-group-pathname group nnml-directory))) number found) (when (file-exists-p nov) (nnheader-insert-file-contents nov) @@ -536,7 +556,7 @@ all. This may very well take some time.") (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnml-nov-is-evil) nil - (let ((nov (concat nnml-current-directory nnml-nov-file-name))) + (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory))) (when (file-exists-p nov) (save-excursion (set-buffer nntp-server-buffer) @@ -558,7 +578,8 @@ all. This may very well take some time.") (if (not group) t (let ((pathname (nnmail-group-pathname group nnml-directory)) - (pathname-coding-system 'binary)) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) (when (not (equal pathname nnml-current-directory)) (setq nnml-current-directory pathname nnml-current-group group @@ -632,8 +653,8 @@ all. This may very well take some time.") (push (list group active) nnml-group-alist)) (setcdr active (1+ (cdr active))) (while (file-exists-p - (concat (nnmail-group-pathname group nnml-directory) - (int-to-string (cdr active)))) + (expand-file-name (int-to-string (cdr active)) + (nnmail-group-pathname group nnml-directory))) (setcdr active (1+ (cdr active)))) (cdr active))) @@ -673,8 +694,9 @@ all. This may very well take some time.") (save-excursion (set-buffer buffer) (set (make-local-variable 'nnml-nov-buffer-file-name) - (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) + (expand-file-name + nnml-nov-file-name + (nnmail-group-pathname group nnml-directory))) (erase-buffer) (when (file-exists-p nnml-nov-buffer-file-name) (nnheader-insert-file-contents nnml-nov-buffer-file-name))) @@ -736,7 +758,7 @@ all. This may very well take some time.") (unless no-active (nnmail-save-active nnml-group-alist nnml-active-file)))))) -(defvar files) +(eval-when-compile (defvar files)) (defun nnml-generate-active-info (dir) ;; Update the active info for this group. (let ((group (nnheader-file-to-group diff --git a/lisp/nnoo.el b/lisp/nnoo.el index 44a0f83..dc2fa31 100644 --- a/lisp/nnoo.el +++ b/lisp/nnoo.el @@ -1,5 +1,7 @@ ;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -302,6 +304,20 @@ All functions will return nil and report an error." (&rest args) (nnheader-report ',backend ,(format "%s-%s not implemented" backend function)))))))) + +(defun nnoo-set (server &rest args) + (let ((parents (nnoo-parents (car server))) + (nnoo-parent-backend (car server))) + (while parents + (nnoo-change-server (caar parents) + (cadr server) + (cdar parents)) + (pop parents))) + (nnoo-change-server (car server) + (cadr server) (cddr server)) + (while args + (set (pop args) (pop args)))) + (provide 'nnoo) ;;; nnoo.el ends here. diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el new file mode 100644 index 0000000..1e92a5d --- /dev/null +++ b/lisp/nnshimbun.el @@ -0,0 +1,1382 @@ +;;; nnshimbun.el --- interfacing with web newspapers -*- coding: junet; -*- + +;; Authors: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Keywords: news + +;;; Copyright: + +;; This file is a part of Semi-Gnus. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Gnus backend to read newspapers on WEB. + + +;;; Defintinos: + +(gnus-declare-backend "nnshimbun" 'address) + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'static)) + +(require 'nnheader) +(require 'nnmail) +(require 'nnoo) +(require 'gnus-bcklg) +(eval-when-compile (ignore-errors (require 'nnweb))) +;; Report failure to find w3 at load time if appropriate. +(eval '(require 'nnweb)) +(require 'mcharset) + + +(nnoo-declare nnshimbun) + +(defvar nnshimbun-check-interval 300) + +(defconst nnshimbun-mew-groups + '(("meadow-develop" "meadow-develop" nil t) + ("meadow-users-jp" "meadow-users-jp") + ("mule-win32" "mule-win32") + ("mew-win32" "mew-win32") + ("mew-dist" "mew-dist/3300" t) + ("mgp-users-jp" "mgp-users-jp/A" t t))) + +(defvar nnshimbun-type-definition + `(("asahi" + (url . "http://spin.asahi.com/") + (groups "national" "business" "politics" "international" "sports" "personal" "feneral") + (coding-system . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis)) + (generate-nov . nnshimbun-generate-nov-for-each-group) + (get-headers . nnshimbun-asahi-get-headers) + (index-url . (format "%sp%s.html" nnshimbun-url nnshimbun-current-group)) + (from-address . "webmaster@www.asahi.com") + (make-contents . nnshimbun-make-text-or-html-contents) + (contents-start . "\n\n") + (contents-end . "\n\n")) + ("sponichi" + (url . "http://www.sponichi.co.jp/") + (groups "baseball" "soccer" "usa" "others" "society" "entertainment" "horseracing") + (coding-system . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis)) + (generate-nov . nnshimbun-generate-nov-for-each-group) + (get-headers . nnshimbun-sponichi-get-headers) + (index-url . (format "%s%s/index.html" nnshimbun-url nnshimbun-current-group)) + (from-address . "webmaster@www.sponichi.co.jp") + (make-contents . nnshimbun-make-text-or-html-contents) + (contents-start . "\n$B!!(B") + (contents-end . "\n")) + ("cnet" + (url . "http://cnet.sphere.ne.jp/") + (groups "comp") + (coding-system . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis)) + (generate-nov . nnshimbun-generate-nov-for-each-group) + (get-headers . nnshimbun-cnet-get-headers) + (index-url . (format "%s/News/Oneweek/" nnshimbun-url)) + (from-address . "cnet@sphere.ad.jp") + (make-contents . nnshimbun-make-html-contents) + (contents-start . "\n\n") + (contents-end . "\n\n")) + ("wired" + (url . "http://www.hotwired.co.jp/") + (groups "business" "culture" "technology") + (coding-system . ,(static-if (boundp 'MULE) '*euc-japan* 'euc-jp)) + (generate-nov . nnshimbun-generate-nov-for-all-groups) + (get-headers . nnshimbun-wired-get-all-headers) + (index-url) + (from-address . "webmaster@www.hotwired.co.jp") + (make-contents . nnshimbun-make-html-contents) + (contents-start . "\n\n") + (contents-end . "\n\n")) + ("yomiuri" + (url . "http://www.yomiuri.co.jp/") + (groups "shakai" "sports" "seiji" "keizai" "kokusai" "fuho") + (coding-system . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis)) + (generate-nov . nnshimbun-generate-nov-for-all-groups) + (get-headers . nnshimbun-yomiuri-get-all-headers) + (index-url . (concat nnshimbun-url "main.htm")) + (from-address . "webmaster@www.yomiuri.co.jp") + (make-contents . nnshimbun-make-text-or-html-contents) + (contents-start . "\n\n") + (contents-end . "\n\n")) + ("zdnet" + (url . "http://www.zdnet.co.jp/news/") + (groups "comp") + (coding-system . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis)) + (generate-nov . nnshimbun-generate-nov-for-each-group) + (get-headers . nnshimbun-zdnet-get-headers) + (index-url . nnshimbun-url) + (from-address . "zdnn@softbank.co.jp") + (make-contents . nnshimbun-make-html-contents) + (contents-start . "\\(\\|\\)") + (contents-end . "\\(\\|\\)")) + ("mew" + (url . "http://www.mew.org/archive/") + (groups ,@(mapcar #'car nnshimbun-mew-groups)) + (coding-system . ,(static-if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp)) + (generate-nov . nnshimbun-generate-nov-for-each-group) + (get-headers . nnshimbun-mew-get-headers) + (index-url . (nnshimbun-mew-concat-url "index.html")) + (make-contents . nnshimbun-make-mhonarc-contents)) + ("xemacs" + (url . "http://www.xemacs.org/list-archives/") + (groups "xemacs-announce" "xemacs-beta-ja" "xemacs-beta" + "xemacs-build-reports" "xemacs-cvs" "xemacs-mule" + "xemacs-nt" "xemacs-patches" "xemacs-users-ja" "xemacs") + (coding-system . ,(static-if (boundp 'MULE) '*euc-japan* 'euc-jp)) + (generate-nov . nnshimbun-generate-nov-for-each-group) + (get-headers . nnshimbun-xemacs-get-headers) + (index-url . (nnshimbun-xemacs-concat-url nil)) + (make-contents . nnshimbun-make-mhonarc-contents)) + ("netbsd" + (url . "http://www.jp.netbsd.org/ja/JP/ml/") + (groups "announce-ja" "junk-ja" "tech-misc-ja" "tech-pkg-ja" + "port-arm32-ja" "port-hpcmips-ja" "port-mac68k-ja" + "port-mips-ja" "port-powerpc-ja" "hpcmips-changes-ja" + "members-ja" "admin-ja" "www-changes-ja") + (coding-system . ,(static-if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp)) + (generate-nov . nnshimbun-generate-nov-for-each-group) + (get-headers . nnshimbun-netbsd-get-headers) + (index-url . (format "%s%s/index.html" nnshimbun-url nnshimbun-current-group)) + (make-contents . nnshimbun-make-mhonarc-contents)) + )) + +(defvar nnshimbun-x-face-alist + '(("default" . + (("default" . + "X-Face: Ygq$6P.,%Xt$U)DS)cRY@k$VkW!7(X'X'?U{{osjjFG\"E]hND;SPJ-J?O?R|a?L + g2$0rVng=O3Lt}?~IId8Jj&vP^3*o=LKUyk(`t%0c!;t6REk=JbpsEn9MrN7gZ%")))) + "Alist of server vs. alist of group vs. X-Face field. It looks like: + +\((\"asahi\" . ((\"national\" . \"X-face: ***\") + (\"business\" . \"X-Face: ***\") + ;; + ;; + (\"default\" . \"X-face: ***\"))) + (\"sponichi\" . ((\"baseball\" . \"X-face: ***\") + (\"soccer\" . \"X-Face: ***\") + ;; + ;; + (\"default\" . \"X-face: ***\"))) + ;; + (\"default\" . ((\"default\" . \"X-face: ***\")))") + +(defvoo nnshimbun-directory (nnheader-concat gnus-directory "shimbun/") + "Where nnshimbun will save its files.") + +(defvoo nnshimbun-nov-is-evil nil + "*Non-nil means that nnshimbun will never retrieve NOV headers.") + +(defvoo nnshimbun-nov-file-name ".overview") + +(defvoo nnshimbun-pre-fetch-article nil + "*Non nil means that nnshimbun fetch unread articles when scanning groups.") + +;; set by nnshimbun-possibly-change-group +(defvoo nnshimbun-buffer nil) +(defvoo nnshimbun-current-directory nil) +(defvoo nnshimbun-current-group nil) + +;; set by nnshimbun-open-server +(defvoo nnshimbun-url nil) +(defvoo nnshimbun-coding-system nil) +(defvoo nnshimbun-groups nil) +(defvoo nnshimbun-generate-nov nil) +(defvoo nnshimbun-get-headers nil) +(defvoo nnshimbun-index-url nil) +(defvoo nnshimbun-from-address nil) +(defvoo nnshimbun-make-contents nil) +(defvoo nnshimbun-contents-start nil) +(defvoo nnshimbun-contents-end nil) +(defvoo nnshimbun-server-directory nil) + +(defvoo nnshimbun-status-string "") +(defvoo nnshimbun-nov-last-check nil) +(defvoo nnshimbun-nov-buffer-alist nil) +(defvoo nnshimbun-nov-buffer-file-name nil) + +(defvoo nnshimbun-keep-backlog 300) +(defvoo nnshimbun-backlog-articles nil) +(defvoo nnshimbun-backlog-hashtb nil) + +(defconst nnshimbun-meta-content-type-charset-regexp + (eval-when-compile + (concat "")) + "Regexp used in parsing ` +for a charset indication") + +(defconst nnshimbun-meta-charset-content-type-regexp + (eval-when-compile + (concat "")) + "Regexp used in parsing ` +for a charset indication") + + + +;;; backlog +(defmacro nnshimbun-backlog (&rest form) + `(let ((gnus-keep-backlog nnshimbun-keep-backlog) + (gnus-backlog-buffer (format " *nnshimbun backlog %s*" (nnoo-current-server 'nnshimbun))) + (gnus-backlog-articles nnshimbun-backlog-articles) + (gnus-backlog-hashtb nnshimbun-backlog-hashtb)) + (unwind-protect + (progn ,@form) + (setq nnshimbun-backlog-articles gnus-backlog-articles + nnshimbun-backlog-hashtb gnus-backlog-hashtb)))) +(put 'nnshimbun-backlog 'lisp-indent-function 0) +(put 'nnshimbun-backlog 'edebug-form-spec '(form body)) + + + +;;; Interface Functions +(nnoo-define-basics nnshimbun) + +(deffoo nnshimbun-open-server (server &optional defs) + ;; Set default values. + (dolist (default (cdr (assoc server nnshimbun-type-definition))) + (let ((symbol (intern (concat "nnshimbun-" (symbol-name (car default)))))) + (unless (assq symbol defs) + (push (list symbol (cdr default)) defs)))) + ;; Set directory for server working files. + (push (list 'nnshimbun-server-directory + (file-name-as-directory + (expand-file-name server nnshimbun-directory))) + defs) + (nnoo-change-server 'nnshimbun server defs) + (nnshimbun-possibly-change-group nil server) + ;; Make directories. + (unless (file-exists-p nnshimbun-directory) + (ignore-errors (make-directory nnshimbun-directory t))) + (cond + ((not (file-exists-p nnshimbun-directory)) + (nnshimbun-close-server) + (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-directory)) + ((not (file-directory-p (file-truename nnshimbun-directory))) + (nnshimbun-close-server) + (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-directory)) + (t + (unless (file-exists-p nnshimbun-server-directory) + (ignore-errors (make-directory nnshimbun-server-directory t))) + (cond + ((not (file-exists-p nnshimbun-server-directory)) + (nnshimbun-close-server) + (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-server-directory)) + ((not (file-directory-p (file-truename nnshimbun-server-directory))) + (nnshimbun-close-server) + (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-server-directory)) + (t + (nnheader-report 'nnshimbun "Opened server %s using directory %s" + server nnshimbun-server-directory) + t))))) + +(deffoo nnshimbun-close-server (&optional server) + (and (nnshimbun-server-opened server) + (gnus-buffer-live-p nnshimbun-buffer) + (kill-buffer nnshimbun-buffer)) + (nnshimbun-backlog (gnus-backlog-shutdown)) + (nnshimbun-save-nov) + (nnoo-close-server 'nnshimbun server) + t) + +(static-when (boundp 'MULE) + (unless (coding-system-p 'euc-japan) + (copy-coding-system '*euc-japan* 'euc-japan)) + (unless (coding-system-p 'shift_jis) + (copy-coding-system '*sjis* 'shift_jis)) + (eval-and-compile + (defalias-maybe 'coding-system-category 'get-code-mnemonic))) + +(defun nnshimbun-retrieve-url (url &optional no-cache) + "Rertrieve URL contents and insert to current buffer." + (let ((buf (current-buffer)) + (url-working-buffer url-working-buffer)) + (let ((old-asynch (default-value 'url-be-asynchronous)) + (old-caching (default-value 'url-automatic-caching)) + (old-mode (default-value 'url-standalone-mode))) + (setq-default url-be-asynchronous nil) + (when no-cache + (setq-default url-automatic-caching nil) + (setq-default url-standalone-mode nil)) + (unwind-protect + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (input-coding-system 'binary) + (output-coding-system 'binary) + (default-enable-multibyte-characters nil)) + (set-buffer + (setq url-working-buffer + (cdr (url-retrieve url no-cache)))) + (url-uncompress)) + (setq-default url-be-asynchronous old-asynch) + (setq-default url-automatic-caching old-caching) + (setq-default url-standalone-mode old-mode))) + (let ((charset + (or url-current-mime-charset + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (or (re-search-forward + nnshimbun-meta-content-type-charset-regexp nil t) + (re-search-forward + nnshimbun-meta-charset-content-type-regexp nil t)) + (buffer-substring-no-properties (match-beginning 2) + (match-end 2))))))) + (decode-coding-region + (point-min) (point-max) + (if charset + (let ((mime-charset-coding-system-alist + (append '((euc-jp . euc-japan) + (shift-jis . shift_jis) + (shift_jis . shift_jis) + (sjis . shift_jis) + (x-euc-jp . euc-japan) + (x-shift-jis . shift_jis) + (x-shift_jis . shift_jis) + (x-sjis . shift_jis)) + mime-charset-coding-system-alist))) + (mime-charset-to-coding-system charset)) + (let ((default (condition-case nil + (coding-system-category nnshimbun-coding-system) + (error nil))) + (candidate (detect-coding-region (point-min) (point-max)))) + (unless (listp candidate) + (setq candidate (list candidate))) + (catch 'coding + (dolist (coding candidate) + (if (eq default (coding-system-category coding)) + (throw 'coding coding))) + (if (eq (coding-system-category 'binary) + (coding-system-category (car candidate))) + nnshimbun-coding-system + (car candidate))))))) + (set-buffer-multibyte t) + (set-buffer buf) + (insert-buffer url-working-buffer) + (kill-buffer url-working-buffer))) + +(deffoo nnshimbun-request-article (article &optional group server to-buffer) + (when (nnshimbun-possibly-change-group group server) + (if (stringp article) + (setq article (nnshimbun-search-id group article))) + (if (integerp article) + (nnshimbun-request-article-1 article group server to-buffer) + (nnheader-report 'nnml "Couldn't retrieve article: %s" (prin1-to-string article)) + nil))) + +(defsubst nnshimbun-header-xref (x) + (if (and (setq x (mail-header-xref x)) + (string-match "^Xref: " x)) + (substring x 6) + x)) + +(defun nnshimbun-request-article-1 (article &optional group server to-buffer) + (if (nnshimbun-backlog + (gnus-backlog-request-article + group article (or to-buffer nntp-server-buffer))) + (cons group article) + (let (header contents) + (when (setq header (save-excursion + (set-buffer (nnshimbun-open-nov group)) + (and (nnheader-find-nov-line article) + (nnheader-parse-nov)))) + (let* ((xref (nnshimbun-header-xref header)) + (x-faces (cdr (or (assoc (or server + (nnoo-current-server 'nnshimbun)) + nnshimbun-x-face-alist) + (assoc "default" nnshimbun-x-face-alist)))) + (x-face (cdr (or (assoc group x-faces) + (assoc "default" x-faces))))) + (save-excursion + (set-buffer nnshimbun-buffer) + (erase-buffer) + (nnshimbun-retrieve-url xref) + (nnheader-message 6 "nnshimbun: Make contents...") + (goto-char (point-min)) + (setq contents (funcall nnshimbun-make-contents header x-face)) + (nnheader-message 6 "nnshimbun: Make contents...done")))) + (when contents + (save-excursion + (set-buffer (or to-buffer nntp-server-buffer)) + (erase-buffer) + (insert contents) + (nnshimbun-backlog + (gnus-backlog-enter-article group article (current-buffer))) + (nnheader-report 'nnshimbun "Article %s retrieved" (mail-header-id header)) + (cons group (mail-header-number header))))))) + +(deffoo nnshimbun-request-group (group &optional server dont-check) + (let ((pathname-coding-system 'binary)) + (cond + ((not (nnshimbun-possibly-change-group group server)) + (nnheader-report 'nnshimbun "Invalid group (no such directory)")) + ((not (file-exists-p nnshimbun-current-directory)) + (nnheader-report 'nnshimbun "Directory %s does not exist" + nnshimbun-current-directory)) + ((not (file-directory-p nnshimbun-current-directory)) + (nnheader-report 'nnshimbun "%s is not a directory" nnshimbun-current-directory)) + (dont-check + (nnheader-report 'nnshimbun "Group %s selected" group) + t) + (t + (let (beg end lines) + (save-excursion + (set-buffer (nnshimbun-open-nov group)) + (goto-char (point-min)) + (setq beg (ignore-errors (read (current-buffer)))) + (goto-char (point-max)) + (forward-line -1) + (setq end (ignore-errors (read (current-buffer))) + lines (count-lines (point-min) (point-max)))) + (nnheader-report 'nnshimbunw "Selected group %s" group) + (nnheader-insert "211 %d %d %d %s\n" + lines (or beg 0) (or end 0) group)))))) + +(deffoo nnshimbun-request-scan (&optional group server) + (nnshimbun-possibly-change-group group server) + (nnshimbun-generate-nov-database group)) + +(deffoo nnshimbun-close-group (group &optional server) + (nnshimbun-write-nov group) + t) + +(deffoo nnshimbun-request-list (&optional server) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (dolist (group nnshimbun-groups) + (when (nnshimbun-possibly-change-group group server) + (let (beg end) + (save-excursion + (set-buffer (nnshimbun-open-nov group)) + (goto-char (point-min)) + (setq beg (ignore-errors (read (current-buffer)))) + (goto-char (point-max)) + (forward-line -1) + (setq end (ignore-errors (read (current-buffer))))) + (insert (format "%s %d %d n\n" group (or end 0) (or beg 0))))))) + t) ; return value + +(eval-and-compile + (if (fboundp 'mime-entity-fetch-field) + ;; For Semi-Gnus. + (defun nnshimbun-insert-header (header) + (insert "Subject: " (or (mime-entity-fetch-field header 'Subject) "(none)") "\n" + "From: " (or (mime-entity-fetch-field header 'From) "(nobody)") "\n" + "Date: " (or (mail-header-date header) "") "\n" + "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n") + (let ((refs (mail-header-references header))) + (and refs + (string< "" refs) + (insert "References: " refs "\n"))) + (insert "Lines: " (number-to-string (or (mail-header-lines header) 0)) "\n" + "Xref: " (nnshimbun-header-xref header) "\n")) + ;; For pure Gnus. + (defun nnshimbun-insert-header (header) + (nnheader-insert-header header) + (delete-char -1) + (insert "Xref: " (nnshimbun-header-xref header) "\n")))) + +(deffoo nnshimbun-retrieve-headers (articles &optional group server fetch-old) + (when (nnshimbun-possibly-change-group group server) + (if (nnshimbun-retrieve-headers-with-nov articles fetch-old) + 'nov + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let (header) + (dolist (art articles) + (if (stringp art) + (setq art (nnshimbun-search-id group art))) + (if (integerp art) + (when (setq header + (save-excursion + (set-buffer (nnshimbun-open-nov group)) + (and (nnheader-find-nov-line art) + (nnheader-parse-nov)))) + (insert (format "220 %d Article retrieved.\n" art)) + (nnshimbun-insert-header header) + (insert ".\n") + (delete-region (point) (point-max)))))) + 'header)))) + +(defun nnshimbun-retrieve-headers-with-nov (articles &optional fetch-old) + (if (or gnus-nov-is-evil nnshimbun-nov-is-evil) + nil + (let ((nov (expand-file-name nnshimbun-nov-file-name nnshimbun-current-directory))) + (when (file-exists-p nov) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents nov) + (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 Database Operations + +(defun nnshimbun-generate-nov-database (group) + (prog1 (funcall nnshimbun-generate-nov group) + (nnshimbun-write-nov group))) + +(defun nnshimbun-generate-nov-for-each-group (group) + (nnshimbun-possibly-change-group group) + (save-excursion + (set-buffer (nnshimbun-open-nov group)) + (let (i) + (goto-char (point-max)) + (forward-line -1) + (setq i (or (ignore-errors (read (current-buffer))) 0)) + (dolist (header (save-excursion + (set-buffer nnshimbun-buffer) + (erase-buffer) + (nnshimbun-retrieve-url (eval nnshimbun-index-url) t) + (goto-char (point-min)) + (funcall nnshimbun-get-headers))) + (unless (nnshimbun-search-id group (mail-header-id header)) + (mail-header-set-number header (setq i (1+ i))) + (goto-char (point-max)) + (nnheader-insert-nov header) + (if nnshimbun-pre-fetch-article + (nnshimbun-request-article-1 i group nil nnshimbun-buffer))))))) + +(defun nnshimbun-generate-nov-for-all-groups (&rest args) + (unless (and nnshimbun-nov-last-check + (< (nnshimbun-lapse-seconds nnshimbun-nov-last-check) + nnshimbun-check-interval)) + (save-excursion + (dolist (list (funcall nnshimbun-get-headers)) + (let ((group (car list))) + (nnshimbun-possibly-change-group group) + (when (cdr list) + (set-buffer (nnshimbun-open-nov group)) + (let (i) + (goto-char (point-max)) + (forward-line -1) + (setq i (or (ignore-errors (read (current-buffer))) 0)) + (dolist (header (cdr list)) + (unless (nnshimbun-search-id group (mail-header-id header)) + (mail-header-set-number header (setq i (1+ i))) + (goto-char (point-max)) + (nnheader-insert-nov header) + (if nnshimbun-pre-fetch-article + (nnshimbun-request-article-1 i group nil nnshimbun-buffer)))))))) + (nnshimbun-save-nov) + (setq nnshimbun-nov-last-check (current-time))))) + +(defun nnshimbun-search-id (group id &optional nov) + (save-excursion + (set-buffer (nnshimbun-open-nov group)) + (goto-char (point-min)) + (let (found) + (while (and (not found) + (search-forward id nil t)) ; We find the ID. + ;; And the id is in the fourth field. + (if (not (and (search-backward "\t" nil t 4) + (not (search-backward "\t" (gnus-point-at-bol) t)))) + (forward-line 1) + (forward-line 0) + (setq found t))) + (unless found + (goto-char (point-min)) + (when (search-forward (concat "X-Nnshimbun-Id: " id) nil t) + (forward-line 0) + (setq found t))) + (if found + (if nov + (nnheader-parse-nov) + ;; We return the article number. + (ignore-errors (read (current-buffer)))))))) + +(defun nnshimbun-nov-fix-header (group header args) + (save-excursion + (set-buffer (nnshimbun-open-nov group)) + (when (nnheader-find-nov-line (mail-header-number header)) + (dolist (arg args) + (if (eq (car arg) 'id) + (let ((extra (mail-header-extra header))) + (unless (assq 'X-Nnshimbun-Id extra) + (mail-header-set-extra + header + (cons (cons 'X-Nnshimbun-Id (mail-header-id header)) + extra))) + (mail-header-set-id header (cdr arg))) + (let ((func (intern (concat "mail-header-set-" (symbol-name (car arg)))))) + (if (cdr arg) (eval (list func header (cdr arg))))))) + (mail-header-set-xref header (nnshimbun-header-xref header)) + (delete-region (point) (progn (forward-line 1) (point))) + (nnheader-insert-nov header)))) + +(defun nnshimbun-open-nov (group) + (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist)))) + (if (buffer-live-p buffer) + buffer + (setq buffer (gnus-get-buffer-create + (format " *nnshimbun overview %s %s*" + (nnoo-current-server 'nnshimbun) group))) + (save-excursion + (set-buffer buffer) + (set (make-local-variable 'nnshimbun-nov-buffer-file-name) + (expand-file-name + nnshimbun-nov-file-name + (nnmail-group-pathname group nnshimbun-server-directory))) + (erase-buffer) + (when (file-exists-p nnshimbun-nov-buffer-file-name) + (nnheader-insert-file-contents nnshimbun-nov-buffer-file-name)) + (set-buffer-modified-p nil)) + (push (cons group buffer) nnshimbun-nov-buffer-alist) + buffer))) + +(defun nnshimbun-write-nov (group) + (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist)))) + (when (buffer-live-p buffer) + (save-excursion + (set-buffer buffer) + (buffer-modified-p) + (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name + nil 'nomesg))))) + +(defun nnshimbun-save-nov () + (save-excursion + (while nnshimbun-nov-buffer-alist + (when (buffer-name (cdar nnshimbun-nov-buffer-alist)) + (set-buffer (cdar nnshimbun-nov-buffer-alist)) + (when (buffer-modified-p) + (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name + nil 'nomesg)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (setq nnshimbun-nov-buffer-alist (cdr nnshimbun-nov-buffer-alist))))) + + + +;;; Server Initialize +(defun nnshimbun-possibly-change-group (group &optional server) + (when server + (unless (nnshimbun-server-opened server) + (nnshimbun-open-server server))) + (unless (gnus-buffer-live-p nnshimbun-buffer) + (setq nnshimbun-buffer + (save-excursion + (nnheader-set-temp-buffer + (format " *nnshimbun %s*" (nnoo-current-server 'nnshimbun)))))) + (if (not group) + t + (let ((pathname (nnmail-group-pathname group nnshimbun-server-directory)) + (pathname-coding-system 'binary)) + (unless (equal pathname nnshimbun-current-directory) + (setq nnshimbun-current-directory pathname + nnshimbun-current-group group)) + (unless (file-exists-p nnshimbun-current-directory) + (ignore-errors (make-directory nnshimbun-current-directory t))) + (cond + ((not (file-exists-p nnshimbun-current-directory)) + (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-current-directory)) + ((not (file-directory-p (file-truename nnshimbun-current-directory))) + (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-current-directory)) + (t t))))) + + + +;;; Misc Functions + +(eval-and-compile + (if (fboundp 'eword-encode-string) + ;; For Semi-Gnus. + (defun nnshimbun-mime-encode-string (string) + (mapconcat + #'identity + (split-string (eword-encode-string (nnweb-decode-entities-string string)) "\n") + "")) + ;; For pure Gnus. + (defun nnshimbun-mime-encode-string (string) + (mapconcat + #'identity + (split-string + (with-temp-buffer + (insert (nnweb-decode-entities-string string)) + (rfc2047-encode-region (point-min) (point-max)) + (buffer-substring (point-min) (point-max))) + "\n") + "")))) + +(defun nnshimbun-lapse-seconds (time) + (let ((now (current-time))) + (+ (* (- (car now) (car time)) 65536) + (- (nth 1 now) (nth 1 time))))) + +(defun nnshimbun-make-date-string (year month day &optional time) + (format "%02d %s %04d %s +0900" + day + (aref [nil "Jan" "Feb" "Mar" "Apr" "May" "Jun" + "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] + month) + (cond ((< year 69) + (+ year 2000)) + ((< year 100) + (+ year 1900)) + ((< year 1000) ; possible 3-digit years. + (+ year 1900)) + (t year)) + (or time "00:00"))) + +(if (fboundp 'regexp-opt) + (defalias 'nnshimbun-regexp-opt 'regexp-opt) + (defun nnshimbun-regexp-opt (strings &optional paren) + "Return a regexp to match a string in STRINGS. +Each string should be unique in STRINGS and should not contain any regexps, +quoted or not. If optional PAREN is non-nil, ensure that the returned regexp +is enclosed by at least one regexp grouping construct." + (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" ""))) + (concat open-paren (mapconcat 'regexp-quote strings "\\|") close-paren)))) + + +;; Fast fill-region function + +(defvar nnshimbun-fill-column (min 80 (- (frame-width) 4))) + +(defconst nnshimbun-kinsoku-bol-list + (funcall + (if (fboundp 'string-to-char-list) + 'string-to-char-list + 'string-to-list) "\ +!)-_~}]:;',.?$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7!8!9!:!;!!?!@!A(B\ +$B!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n$!$#$%$'$)$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v(B")) + +(defconst nnshimbun-kinsoku-eol-list + (funcall + (if (fboundp 'string-to-char-list) + 'string-to-char-list + 'string-to-list) + "({[`$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!x(B")) + +(defun nnshimbun-fill-line () + (forward-line 0) + (let ((top (point)) chr) + (while (if (>= (move-to-column nnshimbun-fill-column) + nnshimbun-fill-column) + (not (progn + (if (memq (preceding-char) nnshimbun-kinsoku-eol-list) + (progn + (backward-char) + (while (memq (preceding-char) nnshimbun-kinsoku-eol-list) + (backward-char)) + (insert "\n")) + (while (memq (setq chr (following-char)) nnshimbun-kinsoku-bol-list) + (forward-char)) + (if (looking-at "\\s-+") + (or (eolp) (delete-region (point) (match-end 0))) + (or (> (char-width chr) 1) + (re-search-backward "\\<" top t) + (end-of-line))) + (or (eolp) (insert "\n")))))) + (setq top (point)))) + (forward-line 1) + (not (eobp))) + +(defsubst nnshimbun-shallow-rendering () + (goto-char (point-min)) + (while (search-forward "

" nil t) + (insert "\n\n")) + (goto-char (point-min)) + (while (search-forward "
" nil t) + (insert "\n")) + (nnweb-remove-markup) + (nnweb-decode-entities) + (goto-char (point-min)) + (while (nnshimbun-fill-line)) + (goto-char (point-min)) + (when (skip-chars-forward "\n") + (delete-region (point-min) (point))) + (while (search-forward "\n\n" nil t) + (let ((p (point))) + (when (skip-chars-forward "\n") + (delete-region p (point))))) + (goto-char (point-max)) + (when (skip-chars-backward "\n") + (delete-region (point) (point-max))) + (insert "\n")) + +(defun nnshimbun-make-text-or-html-contents (header &optional x-face) + (let ((case-fold-search t) (html t) (start)) + (when (and (re-search-forward nnshimbun-contents-start nil t) + (setq start (point)) + (re-search-forward nnshimbun-contents-end nil t)) + (delete-region (match-beginning 0) (point-max)) + (delete-region (point-min) start) + (nnshimbun-shallow-rendering) + (setq html nil)) + (goto-char (point-min)) + (nnshimbun-insert-header header) + (insert "Content-Type: " (if html "text/html" "text/plain") + "; charset=ISO-2022-JP\nMIME-Version: 1.0\n") + (when x-face + (insert x-face) + (unless (bolp) + (insert "\n"))) + (insert "\n") + (encode-coding-string (buffer-string) + (mime-charset-to-coding-system "ISO-2022-JP")))) + +(defun nnshimbun-make-html-contents (header &optional x-face) + (let (start) + (when (and (re-search-forward nnshimbun-contents-start nil t) + (setq start (point)) + (re-search-forward nnshimbun-contents-end nil t)) + (delete-region (match-beginning 0) (point-max)) + (delete-region (point-min) start)) + (goto-char (point-min)) + (nnshimbun-insert-header header) + (insert "Content-Type: text/html; charset=ISO-2022-JP\n" + "MIME-Version: 1.0\n") + (when x-face + (insert x-face) + (unless (bolp) + (insert "\n"))) + (insert "\n") + (encode-coding-string (buffer-string) + (mime-charset-to-coding-system "ISO-2022-JP")))) + +(defun nnshimbun-make-mhonarc-contents (header &rest args) + (require 'mml) + (if (search-forward "" nil t) + (progn + (forward-line 0) + ;; Processing headers. + (save-restriction + (narrow-to-region (point-min) (point)) + (nnweb-decode-entities) + (goto-char (point-min)) + (while (search-forward "\n\n" nil t) + (replace-match "\n")) + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (replace-match " ")) + (goto-char (point-min)) + (let (buf refs) + (while (not (eobp)) + (cond + ((looking-at "\n" nil t) + (point))) + (when (search-forward "\n\n" nil t) + (forward-line -1) + (delete-region (point) (point-max))) + (nnweb-remove-markup) + (nnweb-decode-entities))) + (goto-char (point-min)) + (nnshimbun-insert-header header) + (insert "Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")) + (encode-coding-string (buffer-string) + (mime-charset-to-coding-system "ISO-2022-JP"))) + + +;;; www.asahi.com + +(defun nnshimbun-asahi-get-headers () + (when (search-forward "\n\n" nil t) + (delete-region (point-min) (point)) + (when (search-forward "\n\n" nil t) + (forward-line -1) + (delete-region (point) (point-max)) + (goto-char (point-min)) + (let (headers) + (while (re-search-forward + "^$B"#(B *" + nil t) + (let ((id (format "<%s%s%%%s>" + (match-string 2) + (match-string 3) + nnshimbun-current-group)) + (url (match-string 1))) + (push (make-full-mail-header + 0 + (nnshimbun-mime-encode-string + (mapconcat 'identity + (split-string + (buffer-substring + (match-end 0) + (progn (search-forward "
" nil t) (point))) + "\\(<[^>]+>\\|\r\\)") + "")) + nnshimbun-from-address + "" id "" 0 0 (concat nnshimbun-url url)) + headers))) + (setq headers (nreverse headers)) + (let ((i 0)) + (while (and (nth i headers) + (re-search-forward + "^\\[\\([0-9][0-9]\\)/\\([0-9][0-9]\\) \\([0-9][0-9]:[0-9][0-9]\\)\\]" + nil t)) + (let ((month (string-to-number (match-string 1))) + (date (decode-time (current-time)))) + (mail-header-set-date + (nth i headers) + (nnshimbun-make-date-string + (if (and (eq 12 month) (eq 1 (nth 4 date))) + (1- (nth 5 date)) + (nth 5 date)) + month + (string-to-number (match-string 2)) + (match-string 3)))) + (setq i (1+ i)))) + (nreverse headers))))) + + + +;;; www.sponichi.co.jp + +(defun nnshimbun-sponichi-get-headers () + (when (search-forward "$B%K%e!<%9%$%s%G%C%/%9(B" nil t) + (delete-region (point-min) (point)) + (when (search-forward "$B%"%I%?%0(B" nil t) + (forward-line 2) + (delete-region (point) (point-max)) + (goto-char (point-min)) + (let ((case-fold-search t) headers) + (while (re-search-forward + "^" + nil t) + (let ((url (match-string 1)) + (id (format "<%s%s%s%s%%%s>" + (match-string 3) + (match-string 4) + (match-string 5) + (match-string 6) + nnshimbun-current-group)) + (date (nnshimbun-make-date-string + (string-to-number (match-string 3)) + (string-to-number (match-string 4)) + (string-to-number (match-string 5))))) + (push (make-full-mail-header + 0 + (nnshimbun-mime-encode-string + (mapconcat 'identity + (split-string + (buffer-substring + (match-end 0) + (progn (search-forward "
" nil t) (point))) + "<[^>]+>") + "")) + nnshimbun-from-address + date id "" 0 0 (concat nnshimbun-url url)) + headers))) + headers)))) + + + +;;; CNET Japan + +(defun nnshimbun-cnet-get-headers () + (let ((case-fold-search t) headers) + (while (search-forward "\n\n" nil t) + (let ((subject (buffer-substring (point) (gnus-point-at-eol))) + (point (point))) + (forward-line -2) + (when (looking-at "") + (let ((url (match-string 1)) + (id (format "<%s%s%%%s>" + (match-string 2) + (match-string 3) + nnshimbun-current-group)) + (date (nnshimbun-make-date-string + (string-to-number (match-string 2)) + (string-to-number (match-string 4)) + (string-to-number (match-string 5))))) + (push (make-full-mail-header + 0 + (nnshimbun-mime-encode-string subject) + nnshimbun-from-address + date id "" 0 0 (concat nnshimbun-url url)) + headers))) + (goto-char point))) + headers)) + + + +;;; Wired + +(defun nnshimbun-wired-get-all-headers () + (save-excursion + (set-buffer nnshimbun-buffer) + (let ((group-header-alist (mapcar (lambda (g) (cons g nil)) nnshimbun-groups)) + (case-fold-search t) + (regexp (format + "" + (regexp-quote nnshimbun-url) + (nnshimbun-regexp-opt nnshimbun-groups)))) + (dolist (xover (list (concat nnshimbun-url "news/news/index.html") + (concat nnshimbun-url "news/news/last_seven.html"))) + (erase-buffer) + (nnshimbun-retrieve-url xover t) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let* ((url (concat nnshimbun-url (match-string 2))) + (group (downcase (match-string 3))) + (id (format "<%s%%%s>" (match-string 4) group)) + (date (nnshimbun-make-date-string + (string-to-number (match-string 5)) + (string-to-number (match-string 6)) + (string-to-number (match-string 7)))) + (header (make-full-mail-header + 0 + (nnshimbun-mime-encode-string + (mapconcat 'identity + (split-string + (buffer-substring + (match-end 0) + (progn (search-forward "" nil t) (point))) + "<[^>]+>") + "")) + nnshimbun-from-address + date id "" 0 0 url)) + (x (assoc group group-header-alist))) + (setcdr x (cons header (cdr x)))))) + group-header-alist))) + + + +;;; www.yomiuri.co.jp + +(defun nnshimbun-yomiuri-get-all-headers () + (save-excursion + (set-buffer nnshimbun-buffer) + (erase-buffer) + (nnshimbun-retrieve-url (eval nnshimbun-index-url) t) + (let ((case-fold-search t) + (group-header-alist (mapcar (lambda (g) (cons g nil)) nnshimbun-groups))) + (dolist (group nnshimbun-groups) + (let (start) + (goto-char (point-min)) + (when (and (search-forward (format "\n\n" group) nil t) + (setq start (point)) + (search-forward (format "\n\n" group) nil t)) + (forward-line -1) + (save-restriction + (narrow-to-region start (point)) + (goto-char start) + (while (re-search-forward + "]*>" + nil t) + (let ((url (concat (match-string 1) "a/" (match-string 2))) + (id (format "<%s%s%%%s>" + (match-string 1) + (match-string 3) + group)) + (year (string-to-number (match-string 4))) + (month (string-to-number (match-string 5))) + (day (string-to-number (match-string 6))) + (subject (mapconcat + 'identity + (split-string + (buffer-substring + (match-end 0) + (progn (search-forward "
" nil t) (point))) + "<[^>]+>") + "")) + date x) + (when (string-match "^$B"!(B" subject) + (setq subject (substring subject (match-end 0)))) + (if (string-match "(\\([0-9][0-9]:[0-9][0-9]\\))$" subject) + (setq date (nnshimbun-make-date-string + year month day (match-string 1 subject)) + subject (substring subject 0 (match-beginning 0))) + (setq date (nnshimbun-make-date-string year month day))) + (setcdr (setq x (assoc group group-header-alist)) + (cons (make-full-mail-header + 0 + (nnshimbun-mime-encode-string subject) + nnshimbun-from-address + date id "" 0 0 (concat nnshimbun-url url)) + (cdr x))))))))) + group-header-alist))) + + + +;;; Zdnet Japan + +(defun nnshimbun-zdnet-get-headers () + (let ((case-fold-search t) headers) + (goto-char (point-min)) + (let (start) + (while (and (search-forward "" nil t)) + (delete-region start (point)))) + (goto-char (point-min)) + (while (re-search-forward + "" + nil t) + (let ((year (+ 2000 (string-to-number (match-string 3)))) + (month (string-to-number (match-string 4))) + (day (string-to-number (match-string 5))) + (id (format "<%s%s%s%s%%%s>" + (match-string 3) + (match-string 4) + (match-string 5) + (match-string 6) + nnshimbun-current-group)) + (url (match-string 2))) + (push (make-full-mail-header + 0 + (nnshimbun-mime-encode-string + (mapconcat 'identity + (split-string + (buffer-substring + (match-end 0) + (progn (search-forward "" nil t) (point))) + "<[^>]+>") + "")) + nnshimbun-from-address + (nnshimbun-make-date-string year month day) + id "" 0 0 (concat nnshimbun-url url)) + headers))) + (nreverse headers))) + + + +;;; MLs on www.mew.org + +(defmacro nnshimbun-mew-concat-url (url) + `(concat nnshimbun-url + (nth 1 (assoc nnshimbun-current-group nnshimbun-mew-groups)) + "/" + ,url)) + +(defmacro nnshimbun-mew-reverse-order-p () + `(nth 2 (assoc nnshimbun-current-group nnshimbun-mew-groups))) + +(defmacro nnshimbun-mew-spew-p () + `(nth 3 (assoc nnshimbun-current-group nnshimbun-mew-groups))) + +(defsubst nnshimbun-mew-retrieve-xover (aux) + (erase-buffer) + (nnshimbun-retrieve-url + (nnshimbun-mew-concat-url (if (= aux 1) "index.html" (format "mail%d.html" aux))) + t)) + +(defconst nnshimbun-mew-regexp "]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<") + +(defmacro nnshimbun-mew-extract-header-values () + `(progn + (setq url (nnshimbun-mew-concat-url (match-string 1)) + id (format "<%05d%%%s>" + (1- (string-to-number (match-string 2))) + nnshimbun-current-group) + subject (match-string 3)) + (forward-line 1) + (if (nnshimbun-search-id nnshimbun-current-group id) + (throw 'stop headers) + (push (make-full-mail-header + 0 + (nnshimbun-mime-encode-string subject) + (if (looking-at "\\([^<]+\\)<") + (nnshimbun-mime-encode-string (match-string 1)) + "") + "" id "" 0 0 url) + headers)))) + +(eval-and-compile + (if (fboundp 'mime-entity-fetch-field) + ;; For Semi-Gnus. + (defmacro nnshimbun-mew-mail-header-subject (header) + `(mime-entity-fetch-field ,header 'Subject)) + ;; For pure Gnus. + (defalias 'nnshimbun-mew-mail-header-subject 'mail-header-subject))) + +(defun nnshimbun-mew-get-headers () + (if (nnshimbun-mew-spew-p) + (let ((headers (nnshimbun-mew-get-headers-1))) + (erase-buffer) + (insert-buffer-substring (nnshimbun-open-nov nnshimbun-current-group)) + (delq nil + (mapcar + (lambda (header) + (goto-char (point-min)) + (let ((subject (nnshimbun-mew-mail-header-subject header)) + (found)) + (while (and (not found) + (search-forward subject nil t)) + (if (not (and (search-backward "\t" nil t) + (not (search-backward "\t" (gnus-point-at-bol) t)))) + (forward-line 1) + (setq found t))) + (if found + nil + (goto-char (point-max)) + (nnheader-insert-nov header) + header))) + headers))) + (nnshimbun-mew-get-headers-1))) + +(defun nnshimbun-mew-get-headers-1 () + (let (headers) + (when (re-search-forward + "]*HREF=\"mail\\([0-9]+\\)\\.html\">\\[?Last Page\\]?" nil t) + (let ((limit (string-to-number (match-string 1)))) + (catch 'stop + (if (nnshimbun-mew-reverse-order-p) + (let ((aux 1)) + (while (let (id url subject) + (while (re-search-forward nnshimbun-mew-regexp nil t) + (nnshimbun-mew-extract-header-values)) + (< aux limit)) + (nnshimbun-mew-retrieve-xover (setq aux (1+ aux))))) + (while (> limit 0) + (nnshimbun-mew-retrieve-xover limit) + (setq limit (1- limit)) + (let (id url subject) + (goto-char (point-max)) + (while (re-search-backward nnshimbun-mew-regexp nil t) + (nnshimbun-mew-extract-header-values) + (forward-line -2))))) + headers))))) + + + +;;; MLs on www.xemacs.org + +(defmacro nnshimbun-xemacs-concat-url (url) + `(concat nnshimbun-url nnshimbun-current-group "/" ,url)) + +(defun nnshimbun-xemacs-get-headers () + (let (headers auxs aux) + (catch 'stop + (while (re-search-forward + (concat "\\[Index\\]") + nil t) + (setq auxs (append auxs (list (match-string 1))))) + (while auxs + (erase-buffer) + (nnshimbun-retrieve-url + (nnshimbun-xemacs-concat-url (concat (setq aux (car auxs)) "/"))) + (let (id url subject) + (goto-char (point-max)) + (while (re-search-backward + "]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<" + nil t) + (setq url (nnshimbun-xemacs-concat-url + (concat aux "/" (match-string 1))) + id (format "<%s%05d%%%s>" + aux + (string-to-number (match-string 2)) + nnshimbun-current-group) + subject (match-string 3)) + (forward-line 1) + (if (nnshimbun-search-id nnshimbun-current-group id) + (throw 'stop headers) + (push (make-full-mail-header + 0 + (nnshimbun-mime-encode-string subject) + (if (looking-at "\\([^<]+\\)<") + (match-string 1) + "") + "" id "" 0 0 url) + headers)) + (message "%s" id) + (forward-line -2))) + (setq auxs (cdr auxs)))) + headers)) + +;;; MLs on www.jp.netbsd.org + +(defun nnshimbun-netbsd-get-headers () + (let ((case-fold-search t) headers months) + (goto-char (point-min)) + (while (re-search-forward "" nil t) + (push (match-string 1) months)) + (setq months (nreverse months)) + (catch 'exit + (dolist (month months) + (erase-buffer) + (nnshimbun-retrieve-url + (format "%s%s/%s/maillist.html" nnshimbun-url nnshimbun-current-group month) + t) + (let (id url subject) + (while (re-search-forward + "]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)" + nil t) + (setq url (format "%s%s/%s/%s" + nnshimbun-url + nnshimbun-current-group + month + (match-string 1)) + id (format "<%s%05d%%%s>" + month + (string-to-number (match-string 2)) + nnshimbun-current-group) + subject (match-string 3)) + (if (nnshimbun-search-id nnshimbun-current-group id) + (throw 'exit headers) + (push (make-full-mail-header + 0 + (nnshimbun-mime-encode-string subject) + (if (looking-at " *\\([^<]+\\)<") + (nnshimbun-mime-encode-string (match-string 1)) + "") + "" id "" 0 0 url) + headers))))) + headers))) + +(provide 'nnshimbun) +;;; nnshimbun.el ends here. diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index c28e35c..1a9ac54 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -1,5 +1,5 @@ ;;; nnslashdot.el --- interfacing with Slashdot -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -29,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'nnoo) (require 'message) @@ -36,17 +37,11 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) -(require 'nnweb) (eval-when-compile (ignore-errors - (require 'w3) - (require 'url) - (require 'w3-forms))) + (require 'nnweb))) ;; Report failure to find w3 at load time if appropriate. -(eval '(progn - (require 'w3) - (require 'url) - (require 'w3-forms))) +(eval '(require 'nnweb)) (nnoo-declare nnslashdot) @@ -90,11 +85,13 @@ (deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old) (nnslashdot-possibly-change-server group server) - (unless gnus-nov-is-evil - (if nnslashdot-threaded - (nnslashdot-threaded-retrieve-headers articles group) - (nnslashdot-sane-retrieve-headers articles group)))) - + (condition-case why + (unless gnus-nov-is-evil + (if nnslashdot-threaded + (nnslashdot-threaded-retrieve-headers articles group) + (nnslashdot-sane-retrieve-headers articles group))) + (search-failed (nnslashdot-lose why)))) + (deffoo nnslashdot-threaded-retrieve-headers (articles group) (let ((last (car (last articles))) (did nil) @@ -108,31 +105,34 @@ (let ((case-fold-search t)) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url sid)) + (nnweb-insert (format nnslashdot-article-url + (nnslashdot-sid-strip sid)) t) (goto-char (point-min)) (search-forward "Posted by ") (when (looking-at "]+>\\([^<]+\\)") - (setq from (match-string 1))) + (setq from (nnweb-decode-entities-string (match-string 1)))) (search-forward " on ") (setq date (nnslashdot-date-to-date (buffer-substring (point) (1- (search-forward "<"))))) - (forward-line 2) - (setq lines (count-lines - (point) - (search-forward - "A href=http://slashdot.org/article.pl"))) + (setq lines (/ (- (point) + (progn (forward-line 1) (point))) + 60)) (push (cons 1 (make-full-mail-header - 1 group from date (concat "<" sid "%1@slashdot>") + 1 group from date + (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>") "" 0 lines nil nil)) headers)) (while (and (setq start (pop startats)) (< start last)) (setq point (goto-char (point-max))) (nnweb-insert - (format nnslashdot-comments-url sid nnslashdot-threshold 0 start)) + (format nnslashdot-comments-url + (nnslashdot-sid-strip sid) + nnslashdot-threshold 0 start) + t) (when first-comments (setq first-comments nil) (goto-char (point-max)) @@ -143,21 +143,26 @@ (setq startats (sort startats '<))) (goto-char point) (while (re-search-forward - "\\([^<]+\\).*score:\\([^)]+\\))" + "<\\(b\\|H4\\)>\\([^<]+\\).*score:\\([^)]+\\))" nil t) (setq article (string-to-number (match-string 1)) - subject (match-string 2) - score (match-string 3)) + subject (match-string 3) + score (match-string 5)) (when (string-match "^Re: *" subject) (setq subject (concat "Re: " (substring subject (match-end 0))))) + (setq subject (nnweb-decode-entities-string subject)) (forward-line 1) (if (looking-at "by ]+>\\([^<]+\\)[ \t\n]*.*(\\([^)]+\\))") - (setq from (concat (match-string 1) - " <" (match-string 2) ">")) - (looking-at "by \\(.+\\) on ") - (setq from (match-string 1))) - (goto-char (- (match-end 0) 5)) + (progn + (goto-char (- (match-end 0) 5)) + (setq from (concat + (nnweb-decode-entities-string (match-string 1)) + " <" (match-string 2) ">"))) + (setq from "") + (when (looking-at "by \\(.+\\) on ") + (goto-char (- (match-end 0) 5)) + (setq from (nnweb-decode-entities-string (match-string 1))))) (search-forward " on ") (setq date (nnslashdot-date-to-date @@ -165,7 +170,7 @@ (setq lines (/ (abs (- (search-forward ""))) 70)) - (forward-line 2) + (forward-line 4) (setq parent (if (looking-at ".*cid=\\([0-9]+\\)") (match-string 1) @@ -178,11 +183,11 @@ (1+ article) (concat subject " (" score ")") from date - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ article)) "@slashdot>") (if parent - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ (string-to-number parent))) "@slashdot>") "") @@ -192,8 +197,9 @@ (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header)))) + (mm-with-unibyte-current-buffer + (dolist (header nnslashdot-headers) + (nnheader-insert-nov (cdr header))))) 'nov)) (deffoo nnslashdot-sane-retrieve-headers (articles group) @@ -206,23 +212,25 @@ (set-buffer nnslashdot-buffer) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url sid)) + (nnweb-insert (format nnslashdot-article-url + (nnslashdot-sid-strip sid)) t) (goto-char (point-min)) (search-forward "Posted by ") (when (looking-at "]+>\\([^<]+\\)") - (setq from (match-string 1))) + (setq from (nnweb-decode-entities-string (match-string 1)))) (search-forward " on ") (setq date (nnslashdot-date-to-date (buffer-substring (point) (1- (search-forward "<"))))) (forward-line 2) (setq lines (count-lines (point) - (search-forward - "A href=http://slashdot.org/article.pl"))) + (re-search-forward + "A href=\"\\(http://slashdot.org\\)?/article"))) (push (cons 1 (make-full-mail-header - 1 group from date (concat "<" sid "%1@slashdot>") + 1 group from date (concat "<" (nnslashdot-sid-strip sid) + "%1@slashdot>") "" 0 lines nil nil)) headers)) (while (or (not article) @@ -232,23 +240,31 @@ (setq start (1+ article))) (setq point (goto-char (point-max))) (nnweb-insert - (format nnslashdot-comments-url sid nnslashdot-threshold 4 start)) + (format nnslashdot-comments-url (nnslashdot-sid-strip sid) + nnslashdot-threshold 4 start) + t) (goto-char point) (while (re-search-forward - "\\([^<]+\\).*score:\\([^)]+\\))" + "<\\(b\\|H4\\)>\\([^<]+\\).*score:\\([^)]+\\))" nil t) (setq article (string-to-number (match-string 1)) - subject (match-string 2) - score (match-string 3)) + subject (match-string 3) + score (match-string 5)) (when (string-match "^Re: *" subject) (setq subject (concat "Re: " (substring subject (match-end 0))))) + (setq subject (nnweb-decode-entities-string subject)) (forward-line 1) (if (looking-at "by ]+>\\([^<]+\\)[ \t\n]*.*(\\([^)]+\\))") - (setq from (concat (match-string 1) " <" (match-string 2) ">")) - (looking-at "by \\(.+\\) on ") - (setq from (match-string 1))) - (goto-char (- (match-end 0) 5)) + (progn + (goto-char (- (match-end 0) 5)) + (setq from (concat + (nnweb-decode-entities-string (match-string 1)) + " <" (match-string 2) ">"))) + (setq from "") + (when (looking-at "by \\(.+\\) on ") + (goto-char (- (match-end 0) 5)) + (setq from (nnweb-decode-entities-string (match-string 1))))) (search-forward " on ") (setq date (nnslashdot-date-to-date @@ -268,11 +284,11 @@ (make-full-mail-header (1+ article) (concat subject " (" score ")") from date - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ article)) "@slashdot>") (if parent - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ (string-to-number parent))) "@slashdot>") "") @@ -283,8 +299,9 @@ (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header)))) + (mm-with-unibyte-current-buffer + (dolist (header nnslashdot-headers) + (nnheader-insert-nov (cdr header))))) 'nov)) (deffoo nnslashdot-request-group (group &optional server dont-check) @@ -310,45 +327,49 @@ (deffoo nnslashdot-request-article (article &optional group server buffer) (nnslashdot-possibly-change-server group server) (let (contents) - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (goto-char (point-min)) - (when (and (stringp article) - (string-match "%\\([0-9]+\\)@" article)) - (setq article (string-to-number (match-string 1 article)))) - (when (numberp article) - (if (= article 1) - (progn - (re-search-forward "Posted by .* on ") - (forward-line 1) + (condition-case why + (save-excursion + (set-buffer nnslashdot-buffer) + (let ((case-fold-search t)) + (goto-char (point-min)) + (when (and (stringp article) + (string-match "%\\([0-9]+\\)@" article)) + (setq article (string-to-number (match-string 1 article)))) + (when (numberp article) + (if (= article 1) + (progn + (re-search-forward "Posted by *<[^>]+>[^>]*<[^>]+> *on ") + (search-forward "
") + (setq contents + (buffer-substring + (point) + (progn + (re-search-forward + "

.*A href=\"\\(http://slashdot.org\\)?/article") + (match-beginning 0))))) + (search-forward (format "" (1- article))) (setq contents (buffer-substring - (point) - (progn - (re-search-forward - "

.*A href=http://slashdot.org/article.pl") - (match-beginning 0))))) - (search-forward (format "" (1- article))) - (setq contents - (buffer-substring - (re-search-forward "]+>") - (search-forward ""))))))) + (re-search-forward "]+>") + (search-forward ""))))))) + (search-failed (nnslashdot-lose why))) + (when contents (save-excursion (set-buffer (or buffer nntp-server-buffer)) (erase-buffer) - (insert contents) - (goto-char (point-min)) - (while (search-forward "

" nil t) - (replace-match "

" t t)) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) - "\n") - (let ((header (cdr (assq article nnslashdot-headers)))) - (nnheader-insert-header header)) - (nnheader-report 'nnslashdot "Fetched article %s" article) + (mm-with-unibyte-current-buffer + (insert contents) + (goto-char (point-min)) + (while (re-search-forward "\\(
\r?\\)+" nil t) + (replace-match "

" t t)) + (goto-char (point-min)) + (insert "Content-Type: text/html\nMIME-Version: 1.0\n") + (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) + "\n") + (let ((header (cdr (assq article nnslashdot-headers)))) + (nnheader-insert-header header)) + (nnheader-report 'nnslashdot "Fetched article %s" article)) (cons group article))))) (deffoo nnslashdot-close-server (&optional server) @@ -363,49 +384,55 @@ (nnslashdot-possibly-change-server nil server) (let ((number 0) sid elem description articles gname) - ;; First we do the Ultramode to get info on all the latest groups. - (with-temp-buffer - (nnweb-insert "http://slashdot.org/slashdot.xml") - (goto-char (point-min)) - (while (search-forward "" nil t) - (narrow-to-region (point) (search-forward "")) - (goto-char (point-min)) - (re-search-forward "\\([^<]+\\)") - (setq description (match-string 1)) - (re-search-forward "\\([^<]+\\)") - (setq sid (match-string 1)) - (string-match "/\\([0-9/]+\\).shtml" sid) - (setq sid (match-string 1 sid)) - (re-search-forward "\\([^<]+\\)") - (setq articles (string-to-number (match-string 1))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid) nnslashdot-groups)) - (goto-char (point-max)) - (widen))) - ;; Then do the older groups. - (while (> (- nnslashdot-group-number number) 0) - (with-temp-buffer - (let ((case-fold-search t)) - (nnweb-insert (format nnslashdot-active-url number)) - (goto-char (point-min)) - (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" nil t) - (setq sid (match-string 1) - description (match-string 2)) - (forward-line 1) - (when (re-search-forward "\\([0-9]+\\)" nil t) - (setq articles (string-to-number (match-string 1)))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid) nnslashdot-groups))))) - (incf number 30)) + (condition-case why + ;; First we do the Ultramode to get info on all the latest groups. + (progn + (mm-with-unibyte-buffer + (nnweb-insert "http://slashdot.org/slashdot.xml" t) + (goto-char (point-min)) + (while (search-forward "" nil t) + (narrow-to-region (point) (search-forward "")) + (goto-char (point-min)) + (re-search-forward "\\([^<]+\\)") + (setq description + (nnweb-decode-entities-string (match-string 1))) + (re-search-forward "\\([^<]+\\)") + (setq sid (match-string 1)) + (string-match "/\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) + (setq sid (concat "00/" (match-string 1 sid))) + (re-search-forward "\\([^<]+\\)") + (setq articles (string-to-number (match-string 1))) + (setq gname (concat description " (" sid ")")) + (if (setq elem (assoc gname nnslashdot-groups)) + (setcar (cdr elem) articles) + (push (list gname articles sid) nnslashdot-groups)) + (goto-char (point-max)) + (widen))) + ;; Then do the older groups. + (while (> (- nnslashdot-group-number number) 0) + (mm-with-unibyte-buffer + (let ((case-fold-search t)) + (nnweb-insert (format nnslashdot-active-url number) t) + (goto-char (point-min)) + (while (re-search-forward + "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" + nil t) + (setq sid (match-string 1) + description + (nnweb-decode-entities-string (match-string 2))) + (forward-line 1) + (when (re-search-forward "\\([0-9]+\\)" nil t) + (setq articles (string-to-number (match-string 1)))) + (setq gname (concat description " (" sid ")")) + (if (setq elem (assoc gname nnslashdot-groups)) + (setcar (cdr elem) articles) + (push (list gname articles sid) nnslashdot-groups))))) + (incf number 30))) + (search-failed (nnslashdot-lose why))) (nnslashdot-write-groups) (nnslashdot-generate-active) t)) - + (deffoo nnslashdot-request-newgroups (date &optional server) (nnslashdot-possibly-change-server nil server) (nnslashdot-generate-active) @@ -413,7 +440,7 @@ (deffoo nnslashdot-request-post (&optional server) (nnslashdot-possibly-change-server nil server) - (let ((sid (message-fetch-field "newsgroups")) + (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) (subject (message-fetch-field "subject")) (references (car (last (split-string (message-fetch-field "references"))))) @@ -434,6 +461,9 @@ (insert "\n") (setq quoted nil))) (forward-line 1)) + (goto-char (point-min)) + (while (re-search-forward "^ *\n" nil t) + (replace-match "

\n")) (widen) (when (message-goto-signature) (forward-line -1) @@ -457,6 +487,16 @@ ("postercomment" . ,body) ("posttype" . "html"))))) +(deffoo nnslashdot-request-delete-group (group &optional force server) + (nnslashdot-possibly-change-server group server) + (setq nnslashdot-groups (delq (assoc group nnslashdot-groups) + nnslashdot-groups)) + (nnslashdot-write-groups)) + +(deffoo nnslashdot-request-close () + (setq nnslashdot-headers nil + nnslashdot-groups nil)) + (nnoo-define-skeleton nnslashdot) ;;; Internal functions @@ -472,7 +512,7 @@ (defun nnslashdot-read-groups () (let ((file (expand-file-name "groups" nnslashdot-directory))) (when (file-exists-p file) - (with-temp-buffer + (mm-with-unibyte-buffer (insert-file-contents file) (goto-char (point-min)) (setq nnslashdot-groups (read (current-buffer))))))) @@ -492,13 +532,15 @@ (format " *nnslashdot %s*" server)))))) (defun nnslashdot-date-to-date (sdate) - (let ((elem (delete "" (split-string sdate)))) - (concat (substring (nth 0 elem) 0 3) " " - (substring (nth 1 elem) 0 3) " " - (substring (nth 2 elem) 0 2) " " - (substring (nth 3 elem) 1 6) " " - (format-time-string "%Y") " " - (nth 4 elem)))) + (condition-case err + (let ((elem (delete "" (split-string sdate)))) + (concat (substring (nth 0 elem) 0 3) " " + (substring (nth 1 elem) 0 3) " " + (substring (nth 2 elem) 0 2) " " + (substring (nth 3 elem) 1 6) " " + (format-time-string "%Y") " " + (nth 4 elem))) + (error ""))) (defun nnslashdot-generate-active () (save-excursion @@ -508,6 +550,16 @@ (insert (prin1-to-string (car elem)) " " (number-to-string (cadr elem)) " 1 y\n")))) +(defun nnslashdot-lose (why) + (error "Slashdot HTML has changed; please get a new version of nnslashdot")) + +;(defun nnslashdot-sid-strip (sid) +; (if (string-match "^00/" sid) +; (substring sid (match-end 0)) +; sid)) + +(defalias 'nnslashdot-sid-strip 'identity) + (provide 'nnslashdot) ;;; nnslashdot.el ends here diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index ace0c9a..140fe5e 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -1,5 +1,7 @@ ;;; nnsoup.el --- SOUP access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -27,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nnheader) (require 'nnmail) (require 'gnus-soup) @@ -44,16 +47,16 @@ ("/tmp/")) "*Where nnsoup will store temporary files.") -(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/") +(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory) "*Directory where outgoing packets will be composed.") -(defvoo nnsoup-replies-format-type ?n +(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format. "*Format of the replies packages.") (defvoo nnsoup-replies-index-type ?n "*Index type of the replies packages.") -(defvoo nnsoup-active-file (concat nnsoup-directory "active") +(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory) "Active file.") (defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz" @@ -255,7 +258,7 @@ backend for the messages.") (nth 1 (nnsoup-article-to-area article nnsoup-current-group)))))) (cond ((= kind ?m) 'mail) - ((= kind ?n) 'news) + ((= kind ?n) 'news) (t 'unknown))))) (deffoo nnsoup-close-group (group &optional server) @@ -313,7 +316,7 @@ backend for the messages.") (setq info (pop infolist) range-list (gnus-uncompress-range (car info)) prefix (gnus-soup-area-prefix (nth 1 info))) - (when ;; All the articles in this file are marked for expiry. + (when;; All the articles in this file are marked for expiry. (and (or (setq mod-time (nth 5 (file-attributes (nnsoup-file prefix)))) (setq mod-time (nth 5 (file-attributes @@ -422,12 +425,15 @@ backend for the messages.") (setq cur-prefix (nnsoup-next-prefix)) (nnheader-message 5 "Incorporating file %s..." cur-prefix) (when (file-exists-p - (setq file (concat nnsoup-tmp-directory - (gnus-soup-area-prefix area) ".IDX"))) + (setq file + (expand-file-name + (concat (gnus-soup-area-prefix area) ".IDX") + nnsoup-tmp-directory))) (rename-file file (nnsoup-file cur-prefix))) (when (file-exists-p - (setq file (concat nnsoup-tmp-directory - (gnus-soup-area-prefix area) ".MSG"))) + (setq file (expand-file-name + (concat (gnus-soup-area-prefix area) ".MSG") + nnsoup-tmp-directory))) (rename-file file (nnsoup-file cur-prefix t)) (gnus-soup-set-area-prefix area cur-prefix) ;; Find the number of new articles in this area. @@ -476,7 +482,8 @@ backend for the messages.") (goto-char (point-min)) (cond ;; rnews batch format - ((= format ?n) + ((or (= format ?u) + (= format ?n)) ;; Gnus back compatibility. (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$") (forward-line 1) (push (list @@ -530,17 +537,19 @@ backend for the messages.") (let* ((file (concat prefix (if message ".MSG" ".IDX"))) (buffer-name (concat " *nnsoup " file "*"))) (or (get-buffer buffer-name) ; File already loaded. - (when (file-exists-p (concat nnsoup-directory file)) + (when (file-exists-p (expand-file-name file nnsoup-directory)) (save-excursion ; Load the file. (set-buffer (get-buffer-create buffer-name)) (buffer-disable-undo) (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers) - (nnheader-insert-file-contents (concat nnsoup-directory file)) + (nnheader-insert-file-contents + (expand-file-name file nnsoup-directory)) (current-buffer)))))) (defun nnsoup-file (prefix &optional message) (expand-file-name - (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))) + (concat prefix (if message ".MSG" ".IDX")) + nnsoup-directory)) (defun nnsoup-message-buffer (prefix) (nnsoup-index-buffer prefix 'msg)) @@ -590,7 +599,7 @@ backend for the messages.") (let ((format (gnus-soup-encoding-format (gnus-soup-area-encoding (nth 1 area))))) (goto-char end) - (when (or (= format ?n) (= format ?m)) + (when (or (= format ?u) (= format ?n) (= format ?m)) (setq end (progn (forward-line -1) (point)))))) (set-buffer msg-buf)) (widen) @@ -721,7 +730,7 @@ backend for the messages.") (unless nnsoup-replies-list (setq nnsoup-replies-list (gnus-soup-parse-replies - (concat nnsoup-replies-directory "REPLIES")))) + (expand-file-name "REPLIES" nnsoup-replies-directory)))) (let ((replies nnsoup-replies-list)) (while (and replies (not (string= kind (gnus-soup-reply-kind (car replies))))) @@ -766,13 +775,13 @@ backend for the messages.") (if (not (setq elem (assoc group active))) (push (list group (cons 1 lines) (list (cons 1 lines) - (vector ident group "ncm" "" lines))) + (vector ident group "ucm" "" lines))) active) (nconc elem (list (list (cons (1+ (setq min (cdadr elem))) (+ min lines)) - (vector ident group "ncm" "" lines)))) + (vector ident group "ucm" "" lines)))) (setcdr (cadr elem) (+ min lines))) (setq files (cdr files))) (nnheader-message 5 "") @@ -800,7 +809,8 @@ backend for the messages.") ;; Sort and delete the files. (setq non-files (sort non-files 'string<)) (map-y-or-n-p "Delete file %s? " - (lambda (file) (delete-file (concat nnsoup-directory file))) + (lambda (file) (delete-file + (expand-file-name file nnsoup-directory))) non-files))) (provide 'nnsoup) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 07b0b80..a4018f3 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -1,5 +1,7 @@ ;;; nnspool.el --- spool access for GNU Emacs -;; Copyright (C) 198,998,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. + +;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, +;; 2000 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -27,6 +29,8 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'nnheader) (require 'nntp) (require 'nnoo) @@ -47,7 +51,10 @@ If you are using Cnews, you probably should set this variable to nil.") (defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") "Local news nov directory.") -(defvoo nnspool-lib-dir "/usr/lib/news/" +(defvoo nnspool-lib-dir + (if (file-exists-p "/usr/lib/news/active") + "/usr/lib/news/" + "/var/lib/news/") "Where the local news library files are stored.") (defvoo nnspool-active-file (concat nnspool-lib-dir "active") @@ -148,7 +155,7 @@ there.") (and do-message (zerop (% (incf count) 20)) (nnheader-message 5 "nnspool: Receiving headers... %d%%" - (/ (* count 100) number)))) + (/ (* count 100) number)))) (when do-message (nnheader-message 5 "nnspool: Receiving headers...done")) @@ -298,8 +305,8 @@ there.") (read (current-buffer))) seconds)) (push (buffer-substring - (match-beginning 1) (match-end 1)) - groups) + (match-beginning 1) (match-end 1)) + groups) (zerop (forward-line -1)))) (erase-buffer) (while groups diff --git a/lisp/nntp.el b/lisp/nntp.el index 1f3e23d..542e59c 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,5 +1,7 @@ ;;; nntp.el --- nntp access for Gnus -;;; Copyright (C) 1987-90,92-99 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Katsumi Yamaoka @@ -26,6 +28,8 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'nnheader) (require 'nnoo) (require 'gnus-util) @@ -38,6 +42,40 @@ (defvoo nntp-port-number "nntp" "Port number on the physical nntp server.") +(defvoo nntp-list-options nil + "List of newsgroup name used for a option of the LIST command to +restrict the listing output to only the specified newsgroups. +Each newsgroup name can be a shell-style wildcard, for instance, +\"fj.*\", \"japan.*\", etc. Fortunately, if the server can accept +such a option, it will probably make gnus run faster. You may +use it as a server variable as follows: + +\(setq gnus-select-method + '(nntp \"news.somewhere.edu\" + (nntp-list-options (\"fj.*\" \"japan.*\"))))") + +(defvoo nntp-options-subscribe nil + "Regexp matching the newsgroup names which will be subscribed +unconditionally. It may be effective as well as `nntp-list-options' +even though the server could not accept a shell-style wildcard as a +option of the LIST command. You may use it as a server variable as +follows: + +\(setq gnus-select-method + '(nntp \"news.somewhere.edu\" + (nntp-options-subscribe \"^fj\\\\.\\\\|^japan\\\\.\")))") + +(defvoo nntp-options-not-subscribe nil + "Regexp matching the newsgroup names which will not be subscribed +unconditionally. It may be effective as well as `nntp-list-options' +even though the server could not accept a shell-style wildcard as a +option of the LIST command. You may use it as a server variable as +follows: + +\(setq gnus-select-method + '(nntp \"news.somewhere.edu\" + (nntp-options-not-subscribe \"\\\\.binaries\\\\.\")))") + (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd @@ -48,10 +86,10 @@ server spawn an nnrpd server.") It is called with no parameters.") (defvoo nntp-server-action-alist - '(("nntpd 1\\.5\\.11t" - (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)) - ("NNRP server Netscape" - (setq nntp-server-list-active-group nil))) + '(("nntpd 1\\.5\\.11t" + (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)) + ("NNRP server Netscape" + (setq nntp-server-list-active-group nil))) "Alist of regexps to match on server types and actions to be taken. For instance, if you want Gnus to beep every time you connect to innd, you could say something like: @@ -172,7 +210,8 @@ server there that you can connect to. See also (defvoo nntp-connection-timeout nil "*Number of seconds to wait before an nntp connection times out. -If this variable is nil, which is the default, no timers are set.") +If this variable is nil, which is the default, no timers are set. +NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") (defvoo nntp-prepare-post-hook nil "*Hook run just before posting an article. It is supposed to be used for @@ -305,7 +344,7 @@ noticing asynchronous data.") (let ((alist nntp-connection-alist) (buffer (if (stringp buffer) (get-buffer buffer) buffer)) process entry) - (while (setq entry (pop alist)) + (while (and alist (setq entry (pop alist))) (when (eq buffer (cadr entry)) (setq process (car entry) alist nil))) @@ -337,17 +376,26 @@ noticing asynchronous data.") (save-excursion (set-buffer (process-buffer process)) (erase-buffer))) - (when command - (nntp-send-string process command)) - (cond - ((eq callback 'ignore) - t) - ((and callback wait-for) - (nntp-async-wait process wait-for buffer decode callback) - t) - (wait-for - (nntp-wait-for process wait-for buffer decode)) - (t t))))) + (condition-case err + (progn + (when command + (nntp-send-string process command)) + (cond + ((eq callback 'ignore) + t) + ((and callback wait-for) + (nntp-async-wait process wait-for buffer decode callback) + t) + (wait-for + (nntp-wait-for process wait-for buffer decode)) + (t t))) + (error + (nnheader-report 'nntp "Couldn't open connection to %s: %s" + address err)) + (quit + (message "Quit retrieving data from nntp") + (signal 'quit nil) + nil))))) (defsubst nntp-send-command (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." @@ -439,36 +487,36 @@ noticing asynchronous data.") (nntp-inhibit-erase t) article) ;; Send HEAD commands. - (while (setq article (pop articles)) - (nntp-send-command - nil - "HEAD" (if (numberp article) - (int-to-string article) - ;; `articles' is either a list of article numbers - ;; or a list of article IDs. - article)) - (incf count) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (set-buffer buf) - (goto-char last-point) - ;; Count replies. - (while (nntp-next-result-arrived-p) - (setq last-point (point)) - (incf received)) - (< received count)) - ;; If number of headers is greater than 100, give - ;; informative messages. - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (zerop (% received 20)) - (nnheader-message 6 "NNTP: Receiving headers... %d%%" - (/ (* received 100) number))) - (nntp-accept-response)))) + (while (setq article (pop articles)) + (nntp-send-command + nil + "HEAD" (if (numberp article) + (int-to-string article) + ;; `articles' is either a list of article numbers + ;; or a list of article IDs. + article)) + (incf count) + ;; Every 400 requests we have to read the stream in + ;; order to avoid deadlocks. + (when (or (null articles) ;All requests have been sent. + (zerop (% count nntp-maximum-request))) + (nntp-accept-response) + (while (progn + (set-buffer buf) + (goto-char last-point) + ;; Count replies. + (while (nntp-next-result-arrived-p) + (setq last-point (point)) + (incf received)) + (< received count)) + ;; If number of headers is greater than 100, give + ;; informative messages. + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (zerop (% received 20)) + (nnheader-message 6 "NNTP: Receiving headers... %d%%" + (/ (* received 100) number))) + (nntp-accept-response)))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (nnheader-message 6 "NNTP: Receiving headers...done")) @@ -485,7 +533,7 @@ noticing asynchronous data.") (nntp-possibly-change-group nil server) (when (nntp-find-connection-buffer nntp-server-buffer) (save-excursion - ;; Erase nntp-sever-buffer before nntp-inhibit-erase. + ;; Erase nntp-server-buffer before nntp-inhibit-erase. (set-buffer nntp-server-buffer) (erase-buffer) (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) @@ -498,6 +546,7 @@ noticing asynchronous data.") (received 0) (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"))) (while groups ;; Send the command to the server. @@ -508,27 +557,42 @@ noticing asynchronous data.") (when (or (null groups) ;All requests have been sent. (zerop (% count nntp-maximum-request))) (nntp-accept-response) - (while (progn - (goto-char last-point) - ;; Count replies. - (while (re-search-forward "^[0-9]" nil t) - (incf received)) - (setq last-point (point)) - (< received count)) + (while (and (gnus-buffer-live-p buf) + (progn + ;; Search `blue moon' in this file for the + ;; reason why set-buffer here. + (set-buffer buf) + (goto-char last-point) + ;; Count replies. + (while (re-search-forward "^[0-9]" nil t) + (incf received)) + (setq last-point (point)) + (< received count))) (nntp-accept-response)))) ;; Wait for the reply from the final command. + (unless (gnus-buffer-live-p buf) + (error + (nnheader-report 'nntp "Connection to %s is closed." server))) + (set-buffer buf) (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) (when (looking-at "^[23]") - (while (progn - (goto-char (point-max)) - (if (not nntp-server-list-active-group) - (not (re-search-backward "\r?\n" (- (point) 3) t)) - (not (re-search-backward "^\\.\r?\n" (- (point) 4) t)))) - (nntp-accept-response))) + (while (and (gnus-buffer-live-p buf) + (progn + (set-buffer buf) + (goto-char (point-max)) + (if (not nntp-server-list-active-group) + (not (re-search-backward "\r?\n" (- (point) 3) t)) + (not (re-search-backward "^\\.\r?\n" + (- (point) 4) t))))) + (nntp-accept-response))) ;; Now all replies are received. We remove CRs. + (unless (gnus-buffer-live-p buf) + (error + (nnheader-report 'nntp "Connection to %s is closed." server))) + (set-buffer buf) (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t)) @@ -725,8 +789,40 @@ noticing asynchronous data.") (nntp-kill-buffer (process-buffer process))))) (deffoo nntp-request-list (&optional server) + "List active groups. If `nntp-list-options' is non-nil, the listing +output from the server will be restricted to the specified newsgroups. +If `nntp-options-subscribe' is non-nil, remove newsgroups that do not +match the regexp. If `nntp-options-not-subscribe' is non-nil, remove +newsgroups that match the regexp." (nntp-possibly-change-group nil server) - (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")) + (with-current-buffer nntp-server-buffer + (prog1 + (if (not nntp-list-options) + (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST") + (let ((options (if (consp nntp-list-options) + nntp-list-options + (list nntp-list-options))) + (ret t)) + (erase-buffer) + (while options + (goto-char (point-max)) + (narrow-to-region (point) (point)) + (setq ret (and ret + (nntp-send-command-nodelete + "\r?\n\\.\r?\n" + (format "LIST ACTIVE %s" (car options)))) + options (cdr options)) + (nntp-decode-text)) + (widen) + ret)) + (when (and (stringp nntp-options-subscribe) + (not (string-equal "" nntp-options-subscribe))) + (goto-char (point-min)) + (keep-lines nntp-options-subscribe)) + (when (and (stringp nntp-options-not-subscribe) + (not (string-equal "" nntp-options-not-subscribe))) + (goto-char (point-min)) + (flush-lines nntp-options-subscribe))))) (deffoo nntp-request-list-newsgroups (&optional server) (nntp-possibly-change-group nil server) @@ -788,7 +884,7 @@ and a password. If SEND-IF-FORCE, only send authinfo to the server if the .authinfo file has the FORCE token." (let* ((list (gnus-parse-netrc nntp-authinfo-file)) - (alist (gnus-netrc-machine list nntp-address)) + (alist (gnus-netrc-machine list nntp-address "nntp")) (force (gnus-netrc-get alist "force")) (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) (passwd (gnus-netrc-get alist "password"))) @@ -800,13 +896,14 @@ If SEND-IF-FORCE, only send authinfo to the server if the (unless (member user '(nil "")) (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) (when t ;???Should check if AUTHINFO succeeded - (nntp-send-command - "^2.*\r?\n" "AUTHINFO PASS" - (or passwd - nntp-authinfo-password - (setq nntp-authinfo-password - (mail-source-read-passwd (format "NNTP (%s@%s) password: " - user nntp-address)))))))))) + (nntp-send-command + "^2.*\r?\n" "AUTHINFO PASS" + (or passwd + nntp-authinfo-password + (setq nntp-authinfo-password + (mail-source-read-passwd + (format "NNTP (%s@%s) password: " + user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () "Send the AUTHINFO to the nntp server." @@ -816,7 +913,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (when t ;???Should check if AUTHINFO succeeded (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" (mail-source-read-passwd "NNTP (%s@%s) password: " - user nntp-address)))))) + user nntp-address)))))) (defun nntp-send-authinfo-from-file () "Send the AUTHINFO to the nntp server. @@ -875,7 +972,11 @@ password contained in '~/.nntp-authinfo'." (condition-case () (funcall nntp-open-connection-function pbuffer) (error nil) - (quit nil)))) + (quit + (message "Quit opening connection") + (nntp-kill-buffer pbuffer) + (signal 'quit nil) + nil)))) (when timer (nnheader-cancel-timer timer)) (when (and (buffer-name pbuffer) @@ -985,7 +1086,7 @@ password contained in '~/.nntp-authinfo'." (if (memq (following-char) '(?4 ?5)) ;; wants credentials? (if (looking-at "480") - (nntp-handle-authinfo nntp-process-to-buffer) + (nntp-handle-authinfo process) ;; report error message. (nntp-snarf-error-message) (nntp-do-callback nil)) @@ -1080,7 +1181,9 @@ password contained in '~/.nntp-authinfo'." (delete-char 2)) ;; Delete status line. (goto-char (point-min)) - (delete-region (point) (progn (forward-line 1) (point))) + (while (looking-at "[1-5][0-9][0-9] .*\n") + ;; For some unknown reason, there is more than one status line. + (delete-region (point) (progn (forward-line 1) (point)))) ;; Remove "." -> ".." encoding. (while (search-forward "\n.." nil t) (delete-char -1)))) @@ -1126,7 +1229,7 @@ password contained in '~/.nntp-authinfo'." (car (last articles)) 'wait) (goto-char (point-min)) - (when (looking-at "[1-5][0-9][0-9] ") + (when (looking-at "[1-5][0-9][0-9] .*\n") (delete-region (point) (progn (forward-line 1) (point)))) (while (search-forward "\r" nil t) (replace-match "" t t)) @@ -1173,16 +1276,16 @@ password contained in '~/.nntp-authinfo'." (zerop (% count nntp-maximum-request))) (nntp-accept-response) - ;; On some Emacs versions the preceding function has - ;; a tendency to change the buffer. Perhaps. It's - ;; quite difficult to reproduce, because it only - ;; seems to happen once in a blue moon. + ;; On some Emacs versions the preceding function has a + ;; tendency to change the buffer. Perhaps. It's quite + ;; difficult to reproduce, because it only seems to happen + ;; once in a blue moon. (set-buffer process-buffer) (while (progn (goto-char (or last-point (point-min))) ;; Count replies. - (while (re-search-forward "^[0-9][0-9][0-9] " nil t) - (setq received (1+ received))) + (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t) + (incf received)) (setq last-point (point)) (< received count)) (nntp-accept-response) @@ -1194,7 +1297,10 @@ password contained in '~/.nntp-authinfo'." (set-buffer process-buffer) ;; Wait for the reply from the final command. (goto-char (point-max)) - (re-search-backward "^[0-9][0-9][0-9] " nil t) + (while (not (re-search-backward "^[0-9][0-9][0-9] " nil t)) + (nntp-accept-response) + (set-buffer process-buffer) + (goto-char (point-max))) (when (looking-at "^[23]") (while (progn (goto-char (point-max)) @@ -1277,6 +1383,7 @@ password contained in '~/.nntp-authinfo'." "nntpd" buffer nntp-telnet-command nntp-telnet-switches))) (case-fold-search t)) (when (memq (process-status proc) '(open run)) + (nntp-wait-for-string "^r?telnet") (process-send-string proc "set escape \^X\n") (cond ((and nntp-open-telnet-envuser nntp-telnet-user-name) @@ -1306,7 +1413,7 @@ password contained in '~/.nntp-authinfo'." (beginning-of-line) (delete-region (point-min) (point)) (process-send-string proc "\^]") - (nntp-wait-for-string "^telnet") + (nntp-wait-for-string "^r?telnet") (process-send-string proc "mode character\n") (accept-process-output proc 1) (sit-for 1) diff --git a/lisp/nnultimate.el b/lisp/nnultimate.el index b2ff2bf..f4dd670 100644 --- a/lisp/nnultimate.el +++ b/lisp/nnultimate.el @@ -1,5 +1,5 @@ -;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system -;; Copyright (C) 1999 Free Software Foundation, Inc. +;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system -*- coding: iso-latin-1 -*- +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -29,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'nnoo) (require 'message) @@ -36,17 +37,11 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) -(require 'nnweb) (eval-when-compile (ignore-errors - (require 'w3) - (require 'url) - (require 'w3-forms))) + (require 'nnweb))) ;; Report failure to find w3 at load time if appropriate. -(eval '(progn - (require 'w3) - (require 'url) - (require 'w3-forms))) +(eval '(require 'nnweb)) (nnoo-declare nnultimate) @@ -62,6 +57,8 @@ (defvoo nnultimate-groups nil) (defvoo nnultimate-headers nil) (defvoo nnultimate-articles nil) +(defvar nnultimate-table-regexp + "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") ;;; Interface functions @@ -80,6 +77,8 @@ (old-total (or (nth 6 entry) 1)) (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000") (furls (list (concat nnultimate-address (format furl sid)))) + (nnultimate-table-regexp + "postings.*editpost\\|forumdisplay\\|getbio") headers article subject score from date lines parent point contents tinfo fetchers map elem a href garticles topic old-max inc datel table string current-page total-contents pages @@ -88,7 +87,8 @@ (while (and (setq article (car articles)) map) (while (and map - (> article (caar map))) + (or (> article (caar map)) + (< (cadar map) (caar map)))) (pop map)) (when (setq mmap (car map)) (setq farticle -1) @@ -114,7 +114,7 @@ (set-buffer nntp-server-buffer) (erase-buffer)) (setq nnultimate-articles nil) - (with-temp-buffer + (mm-with-unibyte-buffer (dolist (elem fetchers) (setq pages 1 current-page 1 @@ -130,7 +130,8 @@ "-" (number-to-string current-page) (match-string 0 href)))) (goto-char (point-min)) - (setq contents (w3-parse-buffer (current-buffer))) + (setq contents + (ignore-errors (w3-parse-buffer (current-buffer)))) (setq table (nnultimate-find-forum-table contents)) (setq string (mapconcat 'identity (nnweb-text table) "")) (when (string-match "topic is \\([0-9]\\) pages" string) @@ -143,7 +144,7 @@ ;;(setq total-contents (nreverse total-contents)) (dolist (art (cdr elem)) (if (not (nth (1- (cdr art)) total-contents)) - ();(debug) + () ;(debug) (push (list (car art) (nth (1- (cdr art)) total-contents) subject) @@ -165,7 +166,7 @@ (setq date (substring (car datel) (match-end 0)) datel nil)) (pop datel)) - (setq date (delete "" (split-string date "[- \n\t\r    ]"))) + (setq date (delete "" (split-string date "[- \n\t\r    ]"))) (if (or (member "AM" date) (member "PM" date)) (setq date (format "%s %s %s %s" @@ -197,9 +198,10 @@ (setq nnultimate-headers (sort headers 'car-less-than-car)) (save-excursion (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (header nnultimate-headers) - (nnheader-insert-nov (cdr header))))) + (mm-with-unibyte-current-buffer + (erase-buffer) + (dolist (header nnultimate-headers) + (nnheader-insert-nov (cdr header)))))) 'nov))) (deffoo nnultimate-request-group (group &optional server dont-check) @@ -218,6 +220,10 @@ "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) (prin1-to-string group)))))) +(deffoo nnultimate-request-close () + (setq nnultimate-groups-alist nil + nnultimate-groups nil)) + (deffoo nnultimate-request-article (article &optional group server buffer) (nnultimate-possibly-change-server group server) (let ((contents (cdr (assq article nnultimate-articles)))) @@ -230,13 +236,14 @@ (goto-char (point-min)) (insert "Content-Type: text/html\nMIME-Version: 1.0\n") (let ((header (cdr (assq article nnultimate-headers)))) - (nnheader-insert-header header)) + (mm-with-unibyte-current-buffer + (nnheader-insert-header header))) (nnheader-report 'nnultimate "Fetched article %s" article) (cons group article))))) (deffoo nnultimate-request-list (&optional server) (nnultimate-possibly-change-server nil server) - (with-temp-buffer + (mm-with-unibyte-buffer (nnweb-insert (if (string-match "/$" nnultimate-address) (concat nnultimate-address "Ultimate.cgi") @@ -299,7 +306,7 @@ (furls (list (concat nnultimate-address (format furl sid)))) contents forum-contents furl-fetched a subject href garticles topic tinfo old-max inc parse) - (with-temp-buffer + (mm-with-unibyte-buffer (while furls (erase-buffer) (nnweb-insert (pop furls)) @@ -328,7 +335,7 @@ ;; the group is entered, there's 2 new articles in topic one ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 ;; in topic one and 10 will be the 2 in topic three. - (dolist (row (reverse forum-contents)) + (dolist (row (nreverse forum-contents)) (setq row (nth 2 row)) (when (setq a (nnweb-parse-find 'a row)) (setq subject (car (last (nnweb-text a))) @@ -341,25 +348,26 @@ (setq art (1+ (string-to-number (car artlist))))) (pop artlist)) (setq garticles art)) - (string-match "/\\([0-9]+\\).html" href) - (setq topic (string-to-number (match-string 1 href))) - (if (setq tinfo (assq topic topics)) - (progn - (setq old-max (cadr tinfo)) - (setcar (cdr tinfo) garticles)) - (setq old-max 0) - (push (list topic garticles subject href) topics) - (setcar (nthcdr 4 entry) topics)) - (when (not (= old-max garticles)) - (setq inc (- garticles old-max)) - (setq mapping (nconc mapping - (list - (list - old-total (1- (incf old-total inc)) - topic (1+ old-max))))) - (incf old-max inc) - (setcar (nthcdr 5 entry) mapping) - (setcar (nthcdr 6 entry) old-total))))) + (when garticles + (string-match "/\\([0-9]+\\).html" href) + (setq topic (string-to-number (match-string 1 href))) + (if (setq tinfo (assq topic topics)) + (progn + (setq old-max (cadr tinfo)) + (setcar (cdr tinfo) garticles)) + (setq old-max 0) + (push (list topic garticles subject href) topics) + (setcar (nthcdr 4 entry) topics)) + (when (not (= old-max garticles)) + (setq inc (- garticles old-max)) + (setq mapping (nconc mapping + (list + (list + old-total (1- (incf old-total inc)) + topic (1+ old-max))))) + (incf old-max inc) + (setcar (nthcdr 5 entry) mapping) + (setcar (nthcdr 6 entry) old-total)))))) (setcar (nthcdr 7 entry) current-time) (setcar (nthcdr 1 entry) (1- old-total)) (nnultimate-write-groups) @@ -372,8 +380,8 @@ (nnultimate-open-server server)) (unless nnultimate-groups-alist (nnultimate-read-groups) - (setq nnultimate-groups (cdr (assoc nnultimate-address - nnultimate-groups-alist))))) + (setq nnultimate-groups (cdr (assoc nnultimate-address + nnultimate-groups-alist))))) (deffoo nnultimate-open-server (server &optional defs connectionless) (nnheader-init-server-buffer) @@ -387,7 +395,7 @@ (setq nnultimate-groups-alist nil) (let ((file (expand-file-name "groups" nnultimate-directory))) (when (file-exists-p file) - (with-temp-buffer + (mm-with-unibyte-buffer (insert-file-contents file) (goto-char (point-min)) (setq nnultimate-groups-alist (read (current-buffer))))))) @@ -435,11 +443,13 @@ (nth 2 parse)))) (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) case-fold-search) - (when (and href (string-match - "postings\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio" - href)) + (when (and href (string-match nnultimate-table-regexp href)) t)))) (provide 'nnultimate) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; nnultimate.el ends here diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 8d46ed5..e1f43a0 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,5 +1,6 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: David Moore ;; Lars Magne Ingebrigtsen @@ -32,6 +33,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'nntp) (require 'nnheader) (require 'gnus) @@ -62,8 +64,7 @@ component group will show up when you enter the virtual group.") (defvoo nnvirtual-current-group nil) (defvoo nnvirtual-mapping-table nil - "Table of rules on how to map between component group and article number -to virtual article number.") + "Table of rules on how to map between component group and article number to virtual article number.") (defvoo nnvirtual-mapping-offsets nil "Table indexed by component group to an offset to be applied to article numbers in that group.") @@ -121,47 +122,47 @@ to virtual article number.") (let ((gnus-use-cache t)) (setq result (gnus-retrieve-headers articles cgroup nil)))) - (set-buffer nntp-server-buffer) - ;; If we got HEAD headers, we convert them into NOV - ;; headers. This is slow, inefficient and, come to think - ;; of it, downright evil. So sue me. I couldn't be - ;; bothered to write a header parse routine that could - ;; parse a mixed HEAD/NOV buffer. - (when (eq result 'headers) - (nnvirtual-convert-headers)) - (goto-char (point-min)) - (while (not (eobp)) - (delete-region (point) - (progn - (setq carticle (read nntp-server-buffer)) - (point))) - - ;; We remove this article from the articles list, if - ;; anything is left in the articles list after going through - ;; the entire buffer, then those articles have been - ;; expired or canceled, so we appropriately update the - ;; component group below. They should be coming up - ;; generally in order, so this shouldn't be slow. - (setq articles (delq carticle articles)) - - (setq article (nnvirtual-reverse-map-article cgroup carticle)) - (if (null article) - ;; This line has no reverse mapping, that means it - ;; was an extra article reference returned by nntp. - (progn - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Otherwise insert the virtual article number, - ;; and clean up the xrefs. - (princ article nntp-server-buffer) - (nnvirtual-update-xref-header cgroup carticle - prefix system-name) - (forward-line 1)) - ) - - (set-buffer vbuf) - (goto-char (point-max)) - (insert-buffer-substring nntp-server-buffer)) + (set-buffer nntp-server-buffer) + ;; If we got HEAD headers, we convert them into NOV + ;; headers. This is slow, inefficient and, come to think + ;; of it, downright evil. So sue me. I couldn't be + ;; bothered to write a header parse routine that could + ;; parse a mixed HEAD/NOV buffer. + (when (eq result 'headers) + (nnvirtual-convert-headers)) + (goto-char (point-min)) + (while (not (eobp)) + (delete-region (point) + (progn + (setq carticle (read nntp-server-buffer)) + (point))) + + ;; We remove this article from the articles list, if + ;; anything is left in the articles list after going through + ;; the entire buffer, then those articles have been + ;; expired or canceled, so we appropriately update the + ;; component group below. They should be coming up + ;; generally in order, so this shouldn't be slow. + (setq articles (delq carticle articles)) + + (setq article (nnvirtual-reverse-map-article cgroup carticle)) + (if (null article) + ;; This line has no reverse mapping, that means it + ;; was an extra article reference returned by nntp. + (progn + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ;; Otherwise insert the virtual article number, + ;; and clean up the xrefs. + (princ article nntp-server-buffer) + (nnvirtual-update-xref-header cgroup carticle + prefix system-name) + (forward-line 1)) + ) + + (set-buffer vbuf) + (goto-char (point-max)) + (insert-buffer-substring nntp-server-buffer)) ;; Anything left in articles is expired or canceled. ;; Could be smart and not tell it about articles already known? (when articles @@ -198,8 +199,9 @@ to virtual article number.") (save-excursion (when buffer (set-buffer buffer)) - (let ((method (gnus-find-method-for-group - nnvirtual-last-accessed-component-group))) + (let* ((gnus-override-method nil) + (method (gnus-find-method-for-group + nnvirtual-last-accessed-component-group))) (funcall (gnus-get-function method 'request-article) article nil (nth 1 method) buffer))))) ;; This is a fetch by number. @@ -284,12 +286,11 @@ to virtual article number.") (deffoo nnvirtual-request-update-mark (group article mark) (let* ((nart (nnvirtual-map-article article)) - (cgroup (car nart)) - ;; The component group might be a virtual group. - (nmark (gnus-request-update-mark cgroup (cdr nart) mark))) + (cgroup (car nart))) (when (and nart (memq mark gnus-auto-expirable-marks) - (= mark nmark) + ;; The component group might be a virtual group. + (= mark (gnus-request-update-mark cgroup (cdr nart) mark)) (gnus-group-auto-expirable-p cgroup)) (setq mark gnus-expirable-mark))) mark) @@ -367,8 +368,16 @@ to virtual article number.") (nnvirtual-possibly-change-server server) (setq nnvirtual-component-groups (delete (nnvirtual-current-group) nnvirtual-component-groups)) - (dolist (group nnvirtual-component-groups) - (gnus-group-expire-articles-1 group))) + (let (unexpired) + (dolist (group nnvirtual-component-groups) + (setq unexpired (nconc unexpired + (mapcar + #'(lambda (article) + (nnvirtual-reverse-map-article + group article)) + (gnus-uncompress-range + (gnus-group-expire-articles-1 group)))))) + (sort unexpired '<))) ;;; Internal functions. @@ -591,7 +600,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." (aref entry 1) (cdr (aref nnvirtual-mapping-offsets group-pos))) )) - )) + )) @@ -649,7 +658,7 @@ then it is left out of the result." "Return an association list of component article numbers. These are indexed by elements of nnvirtual-component-groups, based on the sequence ARTICLES of virtual article numbers. ARTICLES should be -sorted, and can be a compressed sequence. If any of the article +sorted, and can be a compressed sequence. If any of the article numbers has no corresponding component article, then it is left out of the result." (when (numberp (cdr-safe articles)) @@ -691,28 +700,28 @@ based on the marks on the component groups." ;; Into all-unreads we put (g unreads). ;; Into all-marks we put (g marks). ;; We also increment cnt and tot here, and compute M (max of sizes). - (mapc (lambda (g) - (setq active (gnus-activate-group g) - min (car active) - max (cdr active)) - (when (and active (>= max min) (not (zerop max))) - ;; store active information - (push (list g (- max min -1) max) actives) - ;; collect unread/mark info for later - (setq unreads (gnus-list-of-unread-articles g)) - (setq marks (gnus-info-marks (gnus-get-info g))) - (when gnus-use-cache - (push (cons 'cache - (gnus-cache-articles-in-group g)) - marks)) - (push (cons g unreads) all-unreads) - (push (cons g marks) all-marks) - ;; count groups, total #articles, and max size - (setq size (- max min -1)) - (setq cnt (1+ cnt) - tot (+ tot size) - M (max M size)))) - nnvirtual-component-groups) + (mapcar (lambda (g) + (setq active (gnus-activate-group g) + min (car active) + max (cdr active)) + (when (and active (>= max min) (not (zerop max))) + ;; store active information + (push (list g (- max min -1) max) actives) + ;; collect unread/mark info for later + (setq unreads (gnus-list-of-unread-articles g)) + (setq marks (gnus-info-marks (gnus-get-info g))) + (when gnus-use-cache + (push (cons 'cache + (gnus-cache-articles-in-group g)) + marks)) + (push (cons g unreads) all-unreads) + (push (cons g marks) all-marks) + ;; count groups, total #articles, and max size + (setq size (- max min -1)) + (setq cnt (1+ cnt) + tot (+ tot size) + M (max M size)))) + nnvirtual-component-groups) ;; Number of articles in the virtual group. (setq nnvirtual-mapping-len tot) diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el index 33bd5ea..1a34dde 100644 --- a/lisp/nnwarchive.el +++ b/lisp/nnwarchive.el @@ -1,8 +1,8 @@ ;;; nnwarchive.el --- interfacing with web archives -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; Keywords: news +;; Keywords: news egroups mail-archive ;; This file is part of GNU Emacs. @@ -23,16 +23,12 @@ ;;; Commentary: -;; Note: You need to have `url' and `w3' installed for this backend to -;; work. +;; Note: You need to have `url' (w3 0.46) or greater version +;; installed for this backend to work. -;; A lot of codes stolen from mail-source, nnslashdot, nnweb. - -;; Todo: To support more web archives. - -;; Known bugs: in w3 0.44, there are two copies of url-maybe-relative. -;; If it is loaded from w3.el, (load-library "url"). w3 0.45 should -;; work. +;; Todo: +;; 1. To support more web archives. +;; 2. Generalize webmail to other MHonArc archive. ;;; Code: @@ -42,6 +38,7 @@ (require 'message) (require 'gnus-util) (require 'gnus) +(require 'gnus-bcklg) (require 'nnmail) (require 'mm-util) (require 'mail-source) @@ -60,38 +57,57 @@ (nnoo-declare nnwarchive) -(eval-and-compile - (defvar nnwarchive-type-definition - '((egroups - (open-url - "http://www.egroups.com/register?method=loginAction&email=%s&password=%s" - login passwd) - (list-url - "http://www.egroups.com/UserGroupsPage?") - (list-dissect . nnwarchive-egroups-list) - (list-groups . nnwarchive-egroups-list-groups) - (xover-url - "http://www.egroups.com/group/%s/?fetchForward=1&start=%d" group start) - (xover-last-url - "http://www.egroups.com/group/%s/?fetchForward=1" group) - (xover-page-size . 13) - (xover-dissect . nnwarchive-egroups-xover) - (article-url - "http://www.egroups.com/group/%s/%d.html?raw=1" group article) - (article-dissect . nnwarchive-egroups-article))))) - -(eval-and-compile - (defvar nnwarchive-short-names - '(login passwd))) +(defvar nnwarchive-type-definition + '((egroups + (address . "www.egroups.com") + (open-url + "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" + nnwarchive-login nnwarchive-passwd) + (list-url + "http://www.egroups.com/mygroups") + (list-dissect . nnwarchive-egroups-list) + (list-groups . nnwarchive-egroups-list-groups) + (xover-url + "http://www.egroups.com/messages/%s/%d" group aux) + (xover-last-url + "http://www.egroups.com/messages/%s/" group) + (xover-page-size . 13) + (xover-dissect . nnwarchive-egroups-xover) + (article-url + "http://www.egroups.com/message/%s/%d?source=1" group article) + (article-dissect . nnwarchive-egroups-article) + (authentication . t) + (article-offset . 0) + (xover-files . nnwarchive-egroups-xover-files)) + (mail-archive + (address . "www.mail-archive.com") + (open-url) + (list-url + "http://www.mail-archive.com/lists.html") + (list-dissect . nnwarchive-mail-archive-list) + (list-groups . nnwarchive-mail-archive-list-groups) + (xover-url + "http://www.mail-archive.com/%s/mail%d.html" group aux) + (xover-last-url + "http://www.mail-archive.com/%s/maillist.html" group) + (xover-page-size) + (xover-dissect . nnwarchive-mail-archive-xover) + (article-url + "http://www.mail-archive.com/%s/msg%05d.html" group article1) + (article-dissect . nnwarchive-mail-archive-article) + (xover-files . nnwarchive-mail-archive-xover-files) + (authentication) + (article-offset . 1)))) + +(defvar nnwarchive-default-type 'egroups) (defvoo nnwarchive-directory (nnheader-concat gnus-directory "warchive/") "Where nnwarchive will save its files.") -(eval-and-compile - (defvoo nnwarchive-type 'egroups - "The type of nnwarchive.")) +(defvoo nnwarchive-type nil + "The type of nnwarchive.") -(defvoo nnwarchive-address "egroups.com" +(defvoo nnwarchive-address "" "The address of nnwarchive.") (defvoo nnwarchive-login nil @@ -104,138 +120,148 @@ (defvoo nnwarchive-headers-cache nil) -(defvoo nnwarchive-opened nil) +(defvoo nnwarchive-authentication nil) + +(defvoo nnwarchive-nov-is-evil nil) (defconst nnwarchive-version "nnwarchive 1.0") ;;; Internal variables -(defvar nnwarchive-open-url nil) -(defvar nnwarchive-open-dissect nil) +(defvoo nnwarchive-open-url nil) +(defvoo nnwarchive-open-dissect nil) + +(defvoo nnwarchive-list-url nil) +(defvoo nnwarchive-list-dissect nil) +(defvoo nnwarchive-list-groups nil) -(defvar nnwarchive-list-url nil) -(defvar nnwarchive-list-dissect nil) -(defvar nnwarchive-list-groups nil) +(defvoo nnwarchive-xover-files nil) +(defvoo nnwarchive-xover-url nil) +(defvoo nnwarchive-xover-last-url nil) +(defvoo nnwarchive-xover-dissect nil) +(defvoo nnwarchive-xover-page-size nil) -(defvar nnwarchive-xover-url nil) -(defvar nnwarchive-xover-last-url nil) -(defvar nnwarchive-xover-dissect nil) -(defvar nnwarchive-xover-page-size nil) +(defvoo nnwarchive-article-url nil) +(defvoo nnwarchive-article-dissect nil) +(defvoo nnwarchive-xover-files nil) +(defvoo nnwarchive-article-offset 0) -(defvar nnwarchive-article-url nil) -(defvar nnwarchive-article-dissect nil) +(defvoo nnwarchive-buffer nil) -(defvar nnwarchive-buffer nil) +(defvoo nnwarchive-keep-backlog 300) +(defvar nnwarchive-backlog-articles nil) +(defvar nnwarchive-backlog-hashtb nil) + +(defvoo nnwarchive-headers nil) -(defvar nnwarchive-headers nil) ;;; Interface functions (nnoo-define-basics nnwarchive) -(eval-and-compile - (defun nnwarchive-bind-1 () - (let ((defaults (cdr (assq nnwarchive-type nnwarchive-type-definition))) - (short-names nnwarchive-short-names) - default bind) - (while (setq default (pop defaults)) - (push (list (intern (concat "nnwarchive-" (symbol-name (car default)))) - (list 'quote (cdr default))) bind)) - (while (setq default (pop short-names)) - (push (list default - (intern (concat "nnwarchive-" - (symbol-name default)))) - bind)) - bind))) - -(defmacro nnwarchive-bind (&rest body) - "Return a `let' form that binds all variables in TYPE. -Read `mail-source-bind' for details." - `(let ,(nnwarchive-bind-1) - ,@body)) - -(put 'nnwarchive-bind 'lisp-indent-function 0) -(put 'nnwarchive-bind 'edebug-form-spec '(form body)) +(defun nnwarchive-set-default (type) + (let ((defs (cdr (assq type nnwarchive-type-definition))) + def) + (dolist (def defs) + (set (intern (concat "nnwarchive-" (symbol-name (car def)))) + (cdr def))))) + +(defmacro nnwarchive-backlog (&rest form) + `(let ((gnus-keep-backlog nnwarchive-keep-backlog) + (gnus-backlog-buffer + (format " *nnwarchive backlog %s*" nnwarchive-address)) + (gnus-backlog-articles nnwarchive-backlog-articles) + (gnus-backlog-hashtb nnwarchive-backlog-hashtb)) + (unwind-protect + (progn ,@form) + (setq nnwarchive-backlog-articles gnus-backlog-articles + nnwarchive-backlog-hashtb gnus-backlog-hashtb)))) +(put 'nnwarchive-backlog 'lisp-indent-function 0) +(put 'nnwarchive-backlog 'edebug-form-spec '(form body)) + +(defun nnwarchive-backlog-enter-article (group number buffer) + (nnwarchive-backlog + (gnus-backlog-enter-article group number buffer))) + +(defun nnwarchive-get-article (article &optional group server buffer) + (if (numberp article) + (if (nnwarchive-backlog + (gnus-backlog-request-article group article + (or buffer nntp-server-buffer))) + (cons group article) + (let (contents) + (save-excursion + (set-buffer nnwarchive-buffer) + (goto-char (point-min)) + (let ((article1 (- article nnwarchive-article-offset))) + (nnwarchive-url nnwarchive-article-url)) + (setq contents (funcall nnwarchive-article-dissect group article))) + (when contents + (save-excursion + (set-buffer (or buffer nntp-server-buffer)) + (erase-buffer) + (insert contents) + (nnwarchive-backlog-enter-article group article (current-buffer)) + (nnheader-report 'nnwarchive "Fetched article %s" article) + (cons group article))))) + nil)) (deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old) (nnwarchive-possibly-change-server group server) - (nnwarchive-bind + (if (or gnus-nov-is-evil nnwarchive-nov-is-evil) + (with-temp-buffer + (with-current-buffer nntp-server-buffer + (erase-buffer)) + (let ((buf (current-buffer)) b e) + (dolist (art articles) + (nnwarchive-get-article art group server buf) + (setq b (goto-char (point-min))) + (if (search-forward "\n\n" nil t) + (forward-char -1) + (goto-char (point-max))) + (setq e (point)) + (with-current-buffer nntp-server-buffer + (insert (format "221 %d Article retrieved.\n" art)) + (insert-buffer-substring buf b e) + (insert ".\n")))) + 'headers) (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) (save-excursion (set-buffer nnwarchive-buffer) (erase-buffer) - (let (point start starts) - (setq starts (nnwarchive-paged (sort articles '<))) - (while (setq start (pop starts)) - (goto-char (point-max)) - (nnwarchive-url nnwarchive-xover-url)) - (if nnwarchive-xover-dissect - (funcall nnwarchive-xover-dissect)))) + (funcall nnwarchive-xover-files group articles)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let (header) - (dolist (art articles) - (if (setq header (assq art nnwarchive-headers)) - (nnheader-insert-nov (cdr header)))))) + (dolist (art articles) + (if (setq header (assq art nnwarchive-headers)) + (nnheader-insert-nov (cdr header)))))) (let ((elem (assoc group nnwarchive-headers-cache))) (if elem (setcdr elem nnwarchive-headers) (push (cons group nnwarchive-headers) nnwarchive-headers-cache))) 'nov)) -(deffoo nnwarchive-retrieve-groups (groups &optional server) - "Retrieve group info on GROUPS." - (nnwarchive-possibly-change-server nil server) - (nnwarchive-bind - (if nnwarchive-list-groups - (funcall nnwarchive-list-groups groups)) - (nnwarchive-write-groups) - (nnwarchive-generate-active) - 'active)) - (deffoo nnwarchive-request-group (group &optional server dont-check) (nnwarchive-possibly-change-server nil server) - (nnwarchive-bind - (if nnwarchive-list-groups - (funcall nnwarchive-list-groups (list group))) - (nnwarchive-write-groups) - (let ((elem (assoc group nnwarchive-groups))) - (cond - ((not elem) - (nnheader-report 'nnwarchive "Group does not exist")) - (t - (nnheader-report 'nnwarchive "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0) - (prin1-to-string group)) - t))))) - -(deffoo nnwarchive-close-group (group &optional server) - (nnwarchive-possibly-change-server group server) - (nnwarchive-bind - (when (gnus-buffer-live-p nnwarchive-buffer) - (save-excursion - (set-buffer nnwarchive-buffer) - (kill-buffer nnwarchive-buffer))) - t)) + (when (and (not dont-check) nnwarchive-list-groups) + (funcall nnwarchive-list-groups (list group)) + (nnwarchive-write-groups)) + (let ((elem (assoc group nnwarchive-groups))) + (cond + ((not elem) + (nnheader-report 'nnwarchive "Group does not exist")) + (t + (nnheader-report 'nnwarchive "Opened group %s" group) + (nnheader-insert + "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0) + (prin1-to-string group)) + t)))) (deffoo nnwarchive-request-article (article &optional group server buffer) (nnwarchive-possibly-change-server group server) - (nnwarchive-bind - (let (contents) - (save-excursion - (set-buffer nnwarchive-buffer) - (goto-char (point-min)) - (nnwarchive-url nnwarchive-article-url) - (setq contents (funcall nnwarchive-article-dissect))) - (when contents - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (insert contents) - (nnheader-report 'nnwarchive "Fetched article %s" article) - (cons group article)))))) + (nnwarchive-get-article article group server buffer)) (deffoo nnwarchive-close-server (&optional server) (when (and (nnwarchive-server-opened server) @@ -243,60 +269,47 @@ Read `mail-source-bind' for details." (save-excursion (set-buffer nnwarchive-buffer) (kill-buffer nnwarchive-buffer))) + (nnwarchive-backlog + (gnus-backlog-shutdown)) (nnoo-close-server 'nnwarchive server)) (deffoo nnwarchive-request-list (&optional server) (nnwarchive-possibly-change-server nil server) - (nnwarchive-bind - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (if nnwarchive-list-url - (nnwarchive-url nnwarchive-list-url)) - (if nnwarchive-list-dissect - (funcall nnwarchive-list-dissect)) - (nnwarchive-write-groups) - (nnwarchive-generate-active))) - 'active) - -(deffoo nnwarchive-request-newgroups (date &optional server) - (nnwarchive-possibly-change-server nil server) - (nnwarchive-bind + (save-excursion + (set-buffer nnwarchive-buffer) + (erase-buffer) + (if nnwarchive-list-url + (nnwarchive-url nnwarchive-list-url)) + (if nnwarchive-list-dissect + (funcall nnwarchive-list-dissect)) (nnwarchive-write-groups) (nnwarchive-generate-active)) - 'active) - -(deffoo nnwarchive-asynchronous-p () - nil) - -(deffoo nnwarchive-server-opened (&optional server) - nnwarchive-opened) + t) (deffoo nnwarchive-open-server (server &optional defs connectionless) + (nnoo-change-server 'nnwarchive server defs) (nnwarchive-init server) - (if (nnwarchive-server-opened server) - t + (when nnwarchive-authentication (setq nnwarchive-login (or nnwarchive-login (read-string - (format "Login at %s: " server) - user-mail-address))) + (format "Login at %s: " server) + user-mail-address))) (setq nnwarchive-passwd (or nnwarchive-passwd (mail-source-read-passwd - (format "Password for %s at %s: " nnwarchive-login server)))) - (nnwarchive-bind - (unless nnwarchive-groups - (nnwarchive-read-groups)) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (if nnwarchive-open-url - (nnwarchive-url nnwarchive-open-url)) - (if nnwarchive-open-dissect - (funcall nnwarchive-open-dissect)) - (setq nnwarchive-opened t))) - t)) + (format "Password for %s at %s: " + nnwarchive-login server))))) + (unless nnwarchive-groups + (nnwarchive-read-groups)) + (save-excursion + (set-buffer nnwarchive-buffer) + (erase-buffer) + (if nnwarchive-open-url + (nnwarchive-url nnwarchive-open-url)) + (if nnwarchive-open-dissect + (funcall nnwarchive-open-dissect))) + t) (nnoo-define-skeleton nnwarchive) @@ -324,13 +337,28 @@ Read `mail-source-bind' for details." (defun nnwarchive-init (server) "Initialize buffers and such." + (let ((type (intern server)) (defs nnwarchive-type-definition) def) + (cond + ((equal server "") + (setq type nnwarchive-default-type)) + ((assq type nnwarchive-type-definition) t) + (t + (setq type nil) + (while (setq def (pop defs)) + (when (equal (cdr (assq 'address (cdr def))) server) + (setq defs nil) + (setq type (car def)))) + (unless type + (error "Undefined server %s" server)))) + (setq nnwarchive-type type)) (unless (file-exists-p nnwarchive-directory) (gnus-make-directory nnwarchive-directory)) (unless (gnus-buffer-live-p nnwarchive-buffer) (setq nnwarchive-buffer (save-excursion (nnheader-set-temp-buffer - (format " *nnwarchive %s %s*" nnwarchive-type server)))))) + (format " *nnwarchive %s %s*" nnwarchive-type server))))) + (nnwarchive-set-default nnwarchive-type)) (defun nnwarchive-encode-www-form-urlencoded (pairs) "Return PAIRS encoded for forms." @@ -359,50 +387,16 @@ Read `mail-source-bind' for details." expr))) (defun nnwarchive-url (xurl) - (let ((url-confirmation-func 'identity)) - (cond - ((eq (car xurl) 'post) - (pop xurl) - (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) - (t - (nnweb-insert (apply 'format (nnwarchive-eval xurl))))))) - -(defun nnwarchive-decode-entities () - (goto-char (point-min)) - (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t) - (replace-match (char-to-string - (if (eq (aref (match-string 1) 0) ?\#) - (string-to-number (substring (match-string 1) 1)) - (or (cdr (assq (intern (match-string 1)) - w3-html-entities)) - ?#))) - t t))) - -(defun nnwarchive-decode-entities-string (str) - (with-temp-buffer - (insert str) - (nnwarchive-decode-entities) - (buffer-substring (point-min) (point-max)))) - -(defun nnwarchive-remove-markup () - (goto-char (point-min)) - (while (search-forward "" nil t) - (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "<[^>]+>" nil t) - (replace-match "" t t))) - -(defun nnwarchive-date-to-date (sdate) - (let ((elem (split-string sdate))) - (concat (substring (nth 0 elem) 0 3) " " - (substring (nth 1 elem) 0 3) " " - (substring (nth 2 elem) 0 2) " " - (substring (nth 3 elem) 1 6) " " - (format-time-string "%Y") " " - (nth 4 elem)))) - + (mm-with-unibyte-current-buffer + (let ((url-confirmation-func 'identity) + (url-cookie-multiple-line nil)) + (cond + ((eq (car xurl) 'post) + (pop xurl) + (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) + (t + (nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))) + (defun nnwarchive-generate-active () (save-excursion (set-buffer nntp-server-buffer) @@ -430,69 +424,63 @@ Read `mail-source-bind' for details." (erase-buffer) (nnwarchive-url nnwarchive-xover-last-url) (goto-char (point-min)) - (when (re-search-forward "of \\([0-9]+\\)" nil t) - (setq articles (string-to-number (match-string 1)))) + (when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*" nil t) + (setq articles (string-to-number (match-string 1)))) (let ((elem (assoc group nnwarchive-groups))) - (if elem - (setcar (cdr elem) articles) - (push (list group articles "") nnwarchive-groups))) + (if elem + (setcar (cdr elem) articles) + (push (list group articles "") nnwarchive-groups))) (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) - (nnwarchive-egroups-xover) - (let ((elem (assoc group nnwarchive-headers-cache))) - (if elem - (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) nnwarchive-headers-cache))))))) + (nnwarchive-egroups-xover group) + (let ((elem (assoc group nnwarchive-headers-cache))) + (if elem + (setcdr elem nnwarchive-headers) + (push (cons group nnwarchive-headers) nnwarchive-headers-cache))))))) (defun nnwarchive-egroups-list () (let ((case-fold-search t) group description elem articles) (goto-char (point-min)) (while - (re-search-forward - "/group/\\([^/]+\\)/info\\.html[^>]+>[^>]+>[\040\t]*-[\040\t]*\\([^<]+\\)<" - nil t) + (re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t) (setq group (match-string 1) description (match-string 2)) - (forward-line 1) - (when (re-search-forward ">\\([0-9]+\\)<" nil t) - (setq articles (string-to-number (match-string 1)))) (if (setq elem (assoc group nnwarchive-groups)) - (setcar (cdr elem) articles) - (push (list group articles description) nnwarchive-groups))) - (nnwarchive-egroups-list-groups (mapcar 'identity nnwarchive-groups))) + (setcar (cdr elem) 0) + (push (list group articles description) nnwarchive-groups)))) t) -(defun nnwarchive-egroups-xover() - (let (article subject from date group) +(defun nnwarchive-egroups-xover (group) + (let (article subject from date) (goto-char (point-min)) (while (re-search-forward - "]+>\\([^<]+\\)<" + "]+>\\([^<]+\\)<" nil t) - (setq group (match-string 1) - article (string-to-number (match-string 2)) - subject (match-string 3)) - (forward-line 1) - (unless (assq article nnwarchive-headers) - (if (looking-at "]+>]+>\\([^<]+\\)") - (setq from (match-string 1))) - (forward-line 1) - (if (looking-at "]+>]+>\\([^<]+\\)") - (setq date (identity (match-string 1)))) - (push (cons - article - (make-full-mail-header - article - (nnwarchive-decode-entities-string subject) - (nnwarchive-decode-entities-string from) - date - (concat "<" group "%" - (number-to-string article) - "@egroup.com>") - "" - 0 0 "")) nnwarchive-headers)))) + (setq group (match-string 1) + article (string-to-number (match-string 2)) + subject (match-string 3)) + (forward-line 1) + (unless (assq article nnwarchive-headers) + (if (looking-at "]+>]+>\\([^<]+\\)") + (setq from (match-string 1))) + (forward-line 1) + (if (looking-at "]+>]+>\\([^<]+\\)") + (setq date (identity (match-string 1)))) + (push (cons + article + (make-full-mail-header + article + (nnweb-decode-entities-string subject) + (nnweb-decode-entities-string from) + date + (concat "<" group "%" + (number-to-string article) + "@egroup.com>") + "" + 0 0 "")) nnwarchive-headers)))) nnwarchive-headers) -(defun nnwarchive-egroups-article () +(defun nnwarchive-egroups-article (group articles) (goto-char (point-min)) (if (search-forward "

" nil t)
       (delete-region (point-min) (point)))
@@ -501,9 +489,266 @@ Read `mail-source-bind' for details."
       (delete-region (point) (point-max)))
   (goto-char (point-min))
   (while (re-search-forward "]+>\\([^<]+\\)" nil t)
-    (replace-match "<\\1>"))
-  (nnwarchive-decode-entities)
-  (buffer-substring (point-min) (point-max)))
+    (replace-match "\\1"))
+  (nnweb-decode-entities)
+  (buffer-string))
+
+(defun nnwarchive-egroups-xover-files (group articles)
+  (let (aux auxs)
+    (setq auxs (nnwarchive-paged (sort articles '<)))
+    (while (setq aux (pop auxs))
+      (goto-char (point-max))
+      (nnwarchive-url nnwarchive-xover-url))
+    (if nnwarchive-xover-dissect
+	(nnwarchive-egroups-xover group))))
+
+;; mail-archive
+
+(defun nnwarchive-mail-archive-list-groups (groups)
+  (save-excursion
+    (let (articles)
+      (set-buffer nnwarchive-buffer)
+      (dolist (group groups)
+	(erase-buffer)
+	(nnwarchive-url nnwarchive-xover-last-url)
+	(goto-char (point-min))
+	(when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
+	  (setq articles (1+ (string-to-number (match-string 1)))))
+	(let ((elem (assoc group nnwarchive-groups)))
+	  (if elem
+	      (setcar (cdr elem) articles)
+	    (push (list group articles "") nnwarchive-groups)))
+	(setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
+	(nnwarchive-mail-archive-xover group)
+	(let ((elem (assoc group nnwarchive-headers-cache)))
+	  (if elem
+	      (setcdr elem nnwarchive-headers)
+	    (push (cons group nnwarchive-headers) 
+		  nnwarchive-headers-cache)))))))
+
+(defun nnwarchive-mail-archive-list ()
+  (let ((case-fold-search t)
+	group description elem articles)
+    (goto-char (point-min))
+    (while (re-search-forward "\\([^>]+\\)<" nil t)
+      (setq group (match-string 1)
+	    description (match-string 2))
+      (forward-line 1)
+      (setq articles 0)
+      (if (setq elem (assoc group nnwarchive-groups))
+	  (setcar (cdr elem) articles)
+	(push (list group articles description) nnwarchive-groups))))
+  t)
+
+(defun nnwarchive-mail-archive-xover (group)
+  (let (article subject from date)
+    (goto-char (point-min))
+    (while (re-search-forward
+	    "]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
+	    nil t)
+      (setq article (1+ (string-to-number (match-string 1)))
+	    subject (match-string 2))
+      (forward-line 1)
+      (unless (assq article nnwarchive-headers)
+	(if (looking-at "