From 49d38b41c190eaab2cb34294fac7302a9c9ea353 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 2 May 2003 02:34:56 +0000 Subject: [PATCH] Feedback from the t-gnus-6_15 branch. --- ChangeLog | 4247 ++--- ChangeLog.1 | 4 + ChangeLog.2 | 4 + ChangeLog.3 | 2920 +++ GNUS-NEWS | 493 +- INSTALL.ja | 91 + Makefile.in | 42 +- Mule23@1934.en | 109 +- Mule23@1934.ja | 119 +- README | 68 - README-gnus-bbdb.en | 54 +- README-gnus-bbdb.ja | 54 +- README.T-gnus | 11 +- README.branch | 27 +- README.branch.ja | 27 +- README.semi | 39 +- README.semi.ja | 42 +- aclocal.m4 | 229 +- configure | 3109 +++- configure.in | 8 +- contrib/ChangeLog | 220 + contrib/base64.el | 278 + contrib/gnus-idna.el | 154 + contrib/gpg-ring.el | 481 + contrib/gpg.el | 1322 ++ contrib/hashcash.el | 219 + contrib/md5.el | 409 + contrib/mml-smime.el | 80 - contrib/passwd.el | 386 + contrib/regexp-opt.el | 238 + contrib/rfc2015.el | 188 - contrib/smime.el | 279 - contrib/ssl.el | 201 + contrib/ucs-tables.el | 2479 +++ contrib/vcard.el | 2 +- contrib/xml.el | 501 + etc/Makefile.in | 60 + etc/gnus-tut.txt | 1623 +- etc/gnus/catchup.pbm | Bin 0 -> 81 bytes etc/gnus/catchup.xpm | 33 + etc/gnus/cu-exit.pbm | Bin 0 -> 81 bytes etc/gnus/cu-exit.xpm | 31 + etc/gnus/describe-group.pbm | Bin 0 -> 81 bytes etc/gnus/describe-group.xpm | 32 + etc/gnus/exit-gnus.pbm | Bin 0 -> 81 bytes etc/gnus/exit-gnus.xpm | 33 + etc/gnus/exit-summ.pbm | Bin 0 -> 81 bytes etc/gnus/exit-summ.xpm | 30 + etc/gnus/followup.pbm | Bin 0 -> 81 bytes etc/gnus/followup.xpm | 31 + etc/gnus/fuwo.pbm | Bin 0 -> 81 bytes etc/gnus/fuwo.xpm | 31 + etc/gnus/get-news.pbm | Bin 0 -> 81 bytes etc/gnus/get-news.xpm | 31 + etc/gnus/gnntg.pbm | Bin 0 -> 81 bytes etc/gnus/gnntg.xpm | 31 + etc/gnus/gnus.xpm | 4 +- etc/gnus/important.xpm | 32 + etc/gnus/kill-group.pbm | Bin 0 -> 81 bytes etc/gnus/kill-group.xpm | 30 + etc/gnus/mail-reply.pbm | Bin 0 -> 81 bytes etc/gnus/mail-reply.xpm | 32 + etc/gnus/next-ur.pbm | Bin 0 -> 81 bytes etc/gnus/next-ur.xpm | 35 + etc/gnus/oort.xface | 3 + etc/gnus/post.pbm | Bin 0 -> 81 bytes etc/gnus/post.xpm | 35 + etc/gnus/prev-ur.pbm | Bin 0 -> 81 bytes etc/gnus/prev-ur.xpm | 35 + etc/gnus/preview.xbm | 10 + etc/gnus/preview.xpm | 33 + etc/gnus/receipt.xpm | 32 + etc/gnus/reply-wo.pbm | Bin 0 -> 81 bytes etc/gnus/reply-wo.xpm | 31 + etc/gnus/reply.pbm | Bin 0 -> 81 bytes etc/gnus/reply.xpm | 31 + etc/gnus/rot13.pbm | Bin 0 -> 81 bytes etc/gnus/rot13.xpm | 32 + etc/gnus/save-aif.pbm | Bin 0 -> 81 bytes etc/gnus/save-aif.xpm | 33 + etc/gnus/save-art.pbm | Bin 0 -> 81 bytes etc/gnus/save-art.xpm | 32 + etc/gnus/subscribe.pbm | Bin 0 -> 81 bytes etc/gnus/subscribe.xpm | 32 + etc/gnus/unimportant.xpm | 32 + etc/gnus/unsubscribe.pbm | Bin 0 -> 81 bytes etc/gnus/unsubscribe.xpm | 32 + etc/gnus/uu-decode.pbm | Bin 0 -> 81 bytes etc/gnus/uu-decode.xpm | 36 + etc/gnus/uu-post.pbm | Bin 0 -> 81 bytes etc/gnus/uu-post.xpm | 35 + etc/smilies/blink.pbm | Bin 0 -> 37 bytes etc/smilies/blink.xpm | 20 + etc/smilies/braindamaged.xpm | 20 + etc/smilies/cry.xpm | 20 + etc/smilies/dead.xpm | 20 + etc/smilies/evil.xpm | 20 + etc/smilies/forced.xpm | 20 + etc/smilies/frown.xpm | 20 + etc/smilies/grin.xpm | 21 + etc/smilies/indifferent.xpm | 20 + etc/smilies/reverse-smile.xpm | 20 + etc/smilies/sad.pbm | Bin 0 -> 37 bytes etc/smilies/sad.xpm | 20 + etc/smilies/smile.xpm | 20 + etc/smilies/wry.xpm | 20 + lisp/ChangeLog |18625 +++++++++++++------- lisp/Makefile.in | 72 +- lisp/binhex.el | 62 +- lisp/dgnushack.el | 836 +- lisp/earcon.el | 11 +- lisp/flow-fill.el | 85 +- lisp/gnus-agent.el | 3157 +++- lisp/gnus-art.el | 4438 +++-- lisp/gnus-async.el | 22 +- lisp/gnus-audio.el | 27 +- lisp/gnus-bbdb.el | 196 +- lisp/gnus-bcklg.el | 12 +- lisp/gnus-cache.el | 246 +- lisp/gnus-cite.el | 258 +- lisp/gnus-clfns.el | 367 +- lisp/gnus-cus.el | 459 +- lisp/gnus-demon.el | 54 +- lisp/gnus-draft.el | 148 +- lisp/gnus-dup.el | 10 +- lisp/gnus-eform.el | 6 +- lisp/gnus-ems.el | 163 +- lisp/gnus-gl.el | 28 +- lisp/gnus-group.el | 1179 +- lisp/gnus-i18n.el | 14 +- lisp/gnus-int.el | 204 +- lisp/gnus-kill.el | 36 +- lisp/gnus-load.el | 102 - lisp/gnus-logic.el | 79 +- lisp/gnus-mailcap.el | 146 +- lisp/gnus-ml.el | 32 +- lisp/gnus-mlspl.el | 52 +- lisp/gnus-msg.el | 1493 +- lisp/gnus-nocem.el | 9 +- lisp/gnus-offline.el | 16 +- lisp/gnus-ofsetup.el | 66 +- lisp/gnus-picon.el | 898 +- lisp/gnus-range.el | 226 +- lisp/gnus-salt.el | 59 +- lisp/gnus-score.el | 209 +- lisp/gnus-setup.el | 9 +- lisp/gnus-soup.el | 36 +- lisp/gnus-spec.el | 364 +- lisp/gnus-srvr.el | 336 +- lisp/gnus-start.el | 843 +- lisp/gnus-sum.el | 4809 +++-- lisp/gnus-topic.el | 367 +- lisp/gnus-undo.el | 4 +- lisp/gnus-util.el | 831 +- lisp/gnus-uu.el | 245 +- lisp/gnus-vers.el | 14 +- lisp/gnus-vm.el | 8 +- lisp/gnus-win.el | 87 +- lisp/gnus-xmas.el | 336 +- lisp/gnus.el | 1436 +- lisp/ietf-drums.el | 63 +- lisp/imap.el | 733 +- lisp/lpath.el | 185 +- lisp/mail-parse.el | 4 + lisp/mail-source.el | 354 +- lisp/md5.el | 92 +- lisp/message.el | 4005 +++-- lisp/messagexmas.el | 12 +- lisp/messcompat.el | 6 +- lisp/mm-bodies.el | 256 +- lisp/mm-decode.el | 927 +- lisp/mm-encode.el | 62 +- lisp/mm-partial.el | 63 +- lisp/mm-util.el | 686 +- lisp/mm-uu.el | 592 +- lisp/mm-view.el | 552 +- lisp/mmgnus.el | 50 +- lisp/mml.el | 713 +- lisp/nnagent.el | 110 +- lisp/nnbabyl.el | 18 +- lisp/nndb.el | 12 +- lisp/nndoc.el | 332 +- lisp/nndraft.el | 60 +- lisp/nneething.el | 206 +- lisp/nnfolder.el | 645 +- lisp/nngateway.el | 5 +- lisp/nnheader.el | 768 +- lisp/nnheaderxm.el | 5 +- lisp/nnimap.el | 846 +- lisp/nnkiboze.el | 224 +- lisp/nnlistserv.el | 19 +- lisp/nnmail.el | 472 +- lisp/nnmbox.el | 247 +- lisp/nnmh.el | 64 +- lisp/nnml.el | 372 +- lisp/nnoo.el | 12 +- lisp/nnshimbun.el | 2006 +-- lisp/nnslashdot.el | 363 +- lisp/nnsoup.el | 28 +- lisp/nnspool.el | 22 +- lisp/nntp.el | 1429 +- lisp/nnultimate.el | 103 +- lisp/nnvirtual.el | 31 +- lisp/nnwarchive.el | 178 +- lisp/nnweb.el | 673 +- lisp/nnwfm.el | 39 +- lisp/parse-time.el | 4 +- lisp/pop3.el | 290 +- lisp/ptexinfmt.el | 762 - lisp/qp.el | 123 +- lisp/rfc1843.el | 19 +- lisp/rfc2045.el | 2 +- lisp/rfc2047.el | 205 +- lisp/rfc2104.el | 8 +- lisp/rfc2231.el | 12 +- lisp/score-mode.el | 3 +- lisp/smiley-ems.el | 158 - lisp/smiley.el | 566 +- lisp/starttls.el | 7 + lisp/time-date.el | 84 +- lisp/utf7.el | 4 +- lisp/uudecode.el | 198 +- lisp/webmail.el | 294 +- make.bat | 304 +- sample.lpath.el | 8 +- texi/ChangeLog | 2746 ++- texi/Makefile.in | 303 +- texi/dir | 13 + texi/emacs-mime.texi | 2156 ++- texi/etc/bar.xpm | 54 + texi/etc/gnus-group-catchup-current-up.xpm | 39 + texi/etc/gnus-group-catchup-current.xpm | 39 + texi/etc/gnus-group-describe-group-up.xpm | 39 + texi/etc/gnus-group-exit-up.xpm | 39 + texi/etc/gnus-group-get-new-news-this-group-up.xpm | 39 + texi/etc/gnus-group-get-new-news-up.xpm | 39 + texi/etc/gnus-group-kill-group-up.xpm | 38 + texi/etc/gnus-group-subscribe-up.xpm | 38 + texi/etc/gnus-group-unsubscribe-up.xpm | 38 + texi/etc/gnus-summary-caesar-message-up.xpm | 38 + texi/etc/gnus-summary-cancel-article-up.xpm | 39 + texi/etc/gnus-summary-catchup-and-exit-up.xpm | 39 + texi/etc/gnus-summary-catchup-up.xpm | 37 + texi/etc/gnus-summary-exit-up.xpm | 37 + texi/etc/gnus-summary-followup-up.xpm | 38 + .../etc/gnus-summary-followup-with-original-up.xpm | 38 + texi/etc/gnus-summary-mail-copy-up.xpm | 38 + texi/etc/gnus-summary-mail-delete-up.xpm | 39 + texi/etc/gnus-summary-mail-forward-up.xpm | 38 + texi/etc/gnus-summary-mail-get-up.xpm | 38 + texi/etc/gnus-summary-mail-originate-up.xpm | 38 + texi/etc/gnus-summary-mail-reply-up.xpm | 38 + texi/etc/gnus-summary-mail-save-up.xpm | 41 + texi/etc/gnus-summary-next-unread-up.xpm | 39 + texi/etc/gnus-summary-post-news-up.xpm | 38 + texi/etc/gnus-summary-prev-unread-up.xpm | 39 + texi/etc/gnus-summary-reply-up.xpm | 39 + texi/etc/gnus-summary-reply-with-original-up.xpm | 39 + texi/etc/gnus-summary-save-article-file-up.xpm | 41 + texi/etc/gnus-summary-save-article-up.xpm | 41 + texi/etc/gnus-uu-decode-uu-up.xpm | 39 + texi/etc/gnus-uu-post-news-up.xpm | 39 + texi/etc/gnus.xpm | 283 + texi/gnus-faq-ja.texi | 19 +- texi/gnus-faq.texi | 2890 ++- texi/gnus-ja.texi |15959 ++++++++++------- texi/gnus.texi |14824 ++++++++++------ texi/gnuslogo.refcard | 243 - texi/gnusref.tex | 285 +- texi/herds/convol11.pnm | 14 + texi/herds/convol5.pnm | 8 + texi/herds/gnus-herd-bw.png | Bin 0 -> 3672 bytes texi/herds/gnus-herd-new.png | Bin 0 -> 9036 bytes texi/herds/new-herd-1.png | Bin 0 -> 249 bytes texi/herds/new-herd-2.png | Bin 0 -> 420 bytes texi/herds/new-herd-3.png | Bin 0 -> 631 bytes texi/herds/new-herd-4.png | Bin 0 -> 893 bytes texi/herds/new-herd-5.png | Bin 0 -> 1245 bytes texi/herds/new-herd-6.png | Bin 0 -> 2067 bytes texi/herds/new-herd-7.png | Bin 0 -> 2622 bytes texi/herds/new-herd-8.png | Bin 0 -> 3244 bytes texi/herds/new-herd-9.png | Bin 0 -> 3391 bytes texi/herds/new-herd-section.png | Bin 0 -> 3204 bytes texi/herds/new-herd.png | Bin 0 -> 8199 bytes texi/herds/new-herd2.png | Bin 0 -> 3430 bytes texi/message-ja.texi | 1235 +- texi/message.texi | 1118 +- texi/misc/ered.tif | Bin 0 -> 27984 bytes texi/misc/eseptember.tif | Bin 0 -> 3822 bytes texi/misc/fred.tif | Bin 0 -> 10770 bytes texi/misc/fseptember.tif | Bin 0 -> 24798 bytes texi/misc/larsi.png | Bin 0 -> 10768 bytes texi/misc/red.png | Bin 0 -> 3678 bytes texi/misc/red.ps | 2809 +++ texi/misc/september.png | Bin 0 -> 2650 bytes texi/pagestyle.sty | 22 +- texi/picons/att.png | Bin 0 -> 267 bytes texi/picons/berkeley.png | Bin 0 -> 487 bytes texi/picons/caltech.png | Bin 0 -> 812 bytes texi/picons/canada.png | Bin 0 -> 280 bytes texi/picons/cr.png | Bin 0 -> 287 bytes texi/picons/cygnus.xbm | 27 + texi/picons/gnu.xbm | 27 + texi/picons/gov.xbm | 27 + texi/picons/laurie.png | Bin 0 -> 1002 bytes texi/picons/mit.png | Bin 0 -> 388 bytes texi/picons/nasa.png | Bin 0 -> 512 bytes texi/picons/qmw.xbm | 27 + texi/picons/rms.png | Bin 0 -> 834 bytes texi/picons/ruu.xbm | 27 + texi/picons/seuu.xbm | 27 + texi/picons/stanford.png | Bin 0 -> 422 bytes texi/picons/sun.png | Bin 0 -> 334 bytes texi/picons/ubc.xbm | 27 + texi/picons/ufl.png | Bin 0 -> 1016 bytes texi/picons/uio.png | Bin 0 -> 759 bytes texi/picons/unit.png | Bin 0 -> 488 bytes texi/picons/upenn.xbm | 27 + texi/picons/wesleyan.xbm | 27 + texi/picons/yale.xbm | 27 + texi/pixidx.sty | 229 - texi/postamble.tex | 12 +- texi/ps/gnus-big-logo.eps | 1 - texi/ps/gnus-head.eps | 1 - texi/refcard.tex | 89 +- texi/screen/group-topic.png | Bin 0 -> 7356 bytes texi/screen/group.png | Bin 0 -> 5986 bytes texi/screen/server.png | Bin 0 -> 6084 bytes texi/screen/summary-adopt.png | Bin 0 -> 9275 bytes texi/screen/summary-article-c-ug.png | Bin 0 -> 13045 bytes texi/screen/summary-article.png | Bin 0 -> 12148 bytes texi/screen/summary-dummy.png | Bin 0 -> 9036 bytes texi/screen/summary-empty.png | Bin 0 -> 9126 bytes texi/screen/summary-none.png | Bin 0 -> 9668 bytes texi/screen/summary-unthreaded.png | Bin 0 -> 15380 bytes texi/screen/summary.png | Bin 0 -> 9803 bytes texi/smilies/BigFace.tif | Bin 0 -> 130064 bytes texi/smilies/FaceAngry.xpm | 20 + texi/smilies/FaceDevilish.xpm | 20 + texi/smilies/FaceGoofy.xpm | 20 + texi/smilies/FaceGrinning.xpm | 20 + texi/smilies/FaceHappy.xpm | 20 + texi/smilies/FaceIronic.xpm | 20 + texi/smilies/FaceKOed.xpm | 20 + texi/smilies/FaceNyah.xpm | 20 + texi/smilies/FaceSad.xpm | 20 + texi/smilies/FaceStartled.xpm | 20 + texi/smilies/FaceStraight.xpm | 20 + texi/smilies/FaceTalking.xpm | 20 + texi/smilies/FaceTasty.xpm | 20 + texi/smilies/FaceWinking.xpm | 20 + texi/smilies/FaceWry.xpm | 20 + texi/smilies/FaceYukky.xpm | 20 + texi/smilies/WideFaceAse1.xbm | 19 + texi/smilies/WideFaceAse2.xbm | 19 + texi/smilies/WideFaceAse3.xbm | 20 + texi/smilies/WideFaceSmile.xbm | 19 + texi/smilies/WideFaceWeep.xbm | 20 + texi/splitindex | 2 +- texi/texi2latex.el | 107 +- texi/xemacs.mak | 57 - texi/xface/abrahamsen.png | Bin 0 -> 341 bytes texi/xface/aichner.png | Bin 0 -> 333 bytes texi/xface/blanks.png | Bin 0 -> 408 bytes texi/xface/cosgriff.png | Bin 0 -> 311 bytes texi/xface/drazen.png | Bin 0 -> 366 bytes texi/xface/gertzfield.png | Bin 0 -> 374 bytes texi/xface/goldberg.png | Bin 0 -> 364 bytes texi/xface/graf.png | Bin 0 -> 387 bytes texi/xface/hardaker.png | Bin 0 -> 336 bytes texi/xface/hedbor.png | Bin 0 -> 419 bytes texi/xface/ingrand.png | Bin 0 -> 425 bytes texi/xface/kaplan.png | Bin 0 -> 348 bytes texi/xface/karlheg.png | Bin 0 -> 326 bytes texi/xface/kleinpaste.png | Bin 0 -> 286 bytes texi/xface/kyle.png | Bin 0 -> 259 bytes texi/xface/love.png | Bin 0 -> 351 bytes texi/xface/moll.png | Bin 0 -> 244 bytes texi/xface/niksic.png | Bin 0 -> 349 bytes texi/xface/olsen.png | Bin 0 -> 316 bytes texi/xface/patch.png | Bin 0 -> 378 bytes texi/xface/petersen.png | Bin 0 -> 400 bytes texi/xface/pjf.png | Bin 0 -> 253 bytes texi/xface/riocreux.png | Bin 0 -> 419 bytes texi/xface/schauer.png | Bin 0 -> 322 bytes texi/xface/simmonmt.png | Bin 0 -> 285 bytes texi/xface/simmons.png | Bin 0 -> 254 bytes texi/xface/siu.png | Bin 0 -> 378 bytes texi/xface/smb.png | Bin 0 -> 278 bytes texi/xface/sobek.png | Bin 0 -> 358 bytes texi/xface/thomas.png | Bin 0 -> 312 bytes texi/xface/valdis.png | Bin 0 -> 336 bytes texi/xface/verna1.png | Bin 0 -> 310 bytes texi/xface/verna2.png | Bin 0 -> 328 bytes texi/xface/yamaoka.png | Bin 0 -> 320 bytes todo | 1523 ++ xemacs.mak | 143 - 397 files changed, 95762 insertions(+), 40798 deletions(-) create mode 100644 ChangeLog.3 create mode 100644 INSTALL.ja delete mode 100644 README create mode 100644 contrib/ChangeLog create mode 100644 contrib/base64.el create mode 100644 contrib/gnus-idna.el create mode 100644 contrib/gpg-ring.el create mode 100644 contrib/gpg.el create mode 100644 contrib/hashcash.el create mode 100644 contrib/md5.el delete mode 100644 contrib/mml-smime.el create mode 100644 contrib/passwd.el create mode 100644 contrib/regexp-opt.el delete mode 100644 contrib/rfc2015.el delete mode 100644 contrib/smime.el create mode 100644 contrib/ssl.el create mode 100644 contrib/ucs-tables.el create mode 100644 contrib/xml.el create mode 100644 etc/Makefile.in create mode 100644 etc/gnus/catchup.pbm create mode 100644 etc/gnus/catchup.xpm create mode 100644 etc/gnus/cu-exit.pbm create mode 100644 etc/gnus/cu-exit.xpm create mode 100644 etc/gnus/describe-group.pbm create mode 100644 etc/gnus/describe-group.xpm create mode 100644 etc/gnus/exit-gnus.pbm create mode 100644 etc/gnus/exit-gnus.xpm create mode 100644 etc/gnus/exit-summ.pbm create mode 100644 etc/gnus/exit-summ.xpm create mode 100644 etc/gnus/followup.pbm create mode 100644 etc/gnus/followup.xpm create mode 100644 etc/gnus/fuwo.pbm create mode 100644 etc/gnus/fuwo.xpm create mode 100644 etc/gnus/get-news.pbm create mode 100644 etc/gnus/get-news.xpm create mode 100644 etc/gnus/gnntg.pbm create mode 100644 etc/gnus/gnntg.xpm create mode 100644 etc/gnus/important.xpm create mode 100644 etc/gnus/kill-group.pbm create mode 100644 etc/gnus/kill-group.xpm create mode 100644 etc/gnus/mail-reply.pbm create mode 100644 etc/gnus/mail-reply.xpm create mode 100644 etc/gnus/next-ur.pbm create mode 100644 etc/gnus/next-ur.xpm create mode 100644 etc/gnus/oort.xface create mode 100644 etc/gnus/post.pbm create mode 100644 etc/gnus/post.xpm create mode 100644 etc/gnus/prev-ur.pbm create mode 100644 etc/gnus/prev-ur.xpm create mode 100644 etc/gnus/preview.xbm create mode 100644 etc/gnus/preview.xpm create mode 100644 etc/gnus/receipt.xpm create mode 100644 etc/gnus/reply-wo.pbm create mode 100644 etc/gnus/reply-wo.xpm create mode 100644 etc/gnus/reply.pbm create mode 100644 etc/gnus/reply.xpm create mode 100644 etc/gnus/rot13.pbm create mode 100644 etc/gnus/rot13.xpm create mode 100644 etc/gnus/save-aif.pbm create mode 100644 etc/gnus/save-aif.xpm create mode 100644 etc/gnus/save-art.pbm create mode 100644 etc/gnus/save-art.xpm create mode 100644 etc/gnus/subscribe.pbm create mode 100644 etc/gnus/subscribe.xpm create mode 100644 etc/gnus/unimportant.xpm create mode 100644 etc/gnus/unsubscribe.pbm create mode 100644 etc/gnus/unsubscribe.xpm create mode 100644 etc/gnus/uu-decode.pbm create mode 100644 etc/gnus/uu-decode.xpm create mode 100644 etc/gnus/uu-post.pbm create mode 100644 etc/gnus/uu-post.xpm create mode 100644 etc/smilies/blink.pbm create mode 100644 etc/smilies/blink.xpm create mode 100644 etc/smilies/braindamaged.xpm create mode 100644 etc/smilies/cry.xpm create mode 100644 etc/smilies/dead.xpm create mode 100644 etc/smilies/evil.xpm create mode 100644 etc/smilies/forced.xpm create mode 100644 etc/smilies/frown.xpm create mode 100644 etc/smilies/grin.xpm create mode 100644 etc/smilies/indifferent.xpm create mode 100644 etc/smilies/reverse-smile.xpm create mode 100644 etc/smilies/sad.pbm create mode 100644 etc/smilies/sad.xpm create mode 100644 etc/smilies/smile.xpm create mode 100644 etc/smilies/wry.xpm delete mode 100644 lisp/gnus-load.el delete mode 100644 lisp/ptexinfmt.el delete mode 100644 lisp/smiley-ems.el create mode 100644 texi/etc/bar.xpm create mode 100644 texi/etc/gnus-group-catchup-current-up.xpm create mode 100644 texi/etc/gnus-group-catchup-current.xpm create mode 100644 texi/etc/gnus-group-describe-group-up.xpm create mode 100644 texi/etc/gnus-group-exit-up.xpm create mode 100644 texi/etc/gnus-group-get-new-news-this-group-up.xpm create mode 100644 texi/etc/gnus-group-get-new-news-up.xpm create mode 100644 texi/etc/gnus-group-kill-group-up.xpm create mode 100644 texi/etc/gnus-group-subscribe-up.xpm create mode 100644 texi/etc/gnus-group-unsubscribe-up.xpm create mode 100644 texi/etc/gnus-summary-caesar-message-up.xpm create mode 100644 texi/etc/gnus-summary-cancel-article-up.xpm create mode 100644 texi/etc/gnus-summary-catchup-and-exit-up.xpm create mode 100644 texi/etc/gnus-summary-catchup-up.xpm create mode 100644 texi/etc/gnus-summary-exit-up.xpm create mode 100644 texi/etc/gnus-summary-followup-up.xpm create mode 100644 texi/etc/gnus-summary-followup-with-original-up.xpm create mode 100644 texi/etc/gnus-summary-mail-copy-up.xpm create mode 100644 texi/etc/gnus-summary-mail-delete-up.xpm create mode 100644 texi/etc/gnus-summary-mail-forward-up.xpm create mode 100644 texi/etc/gnus-summary-mail-get-up.xpm create mode 100644 texi/etc/gnus-summary-mail-originate-up.xpm create mode 100644 texi/etc/gnus-summary-mail-reply-up.xpm create mode 100644 texi/etc/gnus-summary-mail-save-up.xpm create mode 100644 texi/etc/gnus-summary-next-unread-up.xpm create mode 100644 texi/etc/gnus-summary-post-news-up.xpm create mode 100644 texi/etc/gnus-summary-prev-unread-up.xpm create mode 100644 texi/etc/gnus-summary-reply-up.xpm create mode 100644 texi/etc/gnus-summary-reply-with-original-up.xpm create mode 100644 texi/etc/gnus-summary-save-article-file-up.xpm create mode 100644 texi/etc/gnus-summary-save-article-up.xpm create mode 100644 texi/etc/gnus-uu-decode-uu-up.xpm create mode 100644 texi/etc/gnus-uu-post-news-up.xpm create mode 100644 texi/etc/gnus.xpm delete mode 100644 texi/gnuslogo.refcard create mode 100644 texi/herds/convol11.pnm create mode 100644 texi/herds/convol5.pnm create mode 100644 texi/herds/gnus-herd-bw.png create mode 100644 texi/herds/gnus-herd-new.png create mode 100644 texi/herds/new-herd-1.png create mode 100644 texi/herds/new-herd-2.png create mode 100644 texi/herds/new-herd-3.png create mode 100644 texi/herds/new-herd-4.png create mode 100644 texi/herds/new-herd-5.png create mode 100644 texi/herds/new-herd-6.png create mode 100644 texi/herds/new-herd-7.png create mode 100644 texi/herds/new-herd-8.png create mode 100644 texi/herds/new-herd-9.png create mode 100644 texi/herds/new-herd-section.png create mode 100644 texi/herds/new-herd.png create mode 100644 texi/herds/new-herd2.png create mode 100644 texi/misc/ered.tif create mode 100644 texi/misc/eseptember.tif create mode 100644 texi/misc/fred.tif create mode 100644 texi/misc/fseptember.tif create mode 100644 texi/misc/larsi.png create mode 100644 texi/misc/red.png create mode 100644 texi/misc/red.ps create mode 100644 texi/misc/september.png create mode 100644 texi/picons/att.png create mode 100644 texi/picons/berkeley.png create mode 100644 texi/picons/caltech.png create mode 100644 texi/picons/canada.png create mode 100644 texi/picons/cr.png create mode 100644 texi/picons/cygnus.xbm create mode 100644 texi/picons/gnu.xbm create mode 100644 texi/picons/gov.xbm create mode 100644 texi/picons/laurie.png create mode 100644 texi/picons/mit.png create mode 100644 texi/picons/nasa.png create mode 100644 texi/picons/qmw.xbm create mode 100644 texi/picons/rms.png create mode 100644 texi/picons/ruu.xbm create mode 100644 texi/picons/seuu.xbm create mode 100644 texi/picons/stanford.png create mode 100644 texi/picons/sun.png create mode 100644 texi/picons/ubc.xbm create mode 100644 texi/picons/ufl.png create mode 100644 texi/picons/uio.png create mode 100644 texi/picons/unit.png create mode 100644 texi/picons/upenn.xbm create mode 100644 texi/picons/wesleyan.xbm create mode 100644 texi/picons/yale.xbm delete mode 100644 texi/pixidx.sty create mode 100644 texi/screen/group-topic.png create mode 100644 texi/screen/group.png create mode 100644 texi/screen/server.png create mode 100644 texi/screen/summary-adopt.png create mode 100644 texi/screen/summary-article-c-ug.png create mode 100644 texi/screen/summary-article.png create mode 100644 texi/screen/summary-dummy.png create mode 100644 texi/screen/summary-empty.png create mode 100644 texi/screen/summary-none.png create mode 100644 texi/screen/summary-unthreaded.png create mode 100644 texi/screen/summary.png create mode 100644 texi/smilies/BigFace.tif create mode 100644 texi/smilies/FaceAngry.xpm create mode 100644 texi/smilies/FaceDevilish.xpm create mode 100644 texi/smilies/FaceGoofy.xpm create mode 100644 texi/smilies/FaceGrinning.xpm create mode 100644 texi/smilies/FaceHappy.xpm create mode 100644 texi/smilies/FaceIronic.xpm create mode 100644 texi/smilies/FaceKOed.xpm create mode 100644 texi/smilies/FaceNyah.xpm create mode 100644 texi/smilies/FaceSad.xpm create mode 100644 texi/smilies/FaceStartled.xpm create mode 100644 texi/smilies/FaceStraight.xpm create mode 100644 texi/smilies/FaceTalking.xpm create mode 100644 texi/smilies/FaceTasty.xpm create mode 100644 texi/smilies/FaceWinking.xpm create mode 100644 texi/smilies/FaceWry.xpm create mode 100644 texi/smilies/FaceYukky.xpm create mode 100644 texi/smilies/WideFaceAse1.xbm create mode 100644 texi/smilies/WideFaceAse2.xbm create mode 100644 texi/smilies/WideFaceAse3.xbm create mode 100644 texi/smilies/WideFaceSmile.xbm create mode 100644 texi/smilies/WideFaceWeep.xbm delete mode 100644 texi/xemacs.mak create mode 100644 texi/xface/abrahamsen.png create mode 100644 texi/xface/aichner.png create mode 100644 texi/xface/blanks.png create mode 100644 texi/xface/cosgriff.png create mode 100644 texi/xface/drazen.png create mode 100644 texi/xface/gertzfield.png create mode 100644 texi/xface/goldberg.png create mode 100644 texi/xface/graf.png create mode 100644 texi/xface/hardaker.png create mode 100644 texi/xface/hedbor.png create mode 100644 texi/xface/ingrand.png create mode 100644 texi/xface/kaplan.png create mode 100644 texi/xface/karlheg.png create mode 100644 texi/xface/kleinpaste.png create mode 100644 texi/xface/kyle.png create mode 100644 texi/xface/love.png create mode 100644 texi/xface/moll.png create mode 100644 texi/xface/niksic.png create mode 100644 texi/xface/olsen.png create mode 100644 texi/xface/patch.png create mode 100644 texi/xface/petersen.png create mode 100644 texi/xface/pjf.png create mode 100644 texi/xface/riocreux.png create mode 100644 texi/xface/schauer.png create mode 100644 texi/xface/simmonmt.png create mode 100644 texi/xface/simmons.png create mode 100644 texi/xface/siu.png create mode 100644 texi/xface/smb.png create mode 100644 texi/xface/sobek.png create mode 100644 texi/xface/thomas.png create mode 100644 texi/xface/valdis.png create mode 100644 texi/xface/verna1.png create mode 100644 texi/xface/verna2.png create mode 100644 texi/xface/yamaoka.png create mode 100644 todo delete mode 100644 xemacs.mak diff --git a/ChangeLog b/ChangeLog index 01580b3..aacb375 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3219 +1,2822 @@ -2001-04-10 Katsumi Yamaoka +2003-05-01 Katsumi Yamaoka - * lisp/gnus.el (gnus-interactive): Fix mismatched parentheses. + * lisp/gnus-vers.el: T-gnus 6.15.24 revision 00. - * lisp/nnshimbun.el: Enclose w3m stuff with `eval-and-compile'; - bind `w3m-work-buffer-name' and `w3m-retrieve' when compiling. +2003-05-01 Jesper Harder -2001-04-03 TSUCHIYA Masatoshi + * etc/gnus-tut.txt (http): Update. - * lisp/nnshimbun.el (nnshimbun-type-definition: Follow changes in - asahi.com. - (nnshimbun-asahi-get-headers): Ditto. - (nnshimbun-retrieve-url): Use `w3m-retrieve' if it is available. +2003-05-01 Katsumi Yamaoka -2001-03-19 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.23 revision 00. - * lisp/gnus-kill.el (gnus-execute): Work with the extra headers. - * lisp/gnus-sum.el (gnus-summary-execute-command): Ditto. +2003-05-01 Simon Josefsson -2001-03-13 Katsumi Yamaoka + * GNUS-NEWS: Add prefix limit feature. - * lisp/message.el (message-fix-before-sending): Hide again the - invisible property of encoded binary data parts after checking is - done. - (message-find-invisible-regions): New function. - (message-save-drafts, message-send): Inherit the invisible property - of encoded binary data parts to make MIME-Edit find the MIME part - boundaries. +2003-05-01 Katsumi Yamaoka -2001-03-08 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.22 revision 00. - * lisp/gnus-art.el (gnus-article-prepare-display): Setup MIME - entity even if `gnus-show-mime' is nil. +2003-05-01 Katsumi Yamaoka -2001-03-06 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.20 revision 00. - * lisp/nnshimbun.el (nnshimbun-retrieve-url): Check if - `url-current-mime-charset' is bound. +2003-04-30 Reiner Steib -2001-03-04 Katsumi Yamaoka + * GNUS-NEWS: Added Article Buttons. Added Upgrading (from Simon + Josefsson). Add gnus-mime-delete-part, markup fixes and some + other corrections. Mention Gnus FAQ. - * lisp/gnus.el (gnus-info-find-node): Pretend to be - `gnus-article-mode' in the article buffer. +2003-04-30 Jesper Harder -2001-03-02 Katsumi Yamaoka + * GNUS-NEWS: Additions. - * lisp/nnshimbun.el (nnshimbun-kinsoku-eol-list): Simplified. - (nnshimbun-kinsoku-bol-list): Ditto. +2003-04-30 Katsumi Yamaoka -2001-03-01 Katsumi Yamaoka + * lisp/lpath.el: Bind `default-mime-charset-unlimited'. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. +2003-04-29 Katsumi Yamaoka - * lisp/gnus-group.el (gnus-group-make-shimbun-group): Simplified. + * lisp/dgnushack.el: Autoload font-lock and nnheader for XEmacs + -no-autoloads. - * lisp/dgnushack.el: Load cl-macs to ensure that the macro `dolist' - is defined properly. + * lisp/pop3.el: Require `advice' for compiling it in Gnus. - * lisp/nnwfm.el: Require `gnus-clfns' when compiling. - * lisp/nnshimbun.el: Ditto. - * lisp/mm-util.el: Ditto. - * lisp/gnus-vers.el: Ditto. - * lisp/gnus-score.el: Ditto. - * lisp/gnus-nocem.el: Ditto. +2003-04-28 Reiner Steib - * lisp/gnus-ofsetup.el: Don't require `gnus-clfns'. - (gnus-ofsetup-customize-done): Use `dolist' instead of `mapc'. - (gnus-setup-for-offline): Ditto. + * GNUS-NEWS: Fixed X-Draft-Headers entry. - * lisp/gnus-offline.el: Don't use `mapc' for binding some vars; - don't require `gnus-clfns'. - (gnus-offline-get-menu-items): Rewrite using `dolist'. +2003-04-28 Katsumi Yamaoka - * lisp/gnus-clfns.el (butlast): New compiler macro. - (mapc): Remove. + * lisp/dgnushack.el: Make sure `dolist' is available; require + `advice' before `path-util'; revoke the bogus change of 2003-04-17 + (removing function bindings for XEmacs). + (dgnushack-remove-extra-files-in-package): Clear the value for + `command-line-args-left'. + (dgnushack-install-package-manifest): Ditto. - * lisp/gnus-art.el: Use `dolist' instead of `mapcar' for defining - `gnus-article-read-summary-keys'. + * texi/infohack.el: Load dgnushack.el and ptexinfmt.el first. -2001-02-28 Katsumi Yamaoka +2003-04-27 Simon Josefsson - * lisp/gnus-art.el (gnus-article-mime-edit-article-setup): Leave - the forwarded parts undecoded. - (gnus-article-decode-article-as-default-mime-charset): Set the - value of `default-mime-charset' buffer-locally. + * GNUS-NEWS: Fix PGP entry. Doc GCC variable change. -2001-02-27 Katsumi Yamaoka +2003-04-28 Katsumi Yamaoka - * lisp/gnus.el: Add autoloads for - `gnus-summary-digest-post-forward' and - `gnus-summary-digest-mail-forward'. + * lisp/gnus-vers.el: T-gnus 6.15.19 revision 00. - * lisp/gnus-sum.el (gnus-summary-post-menu): Replace - `gnus-uu-digest-mail-forward' and `gnus-uu-digest-post-forward' - with `gnus-summary-digest-post-forward' and - `gnus-summary-digest-mail-forward'. +2003-04-24 Katsumi Yamaoka - * lisp/gnus-msg.el (gnus-summary-digest-post-forward): Restore and - repair the command `gnus-summary-post-digest' and rename it. - (gnus-summary-digest-mail-forward): Ditto. - (gnus-summary-send-map): Replace `gnus-uu-digest-mail-forward' and - `gnus-uu-digest-post-forward' with - `gnus-summary-digest-post-forward' and - `gnus-summary-digest-mail-forward'. + * lisp/nnheader.el (nnheader-coding-system-p): New function. + (mm-coding-system-p): Alias to `nnheader-coding-system-p'. -2001-02-27 Katsumi Yamaoka +2003-04-23 Katsumi Yamaoka - * lisp/gnus-sum.el (gnus-summary-show-article): Bind - `gnus-inhibit-treatment' to t while fetching the raw article. + * lisp/gnus-clfns.el (coerce, copy-list, merge, string, subseq): + Comment out those compiler macros. + (mapc): Make it comeback. - * lisp/gnus-art.el (gnus-article-mime-edit-exit): Bind - `mime-edit-insert-user-agent-field' to nil while `mime-edit-exit' - is being done; turn off font-lock first; query if the buffer is - modified. - (gnus-article-mime-edit-done): New function. - (gnus-article-mime-edit-article-setup): Make the window fill its - frame; clear the buffere modified flag; substitute key definition - `gnus-article-edit-done' with `gnus-article-mime-edit-done'; don't - turn off font-lock here; bind `mime-edit-insert-user-agent-field' - to nil while `mime-edit-exit' is being done. - (gnus-article-mime-edit-article-unwind): Turn off font-lock first. +2003-04-22 Reiner Steib -2001-02-23 Katsumi Yamaoka + * make.bat: Flag as binary to ensure DOS line terminators. Delete + trailing whitespace. - * lisp/dgnushack.el: Don't require `emu'. +2003-04-21 Reiner Steib + From Frank Schmitt -2001-02-16 Katsumi Yamaoka + * etc/gnus-tut.txt: Update Gnus FAQ, delete trailing whitespace. - * lisp/message.el (message-forward-subject-author-subject): Decode - `From' field. +2003-04-17 Katsumi Yamaoka -2001-02-16 Katsumi Yamaoka + * Makefile.in (xclever-package, xlick-package): New rules. + (install-package, install-package-ja, package, package-ja): Use + them. + (install-package-manifest, remove-extra-files-in-package, + compose-package): Specify the lisp directory for XEmacs package. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. + * aclocal.m4 (AC_PATH_INFO_DIR): Say a note for XEmacs package. - * lisp/gnus-sum.el (gnus-get-newsgroup-headers-xover): Don't use - `gnus-retrieve-parsed-headers' when the backend is nnimap. It is - only a temporary fix for an infloop on nnimap. FIXME!!! - (gnus-select-newsgroup): Ditto. + * lisp/dgnushack.el: Remove useless function bindings for XEmacs. + (dgnushack-install-package-manifest): Create the pkginfo directory. -2001-02-16 Katsumi Yamaoka + * lisp/lpath.el: Fbind `compare-strings' for Mule 2. - * texi/gnus-faq-ja.texi (Q2.1): Remove mention of - `gnus-article-display-hook.' +2003-04-17 Kevin Greiner - * lisp/gnus.el (gnus-article-display-hook): Abolished. + * make.bat: Cleaned up end-of-line characters. - * lisp/gnus-uu.el (gnus-uu-grab-articles): Don't care about - `gnus-article-display-hook'. - * lisp/gnus-sum.el (gnus-summary-show-article): Ditto. - (gnus-summary-search-article): Ditto. +2003-04-17 Steve Youngs - * lisp/gnus-bbdb.el (gnus-bbdb-insinuate): Use - `gnus-article-prepare-hook' instead of `gnus-article-display-hook'. + * Makefile.in (XEMACS): Use @EMACS@. - * lisp/gnus-art.el (gnus-article-prepare-display): Evaluate - `gnus-article-prepare-hook' after an article has been prepared; - don't evaluate `gnus-article-display-hook'. + * aclocal.m4 (AC_PATH_LISPDIR): Set $datadir to $prefix/lib if + building with XEmacs. -2001-02-15 Katsumi Yamaoka + * aclocal.m4 (AC_SET_BUILD_FLAGS): New. So we can set XEmacs + command line options to '-batch -no-autoloads...' for a cleaner + build environment. - * lisp/message.el (message-cite-original-without-signature): - Extract from field for the simple citation line. + * configure.in: Use it. -2001-02-08 Katsumi Yamaoka + * configure: Regenerate. - * lisp/nnshimbun.el (nnshimbun-fml-get-headers): Fix unbalanced - parentheses. +2003-04-16 Reiner Steib + From Frank Schmitt -2001-02-08 Akihiro Arisawa + * make.bat: New variable EMACS_ARGS. Changed XEmacs args. - * lisp/nnshimbun.el: Add `bbdb-ml' support. +2003-04-13 Katsumi Yamaoka -2001-02-02 Akihiro Arisawa + * lisp/lpath.el: Fbind `coding-system-base' for Mule 2. - * lisp/nnshimbun.el (nnshimbun-type-definition): Follow URL change - of `xemacs'. - (nnshimbun-xemacs-get-headers): Ditto. +2003-04-13 Katsumi Yamaoka -2001-02-06 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.18 revision 00. - * README-gnus-bbdb.{en,ja}: Update the patch for BBDB v2.2. + * lisp/message.el (message-forward-subject-name-subject): Rewrite. -2001-02-01 Katsumi Yamaoka + * lisp/mail-source.el (mail-source-fetch-pop): Require `pop3' + explicitly. + (mail-source-check-pop): Ditto. - * lisp/dgnushack.el (dgnushack-texi-format): A workaround for - @ifnottex. +2003-04-07 Katsumi Yamaoka - * texi/Makefile.in (.texi, %.info): Don't use makeinfo command when - gnus-ja.texi or message-ja.texi is given. It is needed for some - make command if which can not understand "%-ja:" or "%-ja.info:". - (.texi, %.info, %-ja.info, %-ja): Don't eval `EMACSINFOHACK'. - (EMACSINFOHACK): Move to lisp/dgnushack.el. + * lisp/nnmail.el (nnmail-split-it): Revoke the change of 1999-08-19. -2001-01-29 Katsumi Yamaoka +2003-04-03 Katsumi Yamaoka - * lisp/gnus-art.el (gnus-article-mime-edit-exit): Use - `buffer-substring-no-properties' instead of `format'. + * lisp/pop3.el (pop3-uidl-support): Default to nil; change the + meaning of a value which it may contain into an alist of servers + and flags of whether they support UIDLs. + (pop3-get-message-numbers): Don't check uidls when + `pop3-leave-mail-on-server' is nil; synch it with the change of + `pop3-uidl-support'. + (pop3-get-uidl): Synch it with the change of `pop3-uidl-support'. -2001-01-23 TAKAHASHI Kaoru +2003-03-31 Katsumi Yamaoka - * lisp/ptexinfmt.el: Support @letterpaper and @afivepaper. + * lisp/gnus-vers.el: T-gnus 6.15.17 revision 00. -2001-01-22 Katsumi Yamaoka +2003-03-24 Katsumi Yamaoka - * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. + * lisp/gnus-art.el (gnus-article-x-face-command): Don't examine + functions if `noninteractive'. + (gnus-article-should-use-smiley-mule): Don't examine values if + `noninteractive'. + (gnus-treat-display-face): Default to nil if x-face-e21 is + available. + (gnus-treat-display-smileys): Don't examine values if + `noninteractive'. - * Makefile.in (install-package-lisp): Use - `install-without-compiling' instead of `install'. + * lisp/message.el (message-yank-original): Check not only the + References field but the `message-reply-headers' variable. - * lisp/Makefile.in (install): Use `install-without-compiling'. - (install-without-compiling): New target. + * lisp/imap.el (imap-tls-open): Don't bind coding-systems; use + `set-buffer-multibyte' instead of `imap-disable-multibyte'. -2001-01-18 Katsumi Yamaoka + * lisp/tls.el: Require `pces'. + (open-tls-stream): Use `as-binary-process'. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. +2003-03-23 Simon Josefsson -2001-01-17 Katsumi Yamaoka + * GNUS-NEWS: Add IDNA. Add TLS. Fix USEFOR reference. - * lisp/dgnushack.el (dgnushack-make-autoloads): Do nothing if the - files for autoloads already exist. - (dgnushack-unexporting-files): More useful message. +2003-03-22 Frank Schmitt - * lisp/Makefile.in (install): Call `clever' before installing. - (install-lisp): Remove. - (clever): Check for whether the all elc files should be recompiled. + * make.bat: Redone from scratch; supports both Emacs and XEmacs + now; correctly generate gnus-load.el; check for errors; use + makeinfo if available, infohack.el if it isn't; be less verbose + when copying files; copy files from etc/gnus and etc/smilies, too - * Makefile.in (xclever): New target. - (install-package-lisp): Replace `install-lisp' with `install'. - (install-package-ja): Replace `xlick' with `xclever'. - (install-package): Ditto. +2003-03-22 Frank Schmitt -2001-01-17 KOSEKI Yoshinori + * make-x.bat: Removed, make.bat does its job now. - * Makefile.in: Unset `PWD' for Meadow/NTEmacs. +2003-03-22 Frank Schmitt -2001-01-15 Katsumi Yamaoka + * etc/gnus-tut.txt: Include Gnus FAQ from http://my.gnus.org. - * lisp/nnheader.el: Require `pces', `poem' and `std11' to reduce - the required value of `recursive-load-depth-limit' for Emacs 21. +2003-03-18 Katsumi Yamaoka - * lisp/message.el (message-followup): Handle "Mail-Copies-To:" - correctly. - (message-get-reply-headers): Ditto. + * lisp/gnus-vers.el: T-gnus 6.15.16 revision 00. -2001-01-15 Keiichi Suzuki +2003-03-04 Katsumi Yamaoka - * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Save excursion - while `bbdb-annotate-message-sender' is being done. + * lisp/gnus-ofsetup.el: Don't require `read-passwd'; don't set + `mail-source-read-passwd' and `gnus-setup-news-hook'. -2001-01-14 Katsumi Yamaoka + * contrib/passwd.el: New file. - * lisp/gnus-art.el (gnus-treatment-function-alist): Use backquote. +2003-02-20 Katsumi Yamaoka -2001-01-13 Kinji Itoh + * lisp/gnus-offline.el (gnus-offline-add-custom-header): Use + insert instead of insert-string which is obsolete in Emacs 21.4 + (synch to the change of Jesper Harder at 2003-02-20). - * Makefile.in (install-package-lisp): Specify EMACS=$(XEMACS). +2003-02-19 Reiner Steib -2001-01-12 Katsumi Yamaoka + * GNUS-NEWS: Renamed `gnus-unsightly-citation-regexp' to + `gnus-cite-unsightly-citation-regexp'. - * lisp/gnus-vers.el (T-gnus): Update to 6.14.6. - (gnus-revision-number): Clear to 00. +2003-02-18 Simon Josefsson - * Sync up with Gnus v5.8.8. + * GNUS-NEWS: Talk about canlock more. -2001-01-11 Katsumi Yamaoka +2003-02-13 Kai Gro,A_(Bjohann - * lisp/gnus-msg.el (gnus-copy-article-buffer): Remove smiley - extents for XEmacs 21.1 using `format'. + * GNUS-NEWS: Add user visible changes from Michael Shields from + the past couple of days. Actual text from Michael. -2001-01-10 Katsumi Yamaoka +2003-02-09 Katsumi Yamaoka - * lisp/gnus.el: Don't autoload "smiley" for `smiley-toggle-buffer'; - don't autoload "gnus-bitmap" or "x-face-mule" when Emacs 21 is - running. + * lisp/gnus-vers.el: T-gnus 6.15.15 revision 00. - * lisp/gnus-art.el (TopLevel): Autoload "gnus-bitmap" for - `smiley-toggle-buffer' when compiling. - (gnus-treatment-function-alist): Use `gnus-smiley-display' for - `gnus-treat-display-smileys' by default when XEmacs or Emacs 21 is - running. - (gnus-treat-display-smileys): Check for `smiley-mule' instead of - `gnus-bitmap'. - (gnus-article-x-face-command): Don't check for xbm for x-face-e21. +2003-01-25 Katsumi Yamaoka -2000-12-22 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.14 revision 00. - * lisp/gnus-msg.el (gnus-debug): Use `sit-for' in the inside of - `save-excursion'. - (gnus-bug): Pop up the sending buffer first. +2003-01-24 Jesper Harder - * lisp/dgnushack.el - (byte-compile-file-form-custom-declare-variable): Use `defvar' - instead of `custom-declare-variable' to make the variable - uncustomizable if the arguments has the keyword `:version'. + * etc/gnus-tut.txt: Update. -2000-12-21 Katsumi Yamaoka +2003-01-24 Katsumi Yamaoka - * lisp/dgnushack.el (TopLevel): Byte-optimize - `custom-declare-variable', `custom-declare-group, and - `custom-declare-face' to omit unsupported keywords when Mule is - running. + * texi/infohack.el (infohack-texi-format): Withdraw the change of + 2003-01-17. -2000-12-06 Katsumi Yamaoka +2003-01-21 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'. + * lisp/gnus-vers.el: T-gnus 6.15.13 revision 00. -2000-12-06 TSUCHIYA Masatoshi +2003-01-17 Katsumi Yamaoka - * 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. + * texi/infohack.el (infohack-texi-format): Insert one excessive + newline after a @foo{bar} thing to prevent clinging of a line and + a line (old texinfmt bug?) if it should be considered only one + thing in a line. -2000-12-03 Tetsuo Tsukamoto +2003-01-17 TSUCHIYA Masatoshi - * texi/gnus-ja.texi: Fixes for the last modification. + * .cvsignore: Import from Oort Gnus. + * contrib/.cvsignore: Ditto. + * etc/.cvsignore: Ditto. + * lisp/.cvsignore: Ditto. + * texi/.cvsignore: Ditto. + * texi/ps/.cvsignore: Ditto. -2000-12-02 Tetsuo Tsukamoto +2003-01-16 Katsumi Yamaoka - * texi/gnus-ja.texi: Translate description about - `nnmail-split-fancy-with-parent'. + * lisp/gnus-msg.el (gnus-summary-digest-mail-forward): Set article + numbers to be marked. - * texi/message-ja.texi: Use two lines for direntry. +2003-01-02 Lars Magne Ingebrigtsen -2000-12-01 Katsumi Yamaoka + (A forgotten thing to synchronize to Oort Gnus.) + * lisp/gnus-msg.el (gnus-summary-mail-forward): To many lists of + lists. - * 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. +2003-01-15 Simon Josefsson -2000-11-27 Katsumi Yamaoka + * GNUS-NEWS: Add. Fix from Reiner Steib + <4uce.02.r.steib@gmx.net>. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 08. +2003-01-14 Katsumi Yamaoka - * lisp/message.el (message-send-mail-with-smtp): Leave the error - handling in `smtp-send-buffer's own care. + * lisp/binhex.el: Require `path-util'. + * lisp/gnus-audio.el: Ditto. + * lisp/spam.el: Ditto. + * lisp/uudecode.el: Ditto. -2000-11-22 Katsumi Yamaoka + * lisp/binhex.el (binhex-use-external): Replace `executable-find' + with `exec-installed-p'. + * lisp/gnus-audio.el (gnus-audio-au-player): Ditto. + (gnus-audio-wav-player): Ditto. + * lisp/spam.el (spam-ifile-path): Ditto. + (spam-bogofilter-path): Ditto. + * lisp/uudecode.el (uudecode-use-external): Ditto. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 07. + * lisp/gnus-int.el (gnus-agent-expire): Make arguments optional. - * lisp/gnus.el: Add autoloads for x-face-e21. +2003-01-13 Katsumi Yamaoka - * 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-util.el (gnus-read-event-char): Take an optional + parameter even if Mule 2.3 is running. - * 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. +2003-01-10 Reiner Steib -2000-11-21 Katsumi Yamaoka + * make.bat: Removed "-no-init-file" (it's the same as "-q"). Use + new variables EMACSBATCH and GNUS_INFO_DIR. Install gnus-?, + message-?, sieve and pgg (in texi). Added hint for dir entries. - * lisp/message.el (message-send-mail-with-smtp): Use - `smtp-send-buffer' if it exists instead of `smtp-via-smtp'. + * make-x.bat: Ditto. - * lisp/dgnushack.el (describe-key-briefly): New compiler macro for - old Emacsen. +2003-01-13 Simon Josefsson -2000-11-17 Akihiro Arisawa + * GNUS-NEWS: Add smileys, Sender:, message-utils. + Expand anti-spam. Fixes. - * lisp/nnheader.el (nnheader-header-value): Save point. +2003-01-12 Katsumi Yamaoka -2000-11-16 Katsuhiro Hermit Endo + * lisp/gnus-vers.el: T-gnus 6.15.12 revision 00. - * texi/gnus-ja.texi (Drafts): Fix typo. +2003-01-12 Katsumi Yamaoka -2000-11-14 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.11 revision 00. - * lisp/gnus-art.el (article-verify-x-pgp-sig): Autoload "mm-uu". - (gnus-treat-x-pgp-sig): Default to nil. +2003-01-11 Katsumi Yamaoka -2000-11-10 Katsumi Yamaoka + * lisp/gnus.art.el (gnus-treat-predicate): Don't follow the Change + of Oort Gnus at 2003-01-02; reverted. - * Mule23@1934.en, Mule23@1934.ja, sample.lpath.el: Upgrade. + * lisp/message.el (message-tool-bar-map): Commented out MIME-Edit + buttons. - * 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. +2003-01-09 Simon Josefsson -2000-11-09 Katsumi Yamaoka + * etc/gnus/preview.xpm: Add. - * configure: Regenerate. +2003-01-06 Simon Josefsson - * 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. + * etc/gnus/receipt.xpm: Add. - * configure: Regenerate. +2003-01-10 Jesper Harder - * 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'. + * etc/gnus/preview.xbm: Add. - * 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. +2003-01-09 Katsumi Yamaoka -2000-11-07 Tetsuo Tsukamoto + * lisp/message.el (message-tool-bar-map): Fix keymap for MIME-Edit. - * texi/gnus-ja.texi: Do not use characters other than ascii ones - for direntries. - * texi/message-ja.texi: Ditto. +2003-01-09 NAKAJI Hiroyuki -2000-11-06 Katsumi Yamaoka + * README.semi.ja: "What's T-gnus?" is revised. - * lisp/Makefile.in (install): Don't check for the file names. + * README.semi: Ditto. -2000-11-04 Katsuhiro Hermit Endo +2003-01-07 Keiichi Suzuki - * lisp/gnus-topic.el (gnus-group-topic-map): Define "T" prefix - command in `gnus-topic-mode-map' instead of `gnus-group-mode-map'. + * lisp/message.el (message-setup-1): Don't call + `message-use-alternative-email-as-from' if it isn't for replying. -2000-10-25 Katsuhiro Hermit Endo +2003-01-05 Katsumi Yamaoka - * lisp/gnus-topic.el (gnus-topic-rename): Use current topic as - initial value for read-string. + * etc/gnus/gnus.xpm (oort): Make the color replaceable. -2000-11-06 Katsumi Yamaoka +2003-01-05 Katsumi Yamaoka - * lisp/Makefile.in (install): Use the lisp function - `dgnushack-exported-files'. + * lisp/gnus-vers.el: T-gnus 6.15.10 revision 00. - * lisp/nnmail.el (nnmail-pathname-coding-system): Default to - `binary'. - * lisp/nnheader.el (nnheader-pathname-coding-system): Ditto. +2003-01-03 Katsumi Yamaoka - * lisp/message.el (message-get-reply-headers): Remove useless - `concat'. + * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Bind the + color for the symbol `oort' as `gnus-group-startup-message' does. - * lisp/md5.el: Restore the file. +2002-12-31 Katsumi Yamaoka - * 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/gnus-start.el (gnus-re-read-newsrc-el-file): Commented out. + (gnus-load): Allow coding-system as an argument. - * lisp/base64.el: New file -- base64 encoding functions using MEL. +2002-12-16 ARISAWA Akihiro -2000-11-05 Tetsuo Tsukamoto + * lisp/nnimap.el (nnimap-callback): Use `nnimap-demule'. + (nnimap-request-article-part): Ditto. - * lisp/smiley.el (smiley-deformed-regexp-alist): Modify regexp for - the winking face. +2002-12-10 Katsumi Yamaoka -2000-11-02 Katsumi Yamaoka + * texi/Makefile.in (%.info, .texi): Conceal control procedures. - * lisp/dgnushack.el (dgnushack-make-manifest): Fix info directory. +2002-12-05 Kai Gro,A_(Bjohann -2000-11-02 Katsumi Yamaoka + * etc/smilies/*.pbm: Made them binary. - * 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. +2002-11-28 Daiki Ueno - * lisp/Makefile.in (install-package-info-ja, install-package-info, - install-package-lick): New targets. - (compose-package): Rename from `package'. - (install-package): Remove. + * lisp/gnus-agent.el (gnus-agent-fetch-headers): Don't refer to + the value of `gnus-agent-file-name'. - * 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. +2002-11-28 Daiki Ueno -2000-11-01 Katsumi Yamaoka + * lisp/gnus-agent.el (gnus-agent-fetch-group-1): Article numbers + should be accessed through `mail-header-number'. - * lisp/dgnushack.el (dgnushack-texi-format): Remove @ignore'd areas - before processing. +2002-11-24 ARISAWA Akihiro -2000-11-01 Katsumi Yamaoka + * lisp/mm-url.el (mm-url-program): Use `exec-installed-p' instead of + `executable-find'. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 06. +2002-11-13 Kai Gro,A_(Bjohann - * 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. + * etc/smilies/blink.xpm: Changed smileys and some new ones from + Alex Schroeder . -2000-10-31 Katsumi Yamaoka +2002-11-12 Katsumi Yamaoka - * lisp/dgnushack.el: Bind `:key-type' and `:value-type' for old - Emacsen. + * lisp/gnus-sum.el (gnus-summary-inherit-default-charset): Inherit + the value for `default-mime-charset-unlimited' as well. + (gnus-summary-setup-default-charset): Bind + `default-mime-charset-unlimited' to nil for nndraft:delayed or + nndraft:drafts groups. -2000-10-31 TAKAHASHI Kaoru + * lisp/gnus-art.el (gnus-article-prepare-display): Don't use + MIME-View for nndraft:delayed or nndraft:drafts groups. + (gnus-article-decode-article-as-default-mime-charset): Don't + decode an article for nndraft:delayed or nndraft:drafts groups. - * lisp/ptexinfmt.el (texinfo-format-direntry): Fixed broken - direntry generate probrem. - (Advised by Tetsuo Tsukamoto ) +2002-11-06 Katsumi Yamaoka -2000-10-31 Katsumi Yamaoka + * lisp/nndraft.el (nndraft-request-article): Don't give a special + treatment to Mule. - * lisp/gnus-sum.el (gnus-summary-insert-line): Work with quoted - double-quote characters. - (gnus-summary-prepare-threads): Ditto. + * lisp/nnheader.el (nnheader-auto-save-coding-system): Undo last + change to restore the default value to emacs-mule or escape-quoted. -2000-10-30 TAKAHASHI Kaoru +2002-11-05 Katsumi Yamaoka - * lisp/ptexinfmt.el (ptexinfmt-disable-broken-notice-flag): Renamed - from `ptexinfmt-disable-broken-notice'. + * lisp/gnus-art.el (gnus-article-mime-edit-article-setup): Don't + perform `mime-edit-again' for a delayed or a queued article. + (gnus-article-mime-edit-done): Bind `inhibit-read-only' to t while + running `gnus-article-edit-done'. -2000-10-27 TAKAHASHI Kaoru +2002-10-30 TSUCHIYA Masatoshi - * lisp/ptexinfmt.el (texinfo-format-printindex): Mule for Windows - detection fixed. + * lisp/dgnushack.el (dgnushack-bind-colon-keywords): Protect + against unexpected data structure. -2000-10-26 Katsumi Yamaoka +2002-10-30 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-group-startup-message): Rewrite for Emacs 21. - * lisp/lpath.el: Fbind `propertize'. + * lisp/nnshimbun.el: Clean up codes. + (nnshimbun-buffer, nnshimbun-current-directory) + (nnshimbun-current-group, nnshimbun-server-directory): Removed. + (nnshimbun-current-server, nnshimbun-server-directory) + (nnshimbun-current-group, nnshimbun-current-directory): New macros. + (nnshimbun-backlog, nnshimbun-find-parameter): Use + `nnshimbun-current-server'. + (nnshimbun-possibly-change-group, nnshimbun-open-server): + Reimplemented. + (nnshimbun-close-server): Do not kill `nnshimbun-buffer'. + (nnshimbun-request-article-1, nnshimbun-request-list): Use + `erase-buffer' instead of `delete-region'. + (nnshimbun-request-article): Use `nnshimbun-current-group'. + (nnshimbun-request-group): Remove redundant checks. + (nnshimbun-request-scan): Check arguments strictly. + (nnshimbun-retrieve-headers, nnshimbun-retrieve-headers-with-nov): + Reimplemented. + (nnshimbun-generate-nov-database, nnshimbun-search-id) + (nnshimbun-write-nov, nnshimbun-request-expire-articles): + Simplified. + (nnshimbun-nov-buffer-name, nnshimbun-nov-file-name): Make the + first argument optional. + (nnshimbun-open-nov): Bind variables to set coding systems for + path names. + (nnshimbun-possibly-change-group, nnshimbun-request-article) + (nnshimbun-write-nov): Strict checking. + (nnshimbun-request-expire-articles): Small fix. + +2002-10-29 Katsumi Yamaoka -2000-10-22 Katsuhiro Hermit Endo + * lisp/gnus-vers.el (gnus-revision-number): Increment to 05. - * texi/gnus-ja.texi (Changing Servers): Fix typo. + * lisp/nnheader.el (nnheader-auto-save-coding-system): Default to + `iso-2022-7bit'. -2000-10-19 TSUCHIYA Masatoshi +2002-10-29 TSUCHIYA Masatoshi - * lisp/nnshimbun.el (nnshimbun-netbsd-get-headers): Fix regular - expression to extract xover urls. + * lisp/nnshimbun.el (nnshimbun-request-article-1): Install trick + to keep compatibility between T-gnus and Oort Gnus. -2000-10-12 Jesper Harder +2002-10-29 Tadashi Watanabe - * make.bat: Makes it possible to generate the Info files on - windows again. + * lisp/nnshimbun.el (nnshimbun-request-expire-articles): Do not + use removed variables. -2000-10-11 Katsumi Yamaoka +2002-10-29 TSUCHIYA Masatoshi - * 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). + * lisp/nnshimbun.el: Clean up. + (nnshimbun-nov-last-check): Removed. + (nnshimbun-nov-buffer-alist): Removed. + (nnshimbun-nov-buffer-file-name): Removed. + (nnshimbun-close-server): Use `nnshimbun-write-nov' instead of + `nnshimbun-save-nov'. + (nnshimbun-mail-header-subject): Removed. + (nnshimbun-mail-header-from): Removed. + (nnshimbun-make-shimbun-header): Removed. + (nnshimbun-parse-nov): New function. + (nnshimbun-request-article-1): Use `nnshimbun-parse-nov' instead + of `nnheader-parse-nov'. + (nnshimbun-retrieve-headers): Likewise. + (nnshimbun-nov-buffer-name): New function. + (nnshimbun-nov-file-name): Ditto. + (nnshimbun-open-nov): Clean up. + (nnshimbun-write-nov): Ditto; Aceept the 2nd optional argument. + (nnshimbun-save-nov): Removed. - * texi/Makefile.in (install-ja-info, install-info, install-ja, - %-ja.info, %-ja): New targets. +2002-10-18 Katsumi Yamaoka - * texi/message-ja.texi (direntry): Replace "message" with - "message-ja". + * lisp/dgnushack.el (dgnushack-dont-compile-files): New constant + containing almost all mm*.el. + (dgnushack-compile): Don't byte-compile the file in + `dgnushack-dont-compile-files'. -2000-10-08 TSUCHIYA Masatoshi +2002-10-09 Katsumi Yamaoka - * lisp/nnshimbun.el (nnshimbun-type-definition): Fix regular - expression to extract article body from `ZDNet'. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. + (gnus-version): T-gnus supports SEMI 1.14 and FLIM 1.14. -2000-10-06 Katsumi Yamaoka + * lisp/mmgnus.el: Remove commented obsolete definitions. - * lisp/imap.el: Require `base64' instead of to autoload it. + * lisp/message.el (message-header-hook): Replace + `eword-encode-header' with `mime-encode-header-in-buffer'. + (message-send-mail-with-smtp): Don't use `smtp-via-smtp'. -2000-10-05 Katsumi Yamaoka +2002-10-07 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/mm-url.el (mm-url-form-encode-xwfu): Use + `file-coding-system' instead of `buffer-file-coding-system' when + Mule 2 is running. - * lisp/gnus-ems.el (gnus-ems-redefine): Revive annulling of - `gnus-summary-set-display-table'. + * lisp/gnus-group.el: Require `mm-url' only when compiling. + (gnus-group-fetch-charter): Require `mm-url'. -2000-10-04 Akihiro Arisawa + * lisp/gnus.el (gnus-default-charset): Default to `iso-8859-1'. - * lisp/gnus-sum.el (gnus-build-sparse-threads): Use - `make-full-mail-header-from-decoded-header' instead of - `make-full-mail-header'. +2002-09-13 TSUCHIYA Masatoshi -2000-10-03 Katsumi Yamaoka + * lisp/nnheader.el (toplevel) [XEmacs]: Remove code to define + `emacs-mule' coding-system, because the generated coding system is + not compatible to the original coding system of FSF Emacs. - * 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. +2002-09-12 TSUCHIYA Masatoshi - * lisp/gnus-offline.el (gnus-offline-after-jobs-done): Use `ding' - with `play-sound-file' for XEmacs statically. + * lisp/nnheader.el (toplevel) [XEmacs]: Define `emacs-mule' coding + system in order to cancel difference on coding systems of + auto-saved files between FSF Emacs and XEmacs. + (nnheader-auto-save-coding-system) [Mule]: The default value of + Mule2 is changed from `*junet*' to `*internal*', in order to unify + coding system of files auto-saved by Mule2. - * lisp/gnus-art.el (gnus-article-add-button): Quote - `:button-keymap' for Mule 2.3 but it won't work. +2002-09-08 Daiki Ueno -2000-09-29 Katsumi Yamaoka + * lisp/gnus-msg.el (gnus-configure-posting-styles): Follow the + change of arglist of gnus-configure-posting-style. + (gnus-configure-posting-style): Check circular import. - * lisp/message.el (message-ignored-supersedes-headers): Synch with - Gnus. +2002-09-08 Daiki Ueno -2000-09-27 TAKAHASHI Kaoru + * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. - * list/ptexinfmt.el (texinfo-multitable-widths): Fix - broken-facility probrem when use multitable unsupported - texinfmt.el. + * lisp/gnus-msg.el (gnus-named-posting-styles): Defcustom. + (gnus-posting-styles): Allow (import "..."). + (gnus-configure-posting-style): Splitted from + gnus-configure-posting-styles. + (gnus-summary-execute-command-with-posting-style): Fix prompt string. -2000-09-26 TAKAHASHI Kaoru + * lisp/gnus-cus.el (gnus-group-parameters): Allow (import "...") + in posting-styles. - * lisp/ptexinfmt.el (texinfo-format-printindex): Use (featurep - 'meadow) instead of `texinfmt-version'. +2002-09-08 Daiki Ueno -2000-09-25 Katsumi Yamaoka + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 05. + * lisp/gnus-msg.el (gnus-named-posting-styles): New variable. + (gnus-summary-send-map): Bind "P" to + gnus-summary-execute-command-with-posting-style. + (gnus-configure-posting-styles): Expand named entries in + gnus-posting-styles. + (gnus-summary-execute-command-with-posting-style): New command. - * texi/gnus-faq-ja.texi, lisp/gnus.el, README.semi.ja, README.semi, - README: Replace "" with - "". +2002-09-06 Katsumi Yamaoka -2000-09-22 TAKAHASHI Kaoru + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. - * lisp/ptexinfmt.el (texinfo-format-printindex): Add - broken-facility check, for Mule for Windows. - (texinfo-format-printindex): New function. + * lisp/gnus-msg.el (gnus-copy-article-buffer): Set a copy buffer + mutibyte; remove invisible and intangible test properties from a + copied article. -2000-09-19 Katsumi Yamaoka +2002-09-05 TAKAHASHI Kaoru - * 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. + * texi/ptexinfmt.el: discard @documentdescription. Support + @ifplaintext, @ifnotplaintext, @ifhtml. Remove obsolete commands. + (texinfo-format-ifhtml, texinfo-format-ifplaintext): New function. -2000-09-19 TSUCHIYA Masatoshi +2002-09-04 TSUCHIYA Masatoshi - * lisp/nnshimbun.el (nnshimbun-type-definition): Follow URL change - of `ZDNet'. + * lisp/gnus-namazu.el (gnus-namazu/highlight-words): Stricten + regular expression to highlight keywords. -2000-09-15 Daiki Ueno +2002-08-28 Katsumi Yamaoka - * lisp/gnus-art.el: Always require `wid-edit'. + * lisp/lpath.el: Fbind `smtpmail-send-it' for Mule 2. -2000-09-14 Katsumi Yamaoka +2002-08-26 Katsumi Yamaoka - * lisp/dgnushack.el (dgnushack-compile): Don't compile gnus-ml.el - when FSFmacs is running. + * lisp/gnus-util.el (frame-parameter): New function for oldies. - * lisp/gnus-ml.el: Bind some undeclared variables. +2002-08-21 Katsumi Yamaoka - * lisp/gnus-art.el (gnus-article-add-button): Add widget button. - (gnus-article-display-mime-message): Don't set - `mime-button-mother-dispatcher'. + * lisp/gnus.el (gnus-frame): Remove. - * lisp/message.el: Require `reporter' for the function - `define-mail-user-agent' when Mule 2.3 is running. +2002-08-11 Katsumi Yamaoka -2000-09-07 Tadashi Watanabe + * lisp/gnus-vers.el: Fix T-gnus version number. - * lisp/smiley.el (smiley-buffer, smiley-create-glyph): Work with - GTK XEmacs as well. +2002-08-06 Katsumi Yamaoka -2000-09-06 TSUCHIYA Masatoshi + * lisp/gnus-vers.el: T-gnus 6.15.8 revision 00. - * 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. +2002-08-06 TSUCHIYA Masatoshi -2000-09-05 TSUCHIYA Masatoshi + * lisp/gnus-namazu.el (gnus-namazu-update-index): Handle error + messages printed by Namazu. + (gnus-namazu/update-sentinel): Likewise. + (gnus-namazu-need-path-normalization): Change its default value. + (gnus-namazu/normalize-results): Remove `file://' prefix. - * 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. + * texi/gnus-ja.texi (Namazu Groups): Update documents. -2000-09-05 Daiki Ueno + * lisp/gnus-namazu.el (gnus-namazu/update-p): Print error + messages. + (gnus-namazu-update-index): Small clean up. + (gnus-namazu-update-all-indices): Ditto. - * lisp/pop3.el (pop3-quit): Don't clear `pop3-uidl-obarray'. - (pop3-save-uidls): Clear `pop3-uidl-obarray' here. +2002-08-05 TSUCHIYA Masatoshi -2000-09-04 Daiki Ueno + * lisp/gnus-namazu.el: Bug fix of updating multiple indices. + (gnus-namazu/setup): Call `gnus-namazu-update-all-indices' without + arguments. + (gnus-namazu-create-index): Clean temporary files even if an + indexer is killed. + (gnus-namazu/update-p): New function. + (gnus-namazu-update-all-indices): Reimplemented. + (gnus-namazu-update-index): Call `gnus-namazu/update-p' to decide + whether the specified index will be updated. + (gnus-namazu/update-sentinel): Follow the change of + `gnus-namazu-update-all-indices'. + +2002-08-05 TSUCHIYA Masatoshi - * 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/gnus.el (toplevel): Add autoloads for + `gnus-namazu-create-index', and `gnus-namazu-update-all-indices' + and `gnus-namazu-update-index'. - * lisp/pop3.el (pop3-ssl-program-name): New variable. + * lisp/gnus-namazu.el: Support automatically updating multiple + indices. + (gnus-namazu-make-index-interval): Abolished. + (gnus-namazu-index-update-interval): New option. + (gnus-namazu/setup): Call `gnus-namazu-update-all-indices' instead + of `gnus-namazu-make-index'. + (gnus-namazu/mknmz-process): Abolished. + (gnus-namazu/status-file-name): New macro. + (gnus-namazu-make-index, gnus-namazu-make-index-stop, + gnus-namazu/mknmz-sentinel): Removed. + (gnus-namazu/mknmz-cleanup, gnus-namazu/index-old-p): New function. + (gnus-namazu-create-index, gnus-namazu-update-all-indices, + gnus-namazu-update-index, gnus-namazu-stop-update): New command. + (gnus-namazu/update-directories, gnus-namazu/update-process): New + internal variable. -2000-08-31 TAKAHASHI Kaoru +2002-07-31 TSUCHIYA Masatoshi - * 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/gnus-namazu.el: Support automatically updating index. + (gnus-namazu-default-index-directory): New constant. + (gnus-namazu-make-index-interval, gnus-namazu-make-index-command, + gnus-namazu-make-index-arguments): New options. + (gnus-namazu/setup): Call `gnus-namazu-make-index'. + (gnus-namazu/real-group-name): Renamed from + `gnus-namazu/check-cache-group'. + (gnus-namazu/cache-group-candidates): Renamed from + `gnus-namazu/cache-group-candidates'. + (gnus-namazu/search): Experimental support of articles covered by + agent. + (gnus-namazu/default-index-directory, gnus-namazu/lapse-seconds, + gnus-namazu/mknmz-sentinel): New internal functions. + (gnus-namazu/mknmz-process): New internal variable. + (gnus-namazu/lock-file-name, gnus-namazu/index-file-name): New + macros. + (gnus-namazu-make-index, gnus-namazu-make-index-stop): New + commands. - * lisp/ptexinfmt.el (ptexinfmt-disable-broken-notice): New - variable. +2002-07-30 TSUCHIYA Masatoshi -2000-08-29 TSUCHIYA Masatoshi + * lisp/gnus-namazu.el (gnus-namazu/request-list): Removed. + (gnus-namazu/get-current-to): New function. + (gnus-namazu/complete-query): Call the above. - * lisp/nnshimbun.el (nnshimbun-zdnet-get-headers): Follow changes - of ZDNet. +2002-07-19 Katsumi Yamaoka -2000-08-25 Katsumi Yamaoka + * lisp/pop3.el: Don't autoload "ssl". + (pop3-open-ssl-stream-1): Require `ssl' before binding ssl-* vars. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. +2002-07-18 Katsumi Yamaoka -2000-08-25 Yagi Tatsuya - Katsumi Yamaoka + * lisp/gnus-namazu.el (gnus-namazu/truncate-article-list): Remove + a redundancy. - * 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. +2002-07-11 TSUCHIYA Masatoshi -2000-08-23 Katsumi Yamaoka + * texi/gnus-ja.texi (Web Newspaper): Update the url of w3m. - * lisp/gnus.el (gnus-group-startup-message): Use `image-size' to - simplify the program. +2002-07-05 Katsumi Yamaoka - * lisp/gnus-group.el (gnus-group-rename-group): Inhibit renaming of - zombie or killed groups. + * lisp/gnus-sum.el (gnus-summary-mode-map): Replace + `gnus-article-toggle-headers' with `gnus-summary-toggle-header'. + (gnus-summary-wash-map): Ditto. + (gnus-summary-wash-hide-map): Replace + `gnus-article-toggle-headers' with `gnus-article-hide-headers'. + (gnus-summary-article-menu): Ditto. -2000-08-21 Katsumi Yamaoka + * lisp/gnus.el: Remove autoload for `gnus-article-toggle-headers'. - * lisp/nnheader.el (nnheader-replace-chars-in-string): Use - `static-if'. - * lisp/message.el (message-replace-chars-in-string): Ditto. + * lisp/gnus-art.el (article-toggle-headers): Abolished. -2000-08-19 TSUCHIYA Masatoshi +2002-07-04 Katsumi Yamaoka - * lisp/nnshimbun.el (nnshimbun-type-definition): Follow changes of - ZDNet. - (nnshimbun-make-text-or-html-contents): Ditto. - (nnshimbun-make-html-contents): Ditto. + * lisp/dgnushack.el (byte-optimize-form-code-walker): Don't modify + the function definition if the bug has already gone; revert to the + use of `defadvice'. -2000-08-18 TSUCHIYA Masatoshi - Akihiro Arisawa +2002-07-03 Keiichi Suzuki - * lisp/nnshimbun.el: Add `mew' and `xemacs' support. + * lisp/gnus-logic.el (gnus-advanced-index): Use luna based index + numbers. -2000-08-17 Katsumi Yamaoka +2002-06-26 Tetsuo Tsukamoto - * 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/imap.el (imap-ssl-open-2): Do away with w32-related + workaround I installed on 1999-12-28, i.e. also call + `as-binary-process' in windows-nt. - * lisp/Makefile.in (install-package): No need to remove - dgnushack.elc. - (install): Don't install ptexinfmt.el; no need to remove - dgnushack.elc. +2002-06-26 Katsumi Yamaoka - * lisp/ptexinfmt.el: New file imported from Wanderlust. + * contrib/hashcash.el: Require `cl' when compiling. + (hashcash-strip-quoted-names): Replace `subseq' with `substring'. + (mail-add-payment): Allow no `mail-header-separator' in the buffer; + don't use `mapc'. -2000-08-09 Katsumi Yamaoka +2002-06-25 TSUCHIYA Masatoshi - * lisp/nntp.el (nntp-open-telnet): Wait for the telnet prompt - before sending a command; allow the rtelnet prompt as well. + * lisp/gnus-namazu.el (gnus-namazu/truncate-article-list): When + `gnus-large-newsgroup' is equal to nil, no confirmation is + required. - * lisp/message.el (message-make-forward-subject): Remove garbage - line. +2002-06-23 Tetsuo Tsukamoto -2000-08-01 Katsumi Yamaoka + * lisp/pop3.el (pop3-open-ssl-stream): Do away with w32-related + workaround I installed on 1999-12-27, i.e. also call + `as-binary-process' in windows-nt. - * configure: Regenerate. - * aclocal.m4 (AC_CHECK_EMACS): Unset `EMACS' environment variable - if it is `t'. +2002-06-12 Katsumi Yamaoka -2000-07-24 Katsumi Yamaoka + * lisp/message.el (message-send): Kill `message-encoding-buffer' + even if sending failed. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. +2002-06-11 Katsumi Yamaoka - * configure: Regenerate with autoconf v2.14.1. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. - * configure.in: Rewrite for using new macros in aclocal.m4. + * lisp/gnus-msg.el (gnus-message-setup-hook): Default to nil. + (gnus-setup-message): Run `gnus-maybe-setup-default-charset'. + (gnus-summary-supersede-article): Don't bind the value for + `gnus-message-setup-hook'. + (gnus-summary-resend-bounced-mail): Ditto. - * 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. + * lisp/dns.el (dns-make-network-process): Bind + `default-process-coding-system' to `(binary . binary)'; bind + `program-coding-system-alist' to nil. - * acinclude.m4: Remove. + * lisp/gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Bind + `input-coding-system' and `output-coding-system' to `binary'. - * lisp/dgnushack.el: Don't add "/usr/share/emacs/site-lisp" to - `load-path'. + * lisp/gnus-namazu.el (gnus-namazu/call-namazu): Bind + `input-coding-system' and `output-coding-system' to the velue of + `gnus-namazu-coding-system'. - * lisp/gnus-ems.el (gnus-ems-redefine): Defalias - `gnus-summary-set-display-table' to `(lambda ())' instead of - `ignore' (don't synch. with Gnus). + * lisp/imap.el (imap-ssl-open): Don't bind the values for + `input-coding-system' and `output-coding-system'. -2000-07-21 Daiki Ueno + * lisp/nnmaildir.el (nnmaildir-request-scan): Bind + `output-coding-system' to the value of + `nnheader-file-coding-system'; bind `file-coding-system' to nil. + (nnmaildir-request-rename-group): Ditto. + (nnmaildir-request-replace-article): Ditto. + (nnmaildir-request-accept-article): Ditto. + (nnmaildir-request-set-mark): Ditto. - * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Use - mime-entity-fetch-field instead of mail-header-from. + * lisp/nnmbox.el (nnmbox-save-buffer): Simplify the source code. -2000-07-18 Daiki Ueno + * lisp/nnrss.el (nnrss-read-server-data): Bind + `input-coding-system' to `binary'. + (nnrss-save-server-data): Bind `output-coding-system' to `binary'. + (nnrss-read-group-data): Bind `input-coding-system' to `binary'. + (nnrss-save-group-data): Bind `output-coding-system' to `binary'. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. +2002-06-07 Katsumi Yamaoka + + * lisp/pop3.el: Add a comment for the use of `ssl' or `tls' + connection with Gnus; always require `pces' and `path-util' for + Gnus. + (pop3-open-ssl-stream-1): Don't require `path-util' here. - * 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. +2002-06-06 Katsumi Yamaoka -2000-07-15 Daiki Ueno + * lisp/pop3.el: Make it can be byte-compiled in the Gnus source + tree with neither errors nor warnings. + (pop3-md5): Fix the logic to check whether the built-in `md5' + allows the 4th argument CODING-SYSTEM. + +2002-06-04 Katsumi Yamaoka * 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. + * contrib/gpg-ring.el: Remove RCS magic cookie. + * lisp/nnir.el: Ditto. - * lisp/gnus-bbdb.el: Check defvaralias when compiling. + * texi/ptexinfmt.el (texinfo-discard-command-and-arg): New + function. - * lisp/gnus-art.el (gnus-article-setup-buffer): Set - gnus-original-article-buffer as unibyte. - (gnus-request-article-this-buffer): Ditto. +2002-06-03 TAKAHASHI Kaoru - * lisp/nnimap.el (nnimap-callback): Don't use nnimap-demule. - (nnimap-request-article-part): Ditto. + * texi/ptexinfmt.el: discard @cartouche. @anchor discard for Mule + 2.3. Support @., @:, @-. + (texinfo-format-inforef): New function. - * lisp/imap.el (imap-open): Set process buffer as unibyte. +2002-05-30 Katsumi Yamaoka -2000-07-13 10:09:52 Katsumi Yamaoka + * lisp/nnheader.el (nnheader-unfold-fws): New function copied from + `ietf-drums-unfold-fws'. + (ietf-drums-unfold-fws): Alias to `nnheader-unfold-fws'. - * acinclude.m4 (AC_CHECK_W3): Fix typo. +2002-05-07 Katsumi Yamaoka -2000-07-13 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.7 revision 00. - * configure: Regenerate with autoconf v2.14.1. - * aclocal.m4: Regenerate with aclocal v1.4. +2002-04-30 Daiki Ueno - * configure.in: Don't call `AC_CHECK_PROG' for `EMACS'. + * lisp/message.el (message-expand-name-function): New user option. + (message-expand-name): Use it. + * lisp/lpath.el: Don't bind lsdb-complete-name and bbdb-complete-name. - * 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. +2002-04-30 Daiki Ueno -2000-07-12 15:47:06 ShengHuo ZHU + * lisp/message.el (message-expand-name): Use lsdb-complete-name if + available. + * lisp/lpath.el: Bind lsdb-complete-name. - * aclocal.m4: Stolen macros from w3. - * configure.in: Use them. - * configure: Generate it. +2002-04-30 Katsumi Yamaoka -2000-07-03 Katsumi Yamaoka + * lisp/dgnushack.el (dgnushack-bind-colon-keywords): Also examine + backquote'd forms. - * lisp/gnus-vers.el (T-gnus): Update to 6.14.5. - (gnus-revision-number): Clear to 00. + * lisp/nnheader.el (nnheader-with-unibyte): New macro. + (mm-with-unibyte): Alias to `nnheader-with-unibyte'. - * README.T-gnus: Update. +2002-04-26 Steve Youngs - * 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. + * aclocal.m4 (AC_PATH_INFODIR): New. Defaults to '$prefix/info' + for Emacs and 'site-packages/info' for XEmacs. + (AC_PATH_ETCDIR): Drop 'gnus' off the end of the default directory + for XEmacs. - * texi/{message.texi,gnus.texi,gnus-ja.texi,ChangeLog}: Sync up - with Gnus v5.8.7. + * configure.in: Use 'AC_PATH_INFO_DIR'. - * contrib/rfc2015.el: New file. +2002-04-23 Daiki Ueno -2000-06-27 Katsumi Yamaoka + * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Disregard the + message cache when bbdb/news-auto-create-p is nil. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. +2002-04-23 Daiki Ueno - * lisp/gnus-sum.el (gnus-mime-extract-message/rfc822): Use - `mime-insert-entity-content' instead of obsolete functions. + * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Work around the + incompatibility with BBDB 2.3x. -2000-06-13 Hirokazu FUKUI +2002-04-22 Daiki Ueno - * lisp/gnus-bbdb.el(gnus-bbdb/update-record): Fix to fetch last - mail field. + * lisp/message.el (message-make-user-agent): Remove product tokens + for gnus-vers. [cf. ] -2000-06-09 Katsumi Yamaoka +2002-04-22 Daiki Ueno - * lisp/gnus.el (gnus-news-group-p): Sync with Gnus. - (gnus-select-method): Remove "*" from doc string. - (gnus-group-startup-message): Use `dino' colors. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. -2000-06-08 Katsumi Yamaoka + * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Tweak BBDB message + caching. + (gnus-bbdb/extract-message-sender-function): New user option. + (gnus-bbdb/extract-message-sender): New function. - * 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. +2002-04-20 Daiki Ueno -2000-06-06 Katsumi Yamaoka + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. - * lisp/message.el (message-save-drafts): Rewrite. + * lisp/gnus-sum.el: Don't autoload gnus-set-summary-default-charset. + (gnus-summary-inherit-default-charset): New function. + (gnus-parse-headers-hook): Use it. + (gnus-summary-setup-default-charset): Set default-mime-charset here. - * 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/gnus-delay.el (gnus-delay-article): Undo the last change. - * 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/gnus-draft.el: Revert to the original implementation. + (gnus-draft-edit-message): Pass restore as the 3rd argument of + gnus-draft-setup; call save-buffer instead of message-save-drafts. + (gnus-draft-setup): Rename from gnus-draft-setup-for-editing. + (gnus-draft-setup-for-sending): Abolish. - * lisp/mail-source.el (mail-source-text-coding-system): Remove. - (TopLevel): require `nnheader'. + * lisp/nnheader.el (nnheader-auto-save-coding-system): New variable. - * 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/message.el (message-draft-coding-system): Delegate the + value to nnheader-auto-save-coding-system. + (message-mode-map): Don't bind message-save-drafts. + (message-dont-send): Use save-buffer instead of message-save-buffer. + (message-save-drafts): Abolish. - * 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'. + * lisp/nndraft.el (nndraft-request-article): Revert to the + original implementation. -2000-06-06 Katsumi Yamaoka +2002-04-18 Daiki Ueno - * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. + * lisp/gnus-draft.el (gnus-group-send-queue): Pass group and + interactive as the arguments of gnus-draft-send. + (gnus-draft-send): Don't give "nndraft:queue" special treatment. - * 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. +2002-04-17 Daiki Ueno -2000-06-01 KANEMATSU Daiji + * lisp/gnus-delay.el (gnus-delay-article): Use `message-save-drafts' + instead of `save-buffer'. - * texi/gnus-ja.texi (gnus-summary-hide-all-threads): Fix typo. +2002-04-08 Daiki Ueno -2000-05-28 TSUCHIYA Masatoshi + * lisp/gnus-draft.el (gnus-draft-send): Always enter the Message + mode. - * nnshimbun.el (nnshimbun-request-article-1): Fix to insert x-face - unless SERVER. - (nnshimbun-asahi-get-headers): Fix for subjects which contain ^M. +2002-03-28 Katsumi Yamaoka -2000-05-26 TSUCHIYA Masatoshi + * lisp/gnus-group.el (gnus-group-completing-read-group-name): Use + `mapatoms' to extract all groups from `gnus-active-hashtb'. - * 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. +2002-03-26 Katsumi Yamaoka -2000-05-26 Katsumi Yamaoka + * lisp/gnus-group.el (gnus-group-completing-read-group-name): + Improve to speed up. + (gnus-group-name-charset-group-alist): Change the default value. - * 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. +2002-03-25 Katsumi Yamaoka -2000-05-25 Tanaka Akira + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. - * README.semi, README.semi.ja: Update for CVS via SSH. + * lisp/message.el (message-save-drafts, message-check-8bit, + message-send-news, message-send-mail, message-send): Replace + `insert-buffer' with `insert-buffer-substring'. + * lisp/gnus-art.el (gnus-article-mime-edit-article-setup, + gnus-article-edit-exit, article-verify-x-pgp-sig): Ditto. -2000-05-25 Katsumi Yamaoka +2002-03-20 Katsumi Yamaoka - * texi/gnus-ja.texi: Change coding-system to `iso-2022-7bit-ss2'. - * texi/TRANSLATION.ja: Replace CRLF with LF. + * lisp/gnus-sum.el (gnus-summary-make-menu-bar): Don't provide + "View as different encoding" submenu if the function + `coding-system-list' is not available. -2000-05-25 Keiichi Suzuki +2002-03-19 Katsumi Yamaoka - * lisp/nnshimbun.el (nnshimbun-fill-line): Use - `nnshimbun-fill-column' instead of `fill-column'. + * lisp/pop3.el (pop3-md5): Treat a given string as binary. -2000-05-25 TSUCHIYA Masatoshi +2002-03-06 Katsumi Yamaoka - * lisp/nnshimbun.el: Clean up codes. + * lisp/gnus-msg.el (gnus-summary-resend-message-edit): Use + `mime-edit-again' instead of `mime-to-mml' to recompose a message. - * lisp/gnus-group.el (gnus-group-make-shimbun-group): Follow - changes in nnshimbun.el. - * texi/gnus-ja.texi (nnshimbun): Ditto. +2002-03-05 Katsumi Yamaoka -2000-05-24 TSUCHIYA Masatoshi + * lisp/message.el (mm-make-temp-file): Copied from mm-util.el. - * 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. +2002-03-04 Katsumi Yamaoka -2000-05-24 Katsumi Yamaoka + * lisp/message.el (message-fix-before-sending): Bind + `mm-7bit-chars' to the value that concat the original value and + escape. - * lisp/gnus-group.el (gnus-group-make-shimbun-group): Complete - completions. + * lisp/nnheader.el (mm-7bit-chars): Remove. -2000-05-24 TSUCHIYA Masatoshi +2002-03-04 Katsumi Yamaoka - * 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. + * lisp/gnus-art.el (gnus-article-edit-mode): Don't call `mml-mode'. -2000-05-24 TSUCHIYA Masatoshi + * lisp/nnheader.el (mm-7bit-chars): Copied from mm-bodies.el. + (mm-multibyte-p): New alias. + (mm-char-int): Alias to `char-int'. - * lisp/nnshimbun.el (nnshimbun-retrieve-url): Add argument to - ignore w3's cache. +2002-02-26 TSUCHIYA Masatoshi -2000-05-24 Katsumi Yamaoka + * lisp/gnus-art.el (gnus-request-article-this-buffer): Sync up + with Oort-gnus. - * 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/nntp.el (nntp-open-via-rlogin-and-telnet): Wrap + `call-process' with `as-binary-process'. - * lisp/nnshimbun.el (nnshimbun-asahi-get-headers): Don't use - `timezone'. - (nnshimbun-type-definition): Add address. +2002-02-25 Katsumi Yamaoka -2000-05-23 Tatsuya Ichikawa + * lisp/smiley.el (smiley-regexp-alist): Fix the order of faces. - * lisp/nnshimbun.el: Add `sponichi' support. +2002-02-25 Katsumi Yamaoka -2000-05-23 KOSEKI Yoshinori + * lisp/smiley.el (smiley-regexp-alist): Use faces which originate + in etc-0.27.tar.gz if exist. + (gnus-smiley-file-types): Add xbm if available. + (smiley-region): Don't put two or more faces in one place. - * lisp/nnshimbun.el (nnshimbun-mime-encode-string): Fix wrong - close brackets. +2002-02-22 Katsumi Yamaoka -2000-05-23 TSUCHIYA Masatoshi + * lisp/gnus-art.el (gnus-request-article-this-buffer): Temporally + fix: erase the buffer before inserting (and saving) an article. - * lisp/nnshimbun.el: Change coding-system. +2002-02-22 Steve Youngs -2000-05-21 TSUCHIYA Masatoshi + * aclocal.m4 (AC_PATH_LISPDIR): Default to + .../site-packages/lisp/gnus for XEmacs. + (AC_PATH_ETCDIR): Default to .../site-packages/etc/gnus for + XEmacs. - * texi/gnus-ja.texi (nnshimbun): Add description. +2002-02-21 Daiki Ueno -2000-05-21 Katsumi Yamaoka + * lisp/gnus-group.el (gnus-group-name-encode): New function. + (gnus-group-encoded-name): New function. + (gnus-group-completing-read-group-name): New function. + (gnus-fetch-group): Use it. + (gnus-group-jump-to-group): Use it. + (gnus-group-unsubscribe-current-group): Use it. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. +2002-02-21 Daiki Ueno - * lisp/dgnushack.el (dgnushack-texi-format): Fix last change. + * lisp/nnheader.el (mm-string-as-unibyte): Undo the last change. + * lisp/gnus-srvr.el (gnus-browse-foreign-server): Ditto. -2000-05-21 TSUCHIYA Masatoshi +2002-02-21 Daiki Ueno - * lisp/nnshimbun.el: New backend. + * lisp/nnheader.el (mm-string-as-unibyte): Alias to + `string-as-unibyte'. - * lisp/gnus-group.el (gnus-group-make-shimbun-group): New command. + * lisp/gnus-srvr.el (gnus-browse-foreign-server): Return unibyte + group names. -2000-05-17 Kenichi OKADA +2002-02-19 Katsumi Yamaoka - * 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". + * lisp/lpath.el: Bind `navi2ch-mona-font'. -2000-05-17 Katsumi Yamaoka +2002-02-18 Daiki Ueno - * 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/gnus-art.el (gnus-treat-monafy): New user option. + (article-monafy): New function. - * 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. +2002-02-18 Katsumi Yamaoka - * lisp/dgnushack.el (dgnushack-texi-format): Use - `output-coding-system' instead of `coding-system-for-write' when - old Mule is used. + * lisp/nnheader.el (std11-field-value): Fix regexp. -2000-05-16 Katsumi Yamaoka +2002-02-15 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. + * lisp/gnus-art.el (gnus-treat-display-grey-xface): Default to nil + under NTEmacs 21. -2000-05-10 Daiki Ueno +2002-02-14 TSUCHIYA Masatoshi - * lisp/gnus-bbdb.el (gnus-bbdb/pop-up-bbdb-buffer): Don't bind - `bbdb-use-pop-up' while executing `bbdb-pop-up-bbdb-buffer'. + * lisp/gnus-namazu.el (gnus-namazu-kill-summary-buffers): New + advice. -2000-05-10 Katsumi Yamaoka +2002-02-12 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. + * lisp/mm-view.el: Require `gnus-mailcap' rather than `mailcap'. -2000-05-10 Katsumi Yamaoka + * lisp/nnheader.el (mm-with-unibyte-buffer): Bind `default-mc-flag' + instead of `mc-flag'. + (nnheader-with-unibyte-current-buffer): New macro. + (mm-with-unibyte-current-buffer): Alias to + `nnheader-with-unibyte-current-buffer'. + (nnheader-guess-mime-charset): New macro. + (mm-guess-mime-charset): Alias to `nnheader-guess-mime-charset'. + (shell-command-to-string): New function for old Emacsen. - * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. + * lisp/lpath.el: Don't fbind `shell-command-to-string'. -2000-05-10 Keiichi Suzuki +2002-02-09 TSUCHIYA Masatoshi - * lisp/message.el (message-list-references): Do not insert - duplicate Message-Id, when specified - `message-list-references-add-position'. + * lisp/gnus-namazu.el (gnus-namazu/group-alist): Abolished. + (gnus-namazu/setup): Not set it. + (gnus-namazu/shutdown): Removed. + (gnus-namazu/group-prefixed-name): Handle case-insensitive file + names by itself. - * lisp/gnus-bbdb.el (gnus-bbdb/split-mail): Support group address. - (gnus-bbdb/insert-address-regexp): New function. +2002-02-09 NISHIDA Masakazu -2000-05-09 Katsumi Yamaoka + * lisp/gnus-namazu.el (gnus-namazu/complete-query): Relaxed the + regexp which matches field search keywords. - * lisp/gnus-msg.el (gnus-debug): Add "nntp.el" and `defvoo'. +2002-02-01 ShengHuo ZHU -2000-05-08 Katsumi Yamaoka + * etc/gnus/gnus.xpm: Remove some garbages at the end of the file. - * lisp/gnus-vers.el (T-gnus): Update to 6.14.4. +2002-02-03 Daiki Ueno - * README.T-gnus: Update. + * lisp/nnir.el (nnir-run-namazu): According to SUSv3, LC_ALL is + prior to the other environment variables whose names are starting + with "LC_". So there is no need to setting them. - * 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. +2002-02-03 Daiki Ueno -2000-04-28 Katsumi Yamaoka + * lisp/nnir.el (nnir-imap-default-charset): New user option. + (nnir-run-imap): Supply the charset of a search criteria. - * 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. +2002-02-01 Katsumi Yamaoka + Suggested by Kenichi OKADA - * contrib/timer.el: New file. Imported from fsf-compat-1.07-pkg. + * lisp/message.el (message-save-drafts): Override + `mime-header-encode-method-alist'. -2000-04-27 Katsumi Yamaoka +2002-02-01 Taiji Can - * lisp/mm-view.el (gnus-article-mime-handles): Don't bind it. + * texi/gnus-ja.texi (Posting Styles): Fix typo. - * lisp/gnus-sum.el (gnus-article-mime-handles): Restore from Gnus. - (gnus-article-decoded-p): Ditto. +2002-01-31 ARISAWA Akihiro - * lisp/gnus-art.el (gnus-article-mime-handles): Don't bind it. - (gnus-article-decoded-p): Ditto. + * lisp/gnus-art.el (gnus-article-display-traditional-message): + Reverted. -2000-04-25 NAKAJI Hiroyuki +2002-01-31 Katsumi Yamaoka - * lisp/dgnushack.el: Add code to avoid mule-2.3@19.34 failing to - make info from texi. Thanks to Hayashi-san. + * lisp/gnus-art.el (gnus-article-setup-buffer): Enable multibyte + in `gnus-original-article-buffer'. -2000-04-25 Katsumi Yamaoka +2002-01-29 Katsumi Yamaoka - * lisp/dgnushack.el (union, member-if, mapcon, last): Remove - compiler macros. + * lisp/message.el (message-cite-prefix-regexp): Fix the regexp. -2000-04-24 Katsumi Yamaoka + * lisp/gnus-sum.el (gnus-mime-extract-message/rfc822): New + implementation. - * lisp/gnus-vers.el (T-gnus): Update to 6.14.3. +2002-01-24 Katsumi Yamaoka - * README.T-gnus: Update. + * lisp/gnus-clfns.el (find-cl-run-time-functions): Insert a + newline before filling a result; ignore non-list forms. - * 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. +2002-01-24 ARISAWA Akihiro - * README: Requires XEmacs 21.1.1 and later. - * texi/{gnus.texi, gnus-faq-ja.texi}: Ditto. + * lisp/gnus-sum.el (gnus-summary-show-article): If coding-system is + specified, bind `default-mime-charset' to it. -2000-04-20 Katsumi Yamaoka +2002-01-23 Katsumi Yamaoka - * lisp/gnus-vers.el (T-gnus): Update to 6.14.2. - (gnus-revision-number): Clear to 00. + * lisp/message.el: Require `base64' before `canlock-om' to avoid + damage to define `base64-encode-string' by MEL. - * README.T-gnus: Update. + * lisp/dgnushack.el: Load base64.el before canlock-om.el to avoid + damage to define `base64-encode-string' by MEL. - * 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. +2002-01-23 Katsumi Yamaoka - * lisp/fill-flowed.el: New file. + * lisp/gnus-sum.el (gnus-article-commands-menu): Bind "Html" to + the command `gnus-article-wash-html'. + (gnus-summary-article-menu): Ditto. + (gnus-summary-wash-map): Bind "h" to the command + `gnus-article-wash-html'. - * texi/{gnus.texi,gnus-ja.texi,ChangeLog}: Sync up with Gnus v5.8.4. + * lisp/gnus-art.el (gnus-article-treatment-menu): Bind + "Treat html" to the command `gnus-article-wash-html'. - * contrib/{vcard.el,one-line-cookie.diff,README}: New files. + * lisp/nnheader.el: Place mm- stuff and mail-parse stuff in front + of the codes which use (or may use) them. -2000-04-14 Katsumi Yamaoka +2002-01-21 ARISAWA Akihiro - * lisp/gnus-msg.el (gnus-summary-yank-message): Rewrite for the use - of the separated message frames; use `gnus-copy-article-buffer'. + * lisp/gnus-art.el (gnus-article-display-traditional-message): Use + `set-buffer-multibyte'. -2000-04-13 Katsumi Yamaoka +2002-01-21 TSUCHIYA Masatoshi - * 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'. + * lisp/gnus-sum.el (gnus-summary-preview-mime-message): Protect + against dead windows. -2000-04-13 Keiichi Suzuki + * lisp/nnheader.el (mm-encode-coding-string): Alias to + `encode-coding-string'. + (mm-decode-coding-string): Alias to 'decode-coding-string'. - * lisp/gnus-spec.el (gnus-update-format): Fix a bug in last - modification. - (gnus-search-or-regist-spec): Change interface. +2002-01-21 Katsumi Yamaoka -2000-04-12 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.6 revision 00. - * 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. + * lisp/nnheader.el (std11-unfold-region): New function copied from + `rfc2047-unfold-region'. + (std11-unfold-field): New function. + (mail-header-unfold-field): Alias to `std11-unfold-field'. -2000-04-12 Katsumi Yamaoka +2002-01-21 Katsumi Yamaoka - * lisp/gnus-vers.el (gnus-revision-number): Increment to 17. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02 (synch + with the released version of Oort Gnus v0.05). - * lisp/gnus-spec.el (gnus-format-specs-compiled): Fix doc string. +2002-01-16 Katsumi Yamaoka -2000-04-11 Keiichi Suzuki + * lisp/dgnushack.el: Advise `byte-compile-inline-expand' for Mule + to ignore built-in functions as Emacs 20+ does. - * lisp/gnus-start.el (gnus-product-variable-touch): Support multiple - arguments. +2002-01-15 Katsumi Yamaoka - * 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-sum.el (gnus-adjust-marked-articles): Fix the record + for `seen' if it looks like (seen NUM1 . NUM2). It should be + (seen (NUM1 . NUM2)). - * 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'. +2002-01-15 Katsumi Yamaoka - * 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. + * lisp/nntp.el (nntp-send-buffer): Bind `mc-flag' to nil. -2000-03-05 Keiichi Suzuki + * lisp/nnheader.el (mm-with-unibyte-buffer): Alias to + `nnheader-with-unibyte-buffer'. + (nnheader-with-unibyte-buffer): New macro. - * 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'. +2002-01-12 Katsuhiro Hermit Endo -2000-03-04 Daiki Ueno + * texi/gnus-ja.texi (Article Date): Update Japanese translation. - * lisp/gnus-spec.el (gnus-compile): Remove gnus-version entry - from gnus-format-specs. +2002-01-11 Katsumi Yamaoka -2000-02-21 Yoshiki Hayashi + * lisp/gnus-clfns.el (butlast): Fix a serious bug that it behaved + like `nbutlast'. Special thanks to Keiichi-san for the great + discovery. - * nnvirtual.el (nnvirtual-request-article): - Bind gnus-override-method to nil. - (nnvirtual-request-update-mark): Don't update mark when - article is not there. + * lisp/gnus.el (gnus-product-variable-file-list): Add a check for + the value of `gnus-use-correct-string-widths' in the forms. -2000-03-03 Daiki Ueno + * lisp/gnus-start.el (gnus-product-quick-file-format): Include the + value of `gnus-use-correct-string-widths' in the file form. + (gnus-product-read-variable-file-1): Check for the equality in the + value of `gnus-use-correct-string-widths' as well. - * lisp/gnus.el (gnus-revision-number): Increment to 12. +2002-01-10 Katsumi Yamaoka - * 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. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01 in + order to force update cached format specs. -2000-03-02 Katsumi Yamaoka + * lisp/gnus-spec.el (gnus-use-correct-string-widths): Default to t. - * lisp/gnus.el (gnus-revision-number): Increment to 11. +2002-01-10 TSUCHIYA Masatoshi -2000-03-01 MORIOKA Tomohiko + * lisp/nnshimbun.el: Adopt for old Gnusae. - * lisp/nnheader.el (nnheader-insert-nov): Use - `mime-entity-fetch-field' instead of `mime-fetch-field'. +2002-01-10 Katsumi Yamaoka - * 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. + * lisp/message.el (message-strip-forbidden-properties): Don't + strip properties when the invisible MIME part is inserted. -2000-03-02 Daiki Ueno + * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Position + point to the top. - * lisp/nnimap.el (nnimap-request-article-part): Don't use - `imap-capability' to detect BODYDETAIL response. +2002-01-05 Lars Magne Ingebrigtsen -2000-03-01 Daiki Ueno + * etc/gnus/oort.xface (X-Face): Oort X-Face from + Raymond Scholz . - * lisp/gnus.el (gnus-revision-number): Increment to 10. +2002-01-09 Katsumi Yamaoka - * 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. + * lisp/lpath.el: Fbind `coding-system-to-mime-charset' for Mule 2. -2000-02-29 Katsumi Yamaoka + * lisp/nnheader.el (std11-fold-region): New function copied from + `rfc2047-fold-region'. + (std11-fold-field): Use it. - * lisp/gnus.el (gnus-revision-number): Increment to 09. +2002-01-09 Katsumi Yamaoka - * lisp/gnus-ems.el (gnus-tilde-cut-form, gnus-tilde-max-form): Copy - from gnus-xmas.el; share them with XEmacs-MULE. + * lisp/gnus.el: Don't autoload "gnus-bitmap". - * lisp/gnus-xmas.el (gnus-tilde-cut-form, gnus-tilde-max-form): - Move to gnus-ems.el. + * lisp/gnus-ems.el: Autoload "smiley-mule" if running Emacs + version is less than 21. -2000-02-20 Daiki Ueno + * lisp/gnus-art.el (gnus-article-smiley-display): Remove. + (gnus-treat-smiley): Reload "smiley-ems" or "smiley-mule" if + needed. + (gnus-treat-display-smileys): Use `gnus-image-type-available-p'. + (gnus-article-smiley-mule-loaded-p): New internal variable. + (gnus-article-should-use-smiley-mule): New user option. - * lisp/gnus.el (gnus-revision-number): Increment to 08. +2002-01-09 TSUCHIYA Masatoshi - * lisp/gnus-bbdb.el: Sync up with Nana-gnus 7 for supporting - `gnus-bbdb/split-mail'. - * README-gnus-bbdb.ja: Ditto. + * lisp/nneething.el (nneething-mime-extensions): New variable. + (nneething-request-article): Refer it. -2000-02-08 Yoshiki Hayashi + * lisp/nnheader.el (mm-detect-coding-region): Alias to + `nnheader-detect-coding-region'. + (nnheader-detect-coding-region): New function. + (mm-detect-mime-charset-region): Alias to + `nnheader-detect-mime-charset-region'. + (nnheader-detect-mime-charset-region) New function. - * gnus-art.el (article-display-face): Show folded X-Face. +2002-01-08 TSUCHIYA Masatoshi -2000-02-08 Keiichi Suzuki + * texi/gnus-ja.texi (Web Newspaper): Update the document of + mime-w3m.el. - * lisp/gnus.el (gnus-revision-number): Increment to 07. +2002-01-08 Katsumi Yamaoka - * lisp/nnmail.el (nnmail-get-new-mail): Do not check - `nnmail-spool-file'. + * lisp/gnus-art.el (article-toggle-headers): Expose headers even + if there is a boundary line. -2000-02-06 Daiki Ueno + * lisp/nntp.el (nntp-send-buffer): Don't use + `mm-with-unibyte-current-buffer'. Use expanded form instead. - * lisp/gnus.el (gnus-revision-number): Increment to 06. + * lisp/gnus-art.el (gnus-treatment-function-alist): Move X-Face + stuff down after unfolding stuff. - * lisp/gnus-ofsetup.el: Provide `gnus-ofsetup'. - (gnus-setup-for-offline): Add `starttls' to IMAP streams; add - `digest-md5' to IMAP authenticators. +2002-01-08 TSUCHIYA Masatoshi - * 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/gnus-namazu.el (gnus-namazu/highlight-words): Reimplemented. - * lisp/imap.el (imap-stream-alist): Remove redundant entry for TLS. +2002-01-08 Katsumi Yamaoka - * lisp/nnimap.el (nnimap-retrieve-headers-progress): Remove - confusing tabs from original header. + * lisp/nnheader.el (mail-narrow-to-head): Copy from ietf-drums.el; + it should go to the beginning of the header after narrowing. + (std11-extract-addresses-components): Protect against nil argument. -2000-02-02 Katsumi Yamaoka +2002-01-08 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. + * lisp/nnheader.el (mail-header-field-value): Alias to + `std11-field-value'. + (std11-field-value): New function. -2000-01-27 Katsumi Yamaoka +2002-01-08 Akihiro Arisawa - * lisp/gnus.el (gnus-revision-number): Increment to 05. + * lisp/nnheader.el (mail-header-parse-addresses): New function. + (std11-extract-addresses-components): New function. - * lisp/gnus-art.el (gnus-treat-display-smileys): Check for the - module `gnus-bitmap' instead of `smiley-mule'. +2002-01-07 Katsumi Yamaoka - * lisp/gnus-sum.el (gnus-summary-exit): Recenter the group buffer - without redisplaying if the point is out of view. + * lisp/gnus-picon.el: Don't require `mail-parse'. -2000-01-25 Katsumi Yamaoka +2002-01-07 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-revision-number): Increment to 04. + * lisp/nnheader.el (mail-header-fold-field): Alias to + `std11-fold-field'. + (std11-fold-field): New function. + (mail-narrow-to-head): Alias to `std11-narrow-to-header'. + (mail-header-narrow-to-field): Alias to `std11-narrow-to-field'. + (std11-narrow-to-field): New function. -2000-01-24 SANETO Takanori +2002-01-07 Katsumi Yamaoka - * lisp/gnus-spec.el: Call `gnus-ems-redefine'. + * lisp/gnus-vers.el: T-gnus 6.15.5 revision 00. - * lisp/pop3.el (pop3-movemail): Don't use `format' for `message'. - * lisp/gnus-offline.el (gnus-offline-toggle-articles-to-fetch): - Ditto. +2002-01-02 ShengHuo ZHU - * 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. + * etc/gnus/describe-group.xpm: Set pixels of first line to + background color. A bug in Emacs? -2000-01-18 Katsumi Yamaoka +2002-01-07 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 03. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 10. - * lisp/gnus-sum.el (gnus-summary-exit): Don't recenter the group - buffer if it is called non-interactively. + * lisp/gnus-picon.el: Require `mail-parse'. -2000-01-18 Katsumi Yamaoka + * lisp/sha1-el.el (sha1-use-external): Replace `executable-find' + with `exec-installed-p'. - * lisp/gnus.el (gnus-revision-number): Increment to 02. +2002-01-06 TSUCHIYA Masatoshi - * lisp/gnus-sum.el (gnus-summary-exit): Recenter the group buffer - if the point is out of view. + * lisp/gnus-namazu.el: Update comments. + (gnus-namazu/search): Convert `gnus-cache-directory' to absolute + before the regular expression which matches paths of persistent + articles is generated. Clean up codes. -2000-01-15 Tsukamoto Tetsuo +2002-01-05 TSUCHIYA Masatoshi - * lisp/gnus-art.el (gnus-article-next-page): Scroll up LINES if - `pos-visible-in-window-p' returns nil. + * lisp/nnshimbun.el (nnshimbun-request-article): Handle the + article properly when no group is specified. + (nnshimbun-write-nov, nnshimbun-save-nov): Save nov databases only + when their sizes are greater than zero. -2000-01-15 Tsukamoto Tetsuo + * lisp/gnus-namazu.el (gnus-namazu-query-highlight): New option. + (gnus-namazu-query-highlight-face): New face. + (gnus-namazu/check-cache-group): New function. + (gnus-namazu/cache-group-candidates): Ditto. + (gnus-namazu/search): Call `gnus-namazu/check-cache-group' to get + groups for cached articles. + (gnus-namazu/highlight-words): New function. + (gnus-namazu-search): Set the group parameter `highlight-words' + when `gnus-namazu-query-highlight' is equal to the other value + than nil. - * lisp/gnus-offline.el (gnus-agent-mode): New advice. + * lisp/gnus-ja.texi (Namazu Groups): Updated. -2000-01-12 Hirokazu FUKUI +2001-12-21 Katsumi Yamaoka - * lisp/base64.el: Unbound base64-*-string and base64-*-region - when defined by autoload. + * lisp/dgnushack.el (dgnushack-bind-colon-keywords): Ignore + non-list forms in the top level. -2000-01-11 Katsumi Yamaoka +2001-12-18 Josh Huber - * lisp/gnus-sum.el (gnus-summary-reselect-current-group): Restore - the original code; hide group contents while rescanning. + * ChangeLog, todo: (oops) changed buffer-file-coding-system back + to coding. -2000-01-07 Katsumi Yamaoka +2001-12-18 Kai Gro,A_(Bjohann - * lisp/gnus-sum.el (gnus-summary-reselect-current-group): Truncate - lines in the imitation buffer; turn off h-scrollbar for XEmacs. + * make-x.bat: Ensure nonempty variable value. Reported by Frank + Haun . -2000-01-07 Katsumi Yamaoka +2001-12-18 01:00:00 ShengHuo ZHU - * lisp/gnus.el (gnus-revision-number): Increment to 01. + * ChangeLog, todo: Add `coding'. - * 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. +2001-12-17 Josh Huber - * lisp/rfc2231.el: Require `cl' when compiling. + * ChangeLog: changed coding to buffer-file-coding-system + * todo: same - * lisp/gnus-clfns.el: New file. +2001-12-10 Kai Gro,A_(Bjohann - * lisp/dgnushack.el: Move compiler macros to gnus-clfns.el; load - gnus-clfns.el. + * make-x.bat: Code cleanup. Fix a bug with "/copy". From Frank + Schmitt . - * lisp/gnus-sum.el (gnus-summary-reselect-current-group): Don't - rescan the current newsgroup before exiting; wear an imitation - summary buffer while rescanning. +2001-12-10 TSUCHIYA Masatoshi -2000-01-06 Hirokazu FUKUI + * lisp/gnus-namazu.el (gnus-namazu-summary-buffer-name): Changed + the expression to decide whether `gnus-summary-buffer-name' should + be advised. + (gnus-namazu/setup): Strict checking the other Gnus variants than + Oort-Gnus before handling `gnus-group-name-charset-group-alist'. - * lisp/dgnushack.el (char-before): Use the byte-optimaization. +2001-12-09 Katsumi Yamaoka -2000-01-05 Katsumi Yamaoka + * lisp/nnheader.el (mm-multibyte-string-p): Alias to + `multibyte-string-p' or `ignore'. - * lisp/gnus.el (gnus-version-number): Update to 6.14.1. - (gnus-revision-number): Clear to 00. +2001-12-09 TSUCHIYA Masatoshi - * README.T-gnus: Update. + * lisp/gnus-namazu.el (gnus-namazu-summary-buffer-name): New + advice. - * 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. + * lisp/gnus-namazu.el (top): Update comments. + (gnus-namazu-indexed-servers): Abolished. + (gnus-namazu-index-directories, gnus-namazu-command): Changed the + default value. + (gnus-namazu/group-name-regexp): New internal constant. + (gnus-namazu/indexed-servers): New function. + (gnus-namazu/setup): Not initialize `gnus-namazu-indexed-servers'. + Add the entry for ephemeral groups generated by + `gnus-namazu-search' to `gnus-group-name-charset-group-alist'. + (gnus-namazu/group-prefixed-name): Fix. + (gnus-namazu/search): Stricten checking the return value of + `gnus-namazu/call-namazu'. Install changes in order to avoid the + difference between regexp-opt module of FSF Emacs and one of XEmacs. + (gnus-namazu/get-target-groups, gnus-namazu/get-current-query): + Refer `gnus-namazu/group-name-regexp'. + (gnus-namazu-search): Slightly modified. - * texi/{postamble.tex,message.texi,gnus.texi,gnus-ja.texi, - emacs-mime.texi,ChangeLog}: Sync up with Gnus v5.8.3. +2001-12-07 Katsumi Yamaoka -2000-01-05 Katsumi Yamaoka + * lisp/message.el (message-mimic-kill-buffer): Bind + `message-kill-buffer-and-remove-file' to nil while calling the + function `message-kill-buffer'. - * README.semi, README.semi.ja, texi/gnus-faq-ja.texi: Update for - the new CVS server. + * texi/message-ja.texi, texi/message-ja.texi: Update. - * lisp/gnus-sum.el (gnus-articles-to-read): Bind - `cursor-in-echo-area' to nil while `read-from-minibuffer'. + * lisp/lpath.el: Fbind `replace-regexp-in-string' for XEmacs and + Mule; don't fbind coding-system-list for Mule. -1999-12-30 Tsukamoto Tetsuo +2001-12-03 TSUCHIYA Masatoshi + (cf. news://news.gnus.org/gnus.gnus-bug #48523) - * lisp/gnus-offline.el (TopLevel): Call - `define-process-argument-editiong' only under Meadow -- i.e. don't - call this function under NTEmacs. + * lisp/message.el (message-kill-buffer-and-remove-file): New user + option. + (message-kill-buffer): Don't remove the backup file if + `message-kill-buffer-and-remove-file' is nil. -1999-12-28 Tsukamoto Tetsuo +2001-12-07 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-revision-number): Increment to 15. + * lisp/gnus-namazu.el (gnus-namazu-case-sensitive-filesystem): New + option. + (gnus-namazu/group-alist): New internal variable. + (gnus-namazu/setup): Initialize it. + (gnus-namazu/shutdown) New function. + (gnus-namazu/request-list): Ditto. + (gnus-namazu/group-prefixed-name): Ditto. + (gnus-namazu/search): Call it instead of + `gnus-group-prefixed-name' in order to normalize a group name on a + case-insensitive file system. - * 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'. +2001-12-05 TSUCHIYA Masatoshi - * lisp/gnus-ofsetup.el (gnus-offline-resource-en): Reorder the - messages. - (gnus-offline-resource-ja): Ditto. + * lisp/gnus-namazu.el (gnus-namazu-need-path-normalization): New + option. + (gnus-namazu/normalize-results): Refined. - * 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. + * lisp/gnus-namazu.el (gnus-namazu-index-directory): Abolished. + (gnus-namazu-index-directories): New option. + (gnus-namazu-coding-system): Changed the default value for Windows + and OS/2. + (gnus-namazu/setup): Follow the abolition of + `gnus-namazu-index-directory'. + (gnus-namazu/normalize-results): New inline function. + (gnus-namazu/call-namazu): Set `file-name-coding-system' and + `pathname-coding-system' to handle querys which include multibyte + characters. Not reset locale environments. Refer + `gnus-namazu-locale' and `gnus-namazu-index-directories'. + (gnus-namazu/search): Call `gnus-namazu/normalize-results'. + Modify a regular expression. + (gnus-namazu/get-target-groups): Modify a regular expression. + (gnus-namazu/get-current-query): Ditto. + (gnus-namazu/truncate-article-list): Ditto. -1999-12-28 Katsumi Yamaoka +2001-12-03 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 14. + * lisp/mm-url.el: Require `path-util'. + (mm-url-program): Replace `executable-find' to `exec-installed-p'. - * lisp/dgnushack.el (mapcon): Bind the 1st arg `fn' as a temp var. +2001-11-29 Katsumi Yamaoka -1999-12-27 Tsukamoto Tetsuo + * lisp/gnus-vers.el (gnus-revision-number): Increment to 09. - * 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. + * lisp/canlock-om.el: New file. + * lips/dgnushack.el: Load canlock-om.el for compiling canlock.el + when `MULE' is bound. + (dgnushack-unexporting-files): Add canlock-om.el when `MULE' is + not bound. + * lisp/message.el: Require `canlock-om' when Mule is running; + autoload cus-edit for the function `customize-save-variable'. + * lisp/nnheader.el (customize-save-variable): Remove. -1999-12-23 Keiichi Suzuki +2001-11-26 Katsumi Yamaoka - * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Fix timing of - `save-restriction'. + * lisp/message.el (message-strip-special-text-properties): Default + to t because of the new function `message-tamago-not-in-use-p'. -1999-12-21 Daiki Ueno +2001-11-26 Kai GroN_johann - * 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'. + * make-x.bat: Use parameter "/copy" rather than "copy" for increased + dwimishness for old-time DOS users. From Frank Schmitt + . -1999-12-21 Katsumi Yamaoka +2001-11-18 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 13. + * lisp/message.el (message-strip-special-text-properties): Default + to nil temporarily (it should be automated). + (message-forbidden-properties): Undo last change. + (message-strip-forbidden-properties): Undo last change; synch with + Oort Gnus. - * lisp/dgnuspath.el.in: Add the path of APEL to `load-path' as well - as its parent directory. +2001-11-16 Katsumi Yamaoka - * lisp/imap.el (base64-encode-string, base64-decode-string): - Autoload "base64" instead of the tricky definitions. + * lisp/message.el (message-forbidden-properties): Defcustom; make + it a list; don't include `intangible', `invisible', + `modification-hooks' or `read-only'. + (message-strip-forbidden-properties): Convert the value of + `message-forbidden-properties' to plist. - * lisp/base64.el: Restore the original code and invalidate it; use - mel for the base64 codec. +2001-11-16 Katsumi Yamaoka -1999-12-20 Katsumi Yamaoka + * lisp/gnus-group.el (gnus-group-group-map): Bind `G n' key to the + command `gnus-group-make-shimbun-group'. + (gnus-group-group-menu): Add `gnus-group-make-shimbun-group'. - * 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'. + * texi/gnus-ja.texi (Foreign Groups): Add a documentation for the + shimbun groups. + (Web Newspaper): Use `G n' key for `gnus-group-make-shimbun-group'. -1999-12-18 Tsukamoto Tetsuo +2001-11-15 Simon Josefsson - * lisp/gnus-offline.el (gnus-offline-after-get-new-news): Refer to - `gnus-offline-connected', not `gnus-plugged'. + * etc/gnus/unimportant.xpm, etc/gnus/important.xpm: New files. - * lisp/gnus-ofsetup.el (gnus-setup-for-offline): No need to use - `unless'. Use `when'. +2001-11-13 Katsumi Yamaoka - * lisp/imap.el (base64-encode-string): Fix. May work. + * lisp/gnus-sum.el (gnus-summary-wash-map): Remove + `gnus-smiley-display'. -1999-12-16 Katsumi Yamaoka +2001-11-11 Simon Josefsson - * 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'. + * make-x.bat: Don't use -nw. Suggested by Frank Haun + . -1999-12-15 Katsumi Yamaoka +2001-11-09 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-revision-number): Increment to 12. + * texi/infohack.el (infohack-texi-format): To process + write-protected files safely, make this buffer be writable after + `find-file' - * lisp/nnimap.el (nnimap-request-newgroups): Use `member-if'. +2001-11-06 Katsumi Yamaoka - * 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/nnheader.el (customize-save-variable): Defun-maybe. - * 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". +2001-11-01 07:00:00 ShengHuo ZHU - * 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. + * etc/smilies/blink.xpm: New set of xpm. From Oliver Scholz + . -1999-12-14 Katsumi Yamaoka +2001-10-29 Per Abrahamsen - * lisp/imap.el (imap-base64-encode-string): Use `static-if' instead - of `static-condition-case'. + * etc/smilies/sad.pbm: New bitmap. + * etc/smilies/blink.pbm: Ditto. + Contributed by Kim F. Storm . -1999-12-14 Katsumi Yamaoka +2001-10-22 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 11. + * lisp/message.el (rfc822-goto-eoh): Remove. - * lisp/imap.el (imap-base64-encode-string): Allow the optional 2nd - arg `no-line-break'. +2001-10-19 Kai GroN_johann + From Frank Schmitt . -1999-12-14 Daiki Ueno + * make-x.bat: Use correct directory structure for XEmacs on Windows. - * 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. +2001-10-19 Katsumi Yamaoka -1999-12-12 Tsukamoto Tetsuo + * lisp/message.el (rfc822-goto-eoh): Define it when void. - * lisp/mail-source.el (mail-source-fetch-imap): Each temporary - buffer name must be specific to its mail source. +2001-10-19 Katsumi Yamaoka -1999-12-11 Tsukamoto Tetsuo + * lisp/message.el (message-resend, message-send): Undo. - * lisp/gnus.el (gnus-revision-number): Increment to 10. +2001-10-19 Katsumi Yamaoka - * lisp/gnus-offline.el (gnus-offline-define-menu-and-key): Don't - call too many `static-if's. + * lisp/message.el (message-resend): Bind + `inhibit-field-text-motion' to t while resending a mail. - * lisp/gnus-uu.el (gnus-uu-grab-move): Simply copy FILE if - `make-symbolic-link' is not availabe. +2001-10-16 Katsumi Yamaoka - * lisp/lpath.el (TopLevel): Don't warn about `make-symbolic-link'. + * lisp/message.el (message-send): Remove the text property `field' + from the encoding buffer. -1999-12-11 Tsukamoto Tetsuo +2001-10-11 Katsumi Yamaoka - * lisp/gnus-offline.el (gnus-offline-set-unplugged-state): Call - the original `gnus-agent-toggle-plugged'. + * lisp/gnus-start.el (gnus-re-read-newsrc-el-file): Use + `gnus-ding-file-coding-system' instead of + `gnus-startup-file-coding-system'; go to the beginning of the + buffer before searching. + (gnus-read-newsrc-el-file): Use `gnus-ding-file-coding-system' + instead of `gnus-startup-file-coding-system'. - * lisp/mail-source.el (mail-source-fetch-imap): Don't create - multiple temporary buffers, and don't kill one. +2001-10-10 Katsumi Yamaoka -1999-12-10 Tsukamoto Tetsuo + * lisp/message.el (message-send-news): Modify the value of + `mime-field-encoding-method-alist' to encode newsgroup names. - * lisp/gnus.el (gnus-revision-number): Increment to 09. + * lisp/gnus-art.el (gnus-article-header-presentation-method): Call + `article-decode-group-name' to decode newsgroup names. + (gnus-article-decode-hook): Default to nil. - * lisp/gnus-ofsetup.el (gnus-setup-for-offline): Accept an - optional argument `force'. Use `read-file-name' instead of - `read-directory-name'. +2001-10-06 08:00:00 ShengHuo ZHU -1999-12-10 Tsukamoto Tetsuo + * Makefile.in (uninstall): Add. - * lisp/gnus.el (gnus-revision-numbser): Increment to 08. + * etc/Makefile.in (uninstall): Add. - * lisp/gnus-agent.el (gnus): Give up to advise here. - (gnus-group-get-new-news): New advice instead. +2001-10-04 Katsumi Yamaoka - * 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/message.el (message-fix-before-sending): Don't expose + invisible MIME parts; don't use `message-find-invisible-regions'. + (message-find-invisible-regions): Remove. + (invisible-region): Advise the function to add the text property + `mime-edit-invisible'. + (message-invisible-region): Remove. + (message-save-drafts): Copy all the text properties from the + editing buffer to the encoding buffer. + (message-send): Ditto. - * 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'. +2001-10-01 Katsumi Yamaoka - * lisp/read-passwd.el (read-pw-set-mail-source-passwd-cache): - Ignore non-POP mail sources. + * lisp/nndoc.el (nndoc-oe-dbx-type-p): Use `string-as-multibyte' + instead of `mm-string-as-multibyte'. + (nndoc-possibly-change-buffer): Use `nnheader-insert-file-contents' + instead of `mm-insert-file-contents'. -1999-12-10 Katsumi Yamaoka +2001-09-28 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 07. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 08. - * lisp/gnus-util.el (gnus-union): Remove. - (gnus-ems-redefine): Don't call it; don't require `gnus-ems'. +2001-09-27 14:00:00 ShengHuo ZHU - * lisp/gnus-agent.el (gnus-agent-fetch-headers): Use `union' - instead of `gnus-union'. + * aclocal.m4 (GNUS_CHECK_FONTS): Typo. Use /dev/null as latex input. -1999-12-10 A.Hitachi - Katsumi Yamaoka +2001-09-27 09:00:00 ShengHuo ZHU - * lisp/dgnushack.el (union): New compiler macro for emulating cl - function. + * aclocal.m4, configure.in: Check commercial fonts. -1999-12-10 Katsumi Yamaoka +2001-09-27 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/message.el (message-find-invisible-regions): Look for the + text-property `mime-edit-invisible' as well as `message-invisible'. + (message-save-drafts): Copy the text-property `mime-edit-invisible' + from the message editing buffer to the encoding buffer. + (message-send): Ditto. - * lisp/dgnushack.el (mapcon, mapc): Eliminate the redundant code. +2001-09-27 Katsuhiro Hermit Endo -1999-12-09 Katsumi Yamaoka + * texi/gnus-ja.texi (Article Hiding): Fix typo. - * lisp/gnus.el (gnus-revision-number): Increment to 06. +2001-09-25 Katsumi Yamaoka -1999-12-09 Tsukamoto Tetsuo + * lisp/gnus-vers.el (gnus-revision-number): Increment to 07. - * lisp/dgnushack.el (dgnushack-install-package): Preserve any file - in $(PACKAGEDIR)/lisp/t-gnus if it is without .el or .elc suffix. +2001-09-24 19:00:00 ShengHuo ZHU -1999-12-09 Katsumi Yamaoka + * configure.in: Generate texi/ps/Makefile. - * lisp/dgnushack.el (mapcon): New compiler macro for emulating cl - function. - (mapc): Bug fix - treat the last arg as a list. +2001-09-21 Kai GroN_johann -1999-12-08 Tsukamoto Tetsuo + * make.bat: Use parameter "/copy" rather than "copy" for increased + dwimishness for old-time DOS users. - * lisp/gnus.el (gnus-revision-number): Increment to 05. +2001-09-18 22:00:00 ShengHuo ZHU - * lisp/gnus-agent.el (gnus): New advice. Always synchronize the - modeline "Plugged" status display with the value of - `gnus-plugged'. + * make-x.bat: New. - * 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. +2001-09-18 Katsumi Yamaoka - * lisp/gnus-ofsetup.el (gnus-ofsetup-customize): Compile lambda - expressions. + * lisp/dgnushack.el: If W3DIR is identical to URLDIR, don't add it + to `load-path'. -1999-12-08 Katsumi Yamaoka +2001-09-17 Katsumi Yamaoka - * lisp/message.el (message-yank-add-new-references): Fix doc string. + * lisp/gnus-diary.el: Don't use `easy-menu-add-item' if it is not + available. - * texi/{message-ja.texi, message.texi} - (message-list-references-add-position, - message-yank-add-new-references): Add documentations. +2001-09-17 Keiichi Suzuki -1999-12-07 Tsukamoto Tetsuo + * lisp/gnus-bbdb.el (gnus-bbdb/insert-address-regexp): + `regexp-quote' for each addresses. - * lisp/gnus-offline.el (gnus-offline-gettext): Rename from - `gnus-offline-get-message'. +2001-09-16 Katsuhiro Hermit Endo - * lisp/gnus-ofsetup.el (gnus-ofsetup-gettext): Rename from - `gnus-ofsetup-get-message'. + * texi/gnus-ja.texi (Drafts): Fix typo. -1999-12-07 Katsumi Yamaoka +2001-09-12 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-revision-number): Increment to 04. - (smiley-toggle-buffer): Autoload "smiley" or "gnus-bitmap". + * lisp/lpath.el: Removed `current-language-environment' and + `language-info-alist'. - * 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. +2001-09-11 TSUCHIYA Masatoshi - * lisp/dgnushack.el (byte-optimize-form-code-walker): Replace with - the bug fixed version rigidly instead of the use of `defadvice'. + * lisp/gnus-art.el (gnus-request-article-this-buffer): Make a copy + of the requested article only when the current directory does noe + equal to `gnus-original-article-buffer'. - * lisp/message.el (font-lock-after-change-function): Don't use - `compile' for the arg of `defadvice'. + * lisp/gnus-art.el (gnus-request-article-this-buffer): Copy an + article from `gnus-original-article-buffer' to + `gnus-article-buffer'. Generate `gnus-original-article-buffer' + safely. -1999-12-06 Keiichi Suzuki +2001-09-10 TSUCHIYA Masatoshi - * 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. + * lisp/gnus-namazu.el: Updated documents. -1999-12-06 Tsukamoto Tetsuo + * texi/gnus-ja.texi (Namazu Groups): New subsection. - * lisp/gnus.el (gnus-revision-number): Increment to 03. +2001-09-10 Katsumi Yamaoka - * 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-namazu.el: Autoload "regexp-opt" for Mule 2.3. - * 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. + * Mule23@1934.en, Mule23@1934.ja: To install contrib/regexp-opt.el + is required. - * lisp/gnus-start.el (save-buffers-kill-emacs): Compile the advice - at the compile time. Use `gnus-alive-p'. + * contrib/regexp-opt.el: Imported from Emacs 20.2. -1999-12-06 Katsumi Yamaoka + * lisp/gnus-bbdb.el (gnus-bbdb/pop-up-bbdb-buffer): Use + `bbdb-display-layout' or `bbdb-pop-up-display-layout' instead of + `bbdb-elided-display' or `bbdb-pop-up-elided-display' when BBDB + v2.33 or later is running. - * lisp/gnus.el (gnus-revision-number): Increment to 02. +2001-09-10 TSUCHIYA Masatoshi - * 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. + * lisp/gnus-namazu.el (top): Not require `std11'. + (gnus-namazu/get-current-from): Use + `mail-extract-address-components' instead of + `std11-extract-address-components'. -1999-12-05 Tsukamoto Tetsuo + * lisp/gnus-namazu.el: New file. - * lisp/gnus.el (gnus-revision-number): Increment to 01. + * lisp/gnus.el (top): Add autoload of `gnus-namazu-search'. - * lisp/gnus-offline.el (gnus): New advice. synchronize - `gnus-offline-connected' with `gnus-plugged'. + * lisp/gnus-sum.el (gnus-summary-mode-map): Define "\C-c\C-n" as + `gnus-namazu-search'. -1999-12-04 Daiki Ueno + * lisp/gnus-group.el (gnus-group-mode-map): Define "\C-c\C-n" as + `gnus-namazu-search', and removed `gnus-group-make-shimbun-group'. - * lisp/gnus.el (gnus-version-number): Update to 6.14.0. - (gnus-revision-number): Clear to 00. +2001-09-10 Katsumi Yamaoka - * 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/gnus-xmas.el (gnus-tilde-pad-form): Abolished. Use the + new function `gnus-correct-pad-form' instead. + * lisp/gnus-spec.el (gnus-tilde-pad-form): Ditto. + +2001-09-05 TSUCHIYA Masatoshi + + * lisp/nnir.el (nnir-run-namazu): Fix a side effect when handling + of process environments. + +2001-09-04 TSUCHIYA Masatoshi + + * lisp/nnir.el (top): Added code to avoid byte-compile warning + about `nnimap-server-buffer'. + (nnir-run-namazu): Disable locale of Namazu. + +2001-09-04 KOSEKI Yoshinori - * 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. + * lisp/nnir.el (gnus-group-mode-hook): Fix typo. - * 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. +2001-09-04 TSUCHIYA Masatoshi - * t-gnus-6_14: NEW PUBLIC BRANCH. + * lisp/nnir.el (top): Don't call `nnir-group-mode-hook' in T-gnus. -1999-12-03 Hirokazu FUKUI - Katsumi Yamaoka + * lisp/gnus-group.el (gnus-group-group-map): Define "G" as + `gnus-group-make-nnir-group', and define "S" as + `gnus-group-make-shimbun-group'. - * lisp/gnus.el (gnus-revision-number): Increment to 01. + * lisp/gnus.el (top): Add autoload of + `gnus-group-make-nnir-group'. - * lisp/dgnushack.el (char-before): Use compiler macro instead of - byte-optimizer. - (char-after): Comment out the byte-optimization. + * lisp/nnir.el: Import from + ftp://ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/nnir.el. - * 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. +2001-08-29 Katsumi Yamaoka -1999-12-02 Katsumi Yamaoka + * lisp/gnus-util.el (gnus-truncate-string): Abolished. - * lisp/imap.el: Remove autoload settings for `base64-decode-string' - and `base64-encode-string'. +2001-08-18 TSUCHIYA Masatoshi -1999-12-02 Katsumi Yamaoka + * lisp/nnshimbun.el (gnus-group-make-shimbun-group): Call + `shimbun-groups' to detect avaiable groups of specified server. - * lisp/gnus.el (gnus-version-number): Update to 6.13.4. - (gnus-revision-number): Clear to 00. +2001-08-17 KANEMATSU Daiji - * README.T-gnus: Update. + * lisp/message.el (message-signature-separator-for-insertion): New + customizable variable which is used for signature separator. + * lisp/message.el (message-insert-signature): Use variable + `message-signature-separator-for-insertion' instead of hard code. - * GNUS-NEWS: Sync up with Pterodactyl Gnus v0.99. +2001-08-15 Yoichi NAKAYAMA - * 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. + * texi/gnus-ja.texi (Browsing the Web): Fix typo. - * lisp/{webmail.el,nnwarchive.el,nnultimate.el,nnslashdot.el}: New - files. +2001-08-13 Katsumi Yamaoka - * texi/{message.texi,message-ja.texi,gnus.texi,gnus-ja.texi, - emacs-mime.texi,Makefile.in,ChangeLog}: Sync up with Pterodactyl - Gnus v0.99. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 06. -1999-12-02 Katsumi Yamaoka +2001-08-10 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-art.el (gnus-request-article-this-buffer): Insert an + article into `gnus-original-article-buffer' instead of + `gnus-article-buffer'. - * lisp/gnus-group.el (gnus-useful-groups): Undo (`or' -> `unless'). +2001-07-31 Katsumi Yamaoka -1999-12-01 Katsumi Yamaoka + * lisp/mml2015.el: Require `gnus-clfns' when compiling. + * lisp/gnus-clfns.el (string-to-list): New compiler macro. - * lisp/gnus.el (gnus-revision-number): Increment to 10. +2001-07-30 Katsumi Yamaoka - * lisp/gnus-art.el (article-treat-overstrike): Work for multibyte - char with old Emacsen as well. + * lisp/gnus-sum.el (gnus-select-newsgroup): Don't examine cached + articles with `gnus-cache-articles-in-group' even if the current + group is not a virtual group (see ChangeLog.1 1999-03-02). -1999-12-01 Daiki Ueno +2001-07-30 Katsumi Yamaoka - * lisp/gnus-agent.el (gnus-category-edit-predicate): Expand `setf' - appears in the backquoted form. - (gnus-category-edit-score): Ditto. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 05. - * lisp/gnus-sum.el (gnus-data-set-header): Expand `setf' - appears in the backquoted form. + * lisp/nnmh.el (nnmh-retrieve-parsed-headers): Abolished. -1999-11-30 Tsukamoto Tetsuo + * lisp/gnus-sum.el (gnus-get-newsgroup-headers-xover): Don't use + `gnus-retrieve-parsed-headers'. + (gnus-fetch-headers): Ditto. - * lisp/gnus.el (gnus-revision-number): Increment to 09. + * lisp/gnus-int.el (gnus-retrieve-parsed-headers): Abolished. - * 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'. + * lisp/gnus-cache.el (gnus-cache-braid-headers): Abolished. + (gnus-cache-retrieve-parsed-headers): Abolished. -1999-11-30 Tsukamoto Tetsuo +2001-07-30 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 08. + * lisp/nnshimbun.el (nnshimbun-request-expire-articles): Bind + `nnmail-expiry-wait-function' to nil if the group's parameter + `expiry-wait' is specified by the user or the shimbun's default + value is provided. - * 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. +2001-07-27 Katsumi Yamaoka - * gnus-ofsetup.el (gnus-ofsetup-update-setting-file): Typo. - (gnus-ofsetup-resource-en): Fix doc strings. - (gnus-ofsetup-resource-ja): Ditto. + * lisp/gnus-msg.el (gnus-message-make-user-agent): New + implementation. -1999-11-30 Katsumi Yamaoka +2001-07-24 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 07. + * lisp/gnus-clfns.el (copy-list): New compiler macro. - * lisp/gnus-art.el (gnus-article-wash-status): Sync up with - Pterodactyl Gnus v0.98. +2001-07-23 Katsumi Yamaoka -1999-11-30 Katsumi Yamaoka + * lisp/gnus-delay.el (gnus-delay-initialize): Don't use the macro + `kbd'. - * lisp/nnimap.el (nnimap-request-newgroups): Don't use `member-if'. + * lisp/nnheader.el (mm-read-coding-system): New function which is + a substitute for mm-util.el. - * lisp/gnus.el (gnus-select-method): Use `if' instead of `when'. +2001-07-19 Katsumi Yamaoka - * lisp/gnus-sum.el (gnus-summary-make-marking-command-1): Use - `car' and `cdr' instead of `cadr'. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. - * lisp/gnus-picon.el (gnus-picons-file-suffixes): Use `cons' - instead of `push'; use `if' instead of `when'. + * lisp/nntp.el (nntp-request-newgroups): Use UTC date for + NEWGROUPS command. - * lisp/gnus-group.el (gnus-group-iterate): Use `car' and `cdr' - instead of `pop'. - (gnus-useful-groups): Use `or' instead of `unless'. + * lisp/gnus-start.el (gnus-find-new-newsgroups): Use + `message-make-date' instead of `current-time-string'. + (gnus-ask-server-for-new-groups): Ditto. + (gnus-check-first-time-used): Ditto. - * lisp/gnus-art.el (gnus-emphasis-alist): Use `car' and `cdr' - instead of `cadr'. +2001-07-17 Katsumi Yamaoka -1999-11-30 Katsumi Yamaoka + * texi/message-ja.texi (message-citation-line-function): Add a + comma just after the `@xref' form. - * lisp/gnus-start.el (save-buffers-kill-emacs): Don't use the macro - `when' in the body of `defadvice'. Use `if' instead. + * lisp/nnheader.el (nnheader-header-value): Ignore leading + whitespaces. - * lisp/dgnushack.el (last, mapc): New compiler macros for emulating - cl functions. + * lisp/dgnushack.el (dgnushack-make-auto-load): Advise + `make-autoload' to handle `define-derived-mode'. -1999-11-29 Katsumi Yamaoka +2001-07-12 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. + * lisp/message.el (message-yank-original): Unwind-protect while + suspending font-lock. + (message-mode): Modify for the following changes. + (message-font-lock-keywords-2): Abolished. + (message-font-lock-keywords-1): Abolished. + (message-font-lock-keywords): Unified. + (message-font-lock-cited-text-matcher): Abolished. + (font-lock-after-change-function): Don't advise it. + (message-font-lock-last-position): Abolished. + (message-font-lock-citation-name-max-column): Abolished. + (message-font-lock-cited-text-regexp) Abolished. + (message-font-lock-fence-close-position): Abolished. + (message-font-lock-fence-open-position): Abolished. + (message-font-lock-fence-close-regexp): Abolished. + (message-font-lock-fence-open-regexp): Abolished. -1999-11-27 Katsumi Yamaoka +2001-07-10 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 06. + * lisp/message.el (message-font-lock-keywords-1): Replace regexp + for mml tags with `mime-edit-tag-regexp'. - * 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. +2001-07-10 Katsumi Yamaoka -1999-11-26 NAKAJI Hiroyuki + * lisp/message.el (message-font-lock-keywords-2): Move definitions + for cited texts and mml tags to `message-font-lock-keywords-1'. - * lisp/gnus.el (gnus-version): Parentheses of gnus-revision-number - are removed to fill gnus-version within 80 columns. +2001-07-10 Katsuhiro Hermit Endo -1999-11-25 NAKAJI Hiroyuki + * texi/gnus-ja.texi (Mail Group Commands): Fix a slight mistake. - * lisp/gnus.el (gnus-version): Shows also gnus-revision-number. +2001-07-09 Katsumi Yamaoka -1999-11-24 Katsumi Yamaoka + * lisp/dgnushack.el: Add the parent directory of the directory + where the APEL modules are installed to `load-path' according to + the description of the file Mule23@1934. - * lisp/gnus.el (gnus-revision-number): Increment to 05. +2001-07-04 Yair Friedman - * lisp/gnus-agent.el (gnus-agent-fetch-headers): Use `gnus-union' - instead of `union'. + * make.bat: Use infohack.el to create info files. - * lisp/gnus-util.el (gnus-union): New function. +2001-07-09 Akihiro Arisawa - * 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. + * README.semi: Modify URI of emacs-w3m. + * README.semi.ja: Ditto. + * Mule23@1934.en: Ditto. + * Mule23@1934.ja: Ditto. + * lisp/nnshimbun.el: Ditto. - * lisp/dgnushack.el (union, copy-list): Remove compiler macros. + * texi/gnus-ja.texi (Top, Article Treatment): Fix typo. + (Web Newspaper): Modify URI of emacs-w3m. -1999-11-24 Katsumi Yamaoka +2001-07-06 KITAGAWA Takurou - * lisp/gnus.el (gnus-revision-number): Increment to 04. + * lisp/Makefile.in (clever): Use `if test... then' instead of + `test... &&'. - * lisp/dgnushack.el (union, copy-list): New compiler macros for - emulating cl functions. +2001-07-06 Katsumi Yamaoka -1999-11-22 Katsumi Yamaoka + * lisp/Makefile.in (clever): Change the quoting style for the + elisp form to check for XEmacs-p. - * lisp/gnus.el (gnus-revision-number): Increment to 03. - (gnus-select-method): Use `condition-case' instead of - `ignore-errors'. + * lisp/dgnushack.el: Require `path-util' first, and then search + for the path if it is not found. - * lisp/gnus-start.el (gnus-site-init-file): Use `condition-case' - instead of `ignore-errors'. +2001-07-05 Katsumi Yamaoka - * lisp/{gnus-ofsetup.el,gnus-offline.el}: Remove RCS magic cookie. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. - * 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'. +2001-06-28 Akitada Koyama -1999-11-22 Katsumi Yamaoka + * texi/gnus-ja.texi (Web Newspaper): Add a description how to show + html documents inline. - * lisp/gnus.el (gnus-revision-number): Increment to 02. +2001-06-28 Katsumi Yamaoka - * 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. + * texi/message-ja.texi (message-suspend-font-lock-when-citing): Add + a description. + * texi/message.texi (message-suspend-font-lock-when-citing): Ditto. - * 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/message.el (message-yank-original): Suspend font-lock'ing + while citing an original message. + (message-suspend-font-lock-when-citing): New user option. - * lisp/gnus-ems.el (gnus-split-string): Remove. +2001-06-25 Katsumi Yamaoka -1999-11-21 Daiki Ueno + * lisp/gnus-clfns.el (find-cl-run-time-functions): New + implementation. - * 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'. +2001-06-22 Katsumi Yamaoka -1999-11-20 Daiki Ueno + * lisp/gnus-art.el (article-display-x-face): Don't gather X-Face + fields in `gnus-original-article-buffer'. - * 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'. +2001-06-18 Katsumi Yamaoka -1999-11-19 Katsumi Yamaoka + * lisp/nnshimbun.el (nnshimbun-find-parameter): Undo the last + bogus changes; use the value of `nnshimbun-pre-fetch-article' if + the value of the group parameter `prefetch-articles' is nil; do + likewise for `encapsulate-images'. - * lisp/gnus.el (gnus-revision-number): Increment to 01. - (gnus-select-method): Use `condition-case' instead of - `ignore-errors'. +2001-06-18 Katsumi Yamaoka - * lisp/pop3.el (pop3-apop): Move the autoload seting to the top - level. + * lisp/nnshimbun.el (nnshimbun-find-parameter): Use the value of + `nnshimbun-pre-fetch-article' if the value of the group parameter + `prefetch-articles' is `off'; do likewise for `encapsulate-images'. - * lisp/md5.el (md5): Allow the optional 4th and 5th arguments - `coding' and `noerror' for the stopgaps. +2001-06-18 Katsumi Yamaoka - * lisp/lpath.el (md5): Allow the optional 4th and 5th arguments - `coding' and `noerror'. - (function-max-args): Maybe-fbind for FSF Emacsen. + * lisp/nnshimbun.el (nnshimbun-encapsulate-images): Fix a + doc-string that both the values `off' and nil specifies not to + encapsulate images. + (nnshimbun-pre-fetch-article): Default to `off'. - * 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'. +2001-06-18 Katsumi Yamaoka - * lisp/gnus-util.el (copy-list): New function defined by - `defun-maybe'. + * lisp/nnshimbun.el (nnshimbun-encapsulate-images): Renamed from + `nnshimbun-encapsulate-article'. + (nnshimbun-request-article-1): Replace `encapsulate-article' with + `encapsulate-images'. + (nnshimbun-find-parameter): Ditto. + (nnshimbun-group-parameters): Ditto. + (nnshimbun-group-parameters-custom): Ditto. - * lisp/gnus-sum.el (gnus-update-summary-mark-positions): Specify - the 3rd arg of `make-full-mail-header' to "nobody" instead of "". +2001-06-15 TSUCHIYA Masatoshi - * lisp/gnus-start.el (gnus-site-init-file): Use `condition-case' - instead of `ignore-errors'. + * lisp/nnshimbun.el (nnshimbun-group-parameters-custom): Add + `encapsulate-article' as a customizable option, and modified + `prefetch-articles'. + (nnshimbun-group-parameters): Add document for + `encapsulate-article'. + (nnshimbun-encapsulate-article): New server variable. + (nnshimbun-find-parameter): Add code for `encapsulate-article'. + (nnshimbun-request-article-1): Refer `encapsulate-article' group + parameter to control `shimbun-encapsulate-article' value when + `shimbun-article' is called. - * lisp/gnus-picon.el: Require `cl'. +2001-06-14 Katsumi Yamaoka - * lisp/{smiley.el,rfc2104.el,nnvirtual.el,mailheader.el, - gnus-offline.el} (cl): Enclose the requiring procedure with - `eval-when-compile'. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. - * lisp/{imap.el,gnus-mailcap.el} (cl): Enclose the requiring - procedure with `eval-when-compile' instead of `eval-and-compile'. +2001-06-14 Katsumi Yamaoka -1999-11-09 Yoshiki Hayashi + * lisp/nnshimbun.el (nnshimbun-request-expire-articles): Use + `nnshimbun-find-parameter'. + (nnshimbun-generate-nov-database): Bind a full group name while + processing. + (nnshimbun-find-parameter): New implementation to refer to the + nnshimbun group parameters. + (nnshimbun-index-range): Add a document that it's just a default. + (nnshimbun-pre-fetch-article): Ditto. + (nnshimbun-group-parameters): Specify a parameter type as `list'. + (TopLevel): Remove the local variable "-*- coding: junet; -*-". - * lisp/read-passwd.el (read-pw-set-mail-source-passwd-cache): - Use mail-sources instead of nnmail-spool-file. - From: Toshiaki -PCX- Tanaka. +2001-06-13 Katsumi Yamaoka -1999-11-09 Katsumi Yamaoka + * lisp/nnshimbun.el (nnshimbun-group-parameters): New group + parameter. It also provides the user option + `nnshimbun-group-parameters-alist' and the function + `nnshimbun-find-group-parameters'. + (nnshimbun-group-parameters-custom): New variable. + (TopLevel): Require `gnus' expressly. - * lisp/gnus.el (gnus-group-startup-message): Insert space before - "based on". - * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Ditto. +2001-06-12 TSUCHIYA Masatoshi -1999-11-09 Katsumi Yamaoka + * lisp/nnshimbun.el (nnshimbun-find-parameter): New macro. + (nnshimbun-generate-nov-database): Use `nnshimbun-find-parameter'. + (nnshimbun-request-expire-articles): Fixed. - * lisp/gnus.el (gnus-version-number): Update to 6.13.3. - (gnus-revision-number): Clear to 00. +2001-06-12 Katsumi Yamaoka - * README.T-gnus: Update. + * lisp/nnshimbun.el (Gnus-p): Use `file-exists-p' instead of + `locate-library' to check for the existence of mailcap.el in the + same directory of gnus.el. + (nnshimbun-retrieve-headers-with-nov): Remove a redundant check + that I made. - * 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. +2001-06-11 Katsumi Yamaoka - * lisp/{rfc2104.el,nnimap.el,imap.el}: New files. + * lisp/lpath.el: Don't Fbind `xml-node-children'. - * texi/gnus-ja.texi: Sync up with Pterodactyl Gnus v0.98 without - translation. +2001-06-11 Akihiro Arisawa - * texi/{gnus.texi,ChangeLog}: Sync up with Pterodactyl Gnus v0.98. + * lisp/nnshimbun.el (nnshimbun-request-expire-articles): Fix + inhibiting the expiring when `nnshimbun-keep-unparsable-dated-articles' + is nil. -1999-11-08 Kinji Itoh +2001-06-11 TSUCHIYA Masatoshi - * 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. + * lisp/gnus-group.el (toplevel): Removed autoload code for + "nnshimbun". -1999-11-08 Daiki Ueno + * texi/gnus-ja.texi (Web Newspaper): Add documents about + `nnshimbun-index-range'. - * lisp/pop3.el (pop3-progress-message): New function. - (pop3-movemail): Use it. +2001-06-11 Katsumi Yamaoka -1999-10-28 Katsumi Yamaoka + * lisp/nnshimbun.el (nnshimbun-request-expire-articles): Don't + refer to the variable `nnshimbun-keep-last-article', we should + keep the last article anyway. + (nnshimbun-keep-last-article): Abolished. - * lisp/gnus.el (TopLevel): Autolaod "gnus-msg" for the function - `gnus-following-method'. + * lisp/gnus.el: Autoload "nnshimbun" for the command `gnus-group- + make-shimbun-group'. - * 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'. +2001-06-11 TSUCHIYA Masatoshi - * lisp/gnus-art.el (gnus-following-method): Move to gnus-msg.el. + * lisp/nnshimbun.el: Remove some garbage. -1999-10-26 Katsumi Yamaoka +2001-06-10 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'. + * texi/message-ja.texi: Use `iso-2022-7bit' instead of + `iso-2022-7bit-ss2' to keep a compatibility between XEmacsen and + FSF Emacsen. + * texi/gnus-ja.texi: Ditto. - * 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. +2001-06-09 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (top-level): Updated comments. + (nnshimbun): New customize group. + (nnshimbun-keep-last-article): Defined as customize variable. + (nnshimbun-keep-unparsable-dated-articles): Ditto. + (nnshimbun-insert-nov): Use `when' instead of `if'. + (gnus-group-shimbun-server-history): Imported from + `gnus-group.el'. + (gnus-group-make-shimbun-group): Ditto. + + * lisp/gnus-group.el (gnus-group-make-shimbun-group): Its real + definition is moved to `nnshimbun.el' and autload code is added. + (gnus-group-shimbun-server-history): Its definition is moved to + `nnshimbun.el'. + +2001-06-08 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el (nnshimbun-use-entire-index): Removed. + (nnshimbun-index-range): New variable. + (nnshimbun-close-server): Check status strictly to close server + safely. + (nnshimbun-generate-nov-database): Refer the group paramter + `nnshimbun-index-range' as the second parameter of + `shimbun-headers'. + (shimbun-mua-use-entire-index): Removed. + (nnshimbun-request-article-1): Replace a date string in + `gnus-newsgroup-data' only when article header has non-nil value. + (nnshimbun-insert-nov): Fixed condition to decide whether + `X-Nnshimbun-Id' should be inseted or not. + +2001-06-08 Katsumi Yamaoka + + * lisp/nnshimbun.el (nnshimbun-expire-nov-databases): Removed. + (nnshimbun-request-expire-articles): Simplified; refer to the + shimbun's default expiration days. + +2001-06-08 Katsumi Yamaoka + + * lisp/lpath.el: Fbind `xml-node-children' for XEmacsen and old FSF + Emacsen. -1999-10-26 Katsumi Yamaoka +2001-06-07 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 13. - (TopLevel): Rearrange autoload settings. + * lisp/nnshimbun.el (nnshimbun-request-expire-articles): Prefer the + group parameter `expiry-wait' when expiring a closed group. - * lisp/gnus-art.el (gnus-treatment-function-alist): Don't use - `smiley-buffer'. +2001-06-07 Katsumi Yamaoka - * 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/nnshimbun.el (nnshimbun-request-article-1): Replace a date + string in `gnus-newsgroup-data' based on the newly retrieved + article. - * 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. +2001-06-07 Katsumi Yamaoka -1999-10-24 Tsukamoto Tetsuo + * lisp/nnshimbun.el (nnshimbun-request-expire-articles): Fix + inhibiting the expiring. - * 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". +2001-06-06 Katsumi Yamaoka - * lisp/gnus-offline.el (TopLevel): Do not consider the functions - defined in "miee". + * lisp/nnshimbun.el (nnshimbun-expire-nov-databases): New command. + (nnshimbun-request-expire-articles): New function. + (nnshimbun-keep-unparsable-dated-articles): New variable. + (nnshimbun-keep-last-article): New variable. + (nnshimbun-insert-nov): Rewrite using `nnshimbun-string-or'. + (nnshimbun-string-or): New macro. + (nnshimbun-tmp-string): New internal variable. + (TopLevel): Require `message' for `message-make-date'. - * lisp/gnus-ofsetup.el (TopLEvel): Do not autoload - `gnus-custom-mode' defined in "gnus-cus". +2001-05-30 Katsumi Yamaoka -1999-10-21 Tsukamoto Tetsuo + * lisp/gnus-clfns.el (find-cl-run-time-functions): Remove a + useless non-global var; scroll the output window automatically. - * lisp/gnus.el (gnus-revision-number): Increment to 11. +2001-05-31 TSUCHIYA Masatoshi - * lisp/gnus-offline.el (TopLevel): Call `mime-set-field-decoder' - when "eword-decode" is loaded. It is for X-Gnus-Offline-Backend - header. + * lisp/nnshimbun.el (nnshimbun-header-xref): Removed. + (nnshimbun-check-header): Removed. + (nnshimbun-make-shimbun-header): Don't call + `nnshimbun-header-xref'. + (nnshimbun-request-group): Simplified. + (nnshimbun-request-article-1): Call `nnshimbun-replace-nov-entry' + instead of `nnshimbun-check-header'. + (nnshimbun-insert-nov): New function. + (nnshimbun-generate-nov-database): Call `nnshimbun-insert-nov' + instead of `nnheader-insert-nov'. + (nnshimbun-replace-nov-entry): New function. -1999-10-19 Katsumi Yamaoka +2001-05-29 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/gnus-clfns.el (find-cl-run-time-functions): Add a parser for + `dolist'; protect against errors. - * lisp/lpath.el (smiley-encode-buffer): Bind it for FSF Emacsen. +2001-05-29 Katsumi Yamaoka - * 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/nnshimbun.el (nnshimbun-retrieve-headers-with-nov): Don't + use `last'. + (nnshimbun-make-shimbun-header): Use the following macros. + (nnshimbun-mail-header-from): New macro whose definition will be + changed statically for Gnus or gnus. + (nnshimbun-mail-header-subject): Ditto. + (TopLevel): Don't require `gnus-clfns'. - * 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.el: Add autoload for `find-cl-run-time-functions'. - * 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'. + * lisp/gnus-clfns.el (find-cl-run-time-functions): New command for + the developers. + (cl-run-time-functions): New variable. + (TopLevel): Don't require `cl' at run-time. -1999-10-18 Katsumi Yamaoka +2001-05-28 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-revision-number): Increment to 09. + * texi/gnus-ja.texi (Web Newspaper): Updated. - * 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. +2001-05-28 Katsumi Yamaoka -1999-10-04 Masatoshi Tsuchiya + * lisp/dgnushack.el (dgnushack-unexporting-files): Add + "nnshimbun.el" if the library "shimbun" is not found. + (TopLevel): Add "/somewhere/apel/" to `load-path' if it is needed. + (locate-library): Redefine it for Mule before it is called. - * 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. + * README.semi.ja: Update for the use of Emacs-W3M. + * README.semi: Ditto. + * Mule23@1934.ja: Ditto. + * Mule23@1934.en: Ditto. -1999-10-11 Katsumi Yamaoka +2001-05-28 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-revision-number): Increment to 08. + * lisp/nnshimbun.el: Reconstructed to use `shimbun'. - * 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. + * lisp/gnus-group.el (gnus-group-make-shimbun-group): + Reconstructed to use `shimbun'. -1999-10-08 Katsumi Yamaoka + * lisp/dgnushack.el (toplevel): Add paths if and only if APEL and + FLIM can't be found. - * lisp/gnus.el (gnus-revision-number): Increment to 07. - (TopLevel): Autoload "gnus-art" for the function - `gnus-article-show-all'. +2001-05-17 Kai =?iso-8859-1?q?Gro=DFjohann?= - * lisp/gnus-sum.el (gnus-summary-select-article): Expose all - hidden text if the command `gnus-summary-toggle-mime' is used. + * etc/Makefile.in (datadir): Set this variable, like in the other + Makefile.in's. Patch from Gaute B Strokkenes . - * 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'. +2001-05-16 Katsumi Yamaoka -1999-10-08 Katsumi Yamaoka + * lisp/dgnushack.el (dgnushack-bind-colon-keywords): Don't ignore + `widget-convert-button', `widget-create' and `widget-put'; ignore + `defface'. - * lisp/gnus.el (gnus-revision-number): Increment to 06. +2001-05-14 Katsumi Yamaoka - * 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'. + * lisp/gnus.el: Require `base64' if `base64-encode-string' is not a + built-in function. -1999-10-07 Yoshiki Hayashi + * lisp/dgnushack.el (dgnushack-bind-colon-keywords): Ignore + `defgroup'. - * lisp/gnus.el (gnus-revision-number): Increment to 05. +2001-05-14 Katsumi Yamaoka -1999-10-07 Katsumi Yamaoka + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. - * lisp/gnus-art.el (gnus-treat-predicate): Examine whether the - argument is list or not before condition. + * lisp/nnmail.el: Don't bind the colon keywords here. + * lisp/gnus.el (gnus-colon-keywords): New variable which will + default to the value of `dgnushack-colon-keywords'; bind them. + * lisp/dgnushack.el (dgnushack-unexporting-files): Add + dgnuskwds.el. + (dgnushack-colon-keywords): New constant which will have the colon + keywords shuld be bound at run-time for old Emacsen; cache them in + the file dgnuskwds.el and bind them. + (dgnushack-bind-colon-keywords): New function. + (locate-library): Make the function to be silent for Mule. + * lisp/Makefile.in (clean): Remove dgnuskwds.el. -1999-10-07 Yoshiki Hayashi +2001-05-07 Katsumi Yamaoka - * lisp/gnus-art.el (gnus-treat-predicate): Work for - (typep "something"). + * lisp/message.el (message-maybe-encode): Don't use + `end-of-invisible'. -1999-10-07 Yoshiki Hayashi +2001-05-07 Katsumi Yamaoka - * 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. + * lisp/gnus-vers.el: T-gnus 6.15.4 revision 00. -1999-10-06 Katsumi Yamaoka +2001-04-27 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 04. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. - * lisp/message.el (message-generate-headers): Don't insert - excessive newline. + * lisp/gnus-art.el (gnus-article-mime-edit-exit): Set buffer to + `gnus-article-buffer' just before `gnus-article-prepare-display' is + called. + (gnus-article-mime-edit-article-setup): Ditto. + (gnus-article-prepare-display): Don't bind `buffer-read-only' + because of `inhibit-read-only'; don't set the value of + `gnus-article-current-summary' here; delete all extents or overlays + and clear the value of `gnus-button-marker-list' in advance; make + it to run in `gnus-article-buffer'. + (gnus-article-prepare): Make it to run in `gnus-article-buffer'. + (article-toggle-headers): Don't bind `buffer-read-only' because of + `inhibit-read-only'. + (article-hide-headers): Ditto. - * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Don't use - negative number for the 2nd arg of `insert-char'. +2001-04-16 Katsumi Yamaoka -1999-10-06 Tsukamoto Tetsuo + * lisp/gnus-vers.el: T-gnus 6.15.3 revision 00. - * lisp/gnus-ofsetup.el (gnus-ofsetup-customize): Info link to - gnus-ja instead of gnus if Japanese environment is on. +2001-04-16 Katsumi Yamaoka -1999-10-06 Katsumi Yamaoka + * lisp/gnus-vers.el: T-gnus 6.15.2 revision 00. - * 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. +2001-04-16 Katsumi Yamaoka - * lisp/gnus-msg.el (gnus-bug): Delete `Cc'; modify version string. + * lisp/gnus-vers.el: T-gnus 6.15.1 revision 00. - * lisp/gnus-xmas.el (gnus-xmas-group-startup-message): Display - version string; fix glyph position. +2001-04-13 Katsumi Yamaoka -1999-10-06 Yoshiki Hayashi + * lisp/lpath.el: Fbind `xml-parse-region' for XEmacsen and old FSF + Emacsen; don't bind `mh-lib-progs'. - * 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. +2001-04-10 Katsumi Yamaoka -1999-10-05 Katsumi Yamaoka + * lisp/nnshimbun.el: Enclose w3m stuff with `eval-and-compile'; + bind `w3m-work-buffer-name' and `w3m-retrieve' when compiling. - * lisp/gnus.el (gnus-revision-number): Increment to 02. +2001-04-09 Katsumi Yamaoka - * 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'. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 10. -1999-10-01 Katsumi Yamaoka +2001-04-03 TSUCHIYA Masatoshi - * lisp/gnus.el (gnus-revision-number): Increment to 01. + * lisp/nnshimbun.el (nnshimbun-type-definition: Follow changes in + asahi.com. + (nnshimbun-asahi-get-headers): Ditto. + (nnshimbun-retrieve-url): Use `w3m-retrieve' if it is available. - * 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. +2001-04-02 Katsumi Yamaoka - * lisp/gnus-msg.el (gnus-bug): Use text/plain for the snooped - environment part. + * lisp/gnus-msg.el (gnus-inews-yank-articles): Make it to work with + multiple articles even if there is a detached minibuffer frame on + some window managers. -1999-09-30 Daiki Ueno +2001-03-21 Thierry Emery - * nnfolder.el (nnfolder-possibly-change-group): Don't create an - active entry for the group even if it doesn't exist. + * lisp/mm-decode.el (mm-copy-to-buffer): Copy buffer in unibyte + mode. -1999-09-28 Daiki Ueno +2001-03-19 Katsumi Yamaoka - * gnus-art.el (gnus-article-mime-part-status): Use `mime-entity-children'. + * lisp/gnus-kill.el (gnus-execute): Work with the extra headers. + * lisp/gnus-sum.el (gnus-summary-execute-command): Ditto. -1999-09-28 Katsumi Yamaoka +2001-03-13 Katsumi Yamaoka - * lisp/gnus.el (gnus-version-number): Update to 6.13.2. - (gnus-revision-number): Clear to 00. + * lisp/message.el (message-fix-before-sending): Hide again the + invisible property of encoded binary data parts after checking is + done. + (message-find-invisible-regions): New function. + (message-save-drafts, message-send): Inherit the invisible property + of encoded binary data parts to make MIME-Edit find the MIME part + boundaries. - * README.T-gnus: Update. + * lisp/dgnushack.el (dgnushack-compose-package): Tidy up. + (dgnushack-make-load): Ditto. - * texi/{message.texi,message-ja.texi,gnus.texi,gnus-ja.texi, - emacs-mime.texi,ChangeLog}: Sync up with Pterodactyl Gnus v0.97. +2001-03-12 Katsumi Yamaoka - * 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. + * lisp/dgnushack.el (dgnushack-compose-package): New function. + (dgnushack-make-load): Add autoload for cus-load if it is missing. -1999-09-24 Katsumi Yamaoka + * lisp/Makefile.in (compose-package): Use + `dgnushack-compose-package'. + (clean, clever): Remove custom-load.el. - * lisp/gnus.el (gnus-revision-number): Increment to 07. + * Makefile.in (elclean): Remove custom-load.el. - * lisp/gnus-art.el (gnus-article-prev-page): Rewrite to realize - smooth scrolling under XEmacs. - (gnus-article-next-page):Ditto. +2001-03-08 Katsumi Yamaoka - * 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. + * lisp/gnus-art.el (gnus-article-prepare-display): Setup MIME + entity even if `gnus-show-mime' is nil. -1999-09-22 Katsumi Yamaoka +2001-03-08 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 06. + * lisp/dgnushack.el: Load gnus-clfns.el after `load-path' is + adjusted. - * lisp/nnmail.el (TopLevel): Bind keywords `:user', `:path' and - `:predicate' for old Emacsen; require `static'. + * lisp/gnus-clfns.el (string): New compiler macro. + (string): Defun-maybe as an ordinary function since it won't be + provided in cl. + * lisp/gnus-score.el (gnus-score-find-bnews): Use it as Gnus does. - * lisp/dgnushack.el (TopLevel): Don't bind keywords `:user', - `:path' and `:predicate'. +2001-03-06 Katsumi Yamaoka -1999-09-20 Daiki Ueno + * lisp/nnshimbun.el (nnshimbun-retrieve-url): Check if + `url-current-mime-charset' is bound. - * gnus-agent.el (gnus-agent-toggle-plugged): Mark the current - modeline as modified. +2001-03-04 Katsumi Yamaoka -1999-09-17 Katsumi Yamaoka + * lisp/gnus.el (gnus-info-find-node): Pretend to be + `gnus-article-mode' in the article buffer. - * lisp/gnus.el (gnus-revision-number): Increment to 05. +2001-03-02 Katsumi Yamaoka - * lisp/gnus-art.el (gnus-treat-article): Inherit the text property - `mime-view-entity' in the modified header under FSF Emacsen. + * lisp/nnshimbun.el (nnshimbun-kinsoku-eol-list): Simplified. + (nnshimbun-kinsoku-bol-list): Ditto. -1999-09-13 Tsukamoto Tetsuo +2001-03-01 Katsumi Yamaoka - * README-offline.en: Rewrite the usage description. - * README-offline.ja: Ditto. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 09. -1999-09-12 Tsukamoto Tetsuo + * lisp/gnus-offline.el (gnus-offline-get-menu-items): Rewrite using + `dolist'. - * lisp/gnus.el (gnus-revision-number): Increment to 04. + * lisp/gnus-group.el (gnus-group-make-shimbun-group): Simplified. - * lisp/gnus-ofsetup.el (gnus-offline-lang): Declare before loading - `gnus-offline'. + * lisp/dgnushack.el: Load cl-macs to ensure that the macro `dolist' + is defined properly. -1999-09-12 Tsukamoto Tetsuo +2001-02-28 Katsumi Yamaoka - * README-offline.en: Do not refer to `gnus-agent-toggle-plugged'. - * README-offline.ja: Ditto. + * lisp/nnwfm.el: Require `gnus-clfns' when compiling. + * lisp/nnshimbun.el: Ditto. + * lisp/nnfolder.el: Ditto. + * lisp/mm-util.el: Ditto. + * lisp/gnus-vers.el: Ditto. + * lisp/gnus-sum.el: Ditto. + * lisp/gnus-score.el: Ditto. + * lisp/gnus-nocem.el: Ditto. -1999-09-11 Tsukamoto Tetsuo + * lisp/gnus-ofsetup.el: Don't require `gnus-clfns'. + (gnus-ofsetup-customize-done): Use `dolist' instead of `mapc'. + (gnus-setup-for-offline): Ditto. - * lisp/gnus.el (gnus-revision-number): Increment to 03. + * lisp/gnus-offline.el: Don't use `mapc' for binding some vars; + don't require `gnus-clfns'. - * lisp/gnus-agent.el (gnus-agent-toggle-plugged): Do not mark - the current buffer as modified. + * lisp/gnus-clfns.el (subseq, merge, coerce, butlast): New compiler + macros. + (mapc): Remove. - * 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. + * lisp/gnus-art.el: Use `dolist' instead of `mapcar' for defining + `gnus-article-read-summary-keys'. -1999-09-04 Daiki Ueno +2001-02-28 Katsumi Yamaoka - * lisp/gnus-msg.el (gnus-configure-posting-styles): Quote `:file'. + * lisp/gnus-art.el (gnus-article-mime-edit-article-setup): Leave + the forwarded parts undecoded. + (gnus-article-decode-article-as-default-mime-charset): Set the + value of `default-mime-charset' buffer-locally. - * 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'. +2001-02-27 Katsumi Yamaoka -1999-09-03 Tsukamoto Tetsuo + * lisp/gnus.el: Add autoloads for + `gnus-summary-digest-post-forward' and + `gnus-summary-digest-mail-forward'. - * lisp/gnus.el (gnus-revision-number): Increment to 02. + * lisp/gnus-sum.el (gnus-summary-post-menu): Replace + `gnus-uu-digest-mail-forward' and `gnus-uu-digest-post-forward' + with `gnus-summary-digest-post-forward' and + `gnus-summary-digest-mail-forward'. - * 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-msg.el (gnus-summary-digest-post-forward): Restore and + repair the command `gnus-summary-post-digest' and rename it. + (gnus-summary-digest-mail-forward): Ditto. + (gnus-summary-send-map): Replace `gnus-uu-digest-mail-forward' and + `gnus-uu-digest-post-forward' with + `gnus-summary-digest-post-forward' and + `gnus-summary-digest-mail-forward'. - * 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. +2001-02-27 Katsumi Yamaoka -1999-09-01 Katsumi Yamaoka + * lisp/gnus-sum.el (gnus-summary-show-article): Bind + `gnus-inhibit-treatment' to t while fetching the raw article. - * lisp/gnus-sum.el (gnus-summary-isearch-article): Don't bind - `isearch-lazy-highlight'. + * lisp/gnus-art.el (gnus-article-mime-edit-exit): Bind + `mime-edit-insert-user-agent-field' to nil while `mime-edit-exit' + is being done; turn off font-lock first; query if the buffer is + modified. + (gnus-article-mime-edit-done): New function. + (gnus-article-mime-edit-article-setup): Make the window fill its + frame; clear the buffere modified flag; substitute key definition + `gnus-article-edit-done' with `gnus-article-mime-edit-done'; don't + turn off font-lock here; bind `mime-edit-insert-user-agent-field' + to nil while `mime-edit-exit' is being done. + (gnus-article-mime-edit-article-unwind): Turn off font-lock first. -1999-08-30 Katsumi Yamaoka +2001-02-23 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 01. + * lisp/dgnushack.el: Don't require `emu'. - * lisp/lpath.el (babel-as-string): Bind it. +2001-02-16 Katsumi Yamaoka - * 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. + * lisp/message.el (message-forward-subject-author-subject): Decode + `From' field. + +2001-02-16 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 08. -1999-08-29 Katsumi Yamaoka + * lisp/gnus-sum.el (gnus-get-newsgroup-headers-xover): Don't use + `gnus-retrieve-parsed-headers' when the backend is nnimap. It is + only a temporary fix for an infloop on nnimap. FIXME!!! + (gnus-select-newsgroup): Ditto. - * lisp/gnus.el (gnus-version-number): Update to 6.13.1. - (gnus-revision-number): Clear to 00. +2001-02-16 Katsumi Yamaoka - * README.T-gnus: Update. + * texi/gnus-ja.texi (New features in Gnus 5.8): Remove annotation + about `gnus-article-display-hook.' + * texi/gnus-faq-ja.texi (Q2.1): Remove mention of + `gnus-article-display-hook.' - * 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-article-display-hook): Abolished. - * 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-uu.el (gnus-uu-grab-articles): Don't care about + `gnus-article-display-hook'. + * lisp/gnus-sum.el (gnus-summary-show-article): Ditto. + (gnus-summary-search-article): Ditto. + + * lisp/gnus-bbdb.el (gnus-bbdb-insinuate): Use + `gnus-article-prepare-hook' instead of `gnus-article-display-hook'. - * 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'. + * lisp/gnus-art.el (gnus-article-prepare-display): Evaluate + `gnus-article-prepare-hook' after an article has been prepared; + don't evaluate `gnus-article-display-hook'. -1999-08-25 Daiki Ueno +2001-02-15 Katsumi Yamaoka - * lisp/gnus-group.el (gnus-group-line-format): Fix typo in - documentation. + * lisp/message.el (message-cite-original-without-signature): + Extract from field for the simple citation line. - * lisp/gnus-sum.el (gnus-summary-mode): Don't set - `gnus-newsgroup-incorporated' explicitly. +2001-02-14 Katsumi Yamaoka -1999-08-24 Katsumi Yamaoka + * lisp/gnus-vers.el (gnus-revision-number): Increment to 07. - * 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. + * lisp/dgnushack.el (dgnushack-make-autoloads): Remove function. + (dgnushack-make-load): Ignore cus-load.el if it does not exist. + (dgnushack-make-auto-load): Remove auto-autoloads.el. + (dgnushack-make-cus-load): Do nothing if loading cus-dep is failed. -1999-08-24 Daiki Ueno + * lisp/Makefile.in (clean): Remove gnus-load.el instead of + custom-load.el. + (compose-package): Call `gnus-load.elc' and then rename + gnus-load.el(c) to auto-autoloads.el(c) instead of the use of + `dgnushack-make-autoloads'. + (clever): No need to remove custom-load.el. - * lisp/gnus.el (gnus-revision-number): Increment to 11. - (gnus-summary-incorporated-face): New face spec. + * Makefile.in (elclean): Remove gnus-load.el instead of + custom-load.el. - * 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'. + * aclocal.m4 (AC_CHECK_URL): Ignore cache. - * lisp/nnmail.el (nnmail-new-mail-numbers): New function. +2001-02-13 Katsumi Yamaoka - * lisp/gnus-srvr.el (gnus-browse-foreign-server): Don't prepend - `K' if the group has already been subscribed. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 06. -1999-08-24 Katsumi Yamaoka +2001-02-11 18:00:00 ShengHuo ZHU - * 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. + * GNUS-NEWS: Copyright and others. - * lisp/gnus-util.el (gnus-eval-in-buffer-window): Select the last - selected frame. +2001-02-09 20:00:00 ShengHuo ZHU -1999-08-23 Katsumi Yamaoka + * aclocal.m4 (AC_CHECK_URL): Add. - * lisp/gnus.el (gnus-revision-number): Increment to 10. + * configure.in: Use it. - * 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. +2001-02-08 Katsumi Yamaoka - * 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'. + * lisp/nnshimbun.el (nnshimbun-fml-get-headers): Fix unbalanced + parentheses. -1999-08-20 Tsukamoto Tetsuo +2001-02-08 Akihiro Arisawa - * lisp/gnus.el (gnus-revision-number): Increment to 09. + * lisp/nnshimbun.el: Add `bbdb-ml' support. - * 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. +2001-02-02 Akihiro Arisawa - * 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. + * lisp/nnshimbun.el (nnshimbun-type-definition): Follow URL change + of `xemacs'. + (nnshimbun-xemacs-get-headers): Ditto. - * README-offline.en : Update. - * README-offline.ja : Ditto. +2001-02-06 Katsumi Yamaoka -1999-08-20 Daiki Ueno + * README-gnus-bbdb.{en,ja}: Update the patch for BBDB v2.2. - * lisp/gnus-sum.el (gnus-wheel-summary-scroll): Bind - `inhibit-read-only' to t; bind `buffer-read-only' to nil. +2001-02-01 Katsumi Yamaoka -1999-08-20 Katsumi Yamaoka + * texi/Makefile.in (.texi, %.info): Don't use makeinfo command when + gnus-ja.texi or message-ja.texi is given. It is needed for some + make command if which can not understand "%-ja:" or "%-ja.info:". - * lisp/gnus.el (gnus-revision-number): Increment to 08. +2001-01-31 Katsumi Yamaoka -1999-08-19 Keiichi Suzuki + * lisp/gnus-sum.el (gnus-summary-display-article): Replace + `mm-enable-multibyte-mule4' with `set-buffer-multibyte'. - * lisp/nnmail.el (nnmail-split-it): Match whole word for getting - group name with `\N'. +2001-01-29 Katsumi Yamaoka -1999-08-19 Daiki Ueno + * lisp/gnus-art.el (gnus-article-mime-edit-exit): Use + `buffer-substring-no-properties' instead of `format'. - * lisp/gnus.el (gnus-revision-number): Increment to 07. +2001-01-23 TAKAHASHI Kaoru - * 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'. + * texi/ptexinfmt.el: Support @letterpaper and @afivepaper. -1999-08-18 Daiki Ueno +2001-01-22 Katsumi Yamaoka - * lisp/pop3.el (pop3-get-extended-response): Fix regexp. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 05. -1999-08-18 Katsumi Yamaoka + * Makefile.in (install-package-lisp): Use + `install-without-compiling' instead of `install'. - * lisp/gnus.el (gnus-revision-number): Increment to 06. + * lisp/Makefile.in (install): Use `install-without-compiling'. + (install-without-compiling): New target. - * 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. +2001-01-22 Katsumi Yamaoka -1999-08-18 Daiki Ueno + * texi/Makefile.in (.texi, %.info, %-ja.info, %-ja): Use + `infohack-texi-format'. - * lisp/pop3.el (pop3-retr): Undo last change. + * texi/infohack: (infohack-texi-format): New function. + * lisp/dgnushack.el (dgnushack-texi-format): Move to + texi/infohack.el and rename. + (dgnushack-texi-add-suffix-and-format): Remove. -1999-08-17 Daiki Ueno + * texi/ptexinfmt.el: New file. + * lisp/ptexinfmt.el: Move to texi/. - * lisp/gnus.el (gnus-revision-number): Increment to 05. +2001-01-18 Katsumi Yamaoka - * 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. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. -1999-08-17 Katsumi Yamaoka +2001-01-17 Katsumi Yamaoka - * lisp/gnus.el (gnus-revision-number): Increment to 04. + * lisp/dgnushack.el (dgnushack-make-autoloads): Do nothing if the + files for autoloads already exist. + (dgnushack-unexporting-files): More useful message. - * lisp/gnus-sum.el (gnus-wheel-summary-scroll): Use - `event-basic-type' instead of `event-button' under FSF Emacsen. + * lisp/Makefile.in (install): Call `clever' before installing. + (install-lisp): Remove. + (clever): Check for whether the all elc files should be recompiled. -1999-08-16 Katsumi Yamaoka + * Makefile.in (xclever): New target. + (install-package-lisp): Replace `install-lisp' with `install'. + (install-package-ja): Replace `xlick' with `xclever'. + (install-package): Ditto. - * lisp/gnus.el (gnus-revision-number): Increment to 03. +2001-01-17 KOSEKI Yoshinori -1999-08-16 Daiki Ueno + * Makefile.in: Unset `PWD' for Meadow/NTEmacs. - * 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. +2001-01-15 Jesper Harder -1999-08-16 Katsumi Yamaoka + * make.bat: Fix doc. - * lisp/gnus.el (gnus-revision-number): Increment to 02. +2001-01-15 Katsumi Yamaoka - * lisp/nnheader.el (make-full-mail-header-from-decoded-header): Use - `defun' instead of `defsubst'. - (make-full-mail-header): Ditto. + * lisp/nnheader.el: Require `pces', `poem' and `std11' to reduce + the required value of `recursive-load-depth-limit' for Emacs 21. - * lisp/dgnushack.el (dgnushack-texi-format): Fold up long lines. - (TopLevel): Autoload "texinfmt" for avoiding byte compile warning. + * lisp/message.el (message-followup): Handle "Mail-Copies-To:" + correctly. + (message-get-reply-headers): Ditto. -1999-08-16 Tsukamoto Tetsuo +2001-01-15 Keiichi Suzuki - * lisp/gnus.el (gnus-revision-number): Increment to 01. + * lisp/gnus-bbdb.el (gnus-bbdb/update-record): Save excursion + while `bbdb-annotate-message-sender' is being done. - * lisp/gnus-draft.el (gnus-group-send-drafts): Say which message - is being sent. +2001-01-13 Kinji Itoh - * 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. + * Makefile.in (install-package-lisp): Specify EMACS=$(XEMACS). -1999-08-15 Daiki Ueno +2001-01-11 Katsumi Yamaoka - * 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. + * lisp/gnus-msg.el (gnus-copy-article-buffer): Remove smiley + extents for XEmacs 21.1 using `format'. -1999-08-04 Katsumi Yamaoka + * lisp/dgnushack.el (dgnushack-texi-format): Cancel last change. - * lisp/gnus.el: T-gnus 6.13.0 is released. +2001-01-10 Katsumi Yamaoka -1999-08-04 Katsumi Yamaoka + * lisp/gnus-vers.el (gnus-revision-number): Increment to 03. - * ChangeLog.2: New file, rename from ChangeLog. + * lisp/gnus.el: Don't autoload "smiley" for `smiley-toggle-buffer'; + don't autoload "gnus-bitmap" or "x-face-mule" when Emacs 21 is + running. - * lisp/dgnushack.el (TopLevel): Rearrange. + * lisp/gnus-art.el (TopLevel): Autoload "gnus-bitmap" for + `smiley-toggle-buffer' when compiling. + (gnus-treatment-function-alist): Use `gnus-smiley-display' for + `gnus-treat-display-smileys' by default when XEmacs or Emacs 21 is + running. + (gnus-treat-display-smileys): Check for `smiley-mule' instead of + `gnus-bitmap'. + (gnus-article-x-face-command): Don't check for xbm for x-face-e21. - * README.branch.ja: Update for t-gnus-6_12 and t-gnus-6_13 branch. - * README.branch: Ditto. +2001-01-05 Katsumi Yamaoka - * texi/gnus-faq.texi: Replace ftp.jaist.ac.jp with ftp.etl.go.jp. + * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. - * 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. + * lisp/dgnushack.el (dgnushack-texi-format): Remove "@anchor" if it + is not supported. + +2000-12-26 Katsumi Yamaoka + + * lisp/gnus.el: Bind `:parameter-type', `:parameter-document', + `:function', `:function-document', `:variable', + `:variable-document', `:variable-group', `:variable-type' and + `:variable-default' for old Emacsen. + +2000-12-22 Katsumi Yamaoka + + * lisp/gnus-vers.el (gnus-revision-number): Increment to 01. + + * configure: Regenerate. + * configure.in: Add `AC_PATH_ETCDIR'. + * Makefile.in (install-etc): New target. + + * lisp/nnheader.el (mm-image-load-path): Alias to + `nnheader-image-load-path'. + (nnheader-image-load-path): New function copied from + the function `mm-image-load-path' in mm-util.el. + + * lisp/drums.el: Remove. + +2000-12-22 03:00:00 ShengHuo ZHU + + * configure.in: Add etc/Makefile. + +2000-12-22 Katsumi Yamaoka + + * lisp/gnus-msg.el (gnus-debug): Use `sit-for' in the inside of + `save-excursion'. + (gnus-bug): Pop up the sending buffer first. + + * lisp/gnus-art.el (article-treat-dumbquotes): Quote backslashes in + doc-string. + + * lisp/dgnushack.el + (byte-compile-file-form-custom-declare-variable): Use `defvar' + instead of `custom-declare-variable' to make the variable + uncustomizable if the arguments has the keyword `:version'. + +2000-12-22 Katsuhiro Hermit Endo + + * README.semi.ja: Fix typo. + +2000-12-21 Katsumi Yamaoka + + * lisp/lpath.el: Fbind `compose-mail' for Mule. + + * lisp/dgnushack.el (TopLevel): Byte-optimize + `custom-declare-variable', `custom-declare-group, and + `custom-declare-face' to omit unsupported keywords when Mule is + running. + +2000-12-20 Katsumi Yamaoka + + * lisp/gnus-vers.el: T-gnus 6.15.0 revision 00. + + * 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'. + + * lisp/lpath.el (TopLevel): Fbind `shell-command-to-string' for + Mule. + (TopLevel): Don't require `custom' here. + +2000-12-20 Jesper Harder + + * make.bat: set max-lisp-eval-depth. - * t-gnus-6_13: NEW PUBLIC BRANCH. +See ChangeLog.3 for earlier changes. -See ChangeLog.2 for earlier changes. +;; Local Variables: +;; coding: iso-2022-7bit +;; End: diff --git a/ChangeLog.1 b/ChangeLog.1 index 2b2a04e..711e7f1 100644 --- a/ChangeLog.1 +++ b/ChangeLog.1 @@ -4119,3 +4119,7 @@ (message-send-news-with-gnus): New function. (message-cancel-news): Use `message-send-news' instead of `message-send-news-function'. + +;; Local Variables: +;; coding: iso-2022-7bit +;; End: diff --git a/ChangeLog.2 b/ChangeLog.2 index 616c7b3..fad70e3 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -618,3 +618,7 @@ (initialize-instance): New method. See ChangeLog.1 for earlier changes. + +;; Local Variables: +;; coding: iso-2022-7bit +;; End: diff --git a/ChangeLog.3 b/ChangeLog.3 new file mode 100644 index 0000000..d661655 --- /dev/null +++ b/ChangeLog.3 @@ -0,0 +1,2920 @@ +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. + +;; Local Variables: +;; coding: iso-2022-7bit +;; End: diff --git a/GNUS-NEWS b/GNUS-NEWS index 057a7f6..79b7cf7 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -1,10 +1,466 @@ -** Gnus changes. +GNUS NEWS -- history of user-visible changes. +Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +See the end for copying conditions. + +Please send Gnus bug reports to bugs@gnus.org. +For older news, see Gnus info node "New Features". + + +* Changes in Oort Gnus + +** The revised Gnus FAQ is included in the manual. +See the info node "Frequently Asked Questions". + +** Upgrading from previous (stable) version if you have used Oort. + +If you have tried Oort (the unstable Gnus branch leading to this +release) but went back to a stable version, be careful when upgrading +to this version. In particular, you will probably want to remove all +.marks (nnml) and .mrk (nnfolder) files, so that flags are read from +your ~/.newsrc.eld instead of from the .marks/.mrk file where this +release store flags. See a later entry for more information about +marks. Note that downgrading isn't save in general. + +** Article Buttons + +More buttons for URLs, mail addresses, Message-IDs, Info links, man pages and +Emacs or Gnus related references, see the info node "Article Buttons". The +variables `gnus-button-*-level' can be used to control the appearance of all +article buttons, see the info node "Article Button Levels". + +** Dired integration +`gnus-dired-minor-mode' installs key bindings in dired buffers to send +a file as an attachment (`C-c C-a'), open a file using the approriate +mailcap entry (`C-c C-l'), and print a file using the mailcap entry +(`C-c P'). It is enabled with + + (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) + +** Gnus can display RSS newsfeeds as a newsgroup. To get started do `B +nnrss RET RET' in the Group buffer. + +** Single-part yenc encoded attachments can be decoded. + +** Picons +The picons code has been reimplemented to work in GNU Emacs -- some of +the previous options have been removed or renamed. + +Picons are small "personal icons" representing users, domain and +newsgroups, which can be displayed in the Article buffer. To enable +picons, install the picons database from + + http://www.cs.indiana.edu/picons/ftp/index.html + +and point `gnus-picon-databases' to that location. + +** If the new option `gnus-treat-body-boundary' is `head', a boundary +line is drawn at the end of the headers. + +** Retrieval of charters and control messages +There are new commands for fetching newsgroup charters (`H c') and +control messages (`H C'). + +** Delayed articles +You can delay the sending of a message with `C-c C-j' in the Message +buffer. The messages are delivered at specified time. This is useful +for sending yourself reminders. Setup with (gnus-delay-initialize). + +** If `auto-compression-mode' is enabled, attachments are automatically +decompressed when activated. + +** If the new option `nnml-use-compressed-files' is non-nil, +the nnml back end allows compressed message files. + +** Signed article headers (X-PGP-Sig) can be verified with `W p'. + +** The Summary Buffer uses an arrow in the fringe to indicate the current +article. Use (setq gnus-summary-display-arrow nil) to disable it. + +** Warn about email replies to news +Do you often find yourself replying to news by email by mistake? Then +the new option `gnus-confirm-mail-reply-to-news' is just the thing for +you. + +** If the new option `gnus-summary-display-while-building' is non-nil, +the summary buffer is shown and updated as it's being built. + +** The new `recent' mark "." indicates newly arrived messages (as +opposed to old but unread messages). + +** The new option `gnus-gcc-mark-as-read' automatically marks +Gcc articles as read. + +** The nndoc back end now supports mailman digests and exim bounces. + +** Gnus supports RFC 2369 mailing list headers, and adds a number of +related commands in mailing list groups. + +** The Date header can be displayed in a format that can be read aloud +in English, see `gnus-treat-date-english'. + +** The envelope sender address can be customized when using Sendmail, see +`message-sendmail-envelope-from'. + +** diffs are automatically highlighted in groups matching +`mm-uu-diff-groups-regexp' + +** TLS wrapper shipped with Gnus + +TLS/SSL is now supported in IMAP and NNTP via tls.el and GNUTLS. The +old TLS/SSL support via (external third party) ssl.el and OpenSSL +still works. + +** New make.bat for compiling and installing Gnus under MS Windows + +Use make.bat if you want to install Gnus under MS Windows, the first +argument to the batch-program should be the directory where xemacs.exe +respectively emacs.exe is located, iff you want to install Gnus after +compiling it, give make.bat /copy as the second parameter. + +Make.bat has been rewritten from scratch, it now features automatic +recognition of XEmacs and GNU Emacs, generates gnus-load.el, checks if +errors occur while compilation and generation of info files and reports +them at the end of the build process. It now uses makeinfo if it is +available and falls back to infohack.el otherwise. Make.bat should now +install all files which are necessary to run Gnus and be generally a +complete replacement for the "configure; make; make install" cycle used +under Unix systems. + +The new make.bat makes make-x.bat superfluous, so it has been removed. + +** Support for non-ASCII domain names + +Message supports non-ASCII domain names in From:, To: and Cc: and will +query you whether to perform encoding when you try to send a message. +The variable `message-use-idna' controls this. Gnus will also decode +non-ASCII domain names in From:, To: and Cc: when you view a message. +The variable `gnus-use-idna' controls this. + +** Better handling of Microsoft citation styles + +Gnus now tries to recognize the mangled header block that some Microsoft +mailers use to indicate that the rest of the message is a citation, even +though it is not quoted in any way. The variable +`gnus-cite-unsightly-citation-regexp' matches the start of these +citations. + +** gnus-article-skip-boring + +If you set `gnus-article-skip-boring' to t, then Gnus will not scroll +down to show you a page that contains only boring text, which by +default means cited text and signature. You can customize what is +skippable using `gnus-article-boring-faces'. + +This feature is especially useful if you read many articles that +consist of a little new content at the top with a long, untrimmed +message cited below. + +** The format spec %C for positioning point has changed to %*. + +** The new variable `gnus-parameters' can be used to set group parameters. + +Earlier this was done only via `G p' (or `G c'), which stored the +parameters in ~/.newsrc.eld, but via this variable you can enjoy the +powers of customize, and simplified backups since you set the variable +in ~/.emacs instead of ~/.newsrc.eld. The variable maps regular +expressions matching group names to group parameters, a'la: + + (setq gnus-parameters + '(("mail\\..*" + (gnus-show-threads nil) + (gnus-use-scoring nil)) + ("^nnimap:\\(foo.bar\\)$" + (to-group . "\\1")))) + +** Smileys (":-)", ";-)" etc) are now iconized for Emacs too. + +Put (setq gnus-treat-display-smileys nil) in ~/.emacs to disable it. + +** Gnus no longer generate the Sender: header automatically. + +Earlier it was generated iff the user configurable email address was +different from the Gnus guessed default user address. As the guessing +algorithm is rarely correct these days, and (more controversally) the +only use of the Sender: header was to check if you are entitled to +cancel/supersede news (which is now solved by Cancel Locks instead, +see another entry), generation of the header has been disabled by +default. See the variables `message-required-headers', +`message-required-news-headers', and `message-required-mail-headers'. + +** Features from third party message-utils.el added to message.el. + +Message now asks if you wish to remove "(was: )" from +subject lines (see `message-subject-trailing-was-query'). C-c M-m and +C-c M-f inserts markers indicating included text. C-c C-f a adds a +X-No-Archive: header. C-c C-f x inserts appropriate headers and a +note in the body for cross-postings and followups (see the variables +`message-cross-post-*'). + +** References and X-Draft-Headers are no longer generated when you + start composing messages and `message-generate-headers-first' is nil. + +** Improved anti-spam features. + +Gnus is now able to take out spam from your mail and news streams +using a wide variety of programs and filter rules. Among the supported +methods are RBL blocklists, bogofilter and white/blacklists. Hooks +for easy use of external packages such as SpamAssassin and Hashcash +are also new. + +** Easy inclusion of X-Faces headers. + +** In the summary buffer, the new command / N inserts new messages and +/ o inserts old messages. + +** Gnus decodes morse encoded messages if you press W m. + +** Unread count correct in nnimap groups. + +The estimated number of unread articles in the group buffer should now +be correct for nnimap groups. This is achieved by calling +`nnimap-fixup-unread-after-getting-new-news' from the +`gnus-setup-news-hook' (called on startup) and +gnus-after-getting-new-news-hook. (called after getting new mail). If +you have modified those variables from the default, you may want to +add n-f-u-a-g-n-n again. If you were happy with the estimate and want +to save some (minimal) time when getting new mail, remove the +function. + +** Group Carbon Copy (GCC) quoting + +To support groups that contains SPC and other weird characters, groups +are quoted before they are placed in the Gcc: header. This means +variables such as `gnus-message-archive-group' should no longer +contain quote characters to make groups containing SPC work. Also, if +you are using the string "nnml:foo, nnml:bar" (indicating Gcc into two +groups) you must change it to return the list ("nnml:foo" "nnml:bar"), +otherwise the Gcc: line will be quoted incorrectly. Note that +returning the string "nnml:foo, nnml:bar" was incorrect earlier, it +just didn't generate any problems since it was inserted directly. + +** ~/News/overview/ not used. + +As a result of the following change, the ~/News/overview/ directory is +not used any more. You can safely delete the entire hierarchy. + +** gnus-agent + +The Gnus Agent has seen a major updated and is now enabled by default, +and all nntp and nnimap servers from gnus-select-method and +gnus-secondary-select-method are agentized by default. Earlier only +the server in gnus-select-method was agentized by the default, and the +agent was disabled by default. When the agent is enabled, headers are +now also retrieved from the Agent cache instead of the backends when +possible. Earlier this only happened in the unplugged state. You can +enroll or remove servers with `J a' and `J r' in the server buffer. +Gnus will not download articles into the Agent cache, unless you +instruct it to do so, though, by using `J u' or `J s' from the Group +buffer. You revert to the old behaviour of having the Agent disabled +with `(setq gnus-agent nil)'. Note that putting (gnus-agentize) in +~/.gnus is not needed any more. + +** gnus-summary-line-format + +The default value changed to "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n". +Moreover gnus-extra-headers, nnmail-extra-headers and +gnus-ignored-from-addresses changed their default so that the users +name will be replaced by the recipient's name or the group name +posting to for NNTP groups. + +** deuglify.el (gnus-article-outlook-deuglify-article) + +A new file from Raymond Scholz for deuglifying +broken Outlook (Express) articles. + +** (require 'gnus-load) + +If you use a stand-alone Gnus distribution, you'd better add (require +'gnus-load) into your ~/.emacs after adding the Gnus lisp directory +into load-path. + +File gnus-load.el contains autoload commands, functions and variables, +some of which may not be included in distributions of Emacsen. + +** gnus-slave-unplugged + +A new command which starts gnus offline in slave mode. + +** message-insinuate-rmail + +Adding (message-insinuate-rmail) and (setq mail-user-agent +'gnus-user-agent) in .emacs convinces Rmail to compose, reply and +forward messages in message-mode, where you can enjoy the power of +MML. + +** message-minibuffer-local-map + +The line below enables BBDB in resending a message: + +(define-key message-minibuffer-local-map [(tab)] 'bbdb-complete-name) + +** Externalizing and deleting of attachments. + +If gnus-gcc-externalize-attachments (or +message-fcc-externalize-attachments) is non-nil, attach local files as +external parts. + +The command gnus-mime-save-part-and-strip (bound to `C-o' on MIME +buttons) saves a part and replaces the part with an external one. +gnus-mime-delete-part (bound to `d' on MIME buttons) removes a part. +It works only on back ends that support editing. + +** gnus-default-charset + +The default value is determined from the current-language-environment +variable, instead of 'iso-8859-1. Also the ".*" item in +gnus-group-charset-alist is removed. + +** gnus-posting-styles + +Add a new format of match like + + ((header "to" "larsi.*org") + (Organization "Somewhere, Inc.")) + +The old format like the lines below is obsolete, but still accepted. + + (header "to" "larsi.*org" + (Organization "Somewhere, Inc.")) + +** message-ignored-news-headers and message-ignored-mail-headers + +X-Draft-From and X-Gnus-Agent-Meta-Information have been added into +these two variables. If you customized those, perhaps you need add +those two headers too. + +** Gnus reads the NOV and articles in the Agent if plugged. + +If one reads an article while plugged, and the article already exists +in the Agent, it won't get downloaded once more. (setq +gnus-agent-cache nil) reverts to the old behavior. + +** Gnus supports the "format=flowed" (RFC 2646) parameter. + +On composing messages, it is enabled by `use-hard-newlines'. Decoding +format=flowed was present but not documented in earlier versions. + +** Gnus supports the generation of RFC 2298 Disposition Notification requests. + +This is invoked with the C-c M-n key binding from message mode. + +** Gnus supports Maildir groups. + +Gnus includes a new backend nnmaildir.el. + +** Printing capabilities are enhanced. + +Gnus supports Muttprint natively with O P from the Summary and Article +buffers. Also, each individual MIME part can be printed using p on +the MIME button. + +** Message supports the Importance: (RFC 2156) header. + +In the message buffer, `C-c C-f C-i' or `C-c C-u' cycles through the +valid values. + +** Gnus supports Cancel Locks in News. + +This means a header "Cancel-Lock" is inserted in news posting. It is +used to determine if you wrote a article or not (for cancelling and +superseding). Gnus generates a random password string the first time +you post a message, and saves it in your ~/.emacs using the Custom +system. While the variable is called `canlock-password', it is not +security sensitive data. Publishing your canlock string on the web +will not allow anyone to be able to anything she could not already do. +The behaviour can be changed by customizing `message-insert-canlock'. + +** Gnus supports server-side mail filtering using Sieve. + +Sieve rules can be added as Group Parameters for groups, and the +complete Sieve script is generated using `D g' from the Group buffer, +and then uploaded to the server using `C-c C-l' in the generated Sieve +buffer. Search the online Gnus manual for "sieve", and see the new +Sieve manual, for more information. + +** Extended format specs. + +Format spec "%&user-date;" is added into +gnus-summary-line-format-alist. Also, user defined extended format +specs are supported. The extended format specs look like "%u&foo;", +which invokes function gnus-user-format-function-foo. Because "&" is +used as the escape character, old user defined format "%u&" is no +longer supported. + +** `/ *' (gnus-summary-limit-include-cached) is rewritten. + +It was aliased to `Y c' (gnus-summary-insert-cached-articles). The new +function filters out other articles. + +** Some limiting commands accept a C-u prefix to negate the match. + +If C-u is used on subject, author or extra headers, i.e., `/ s', `/ +a', and `/ x' (gnus-summary-limit-to-{subject,author,extra}) +respectively, the result will be to display all articles that do not +match the expression. + +** Group names are treated as UTF-8 by default. + +This is supposedly what USEFOR wanted to migrate to. See +`gnus-group-name-charset-group-alist' and +`gnus-group-name-charset-method-alist' for customization. + +** The nnml and nnfolder backends store marks for each groups. + +This makes it possible to take backup of nnml/nnfolder servers/groups +separately of ~/.newsrc.eld, while preserving marks. It also makes it +possible to share articles and marks between users (without sharing +the ~/.newsrc.eld file) within e.g. a department. It works by storing +the marks stored in ~/.newsrc.eld in a per-group file ".marks" (for +nnml) and "groupname.mrk" (for nnfolder, named "groupname"). If the +nnml/nnfolder is moved to another machine, Gnus will automatically use +the .marks or .mrk file instead of the information in ~/.newsrc.eld. +The new server variables `nnml-marks-is-evil' and +`nnfolder-marks-is-evil' can be used to disable this feature. + +** The menu bar item (in Group and Summary buffer) named "Misc" has +been renamed to "Gnus". + +** The menu bar item (in Message mode) named "MML" has been renamed to +"Attachments". Note that this menu also contains security related +stuff, like signing and encryption. + +** gnus-group-charset-alist and gnus-group-ignored-charsets-alist. + +The regexps in these variables are compared with full group names +instead of real group names in 5.8. Users who customize these +variables should change those regexps accordingly. For example: + + ("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr) + +** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and +** S/MIME (RFC 2630-2633). +It needs an external S/MIME and OpenPGP implementation, but no +additional lisp libraries. This add several menu items to the +Attachments menu, and C-c RET key bindings, when composing messages. +This also obsoletes `gnus-article-hide-pgp-hook'. + +** Gnus inlines external parts (message/external). + +** 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. + +** Bug fixes. + + +* Changes in Pterodactyl Gnus (5.8/5.9) The Gnus NEWS entries are short, but they reflect sweeping changes in four areas: Article display treatment, MIME treatment, internationalization and mail-fetching. -*** The mail-fetching functions have changed. See the manual for the +** 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 @@ -23,30 +479,47 @@ this now has changed to 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 is now a MIME-capable reader. This affects many parts of Gnus, and adds a slew of new commands. See the manual for details. -*** Gnus has also been multilingualized. This also affects too +** Gnus has also been multilingualized. This also affects too many parts of Gnus to summarize here, and adds many new variables. -*** gnus-auto-select-first can now be a function to be +** gnus-auto-select-first can now be a function to be called to position point. -*** The user can now decide which extra headers should be included in +** The user can now decide which extra headers should be included in summary buffers and NOV files. -*** `gnus-article-display-hook' has been removed. Instead, a number +** `gnus-article-display-hook' has been removed. Instead, a number of variables starting with `gnus-treat-' have been added. -*** The Gnus posting styles have been redone again and now works in a +** The Gnus posting styles have been redone again and now works in a subtly different manner. -*** New web-based backends have been added: nnslashdot, nnwarchive +** New web-based backends have been added: nnslashdot, nnwarchive and nnultimate. nnweb has been revamped, again, to keep up with ever-changing layouts. -*** Gnus can now read IMAP mail via nnimap. +** Gnus can now read IMAP mail via nnimap. + + +* For older news, see Gnus info node "New Features". + +---------------------------------------------------------------------- +Copyright information: + +Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. + + Permission is granted to anyone to make or distribute verbatim copies + of this document as received, in any medium, provided that the + copyright notice and this permission notice are preserved, + thus giving the recipient permission to redistribute in turn. + Permission is granted to distribute modified versions + of this document, or of portions of it, + under the above conditions, provided also that they + carry prominent notices stating who last changed them. Local variables: mode: outline diff --git a/INSTALL.ja b/INSTALL.ja new file mode 100644 index 0000000..bb14b03 --- /dev/null +++ b/INSTALL.ja @@ -0,0 +1,91 @@ +T-gnus $B$N%$%s%9%H!<%kJ}K!(B +========================= + +$BI,MW$J$b$N(B +========== + +T-gnus $B$rMxMQ$9$k$K$O!"0J2<$K<($9%P!<%8%g%s$N(B APEL, FLIM $B$*$h$S(B SEMI +$B%Q%C%1!<%8$,I,MW$G$9$N$G!"(BT-gnus $B$r%$%s%9%H!<%k$9$kA0$K$=$l$i$r%$%s%9(B +$B%H!<%k$7$F$/$@$5$$!#(B + +o APEL 10.0 $B0J>e(B +o FLIM 1.14 +o SEMI 1.14 + +$B$=$l$>$l!"(B + +ftp://ftp.m17n.org/pub/mule/apel/ +ftp://ftp.m17n.org/pub/mule/flim/flim-1.14/ +ftp://ftp.m17n.org/pub/mule/semi/semi-1.14-for-flim-1.14/ + +$B$+$i%@%&%s%m!<%I$9$k$3$H$,$G$-$^$9!#(B + +configure $B$Nl9g$O!"(B`make all-ja' $B$rl9g$O!"(B +`make install-ja' $B$rl9g!"(B`make install-package' $B$^$?$O(B `make install-package-ja' +$B$re5-$N%U%!%$%k$,E,@Z$K%$%s%9%H!<%k$5$l$^$9!#(B + +T-gnus $B$N=`Hw(B +============= + +o SEMI $B$r;H$&$h$&$K(B ~/.emacs $B$K0J2<$rDI2C$7$^$9(B + + (load "mime-setup") + +o configure $B$N(B --with-lispdir $B%*%W%7%g%s$G;XDj$7$?%G%#%l%/%H%j(B ($BNc$($P(B + /usr/local/share/emacs/site-lisp/t-gnus) $B$r(B load-path $B$KDI2C$7$^$9(B + + ;; mime-setup $B$r(B load $B$7$F$$$k$H(B add-path $B$H$$$&4X?t$,;H$($^$9(B + (add-path "/usr/local/share/emacs/site-lisp/t-gnus") + +T-gnus $B$N2A$9$k$H(B T-gnus $B$,5/F0$7$^$9!#:G=i$K8=$l$k(B *Group* $B%P%C%U%!$J$I$G(B +C-c C-i $B$r%?%$%W$9$k$H!"$=$l$>$l$N5!G=$KBP1~$7$?(B info $B$r8+$k$3$H$,$G$-(B +$B$k$N$G!"MxMQJ}K!$K4X$9$k>\$7$$$3$H$K$D$$$F$O(B info $B$r;2>H$7$F$/$@$5$$!#(B diff --git a/Makefile.in b/Makefile.in index a1bd47d..69c491b 100644 --- a/Makefile.in +++ b/Makefile.in @@ -40,6 +40,7 @@ all-ja: lick info info-ja lick: cd lisp && $(MAKE) EMACS="$(EMACS)" lispdir="$(lispdir)" all +#install: install-lisp install-info install-etc install: install-lisp install-info install-ja: install install-info-ja @@ -50,22 +51,31 @@ install-lisp: install-info: cd texi && $(MAKE) EMACS="$(EMACS)" infodir="$(infodir)" install +install-etc: + cd etc && $(MAKE) EMACS="$(EMACS)" install + install-info-ja: cd texi && $(MAKE) EMACS="$(EMACS)" infodir="$(infodir)" install-ja ## Rule for XEmacs package. -install-package: xclever compose-package remove-extra-files-in-package \ +install-package: \ + xclever-package \ + compose-package \ + remove-extra-files-in-package \ install-package-lisp \ install-package-info install-package-manifest -install-package-ja: xclever compose-package remove-extra-files-in-package \ +install-package-ja: \ + xclever-package \ + 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: xlick-package xinfo compose-package -package-ja: xlick xinfo xinfo-ja compose-package +package-ja: xlick-package xinfo xinfo-ja compose-package # Sub-rule for XEmacs package. install-package-lisp: @@ -110,8 +120,10 @@ install-package-manifest: package_dir="$(PACKAGEDIR)"; \ fi; \ echo "cd lisp && $(MAKE) EMACS=$(XEMACS) PACKAGEDIR=$$package_dir" \ + "lispdir=$(PACKAGEDIR)/lisp/$(GNUS_PRODUCT_NAME)" \ "install-package-manifest"; \ cd lisp && $(MAKE) EMACS="$(XEMACS)" PACKAGEDIR=$$package_dir \ + lispdir="$(PACKAGEDIR)/lisp/$(GNUS_PRODUCT_NAME)" \ install-package-manifest remove-extra-files-in-package: @@ -121,26 +133,42 @@ remove-extra-files-in-package: package_dir="$(PACKAGEDIR)"; \ fi; \ echo "cd lisp && $(MAKE) EMACS=$(XEMACS) PACKAGEDIR=$$package_dir" \ + "lispdir=$(PACKAGEDIR)/lisp/$(GNUS_PRODUCT_NAME)" \ "remove-extra-files-in-package"; \ cd lisp && $(MAKE) EMACS="$(XEMACS)" PACKAGEDIR=$$package_dir \ + lispdir="$(PACKAGEDIR)/lisp/$(GNUS_PRODUCT_NAME)" \ remove-extra-files-in-package compose-package: - cd lisp && $(MAKE) EMACS="$(XEMACS)" compose-package + cd lisp && $(MAKE) EMACS="$(XEMACS)" \ + lispdir="$(PACKAGEDIR)/lisp/$(GNUS_PRODUCT_NAME)" compose-package ## xclever: cd lisp && $(MAKE) EMACS="$(XEMACS)" lispdir="$(lispdir)" clever +xclever-package: + cd lisp && $(MAKE) EMACS="$(XEMACS)" \ + lispdir="$(PACKAGEDIR)/lisp/$(GNUS_PRODUCT_NAME)" clever + xlick: cd lisp && $(MAKE) EMACS="$(XEMACS)" lispdir="$(lispdir)" all +xlick-package: + cd lisp && $(MAKE) EMACS="$(XEMACS)" \ + lispdir="$(PACKAGEDIR)/lisp/$(GNUS_PRODUCT_NAME)" all + xinfo: cd texi && $(MAKE) EMACS="$(XEMACS)" all-info xinfo-ja: cd texi && $(MAKE) EMACS="$(XEMACS)" ja-info +uninstall: + cd lisp && $(MAKE) lispdir="$(lispdir)" uninstall + cd texi && $(MAKE) uninstall + cd etc && $(MAKE) uninstall + # Rule for Lars and nobody else. some: cd lisp && $(MAKE) EMACS="$(EMACS)" some @@ -159,7 +187,7 @@ clean: for i in lisp texi; do (cd $$i; $(MAKE) clean); done elclean: - cd lisp && rm -f *.elc auto-autoloads.el custom-load.el + cd lisp && rm -f *.elc auto-autoloads.el custom-load.el gnus-load.el x: $(MAKE) EMACS="$(XEMACS)" @@ -169,7 +197,7 @@ xsome: distclean: clean rm -rf *~ - for i in lisp texi; do (cd $$i; $(MAKE) distclean); done + for i in lisp texi etc texi/ps; do (cd $$i; $(MAKE) distclean); done rm -f config.log config.status config.cache Makefile config.status: $(srcdir)/configure diff --git a/Mule23@1934.en b/Mule23@1934.en index 7a45479..9ed0acf 100644 --- a/Mule23@1934.en +++ b/Mule23@1934.en @@ -35,13 +35,17 @@ beginning of .emacs file instead of rebuilding Mule. (makunbound (intern (format "message-%s" symbol))))) -INSTALL CUSTOM, APEL, FLIM, SEMI/WEMI -===================================== +INSTALL CUSTOM, APEL, CLIME, SEMI +================================= -T-gnus requires the latest version of CUSTOM, APEL, FLIM and SEMI or -WEMI; you should install these packages before installing T-gnus. +T-gnus requires the latest version of CUSTOM, APEL, CLIME and SEMI; +CLIME 1.14 provides the same features as FLIM 1.14 for old Emacsen, +which is currently available from: -As for CUSTOM, you should apply the following patch before building it. +ftp://ftp.jpl.org/pub/m17n/clime-1_14-************.tar.gz + +You should install these packages before installing T-gnus. As for +CUSTOM, you should apply the following patch before building it. ------ cut here ------ cut here ------ cut here ------ cut here ------ --- custom-1.9962/cus-face.el~ Wed Mar 4 19:52:39 1998 @@ -62,18 +66,47 @@ By the way, the latest CUSTOM package for Emacs v19 is available from: ftp://ftp.dina.kvl.dk/pub/Staff/Per.Abrahamsen/custom/custom-1.9962.tar.gz +INSTALL regexp-opt.el +===================== + +Some T-gnus modules use the functions `regexp-opt', etc. That +functions are defined in regexp-opt.el(c) in the recent Emacsen, +however, Mule 2.3 does not contain it in the standard Lisp libraries. +Copy the file contrib/regexp-opt.el to site-lisp directory (or any +other directory), and byte-compile it as follows: + + % cp -p contrib/regexp-opt.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile regexp-opt.el + + +INSTALL passwd.el +================= + +This module provide the `read-passwd' function. You have to install +it if you don't have that function. To do this: + + % cp -p contrib/passwd.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile passwd.el + +And add the following line in your .emacs file: + + (autoload 'read-passwd "passwd") + + INSTALL T-gnus ============== There are three ways of making T-gnus with Mule 2.3 based on Emacs 19.34. -1. If you have installed EMU, APEL, FLIM and SEMI or WEMI packages - under the standard load-path, for instance: +1. If you have installed EMU, APEL, CLIME and SEMI packages under the + standard load-path, for instance: - 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/ + EMU: /usr/local/share/mule/19.34/site-lisp/ + APEL: /usr/local/share/mule/site-lisp/apel/ + CLIME: /usr/local/share/mule/site-lisp/flim/ + SEMI: /usr/local/share/mule/site-lisp/semi/ What is more, if you have been replaced old CUSTOM with new CUSTOM or if you have installed new CUSTOM directly under the standard @@ -103,45 +136,53 @@ There are three ways of making T-gnus with Mule 2.3 based on Emacs 19.34. % ./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: +2. If you have installed EMU, APEL, CLIME and SEMI 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. + In this case, you have no need to add paths of CLIME, SEMI 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. + APEL, CLIME and SEMI 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 -============== +USING emacs-w3m (and Emacs/W3) +============================== +The web based backend `nnshimbun' uses the shimbun modules which are +included in emacs-w3m package (and the other web based backends of T- +gnus requires Emacs/W3). emacs-w3m is an interface program to the +external command w3m, visit the following pages for more information. -;; 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 + http://emacs-w3m.namazu.org/ + http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/ -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: +If you wish to build T-gnus to be able to use emacs-w3m and nnshimbun, +you have to specify the path where emacs-w3m is installed using the +configure option `--with-addpath=' (for Emacs/W3, use the configure +option `--with-w3=' or editing the file `~/.lpath.el'). Here is an +example for that: % ./configure --with-emacs=mule\ + --with-addpath=~/elisp/emu/:~/elisp/apel/: ... :~/elisp/w3m/\ --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'. +;; 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'. + +;; By the way, does anyone know where do we find Emacs/W3 package +;; which is suitable to Mule 2.3 based on Emacs 19.34? diff --git a/Mule23@1934.ja b/Mule23@1934.ja index 5f79393..3bcdc8a 100644 --- a/Mule23@1934.ja +++ b/Mule23@1934.ja @@ -36,13 +36,18 @@ lisp/loaddefs.el $B$+$i:o=|$7$F!"(BMule $B$r:n$jD>$5$J$1$l$P$J$j$^$;$s!#(B (makunbound (intern (format "message-%s" symbol))))) -INSTALL CUSTOM, APEL, FLIM, SEMI -================================ +INSTALL CUSTOM, APEL, CLIME, SEMI +================================= -T-gnus $B$O:G?7HG$N(B CUSTOM, APEL, FLIM $B$*$h$S(B SEMI $B$+(B WEMI $B$rI,MW$H$7$^(B -$B$9!#$"$J$?$O$3$l$i$N%Q%C%1!<%8$r(B T-gnus $B$NA0$K%$%s%9%H!<%k$7$J$1$l$P$J(B -$B$j$^$;$s!#(BCUSTOM $B$K$D$$$F$O!":n$kA0$K$"$J$?$O0J2<$N%Q%C%A$rEv$F$kI,MW(B -$B$,$"$j$^$9!#(B +T-gnus $B$O:G?7HG$N(B CUSTOM, APEL, CLIME $B$*$h$S(B SEMI $B$rI,MW$H$7$^$9!#(B +CLIME 1.14 $B$O8E$$(B Emacs $B$K(B FLIM 1.14 $B$HF1$85!G=$rDs6!$9$k$b$N$G!"8=:_(B +$B0J2<$N$b$N$,F~(B +$B$N%G%#%l%/%H%j(B) $B$K%3%T!<$7$F!"(Bbyte-compile $B$7$F2<$5$$!#(B + + % cp -p contrib/regexp-opt.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile regexp-opt.el + + +INSTALL passwd.el +================= + +$B$3$N%b%8%e!<%k$O(B `read-passwd' $B4X?t$rDs6!$7$^$9!#L5$$>l9g$O%$%s%9%H!<(B +$B%k$7$J$1$l$P$J$j$^$;$s!#$=$l$K$O$3$&$7$F2<$5$$!#(B + + % cp -p contrib/passwd.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile passwd.el + +$B$=$7$F(B .emacs $B%U%!%$%k$K0J2<$N9T$rDI2C$7$F2<$5$$!#(B + + (autoload 'read-passwd "passwd") + + INSTALL T-gnus ============== 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. $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 +1. $B$b$7$"$J$?$,(B EMU, APEL, CLIME $B$*$h$S(B SEMI $B$N3F%Q%C%1!<%8$rI8=`$N(B + load-path $B$N2<$K%$%s%9%H!<%k$7$F$$$k$H$7$^$9!#Nc$($P$3$&!#(B - 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/ + EMU: /usr/local/share/mule/19.34/site-lisp/ + APEL: /usr/local/share/mule/site-lisp/apel/ + CLIME: /usr/local/share/mule/site-lisp/flim/ + SEMI: /usr/local/share/mule/site-lisp/semi/ $B$7$+$b!"$b$7$"$J$?$,8E$$(B CUSTOM $B$r?7$7$$(B CUSTOM $B$GCV$-49$($F$$$k$+!"(B $B?7$7$$(B CUSTOM $B$r(B /usr/local/share/mule/19.34/site-lisp/ $B$N$h$&$JI8(B @@ -106,47 +140,54 @@ 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!$ $B$H%?%$%W$7$F2<$5$$!#(B -2. $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=`$G$O$J$$(B load-path $B$K%$%s%9%H!<%k$7$F$$$k$J$i$P!"%3%m%s$G(B - $B6h@Z$i$l$?(B EMU, APEL $B$*$h$S(B CUSTOM $B$,%$%s%9%H!<%k$5$l$F$$$k%G%#%l(B - $B%/%H%jL>$H(B configure $B%*%W%7%g%s$N(B `--with-addpath=' $B$r;H$C$F2<$5$$!#(B - $BNc$($P(B +2. $B$b$7$"$J$?$,(B EMU, APEL, CLIME $B$*$h$S(B SEMI $B$N3F%Q%C%1!<%8$rI8=`$G$O(B + $B$J$$(B load-path $B$K%$%s%9%H!<%k$7$F$$$k$J$i$P!"%3%m%s$G6h@Z$i$l$?(B + EMU, APEL $B$*$h$S(B CUSTOM $B$,%$%s%9%H!<%k$5$l$F$$$k%G%#%l%/%H%jL>$H(B + configure $B%*%W%7%g%s$N(B `--with-addpath=' $B$r;H$C$F2<$5$$!#Nc$($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 + $B$3$N>l9g!"$b$7(B CLIME, SEMI $B$,(B APEL $B$N?F%G%#%l%/%H%j$HF1$8%G%#%l%/%H(B + $B%j$N2<$K%$%s%9%H!<%k$5$l$F$$$k$J$i$P!"$=$l$i$N(B path $B$rDI2C$9$kI,MW(B + $B$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$Fl9g$N!"JL$NJ}K!$G$9!#G[I[$K4^$^$l(B + $B$F$$$k%U%!%$%k(B `sample.lpath.el' $B$r(B `~/.lpath.el' $B$K%3%T!<$7$F!"$"(B + $B$J$?$N4D6-$K9g$&$h$&$K=q$-49$($F2<$5$$!#$=$7$F$N(B T-gnus $B$N%&%'%V$K(B +$B4p$E$$$?%P%C%/%(%s%I$O(B Emacs/W3 $B$rI,MW$H$7$^$9(B)$B!#(Bemacs-w3m $B$O30It%3%^(B +$B%s%I(B w3m $B$X$N%$%s%?!<%U%'!<%9$r9T$J$&%W%m%0%i%`$G!">\:Y>pJs$K$D$$$F$O(B +$B0J2<$N%Z!<%8$rK,$M$F$_$F2<$5$$!#(B + + http://emacs-w3m.namazu.org/ + http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/ -$B$$$/$D$+$N(B T-gnus $B$N%b%8%e!<%k(B ($BNc$($P(B nnshimbun) $B$O(B Emacs W3 $B$rI,MW$H(B -$B$7$^$9!#$b$7$"$J$?$,$9$G$K(B Emacs W3 $B$r%$%s%9%H!<%k$7$F$"$k$N$J$i$P!"$"(B -$B$J$?$O$=$l$i$r;H$($k$h$&$K(B T-gnus $B$r:n$k$3$H$,$G$-$^$9!#$=$N$?$a$K$O!"(B -configure $B%*%W%7%g%s$N(B `--with-w3=' $B$r;H$&$+(B `~/.lpath.el' $B%U%!%$%k$r(B -$BJT=8$7$F!"(BEmacs W3 $B$,%$%s%9%H!<%k$5$l$F$$$k(B path $B$r;XDj$7$J$1$l$P$J$j(B -$B$^$;$s!#0J2<$O(B configure $B%*%W%7%g%s$r;H$&Nc$G$9!#(B +emacs-w3m $B$H(B nnshimbun $B$,;H$($k$h$&$K(B T-gnus $B$r:n$k$K$O!"(Bemacs-w3m $B$,(B +$B%$%s%9%H!<%k$5$l$F$$$k%Q%9$r(B configure $B%*%W%7%g%s$N(B `--with-addpath=' +$B$G;XDj$7$J$1$l$P$J$j$^$;$s(B (Emacs/W3 $BMQ$K$O(B `--with-w3=' $B$r;H$&$+!"$^(B +$B$?$O(B `~/.lpath.el' $B%U%!%$%k$rJT=8$7$F2<$5$$(B)$B!#0J2<$ONc$G$9!#(B % ./configure --with-emacs=mule\ + --with-addpath=~/elisp/emu/:~/elisp/apel/: ... :~/elisp/w3m/\ --with-w3=/usr/local/share/mule/site-lisp/w3/ % make install -$B$b$7(B configure $B$,!V(BW3... not found$B!W$H8@$C$F$b5$$K$7$J$$$G2<$5$$!#$?$H(B -$B$((B `~/.lpath.el' $B%U%!%$%k$G(B Emacs W3 $B$N(B path $B$,;XDj$5$l$F$$$F$b!"(B -configure $B%*%W%7%g%s$N(B `--with-w3=' $B$r;H$o$J$$$H!"8=:_$=$l$O@5>o$KF/$-(B -$B$^$;$s$N$G!#(B +;; $B$b$7(B configure $B$,!V(BW3... not found$B!W$H8@$C$F$b5$$K$7$J$$$G2<$5$$!#(B +;; $B$?$H$((B `~/.lpath.el' $B%U%!%$%k$G(B Emacs/W3 $B$N(B path $B$,;XDj$5$l$F$$$F$b!"(B +;; configure $B%*%W%7%g%s$N(B `--with-w3=' $B$r;H$o$J$$$H!"8=:_$=$l$O@5>o$K(B +;; $BF/$-$^$;$s$N$G!#(B + +;; $B$H$3$m$G!"C/$+(B Emacs 19.34 $B$r%Y!<%9$K$7$?(B Mule 2.3 $B$KE,9g$9$k(B +;; Emacs/W3 $B$,$I$3$K$"$k$+CN$j$^$;$s$+(B? diff --git a/README b/README deleted file mode 100644 index 81e1586..0000000 --- a/README +++ /dev/null @@ -1,68 +0,0 @@ -This package contains a beta version of Gnus. The lisp directory -contains the source lisp files, and the texi directory contains a -draft of the Gnus info pages. - -To use Gnus you first have to unpack the files, which you've obviously -done, because you are reading this. - -You should definitely byte-compile the source files. To do that, you -can simply say "./configure && make" in this directory. If you are -using XEmacs, you *must* say "make EMACS=xemacs". In that case you -may also want to pull down the package of nice glyphs from -. It should be installed -into the "gnus-5.6.53/etc" directory. - -Then you have to tell Emacs where Gnus is. You might put something -like - - (setq load-path (cons (expand-file-name "~/gnus-5.6.53/lisp") load-path)) - -in your .emacs file, or wherever you keep such things. - -To enable reading the Gnus manual, you could say something like: - - (require 'info) - (setq Info-default-directory-list - (cons "~/gnus-5.6.53/texi" Info-default-directory-list)) - -or - - (require 'info) - (setq Info-directory-list - (cons "~/gnus-5.6.53/texi" Info-directory-list)) - -depending on which version of Emacs or XEmacs you're using. - -Note that Gnus and GNUS can't coexist in a single Emacs. They both use -the same function and variable names. If you have been running GNUS -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 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 -backtraces, or, better yet, find out why Gnus does something wrong, -fix it, and send me the diffs. :-) - -There are four main things I want your help and input on: - -1) Startup. Does everything go smoothly, and why not? - -2) Any errors while you read news normally? - -3) Any errors if you do anything abnormal? - -4) Features you do not like, or do like, but would like to tweak a - bit, and features you would like to see. - -Send any comments and all your bug fixes/complaints to -`semi-gnus-ja@meadowy.org' (or `bugs@gnus.org'). diff --git a/README-gnus-bbdb.en b/README-gnus-bbdb.en index 109da56..5ec9011 100644 --- a/README-gnus-bbdb.en +++ b/README-gnus-bbdb.en @@ -13,7 +13,7 @@ gnus-bbdb.el This is the BBDB API module for Semi-gnus. `mime-bbdb' should not be necessary for Semi-gnus, if that module were used. - You need FLIM 1.11.3 or later. + You need FLIM 1.11.3 or later (T-gnus requires FLIM 1.14). If you are using bbdb-auto-notes-hook, the patch listed at the end of this file should be applied. If not, it might not. @@ -28,7 +28,10 @@ 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) + +;; No need to use the following lines under T-gnus 6.15.5 and later. +;(eval-after-load "message" +; '(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 @@ -40,12 +43,12 @@ though FLIM does not decode them, put the following lines in your (eword-decode-string field-body)))) --- - This is a patch for bbdb.el / bbdb-hooks.el. + This is a patch for bbdb-com.el, bbdb-hooks.el and bbdb.el. ------ cut here ------ cut here ------ cut here ------ cut here ------ ---- bbdb-2.32/lisp/bbdb-com.el~ Sun Feb 18 08:00:39 2001 -+++ bbdb-2.32/lisp/bbdb-com.el Sun Feb 18 08:00:39 2001 -@@ -1620,7 +1620,7 @@ +--- bbdb-2.34/lisp/bbdb-com.el~ Tue Jan 15 23:00:57 2002 ++++ bbdb-2.34/lisp/bbdb-com.el Thu Jan 31 03:55:01 2002 +@@ -1686,7 +1686,7 @@ ;; to be enclosed in quotes. Double-quotes and backslashes have ;; already been escaped. This quotes a few extra characters as ;; well (!,%, and $) just for common sense. @@ -54,29 +57,27 @@ though FLIM does not decode them, put the following lines in your (format "\"%s\" <%s>" name net)) (t (format "%s <%s>" name net))))) ---- bbdb-2.32/lisp/bbdb-hooks.el~ Tue Jan 30 08:00:56 2001 -+++ bbdb-2.32/lisp/bbdb-hooks.el Tue Jan 30 08:00:56 2001 -@@ -83,6 +83,8 @@ - ;; +--- bbdb-2.34/lisp/bbdb-hooks.el~ Tue Jan 15 09:00:11 2002 ++++ bbdb-2.34/lisp/bbdb-hooks.el Thu Jan 31 03:55:01 2002 +@@ -36,4 +36,6 @@ ;; +(eval-when-compile (require 'cl)) + (require 'bbdb) - - (defmacro the-v18-byte-compiler-sucks-wet-farts-from-dead-pigeons () -@@ -415,12 +417,23 @@ - (marker (bbdb-header-start)) + (require 'bbdb-com) +@@ -405,13 +407,23 @@ + ignore field pairs fieldval ; do all bindings here for speed regexp string notes-field-name notes -- replace-p replace-or-add-msg) -+ replace-p replace-or-add-msg -+ extract-field-value-funtion) +- replace-p) ++ replace-p extract-field-value-funtion) (set-buffer (marker-buffer marker)) (save-restriction - (widen) - (goto-char marker) - (if (and (setq fieldval (bbdb-extract-field-value "From")) +- (string-match (bbdb-user-mail-names) fieldval)) + (let ((function-list bbdb-extract-field-value-function-list) + function) + (or (progn @@ -90,10 +91,11 @@ though FLIM does not decode them, put the following lines in your + (goto-char marker) + (setq extract-field-value-funtion 'bbdb-extract-field-value)))) + (if (and (setq fieldval (funcall extract-field-value-funtion "From")) - (string-match (bbdb-user-mail-names) fieldval)) ++ (string-match (bbdb-user-mail-names) fieldval)) ;; Don't do anything if this message is from us. Note that we have ;; to look at the message instead of the record, because the record -@@ -431,7 +444,7 @@ + ;; will be of the recipient of the message if it is from us. +@@ -421,7 +433,7 @@ (goto-char marker) (setq field (car (car ignore-all)) regexp (cdr (car ignore-all)) @@ -102,7 +104,7 @@ though FLIM does not decode them, put the following lines in your (if (and fieldval (string-match regexp fieldval)) (setq ignore t) -@@ -444,7 +457,8 @@ +@@ -434,7 +446,8 @@ pairs (cdr (car rest)) ; (REGEXP . STRING) or ; (REGEXP FIELD-NAME STRING) or ; (REGEXP FIELD-NAME STRING REPLACE-P) @@ -110,14 +112,14 @@ though FLIM does not decode them, put the following lines in your + fieldval (funcall extract-field-value-funtion field)) + ; e.g., Subject line (when fieldval - (while pairs - (setq regexp (car (car pairs)) ---- bbdb-2.32/lisp/bbdb.el~ Sun Mar 4 20:30:09 2001 -+++ bbdb-2.32/lisp/bbdb.el Sun Mar 4 20:30:09 2001 -@@ -710,6 +710,7 @@ + ;; we perform the auto notes stuff only for authors of a message + ;; or if explicitly requested +--- bbdb-2.34/lisp/bbdb.el~ Tue Jan 15 23:00:58 2002 ++++ bbdb-2.34/lisp/bbdb.el Thu Jan 31 03:55:01 2002 +@@ -737,6 +737,7 @@ (defvar bbdb-showing-changed-ones nil) (defvar bbdb-modified-p nil) - (defvar bbdb-elided-display nil) + (defvar bbdb-address-print-formatting-alist) ; "bbdb-print" +(defvar bbdb-extract-field-value-function-list nil) (defvar bbdb-debug t) diff --git a/README-gnus-bbdb.ja b/README-gnus-bbdb.ja index 81299ab..a2667c8 100644 --- a/README-gnus-bbdb.ja +++ b/README-gnus-bbdb.ja @@ -13,7 +13,7 @@ gnus-bbdb.el Semi-gnus $B$KFC2=$7$?(B BBDB API $B%b%8%e!<%k$G$9!#$3$N%b%8%e!<%k$r;HMQ$9$k(B $B$3$H$K$h$C$F!"(B Semi-gnus $B$G;HMQ$9$k>l9g$K$O(B mime-bbdb $B$,ITMW$K$J$j$^$9!#(B -1.11.3 $B0J9_$N(B FLIM $B$,I,MW$G$9!#(B +1.11.3 $B0J9_$N(B FLIM $B$,I,MW(B (T-gnus $B$G$O(B FLIM 1.14 $B$,I,MW(B) $B$G$9!#(B bbdb-auto-notes-hook $B$r;HMQ$7$F$$$J$$J}$K$OITMW$G$9$,!";HMQ$7$F$$$kJ}(B $B$O(B bbdb.el / bbdb-hooks.el $B$K$3$N%U%!%$%k$N:G8e$K$"$k(B patch $B$r$"$F$kI,(B @@ -29,7 +29,10 @@ 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) + +;; T-gnus 6.15.5 $B0J>e$G$OITMW$G$9!#(B +;(eval-after-load "message" +; '(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!"" name net)) (t (format "%s <%s>" name net))))) ---- bbdb-2.32/lisp/bbdb-hooks.el~ Tue Jan 30 08:00:56 2001 -+++ bbdb-2.32/lisp/bbdb-hooks.el Tue Jan 30 08:00:56 2001 -@@ -83,6 +83,8 @@ - ;; +--- bbdb-2.34/lisp/bbdb-hooks.el~ Tue Jan 15 09:00:11 2002 ++++ bbdb-2.34/lisp/bbdb-hooks.el Thu Jan 31 03:55:01 2002 +@@ -36,4 +36,6 @@ ;; +(eval-when-compile (require 'cl)) + (require 'bbdb) - - (defmacro the-v18-byte-compiler-sucks-wet-farts-from-dead-pigeons () -@@ -415,12 +417,23 @@ - (marker (bbdb-header-start)) + (require 'bbdb-com) +@@ -405,13 +407,23 @@ + ignore field pairs fieldval ; do all bindings here for speed regexp string notes-field-name notes -- replace-p replace-or-add-msg) -+ replace-p replace-or-add-msg -+ extract-field-value-funtion) +- replace-p) ++ replace-p extract-field-value-funtion) (set-buffer (marker-buffer marker)) (save-restriction - (widen) - (goto-char marker) - (if (and (setq fieldval (bbdb-extract-field-value "From")) +- (string-match (bbdb-user-mail-names) fieldval)) + (let ((function-list bbdb-extract-field-value-function-list) + function) + (or (progn @@ -90,10 +91,11 @@ FLIM $B$G$O(B quote $B$5$l$?(B eword encoded word $B$O(B decode $B$5$l$^$ + (goto-char marker) + (setq extract-field-value-funtion 'bbdb-extract-field-value)))) + (if (and (setq fieldval (funcall extract-field-value-funtion "From")) - (string-match (bbdb-user-mail-names) fieldval)) ++ (string-match (bbdb-user-mail-names) fieldval)) ;; Don't do anything if this message is from us. Note that we have ;; to look at the message instead of the record, because the record -@@ -431,7 +444,7 @@ + ;; will be of the recipient of the message if it is from us. +@@ -421,7 +433,7 @@ (goto-char marker) (setq field (car (car ignore-all)) regexp (cdr (car ignore-all)) @@ -102,7 +104,7 @@ FLIM $B$G$O(B quote $B$5$l$?(B eword encoded word $B$O(B decode $B$5$l$^$ (if (and fieldval (string-match regexp fieldval)) (setq ignore t) -@@ -444,7 +457,8 @@ +@@ -434,7 +446,8 @@ pairs (cdr (car rest)) ; (REGEXP . STRING) or ; (REGEXP FIELD-NAME STRING) or ; (REGEXP FIELD-NAME STRING REPLACE-P) @@ -110,14 +112,14 @@ FLIM $B$G$O(B quote $B$5$l$?(B eword encoded word $B$O(B decode $B$5$l$^$ + fieldval (funcall extract-field-value-funtion field)) + ; e.g., Subject line (when fieldval - (while pairs - (setq regexp (car (car pairs)) ---- bbdb-2.32/lisp/bbdb.el~ Sun Mar 4 20:30:09 2001 -+++ bbdb-2.32/lisp/bbdb.el Sun Mar 4 20:30:09 2001 -@@ -710,6 +710,7 @@ + ;; we perform the auto notes stuff only for authors of a message + ;; or if explicitly requested +--- bbdb-2.34/lisp/bbdb.el~ Tue Jan 15 23:00:58 2002 ++++ bbdb-2.34/lisp/bbdb.el Thu Jan 31 03:55:01 2002 +@@ -737,6 +737,7 @@ (defvar bbdb-showing-changed-ones nil) (defvar bbdb-modified-p nil) - (defvar bbdb-elided-display nil) + (defvar bbdb-address-print-formatting-alist) ; "bbdb-print" +(defvar bbdb-extract-field-value-function-list nil) (defvar bbdb-debug t) diff --git a/README.T-gnus b/README.T-gnus index b32db68..8051cb0 100644 --- a/README.T-gnus +++ b/README.T-gnus @@ -1,7 +1,7 @@ ======================================================================== Codename: T-gnus -Branch Tag: t-gnus-6_14 -Branch Status: Public, Stable +Branch Tag: t-gnus-6_15 +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,7 @@ NEWS: See TODO.ja -* T-gnus 6.14 - this is based on Pterodactyl Gnus. +* T-gnus 6.15 - this is based on Oort Gnus. - The latest T-gnus is T-gnus 6.14.6 (Based on Gnus 5.8.8). It requires - SEMI/WEMI (1.13.5 or later), FLIM (1.13.1 or later), and APEL (10.0 or - later). + The latest T-gnus is T-gnus 6.15.24 (based on Oort Gnus 0.24). It + requires SEMI 1.14, FLIM 1.14, and APEL 10.0 or later. diff --git a/README.branch b/README.branch index 4b7700d..4bd8cc8 100644 --- a/README.branch +++ b/README.branch @@ -1,7 +1,7 @@ README.branch --- description of branches and tags. (DRAFT) ======================================================================== -Semi-gnus revision tree (2000-12-21) +Semi-gnus revision tree (2002-10-09) vendor personal main trunk public branch branches branches @@ -36,16 +36,17 @@ qGnus 0.?? ------> Semi-gnus 6.0.0 : ------------<---------------+ t-gnus-6_14 : Oort Gnus / : | (for FLIM 1.13, : | | : : develop) - : V V : | + : 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 + : | : : | + : : : | feedback | + : : +<--------------+ + : : | | + : akr <-- 6.2.3 : t-gnus-6_15 + : shuhei-k <-- 6.3.1 (for FLIM 1.14, +Gnus 5.6.11 ------> 6.3.3 develop) + : 6.4.0 (for SEMI 1.5) | + : (6.4.?)------> for SEMI 1.5 : : | \ : | \ (Synch with original Gnus | ---> for SEMI 1.6 @@ -133,7 +134,11 @@ Public Branches 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) + t-gnus-6_15 T-gnus for SEMI 1.14, FLIM 1.14 API (develop) + t-gnus-6_15-quimby T-gnus for SEMI 1.14, FLIM 1.14 API (develop) + + Note: T-gnus versions 6.15 based on Oort Gnus v0.03 and earlier + had supported SEMI 1.13 and FLIM 1.13 as well. Personal Branches diff --git a/README.branch.ja b/README.branch.ja index 3b69df8..3eb56f1 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 (2000-12-21) +Semi-gnus revision tree (2001-04-16) vendor personal main trunk public branch branches branches @@ -36,16 +36,17 @@ qGnus 0.?? ------> Semi-gnus 6.0.0 : ------------<---------------+ t-gnus-6_14 : Oort Gnus / : | (for FLIM 1.13, : | | : : develop) - : V V : | + : 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 + : | : : | + : : : | feedback | + : : +<--------------+ + : : | | + : akr <-- 6.2.3 : t-gnus-6_15 + : shuhei-k <-- 6.3.1 (for FLIM 1.14, +Gnus 5.6.11 ------> 6.3.3 develop) + : 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 @@ -133,7 +134,11 @@ Public Branches 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) + t-gnus-6_15 T-gnus for SEMI 1.14, FLIM 1.14 API (develop) + t-gnus-6_15-quimby T-gnus for SEMI 1.14, FLIM 1.14 API (develop) + + $BCm(B: v0.03 $B0JA0$N(B Oort Gnus $B$r85$K$7$?(B T-gnus 6.15 $B$O!"(BSEMI 1.13 $B$H(B + FLIM 1.13 $B$b%5%]!<%H$7$F$$$^$7$?!#(B Personal Branches diff --git a/README.semi b/README.semi index c4376f1..3b4e80b 100644 --- a/README.semi +++ b/README.semi @@ -1,23 +1,31 @@ -This package contains T-gnus 6.14. +This package contains T-gnus 6.15. What is T-gnus? =============== - T-gnus is a replacement of Gnus with gnus-mime for SEMI. It has all -features of Gnus and gnus-mime, so there are no need to install Gnus -to use it, and you must not use gnus-mime for SEMI. + T-gnus is an improvement of Gnus with SEMI's MIME feature. T-gnus +6.15 is based on Oort Gnus v0.24. SEMI may stand for "SEMI is Emacs +MIME Interface" and is developped to provide an easy interfaces for +users to handle MIME message structures. For further information, +refer to REASME.en of SEMI. It requires APEL, FLIM and SEMI packages, so please get and install -them before to install it. T-gnus 6.14 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: +them before to install it. T-gnus 6.15 requires APEL 10.0 or later, +FLIM 1.14 and SEMI 1.14. You can get these packages from: ftp://ftp.m17n.org/pub/mule/apel/ -ftp://ftp.m17n.org/pub/mule/flim/flim-1.13/ -ftp://ftp.m17n.org/pub/mule/semi/semi-1.13-for-flim-1.13/ +ftp://ftp.m17n.org/pub/mule/flim/flim-1.14/ +ftp://ftp.m17n.org/pub/mule/semi/semi-1.14-for-flim-1.14/ Required environment for SEMI is written in README.en of SEMI package. + In addition, if you wish to use the web based backend `nnshimbun', +you have to install the package emacs-w3m and the external command w3m. +Visit the following pages for more information. + +http://emacs-w3m.namazu.org/ +http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/ + How to get? (via CVS) ===================== @@ -31,7 +39,7 @@ How to get? (via CVS) (1) checkout % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \ - checkout -r t-gnus-6_14 gnus + checkout -r t-gnus-6_15 gnus (2) compile @@ -41,15 +49,16 @@ How to get? (via CVS) (3) update - % cvs update -r t-gnus-6_14 gnus + % cvs update -r t-gnus-6_15 gnus Major tags are following: t-gnus-6_15-quimby Assigned to the latest version of T-gnus for developing and synchronizing with Oort Gnus. - t-gnus-6_14 Assigned to the latest development version of - T-gnus. + t-gnus-6_15 Assigned to the latest version of T-gnus for + developing and synchronizing with the released + version of Oort Gnus. pgnus-ichikawa The main trunk of T-gnus. @@ -81,9 +90,9 @@ For more detailed information, please read README.branch. How to get? (via ftp) ===================== - T-gnus 6.14 is available from + T-gnus 6.15 is available from - ftp://ftp.jpl.org/pub/elisp/t-gnus-6.14/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. diff --git a/README.semi.ja b/README.semi.ja index 791bebe..11d5455 100644 --- a/README.semi.ja +++ b/README.semi.ja @@ -1,25 +1,32 @@ -$B$3$N%Q%C%1!<%8$K$O(B T-gnus 6.14 $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 ============= - T-gnus $B$O(B SEMI $B$N$?$a$N(B gnus-mime $B$H(B Gnus $B$NAH9g$;$rCV$-49$($k$b$N$G(B -$B$9!#(BGnus $B$H(B gnus-mime $B$NA4$F$N5!G=$r;}$C$F$$$^$9$N$G!"$3$l$r;HMQ$9$k$?(B -$B$a$K(B Gnus $B$r%$%s%9%H!<%k$9$kI,MW$O$J$/!"(BSEMI $B$N$?$a$N(B gnus-mime $B$O;HMQ(B -$B$7$F$O$$$1$^$;$s!#(B + T-gnus $B$O!"(BSEMI $B$rMxMQ$7$F(B Gnus $B$K(B MIME $B5!G=$rDI2C$9$k$b$N$G$9!#(B +T-gnus 6.15 $B$O(B Oort Gnus v0.24 $B$r%Y!<%9$K$7$F$$$^$9!#(BSEMI $B$O(B Emacs $B$G(B +MIME $B$r;H$($k$h$&$K$9$k$b$N$G!"(BMIME message $B$N9=J8$N9=B$$HMxMQ\$7$/$O!"(BSEMI $B$N(B README.en $B$r;2>H(B +$B$7$F$/$@$5$$!#(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.14 $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 + T-gnus $B$rMxMQ$9$k$K$O(B APEL, FLIM $B$*$h$S(B SEMI $B%Q%C%1!<%8$,I,MW$G$9$N(B +$B$G!"%$%s%9%H!<%k$9$kA0$K$=$l$i$r%$%s%9%H!<%k$7$F$/$@$5$$!#(BT-gnus 6.15 +$B$O(B APEL 10.0 $B0J>e!"(BFLIM 1.14 $B$*$h$S(B SEMI 1.14 $B$rI,MW$H$7$^$9!#$=$l$i$N(B +$B%Q%C%1!<%8$O(B ftp://ftp.m17n.org/pub/mule/apel/ -ftp://ftp.m17n.org/pub/mule/flim/flim-1.13/ -ftp://ftp.m17n.org/pub/mule/semi/semi-1.13-for-flim-1.13/ +ftp://ftp.m17n.org/pub/mule/flim/flim-1.14/ +ftp://ftp.m17n.org/pub/mule/semi/semi-1.14-for-flim-1.14/ -$B$+$iH$7$F(B +$B$+$iH$7$F(B $B$/$@$5$$!#(B + $B2C$($F!"(B`nnshimbun' $B$r;H$$$?$$>l9g$K$O!"(Bemacs-w3m $B%Q%C%1!<%8$H30It(B +$B%3%^%s%I$N(B w3m $B$,I,MW$G$9!#>\$7$$$3$H$O0J2<$N%Z!<%8$r$4Mw2<$5$$!#(B + +http://emacs-w3m.namazu.org/ +http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/ + $Bl=j$+$il=j$+$i /dev/null` ]) W3=${EMACS_cv_ACCEPTABLE_W3} AC_SUBST(W3) - if test "x${EMACS_cv_ACCEPTABLE_W3}" = "x"; then + if test -z "${EMACS_cv_ACCEPTABLE_W3}"; then AC_MSG_RESULT(not found) else AC_MSG_RESULT(${W3}) fi ]) +dnl +dnl Perform sanity checking and try to locate the W3 package +dnl +AC_DEFUN(AC_CHECK_URL, [ +AC_MSG_CHECKING(for acceptable URL version) + +dnl Ignore cache. +unset EMACS_cv_ACCEPTABLE_URL; +unset EMACS_cv_SYS_url_dir; +unset EMACS_cv_SYS_url; + +AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_URL,[ +AC_EMACS_CHECK_LIB(url, url-retrieve, "noecho") +if test "${HAVE_url}" = yes; then + EMACS_cv_ACCEPTABLE_URL=yes +else + EMACS_cv_ACCEPTABLE_URL= +fi + +if test "${EMACS_cv_ACCEPTABLE_URL}" = yes; then + AC_EMACS_LISP(url_dir,(file-name-directory (locate-library \"url\")),"noecho") + EMACS_cv_ACCEPTABLE_URL=$EMACS_cv_SYS_url_dir +fi +]) + AC_ARG_WITH(url,[ --with-url=DIR Specify where to find the url package], [ EMACS_cv_ACCEPTABLE_URL=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ]) + URL=${EMACS_cv_ACCEPTABLE_URL} + AC_SUBST(URL) + if test -z "${EMACS_cv_ACCEPTABLE_URL}"; then + AC_MSG_RESULT(not found) + else + AC_MSG_RESULT(${URL}) + fi +]) + +dnl +dnl Perform checking available fonts: Adobe Bembo, Adobe Futura and +dnl Bitstream Courier. +dnl + +AC_DEFUN(GNUS_CHECK_FONTS, [ +test "$LATEX" = t && LATEX= +test "$LATEX" || AC_PATH_PROGS(LATEX, latex, no) +AC_MSG_CHECKING(for available fonts) +AC_ARG_WITH(fonts,[ --with-fonts Assume all fonts required are available],[USE_FONTS="$withval"]) +WITH_FONTS_bembo='%' +WITHOUT_FONTS_bembo= +WITH_FONTS_pfu='%' +WITHOUT_FONTS_pfu= +WITH_FONTS_bcr='%' +WITHOUT_FONTS_bcr= +if test -z "${USE_FONTS}"; then + if test "${LATEX}" = no; then + : + else + OUTPUT=./conftest-$$ + echo '\nonstopmode\documentclass{article}\usepackage{bembo}\begin{document}\end{document}' > ${OUTPUT} + if ${LATEX} ${OUTPUT} & AC_FD_CC 2>&1 ; then + if test -z "${USE_FONTS}"; then + USE_FONTS="Adobe Bembo" + else + USE_FONTS="${USE_FONTS}, Adobe Bembo" + fi + WITH_FONTS_bembo= + WITHOUT_FONTS_bembo='%' + fi + echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT} + if retval=`${LATEX} ${OUTPUT} & AC_FD_CC`; then + if echo "$retval" | grep 'Some font shapes were not available' >& AC_FD_CC 2>&1 ; then + : + else + if test -z "${USE_FONTS}"; then + USE_FONTS="Adobe Futura" + else + USE_FONTS="${USE_FONTS}, Adobe Futura" + fi + WITH_FONTS_pfu= + WITHOUT_FONTS_pfu='%' + fi + fi + echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{bcr}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT} + if retval=`${LATEX} ${OUTPUT} & AC_FD_CC`; then + if echo "$retval" | grep 'Some font shapes were not available' >& AC_FD_CC 2>&1 ; then + : + else + if test -z "${USE_FONTS}"; then + USE_FONTS="Bitstream Courier" + else + USE_FONTS="${USE_FONTS}, Bitstream Courier" + fi + WITH_FONTS_bcr= + WITHOUT_FONTS_bcr='%' + fi + fi + rm -f ${OUTPUT} ${OUTPUT}.aux ${OUTPUT}.log ${OUTPUT}.dvi + fi +elif test "${USE_FONTS}" = yes ; then + WITH_FONTS_bembo= + WITHOUT_FONTS_bembo='%' + WITH_FONTS_pfu= + WITHOUT_FONTS_pfu='%' + WITH_FONTS_bcr= + WITHOUT_FONTS_bcr='%' +fi +AC_SUBST(WITH_FONTS_bembo) +AC_SUBST(WITHOUT_FONTS_bembo) +AC_SUBST(WITH_FONTS_pfu) +AC_SUBST(WITHOUT_FONTS_pfu) +AC_SUBST(WITH_FONTS_bcr) +AC_SUBST(WITHOUT_FONTS_bcr) +if test -z "${USE_FONTS}" ; then + USE_FONTS=no +fi +USE_FONTS=`echo "${USE_FONTS}" | sed 's/,\([[^,]]*\)$/ and\1/'` +AC_MSG_RESULT(${USE_FONTS}) +if test "${USE_FONTS}" = yes ; then + USE_FONTS='Set in Adobe Bembo, Adobe Futura and Bitstream Courier.' +elif test "${USE_FONTS}" = no ; then + USE_FONTS='' +else + USE_FONTS="Set in ${USE_FONTS}." +fi +AC_SUBST(USE_FONTS) +]) + AC_DEFUN(AC_EXAMINE_PACKAGEDIR, [dnl Examine PACKAGEDIR. AC_EMACS_LISP(PACKAGEDIR, @@ -195,13 +384,13 @@ AC_DEFUN(AC_PATH_PACKAGEDIR, 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 + [if test "$withval" != yes -a -n "$withval"; then PACKAGEDIR=$withval else AC_EXAMINE_PACKAGEDIR fi], AC_EXAMINE_PACKAGEDIR) - if test x$PACKAGEDIR = x; then + if test -z "$PACKAGEDIR"; then AC_MSG_RESULT(not found) else AC_MSG_RESULT($PACKAGEDIR) @@ -216,7 +405,7 @@ AC_DEFUN(AC_ADD_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 + [if test "$withval" != yes -a -n "$withval"; then AC_MSG_CHECKING([where to find the additional elisp libraries]) ADDITIONAL_LOAD_PATH=$withval AC_MSG_RESULT($ADDITIONAL_LOAD_PATH) diff --git a/configure b/configure index 6cc8412..f9209ed 100755 --- a/configure +++ b/configure @@ -1,40 +1,287 @@ #! /bin/sh - # Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf version 2.14.1 -# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# Generated by GNU Autoconf 2.57. # +# Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002 +# Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi + +# Support unset when possible. +if (FOO=FOO; unset FOO) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -n "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + -# Defaults: -ac_help= +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +exec 6>&1 + +# +# Initializations. +# ac_default_prefix=/usr/local -# Any additions from configure.in: -ac_help="$ac_help - --with-emacs=EMACS compile with EMACS [EMACS=emacs, mule...]" -ac_help="$ac_help - --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]" -ac_help="$ac_help - --with-lispdir=DIR Where to install lisp files - (for XEmacs package, use --with-packagedir instead)" -ac_help="$ac_help - --with-w3=DIR Specify where to find the w3 package" -ac_help="$ac_help - --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" +ac_config_libobj_dir=. +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Maximum number of lines to put in a shell here document. +# This variable seems obsolete. It should probably be removed, and +# only ac_max_sed_lines should be used. +: ${ac_max_here_lines=38} + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= + +ac_unique_file="lisp/gnus.el" +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS GNUS_PRODUCT_NAME SET_MAKE INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA MAKEINFO EMACS XEMACS lispdir etcdir info_dir HAVE_url URL HAVE_w3_forms W3 FLAGS LATEX WITH_FONTS_bembo WITHOUT_FONTS_bembo WITH_FONTS_pfu WITHOUT_FONTS_pfu WITH_FONTS_bcr WITHOUT_FONTS_bcr USE_FONTS PACKAGEDIR ADDITIONAL_LOAD_PATH LIBOBJS LTLIBOBJS' +ac_subst_files='' # Initialize some variables set by options. +ac_init_help= +ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. -build=NONE -cache_file=./config.cache +cache_file=/dev/null exec_prefix=NONE -host=NONE no_create= -nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE @@ -43,10 +290,15 @@ program_transform_name=s,x,x, silent= site= srcdir= -target=NONE verbose= x_includes=NONE x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' @@ -60,17 +312,9 @@ oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' -# Initialize some other variables. -subdirs= -MFLAGS= MAKEFLAGS= -SHELL=${CONFIG_SHELL-/bin/sh} -# Maximum number of lines to put in a shell here document. -ac_max_here_lines=12 - ac_prev= for ac_option do - # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" @@ -78,59 +322,59 @@ do continue fi - case "$ac_option" in - -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; - *) ac_optarg= ;; - esac + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. - case "$ac_option" in + case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) - bindir="$ac_optarg" ;; + bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) - ac_prev=build ;; + ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) - build="$ac_optarg" ;; + build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) - cache_file="$ac_optarg" ;; + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) - datadir="$ac_optarg" ;; + datadir=$ac_optarg ;; -disable-* | --disable-*) - ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - eval "enable_${ac_feature}=no" ;; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) - ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac - eval "enable_${ac_feature}='$ac_optarg'" ;; + eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -139,95 +383,47 @@ do -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) - exec_prefix="$ac_optarg" ;; + exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; - -help | --help | --hel | --he) - # Omit some internal or obsolete options to make the list less imposing. - # This message is too long to be a string in the A/UX 3.1 sh. - cat << EOF -Usage: configure [options] [host] -Options: [defaults in brackets after descriptions] -Configuration: - --cache-file=FILE cache test results in FILE - --help print this message - --no-create do not create output files - --quiet, --silent do not print \`checking...' messages - --version print the version of autoconf that created configure -Directory and file names: - --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] - --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [same as prefix] - --bindir=DIR user executables in DIR [EPREFIX/bin] - --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] - --libexecdir=DIR program executables in DIR [EPREFIX/libexec] - --datadir=DIR read-only architecture-independent data in DIR - [PREFIX/share] - --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data in DIR - [PREFIX/com] - --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] - --libdir=DIR object code libraries in DIR [EPREFIX/lib] - --includedir=DIR C header files in DIR [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] - --infodir=DIR info documentation in DIR [PREFIX/info] - --mandir=DIR man documentation in DIR [PREFIX/man] - --srcdir=DIR find the sources in DIR [configure dir or ..] - --program-prefix=PREFIX prepend PREFIX to installed program names - --program-suffix=SUFFIX append SUFFIX to installed program names - --program-transform-name=PROGRAM - run sed PROGRAM on installed program names -EOF - cat << EOF -Host type: - --build=BUILD configure for building on BUILD [BUILD=HOST] - --host=HOST configure for HOST [guessed] - --target=TARGET configure for TARGET [TARGET=HOST] -Features and packages: - --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) - --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] - --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --x-includes=DIR X include files are in DIR - --x-libraries=DIR X library files are in DIR -EOF - if test -n "$ac_help"; then - echo "--enable and --with options recognized:$ac_help" - fi - exit 0 ;; + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; -host | --host | --hos | --ho) - ac_prev=host ;; + ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) - host="$ac_optarg" ;; + host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) - includedir="$ac_optarg" ;; + includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) - infodir="$ac_optarg" ;; + infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) - libdir="$ac_optarg" ;; + libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) - libexecdir="$ac_optarg" ;; + libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ @@ -236,19 +432,19 @@ EOF -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) - localstatedir="$ac_optarg" ;; + localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) - mandir="$ac_optarg" ;; + mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) + | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ @@ -262,26 +458,26 @@ EOF -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) - oldincludedir="$ac_optarg" ;; + oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix="$ac_optarg" ;; + prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) - program_prefix="$ac_optarg" ;; + program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) - program_suffix="$ac_optarg" ;; + program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ @@ -298,7 +494,7 @@ EOF | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) - program_transform_name="$ac_optarg" ;; + program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) @@ -308,7 +504,7 @@ EOF ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) - sbindir="$ac_optarg" ;; + sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ @@ -319,58 +515,57 @@ EOF | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) - sharedstatedir="$ac_optarg" ;; + sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) - site="$ac_optarg" ;; + site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) - srcdir="$ac_optarg" ;; + srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) - sysconfdir="$ac_optarg" ;; + sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) - ac_prev=target ;; + ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) - target="$ac_optarg" ;; + target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; - -version | --version | --versio | --versi | --vers) - echo "configure generated by autoconf version 2.14.1" - exit 0 ;; + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; -with-* | --with-*) - ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac - eval "with_${ac_package}='$ac_optarg'" ;; + eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) - ac_package=`echo $ac_option|sed -e 's/-*without-//'` + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi - ac_package=`echo $ac_package| sed 's/-/_/g'` - eval "with_${ac_package}=no" ;; + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. @@ -381,99 +576,110 @@ EOF ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) - x_includes="$ac_optarg" ;; + x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) - x_libraries="$ac_optarg" ;; + x_libraries=$ac_optarg ;; - -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + -*) { echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } ;; + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$ac_envvar='$ac_optarg'" + export $ac_envvar ;; + *) - if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then - echo "configure: warning: $ac_option: invalid host type" 1>&2 - fi - if test "x$nonopt" != xNONE; then - { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } - fi - nonopt="$ac_option" + # FIXME: should be removed in autoconf 3.0. + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then - { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } -fi - -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - -# File descriptor usage: -# 0 standard input -# 1 file creation -# 2 errors and warnings -# 3 some systems may open it to /dev/tty -# 4 used on the Kubota Titan -# 6 checking for... messages and results -# 5 compiler messages saved in config.log -if test "$silent" = yes; then - exec 6>/dev/null -else - exec 6>&1 + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } fi -exec 5>./config.log -echo "\ -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. -" 1>&5 +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done -# Strip out --no-create and --no-recursion so they do not pile up. -# Also quote any args containing shell metacharacters. -ac_configure_args= -for ac_arg +# Be sure to have absolute paths. +for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ + localstatedir libdir includedir oldincludedir infodir mandir do - case "$ac_arg" in - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) ;; - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) - ac_configure_args="$ac_configure_args '$ac_arg'" ;; - *) ac_configure_args="$ac_configure_args $ac_arg" ;; + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; esac done -# NLS nuisances. -# Only set these to C if already set. These must not be set unconditionally -# because not all systems understand e.g. LANG=C (notably SCO). -# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! -# Non-C LC_CTYPE values break the ctype check. -if test "${LANG+set}" = set; then LANG=C; export LANG; fi -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi -if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi -if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -rf conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo > confdefs.h +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null -# A filename unique to this package, relative to the directory that -# configure is in, which we can look for to find out if srcdir is correct. -ac_unique_file=lisp/gnus.el # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. - ac_prog=$0 - ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` - test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + ac_confdir=`(dirname "$0") 2>/dev/null || +$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$0" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. @@ -483,13 +689,405 @@ else fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then - { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 + { (exit 1); exit 1; }; } else - { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } fi fi -srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` +(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || + { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 + { (exit 1); exit 1; }; } +srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` +ac_env_build_alias_set=${build_alias+set} +ac_env_build_alias_value=$build_alias +ac_cv_env_build_alias_set=${build_alias+set} +ac_cv_env_build_alias_value=$build_alias +ac_env_host_alias_set=${host_alias+set} +ac_env_host_alias_value=$host_alias +ac_cv_env_host_alias_set=${host_alias+set} +ac_cv_env_host_alias_value=$host_alias +ac_env_target_alias_set=${target_alias+set} +ac_env_target_alias_value=$target_alias +ac_cv_env_target_alias_set=${target_alias+set} +ac_cv_env_target_alias_value=$target_alias + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +_ACEOF + + cat <<_ACEOF +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data [PREFIX/share] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --infodir=DIR info documentation [PREFIX/info] + --mandir=DIR man documentation [PREFIX/man] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-emacs=EMACS compile with EMACS [EMACS=emacs, mule...] + --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs] + --with-lispdir=DIR Where to install lisp files + (for XEmacs package, use --with-packagedir instead) + --with-etcdir=DIR Where to install etc files + --with-url=DIR Specify where to find the url package + --with-w3=DIR Specify where to find the w3 package + --with-fonts Assume all fonts required are available + --with-packagedir=DIR package DIR for XEmacs + --with-addpath=PATH search Emacs-Lisp libraries with PATH + use colons to separate directory names + +_ACEOF +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + ac_popdir=`pwd` + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d $ac_dir || continue + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac +# Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be +# absolute. +ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd` +ac_abs_top_builddir=`cd "$ac_dir" && cd ${ac_top_builddir}. && pwd` +ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd` +ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd` + + cd $ac_dir + # Check for guested configure; otherwise get Cygnus style configure. + if test -f $ac_srcdir/configure.gnu; then + echo + $SHELL $ac_srcdir/configure.gnu --help=recursive + elif test -f $ac_srcdir/configure; then + echo + $SHELL $ac_srcdir/configure --help=recursive + elif test -f $ac_srcdir/configure.ac || + test -f $ac_srcdir/configure.in; then + echo + $ac_configure --help + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd $ac_popdir + done +fi + +test -n "$ac_init_help" && exit 0 +if $ac_init_version; then + cat <<\_ACEOF + +Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002 +Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit 0 +fi +exec 5>config.log +cat >&5 <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.57. Invocation command line was + + $ $0 $@ + +_ACEOF +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +hostinfo = `(hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_sep= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 2) + ac_configure_args1="$ac_configure_args1 '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " + ;; + esac + done +done +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Be sure not to use single quotes in there, as some shells, +# such as our DU 5.0 friend, will then `close' the trap. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +{ + (set) 2>&1 | + case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in + *ac_space=\ *) + sed -n \ + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + ;; + *) + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + sed "/^$/d" confdefs.h | sort + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core core.* *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status + ' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo >confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then @@ -500,75 +1098,142 @@ if test -z "$CONFIG_SITE"; then fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then - echo "loading site script $ac_site_file" + { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then - echo "loading cache $cache_file" - test -f "$cache_file" && . $cache_file + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { echo "$as_me:$LINENO: loading cache $cache_file" >&5 +echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; + esac + fi else - echo "creating cache $cache_file" - > $cache_file + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in `(set) 2>&1 | + sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val="\$ac_cv_env_${ac_var}_value" + eval ac_new_val="\$ac_env_${ac_var}_value" + case $ac_old_set,$ac_new_set in + set,) + { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 +echo "$as_me: former value: $ac_old_val" >&2;} + { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 +echo "$as_me: current value: $ac_new_val" >&2;} + ac_cache_corrupted=: + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } fi ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -cross_compiling=$ac_cv_prog_cc_cross - -ac_exeext= -ac_objext=o -if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then - # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. - if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then - ac_n= ac_c=' -' ac_t=' ' - else - ac_n=-n ac_c= ac_t= - fi -else - ac_n= ac_c='\c' ac_t= -fi +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + + + + -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 +echo $ECHO_N "defining gnus product name... $ECHO_C" + if test "${EMACS_cv_GNUS_PRODUCT_NAME+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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:550: checking whether ${MAKE-make} sets \${MAKE}" >&5 -set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` + echo "$as_me:$LINENO: result: ${GNUS_PRODUCT_NAME}" >&5 +echo "${ECHO_T}${GNUS_PRODUCT_NAME}" >&6 + +echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 +set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,./+-,__p_,'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftestmake <<\EOF + cat >conftest.make <<\_ACEOF all: - @echo 'ac_maketemp="${MAKE}"' -EOF + @echo 'ac_maketemp="$(MAKE)"' +_ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. -eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=` +eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi -rm -f conftestmake +rm -f conftest.make fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then - echo "$ac_t""yes" 1>&6 + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 SET_MAKE= else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi @@ -582,10 +1247,16 @@ for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break + elif test -f $ac_dir/shtool; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break fi 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; } + { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5 +echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;} + { (exit 1); exit 1; }; } fi ac_config_guess="$SHELL $ac_aux_dir/config.guess" ac_config_sub="$SHELL $ac_aux_dir/config.sub" @@ -598,58 +1269,67 @@ ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. # SunOS /usr/etc/install # IRIX /sbin/install # AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag # AFS /usr/afsws/bin/install, which mishandles nonexistent args # 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:607: checking for a BSD compatible install" >&5 +echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 +echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 if test -z "$INSTALL"; then -if eval "test \"\${ac_cv_path_install+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +if test "${ac_cv_path_install+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" - for ac_dir in $PATH; do - # Account for people who put trailing slashes in PATH elements. - case "$ac_dir/" in - /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; - *) - # OSF1 and SCO ODT 3.0 have their own names for install. - # Don't use installbsd from OSF since it installs stuff as root - # by default. - for ac_prog in ginstall scoinst install; do - if test -f $ac_dir/$ac_prog; then - if test $ac_prog = install && - 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 - fi - fi + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in + ./ | .// | /cC/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi done - ;; - esac - done - IFS="$ac_save_IFS" + done + ;; +esac +done + fi if test "${ac_cv_path_install+set}" = set; then - INSTALL="$ac_cv_path_install" + INSTALL=$ac_cv_path_install else # As a last resort, use the slow shell script. We don't cache a # path for INSTALL within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the path is relative. - INSTALL="$ac_install_sh" + INSTALL=$ac_install_sh fi fi -echo "$ac_t""$INSTALL" 1>&6 +echo "$as_me:$LINENO: result: $INSTALL" >&5 +echo "${ECHO_T}$INSTALL" >&6 # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. @@ -661,239 +1341,274 @@ test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' # 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 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_MAKEINFO+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$MAKEINFO"; then ac_cv_prog_MAKEINFO="$MAKEINFO" # 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_MAKEINFO="makeinfo" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MAKEINFO="makeinfo" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + test -z "$ac_cv_prog_MAKEINFO" && ac_cv_prog_MAKEINFO="no" fi fi -MAKEINFO="$ac_cv_prog_MAKEINFO" +MAKEINFO=$ac_cv_prog_MAKEINFO if test -n "$MAKEINFO"; then - echo "$ac_t""$MAKEINFO" 1>&6 + echo "$as_me:$LINENO: result: $MAKEINFO" >&5 +echo "${ECHO_T}$MAKEINFO" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - test x$EMACS = xt && EMACS= + test "$EMACS" = t && EMACS= unset ac_cv_prog_EMACS; unset ac_cv_prog_XEMACS; - # Check whether --with-emacs or --without-emacs was given. + +# 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 + if test "$withval" = yes -o -z "$withval"; 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. + # 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:707: checking for $ac_word" >&5 -if eval "test \"\${ac_cv_prog_EMACS+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_EMACS+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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="$ac_prog" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_EMACS="$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + fi fi -EMACS="$ac_cv_prog_EMACS" +EMACS=$ac_cv_prog_EMACS if test -n "$EMACS"; then - echo "$ac_t""$EMACS" 1>&6 + echo "$as_me:$LINENO: result: $EMACS" >&5 +echo "${ECHO_T}$EMACS" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi -test -n "$EMACS" && break + test -n "$EMACS" && break done test -n "$EMACS" || EMACS="emacs" 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 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_EMACS+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 - done - IFS="$ac_save_ifs" - test -z "$ac_cv_prog_EMACS" && ac_cv_prog_EMACS="emacs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_EMACS="$withval" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + + test -z "$ac_cv_prog_EMACS" && ac_cv_prog_EMACS="emacs" fi fi -EMACS="$ac_cv_prog_EMACS" +EMACS=$ac_cv_prog_EMACS if test -n "$EMACS"; then - echo "$ac_t""$EMACS" 1>&6 + echo "$as_me:$LINENO: result: $EMACS" >&5 +echo "${ECHO_T}$EMACS" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi fi -fi +fi; - # Check whether --with-xemacs or --without-xemacs was given. +# 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 + if test "$withval" = yes -o -z "$withval"; 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 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_XEMACS+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_XEMACS="xemacs" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + test -z "$ac_cv_prog_XEMACS" && ac_cv_prog_XEMACS="xemacs" fi fi -XEMACS="$ac_cv_prog_XEMACS" +XEMACS=$ac_cv_prog_XEMACS if test -n "$XEMACS"; then - echo "$ac_t""$XEMACS" 1>&6 + echo "$as_me:$LINENO: result: $XEMACS" >&5 +echo "${ECHO_T}$XEMACS" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi 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 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_XEMACS+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_XEMACS="$withval" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + test -z "$ac_cv_prog_XEMACS" && ac_cv_prog_XEMACS="xemacs" fi fi -XEMACS="$ac_cv_prog_XEMACS" +XEMACS=$ac_cv_prog_XEMACS if test -n "$XEMACS"; then - echo "$ac_t""$XEMACS" 1>&6 + echo "$as_me:$LINENO: result: $XEMACS" >&5 +echo "${ECHO_T}$XEMACS" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi fi EMACS=$XEMACS else XEMACS=xemacs - test x$EMACS = x &&\ - for ac_prog in emacs xemacs mule + test -z "$EMACS" && for ac_prog in emacs xemacs mule do -# Extract the first word of "$ac_prog", so it can be a program name with args. + # 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:846: checking for $ac_word" >&5 -if eval "test \"\${ac_cv_prog_EMACS+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_EMACS+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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="$ac_prog" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_EMACS="$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + fi fi -EMACS="$ac_cv_prog_EMACS" +EMACS=$ac_cv_prog_EMACS if test -n "$EMACS"; then - echo "$ac_t""$EMACS" 1>&6 + echo "$as_me:$LINENO: result: $EMACS" >&5 +echo "${ECHO_T}$EMACS" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi -test -n "$EMACS" && break + test -n "$EMACS" && break done test -n "$EMACS" || EMACS="emacs" -fi +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 + echo "$as_me:$LINENO: checking what a flavor does $EMACS have" >&5 +echo $ECHO_N "checking what a flavor does $EMACS have... $ECHO_C" >&6 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 + echo "$as_me:$LINENO: checking for flavor" >&5 +echo $ECHO_N "checking for flavor... $ECHO_C" >&6 fi -if eval "test \"\${EMACS_cv_SYS_flavor+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +if test "${EMACS_cv_SYS_flavor+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 @@ -906,7 +1621,8 @@ fi flavor=${EMACS_cv_SYS_flavor} if test -z ""noecho""; then - echo "$ac_t""$flavor" 1>&6 + echo "$as_me:$LINENO: result: $flavor" >&5 +echo "${ECHO_T}$flavor" >&6 fi case $EMACS_cv_SYS_flavor in @@ -917,20 +1633,21 @@ fi *) 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 - + echo "$as_me:$LINENO: result: $EMACS_cv_SYS_flavor" >&5 +echo "${ECHO_T}$EMACS_cv_SYS_flavor" >&6 + if test "$prefix" = NONE; then + echo "$as_me:$LINENO: checking prefix for your Emacs" >&5 +echo $ECHO_N "checking prefix for your Emacs... $ECHO_C" >&6 + 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 + echo "$as_me:$LINENO: checking for prefix" >&5 +echo $ECHO_N "checking for prefix... $ECHO_C" >&6 fi -if eval "test \"\${EMACS_cv_SYS_prefix+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +if test "${EMACS_cv_SYS_prefix+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 @@ -943,70 +1660,233 @@ fi prefix=${EMACS_cv_SYS_prefix} if test -z ""noecho""; then - echo "$ac_t""$prefix" 1>&6 + echo "$as_me:$LINENO: result: $prefix" >&5 +echo "${ECHO_T}$prefix" >&6 fi prefix=${EMACS_cv_SYS_prefix} - echo "$ac_t""$prefix" 1>&6 + echo "$as_me:$LINENO: result: $prefix" >&5 +echo "${ECHO_T}$prefix" >&6 fi - # Check whether --with-lispdir or --without-lispdir was given. + +# 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 +fi; + echo "$as_me:$LINENO: checking where lisp files should go" >&5 +echo $ECHO_N "checking where lisp files should go... $ECHO_C" >&6 if test -z "$lispdir"; then theprefix=$prefix - if test "x$theprefix" = "xNONE"; then + if test "$theprefix" = NONE; then theprefix=$ac_default_prefix fi - lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}" + if test "$EMACS_FLAVOR" = "xemacs"; then + datadir="\$(prefix)/lib" + lispdir="\$(datadir)/${EMACS_FLAVOR}/site-packages/lisp/${GNUS_PRODUCT_NAME}" + else + lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}" + fi 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}" + if test "$EMACS_FLAVOR" = "xemacs"; then + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-packages/lisp/${GNUS_PRODUCT_NAME}" + else + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}" + fi 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 + echo "$as_me:$LINENO: result: $lispdir + (it will be ignored when \"make install-package[-ja]\" is done)" >&5 +echo "${ECHO_T}$lispdir + (it will be ignored when \"make install-package[-ja]\" is done)" >&6 else - echo "$ac_t""$lispdir" 1>&6 + echo "$as_me:$LINENO: result: $lispdir" >&5 +echo "${ECHO_T}$lispdir" >&6 fi - -echo $ac_n "checking for acceptable W3 version""... $ac_c" 1>&6 -echo "configure:985: checking for acceptable W3 version" >&5 + + +# Check whether --with-etcdir or --without-etcdir was given. +if test "${with_etcdir+set}" = set; then + withval="$with_etcdir" + etcdir=${withval} +fi; + echo "$as_me:$LINENO: checking where etc files should go" >&5 +echo $ECHO_N "checking where etc files should go... $ECHO_C" >&6 + if test -z "$etcdir"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + etcdir="\$(lispdir)/../../etc" + else + etcdir="\$(lispdir)/../etc" + fi + fi + echo "$as_me:$LINENO: result: $etcdir" >&5 +echo "${ECHO_T}$etcdir" >&6 + + + + echo "$as_me:$LINENO: checking where the TeXinfo docs should go" >&5 +echo $ECHO_N "checking where the TeXinfo docs should go... $ECHO_C" >&6 + if test "$infodir" = "\${prefix}/info"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + info_dir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-packages/info" + else + info_dir="\$(prefix)/info" + fi + else + info_dir=$infodir + fi + echo "$as_me:$LINENO: result: $info_dir + (it will be ignored when \"make install-package[-ja]\" is done)" >&5 +echo "${ECHO_T}$info_dir + (it will be ignored when \"make install-package[-ja]\" is done)" >&6 + + + +echo "$as_me:$LINENO: checking for acceptable URL version" >&5 +echo $ECHO_N "checking for acceptable URL version... $ECHO_C" >&6 + +unset EMACS_cv_ACCEPTABLE_URL; +unset EMACS_cv_SYS_url_dir; +unset EMACS_cv_SYS_url; + +if test "${EMACS_cv_ACCEPTABLE_URL+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + +if test -z ""noecho""; then + echo "$as_me:$LINENO: checking for url-retrieve in url" >&5 +echo $ECHO_N "checking for url-retrieve in url... $ECHO_C" >&6 +fi +library=`echo url | tr _ -` + +elisp="(progn (fmakunbound (quote url-retrieve)) (condition-case nil (progn (require (quote $library)) (fboundp (quote url-retrieve))) (error (prog1 nil (message \"$library not found\")))))" +if test -z ""noecho""; then + echo "$as_me:$LINENO: checking for url" >&5 +echo $ECHO_N "checking for url... $ECHO_C" >&6 +fi +if test "${EMACS_cv_SYS_url+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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_url=$retval + +fi + +url=${EMACS_cv_SYS_url} +if test -z ""noecho""; then + echo "$as_me:$LINENO: result: $url" >&5 +echo "${ECHO_T}$url" >&6 +fi + +if test "${EMACS_cv_SYS_url}" = nil; then + EMACS_cv_SYS_url=no +fi +if test "${EMACS_cv_SYS_url}" = t; then + EMACS_cv_SYS_url=yes +fi +HAVE_url=${EMACS_cv_SYS_url} + +if test -z ""noecho""; then + echo "$as_me:$LINENO: result: $HAVE_url" >&5 +echo "${ECHO_T}$HAVE_url" >&6 +fi + +if test "${HAVE_url}" = yes; then + EMACS_cv_ACCEPTABLE_URL=yes +else + EMACS_cv_ACCEPTABLE_URL= +fi + +if test "${EMACS_cv_ACCEPTABLE_URL}" = yes; then + +elisp="(file-name-directory (locate-library \"url\"))" +if test -z ""noecho""; then + echo "$as_me:$LINENO: checking for url_dir" >&5 +echo $ECHO_N "checking for url_dir... $ECHO_C" >&6 +fi +if test "${EMACS_cv_SYS_url_dir+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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_url_dir=$retval + +fi + +url_dir=${EMACS_cv_SYS_url_dir} +if test -z ""noecho""; then + echo "$as_me:$LINENO: result: $url_dir" >&5 +echo "${ECHO_T}$url_dir" >&6 +fi + + EMACS_cv_ACCEPTABLE_URL=$EMACS_cv_SYS_url_dir +fi + +fi + + +# Check whether --with-url or --without-url was given. +if test "${with_url+set}" = set; then + withval="$with_url" + EMACS_cv_ACCEPTABLE_URL=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` +fi; + URL=${EMACS_cv_ACCEPTABLE_URL} + + if test -z "${EMACS_cv_ACCEPTABLE_URL}"; then + echo "$as_me:$LINENO: result: not found" >&5 +echo "${ECHO_T}not found" >&6 + else + echo "$as_me:$LINENO: result: ${URL}" >&5 +echo "${ECHO_T}${URL}" >&6 + fi + + +echo "$as_me:$LINENO: checking for acceptable W3 version" >&5 +echo $ECHO_N "checking for acceptable W3 version... $ECHO_C" >&6 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 +if test "${EMACS_cv_ACCEPTABLE_W3+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 + echo "$as_me:$LINENO: checking for w3-form-encode-xwfu in w3_forms" >&5 +echo $ECHO_N "checking for w3-form-encode-xwfu in w3_forms... $ECHO_C" >&6 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 + echo "$as_me:$LINENO: checking for w3_forms" >&5 +echo $ECHO_N "checking for w3_forms... $ECHO_C" >&6 fi -if eval "test \"\${EMACS_cv_SYS_w3_forms+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +if test "${EMACS_cv_SYS_w3_forms+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 @@ -1019,38 +1899,40 @@ fi w3_forms=${EMACS_cv_SYS_w3_forms} if test -z ""noecho""; then - echo "$ac_t""$w3_forms" 1>&6 + echo "$as_me:$LINENO: result: $w3_forms" >&5 +echo "${ECHO_T}$w3_forms" >&6 fi -if test "${EMACS_cv_SYS_w3_forms}" = "nil"; then +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 +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 + echo "$as_me:$LINENO: result: $HAVE_w3_forms" >&5 +echo "${ECHO_T}$HAVE_w3_forms" >&6 fi -if test "${HAVE_w3_forms}" = "yes"; then +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 - +if test "${EMACS_cv_ACCEPTABLE_W3}" = yes; 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 + echo "$as_me:$LINENO: checking for w3_dir" >&5 +echo $ECHO_N "checking for w3_dir... $ECHO_C" >&6 fi -if eval "test \"\${EMACS_cv_SYS_w3_dir+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +if test "${EMACS_cv_SYS_w3_dir+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 @@ -1063,7 +1945,8 @@ fi w3_dir=${EMACS_cv_SYS_w3_dir} if test -z ""noecho""; then - echo "$ac_t""$w3_dir" 1>&6 + echo "$as_me:$LINENO: result: $w3_dir" >&5 +echo "${ECHO_T}$w3_dir" >&6 fi EMACS_cv_ACCEPTABLE_W3=$EMACS_cv_SYS_w3_dir @@ -1071,30 +1954,184 @@ fi fi - # Check whether --with-w3 or --without-w3 was given. + +# 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 - + 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 + + if test -z "${EMACS_cv_ACCEPTABLE_W3}"; then + echo "$as_me:$LINENO: result: not found" >&5 +echo "${ECHO_T}not found" >&6 else - echo "$ac_t""${W3}" 1>&6 + echo "$as_me:$LINENO: result: ${W3}" >&5 +echo "${ECHO_T}${W3}" >&6 fi + + echo "$as_me:$LINENO: checking which options to pass on to (X)Emacs" >&5 +echo $ECHO_N "checking which options to pass on to (X)Emacs... $ECHO_C" >&6 + if test "x$FLAGS" = "x"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + FLAGS="-batch -no-autoloads -l \$(srcdir)/dgnushack.el" + else + FLAGS="-batch -q -no-site-file -l \$(srcdir)/dgnushack.el" + fi + else + FLAGS=$FLAGS + fi + echo "$as_me:$LINENO: result: $FLAGS" >&5 +echo "${ECHO_T}$FLAGS" >&6 + + + +test "$LATEX" = t && LATEX= +test "$LATEX" || for ac_prog in latex +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 "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_path_LATEX+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + case $LATEX in + [\\/]* | ?:[\\/]*) + ac_cv_path_LATEX="$LATEX" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_LATEX="$as_dir/$ac_word$ac_exec_ext" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + + ;; +esac +fi +LATEX=$ac_cv_path_LATEX + +if test -n "$LATEX"; then + echo "$as_me:$LINENO: result: $LATEX" >&5 +echo "${ECHO_T}$LATEX" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + test -n "$LATEX" && break +done +test -n "$LATEX" || LATEX="no" + +echo "$as_me:$LINENO: checking for available fonts" >&5 +echo $ECHO_N "checking for available fonts... $ECHO_C" >&6 + +# Check whether --with-fonts or --without-fonts was given. +if test "${with_fonts+set}" = set; then + withval="$with_fonts" + USE_FONTS="$withval" +fi; +WITH_FONTS_bembo='%' +WITHOUT_FONTS_bembo= +WITH_FONTS_pfu='%' +WITHOUT_FONTS_pfu= +WITH_FONTS_bcr='%' +WITHOUT_FONTS_bcr= +if test -z "${USE_FONTS}"; then + if test "${LATEX}" = no; then + : + else + OUTPUT=./conftest-$$ + echo '\nonstopmode\documentclass{article}\usepackage{bembo}\begin{document}\end{document}' > ${OUTPUT} + if ${LATEX} ${OUTPUT} & 5 2>&1 ; then + if test -z "${USE_FONTS}"; then + USE_FONTS="Adobe Bembo" + else + USE_FONTS="${USE_FONTS}, Adobe Bembo" + fi + WITH_FONTS_bembo= + WITHOUT_FONTS_bembo='%' + fi + echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT} + if retval=`${LATEX} ${OUTPUT} & 5`; then + if echo "$retval" | grep 'Some font shapes were not available' >& 5 2>&1 ; then + : + else + if test -z "${USE_FONTS}"; then + USE_FONTS="Adobe Futura" + else + USE_FONTS="${USE_FONTS}, Adobe Futura" + fi + WITH_FONTS_pfu= + WITHOUT_FONTS_pfu='%' + fi + fi + echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{bcr}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT} + if retval=`${LATEX} ${OUTPUT} & 5`; then + if echo "$retval" | grep 'Some font shapes were not available' >& 5 2>&1 ; then + : + else + if test -z "${USE_FONTS}"; then + USE_FONTS="Bitstream Courier" + else + USE_FONTS="${USE_FONTS}, Bitstream Courier" + fi + WITH_FONTS_bcr= + WITHOUT_FONTS_bcr='%' + fi + fi + rm -f ${OUTPUT} ${OUTPUT}.aux ${OUTPUT}.log ${OUTPUT}.dvi + fi +elif test "${USE_FONTS}" = yes ; then + WITH_FONTS_bembo= + WITHOUT_FONTS_bembo='%' + WITH_FONTS_pfu= + WITHOUT_FONTS_pfu='%' + WITH_FONTS_bcr= + WITHOUT_FONTS_bcr='%' +fi + + + + + + +if test -z "${USE_FONTS}" ; then + USE_FONTS=no +fi +USE_FONTS=`echo "${USE_FONTS}" | sed 's/,\([^,]*\)$/ and\1/'` +echo "$as_me:$LINENO: result: ${USE_FONTS}" >&5 +echo "${ECHO_T}${USE_FONTS}" >&6 +if test "${USE_FONTS}" = yes ; then + USE_FONTS='Set in Adobe Bembo, Adobe Futura and Bitstream Courier.' +elif test "${USE_FONTS}" = no ; then + USE_FONTS='' +else + USE_FONTS="Set in ${USE_FONTS}." +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. + echo "$as_me:$LINENO: checking where the XEmacs package is" >&5 +echo $ECHO_N "checking where the XEmacs package is... $ECHO_C" >&6 + +# Check whether --with-packagedir or --without-packagedir was given. if test "${with_packagedir+set}" = set; then withval="$with_packagedir" - if test x$withval != xyes -a x$withval != x; then + if test "$withval" != yes -a -n "$withval"; then PACKAGEDIR=$withval else - + elisp="(let (package-dir)\ (if (boundp (quote early-packages))\ (let ((dirs (delq nil (append (if early-package-load-path\ @@ -1109,13 +2146,13 @@ elisp="(let (package-dir)\ 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 + echo "$as_me:$LINENO: checking for PACKAGEDIR" >&5 +echo $ECHO_N "checking for PACKAGEDIR... $ECHO_C" >&6 fi -if eval "test \"\${EMACS_cv_SYS_PACKAGEDIR+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +if test "${EMACS_cv_SYS_PACKAGEDIR+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 @@ -1128,12 +2165,13 @@ fi PACKAGEDIR=${EMACS_cv_SYS_PACKAGEDIR} if test -z ""noecho""; then - echo "$ac_t""$PACKAGEDIR" 1>&6 + echo "$as_me:$LINENO: result: $PACKAGEDIR" >&5 +echo "${ECHO_T}$PACKAGEDIR" >&6 fi fi else - + elisp="(let (package-dir)\ (if (boundp (quote early-packages))\ (let ((dirs (delq nil (append (if early-package-load-path\ @@ -1148,13 +2186,13 @@ elisp="(let (package-dir)\ 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 + echo "$as_me:$LINENO: checking for PACKAGEDIR" >&5 +echo $ECHO_N "checking for PACKAGEDIR... $ECHO_C" >&6 fi -if eval "test \"\${EMACS_cv_SYS_PACKAGEDIR+set}\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +if test "${EMACS_cv_SYS_PACKAGEDIR+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&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 @@ -1167,301 +2205,938 @@ fi PACKAGEDIR=${EMACS_cv_SYS_PACKAGEDIR} if test -z ""noecho""; then - echo "$ac_t""$PACKAGEDIR" 1>&6 -fi - + echo "$as_me:$LINENO: result: $PACKAGEDIR" >&5 +echo "${ECHO_T}$PACKAGEDIR" >&6 fi - if test x$PACKAGEDIR = x; then - echo "$ac_t""not found" 1>&6 +fi; + if test -z "$PACKAGEDIR"; then + echo "$as_me:$LINENO: result: not found" >&5 +echo "${ECHO_T}not found" >&6 else - echo "$ac_t""$PACKAGEDIR" 1>&6 + echo "$as_me:$LINENO: result: $PACKAGEDIR" >&5 +echo "${ECHO_T}$PACKAGEDIR" >&6 fi else PACKAGEDIR= fi - - # Check whether --with-addpath or --without-addpath was given. + + +# 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 + if test "$withval" != yes -a -n "$withval"; then + echo "$as_me:$LINENO: checking where to find the additional elisp libraries" >&5 +echo $ECHO_N "checking where to find the additional elisp libraries... $ECHO_C" >&6 ADDITIONAL_LOAD_PATH=$withval - echo "$ac_t""$ADDITIONAL_LOAD_PATH" 1>&6 + echo "$as_me:$LINENO: result: $ADDITIONAL_LOAD_PATH" >&5 +echo "${ECHO_T}$ADDITIONAL_LOAD_PATH" >&6 fi else ADDITIONAL_LOAD_PATH= -fi +fi; - -trap '' 1 2 15 -cat > confcache <<\EOF + ac_config_files="$ac_config_files Makefile etc/Makefile lisp/Makefile texi/Makefile texi/gnusconfig.tex texi/ps/Makefile lisp/dgnuspath.el" +cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure -# scripts and configure runs. It is not useful on other systems. -# If it contains results you don't want to keep, you may remove or edit it. +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. # -# By default, configure uses ./config.cache as the cache file, -# creating it if it does not exist already. You can give configure -# the --cache-file=FILE option to use a different cache file; that is -# what configure does when it calls configure scripts in -# subdirectories, so they share the cache. -# Giving --cache-file=/dev/null disables caching, for debugging configure. -# config.status only pays attention to the cache file if you give it the -# --recheck option to rerun configure. +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. # -EOF +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. -(set) 2>&1 | - case `(ac_space=' '; set | grep ac_space) 2>&1` in - *ac_space=\ *) - # `set' does not quote correctly, so add quotes (double-quote substitution - # turns \\\\ into \\, and sed turns \\ into \). - sed -n \ - -e "s/'/'\\\\''/g" \ - -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" - ;; - *) - # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' - ;; - esac >> confcache -if cmp -s $cache_file confcache; then - : -else +{ + (set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} | + sed ' + t clear + : clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + : end' >>confcache +if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then - echo "updating cache $cache_file" - cat confcache > $cache_file + test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" + cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' -# Any assignment to VPATH causes Sun make to only execute -# the first set of double-colon rules, so remove it if not needed. -# If there is a colon in the path, we need to keep it. +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/; +s/:*\${srcdir}:*/:/; +s/:*@srcdir@:*/:/; +s/^\([^=]*=[ ]*\):*/\1/; +s/:*$//; +s/^[^=]*=[ ]*$//; +}' fi -trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 - # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. -cat > conftest.defs <<\EOF -s%#define \([^ ][^ ]*\) *\(.*\)%-D\1=\2%g -s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g -s%\[%\\&%g -s%\]%\\&%g -s%\$%$$%g -EOF -DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` -rm -f conftest.defs - - -# Without the "./", some shells look in PATH for config.status. -: ${CONFIG_STATUS=./config.status} +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then we branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +cat >confdef2opt.sed <<\_ACEOF +t clear +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +t quote +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +t quote +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed + + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_i=`echo "$ac_i" | + sed 's/\$U\././;s/\.o$//;s/\.obj$//'` + # 2. Add them. + ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs -echo creating $CONFIG_STATUS -rm -f $CONFIG_STATUS -cat > $CONFIG_STATUS <&5 +echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF +#! $SHELL +# Generated by $as_me. # Run this file to recreate the current configuration. -# This directory was configured as follows, -# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# -# $0 $ac_configure_args -# # Compiler output produced by configure, useful for debugging -# configure, is in ./config.log if it exists. +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false +SHELL=\${CONFIG_SHELL-$SHELL} +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi + +# Support unset when possible. +if (FOO=FOO; unset FOO) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi -ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" -for ac_option + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME do - case "\$ac_option" in - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - 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.14.1" - exit 0 ;; - -help | --help | --hel | --he | --h) - echo "\$ac_cs_usage"; exit 0 ;; - *) echo "\$ac_cs_usage"; exit 1 ;; - esac + if (set +x; test -n "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi done -ac_given_srcdir=$srcdir -ac_given_INSTALL="$INSTALL" +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi -trap 'rm -fr `echo "Makefile lisp/Makefile lisp/dgnuspath.el texi/Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 -EOF -cat >> $CONFIG_STATUS </dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi -# Protect against being on the right side of a sed subst in config.status. -sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g; - s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF -$ac_vpsub -$extrasub -s%@SHELL@%$SHELL%g -s%@CFLAGS@%$CFLAGS%g -s%@CPPFLAGS@%$CPPFLAGS%g -s%@CXXFLAGS@%$CXXFLAGS%g -s%@FFLAGS@%$FFLAGS%g -s%@DEFS@%$DEFS%g -s%@LDFLAGS@%$LDFLAGS%g -s%@LIBS@%$LIBS%g -s%@exec_prefix@%$exec_prefix%g -s%@prefix@%$prefix%g -s%@program_transform_name@%$program_transform_name%g -s%@bindir@%$bindir%g -s%@sbindir@%$sbindir%g -s%@libexecdir@%$libexecdir%g -s%@datadir@%$datadir%g -s%@sysconfdir@%$sysconfdir%g -s%@sharedstatedir@%$sharedstatedir%g -s%@localstatedir@%$localstatedir%g -s%@libdir@%$libdir%g -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%@MAKEINFO@%$MAKEINFO%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 - -cat >> $CONFIG_STATUS <<\EOF - -# Split the substitutions into bite-sized pieces for seds with -# small command number limits, like on Digital OSF/1 and HP-UX. -ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. -ac_file=1 # Number of current file. -ac_beg=1 # First line for current file. -ac_end=$ac_max_sed_cmds # Line after last line for current file. -ac_more_lines=: -ac_sed_cmds="" -while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file - else - sed "${ac_end}q" conftest.subs > conftest.s$ac_file + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 +echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} + { (exit 1); exit 1; }; } fi - if test ! -s conftest.s$ac_file; then - ac_more_lines=false - rm -f conftest.s$ac_file + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 +echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' else - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f conftest.s$ac_file" - else - ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" - fi - ac_file=`expr $ac_file + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_cmds` + as_ln_s='ln -s' fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + +exec 6>&1 + +# Open the log real soon, to keep \$[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. Logging --version etc. is OK. +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX +} >&5 +cat >&5 <<_CSEOF + +This file was extended by $as_me, which was +generated by GNU Autoconf 2.57. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 +_ACEOF + +# Files that config.status was made for. +if test -n "$ac_config_files"; then + echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_headers"; then + echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_links"; then + echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi + +cat >>$CONFIG_STATUS <<\_ACEOF + +ac_cs_usage="\ +\`$as_me' instantiates files from templates according to the +current configuration. + +Usage: $0 [OPTIONS] [FILE]... + + -h, --help print this help, then exit + -V, --version print version number, then exit + -q, --quiet do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to ." +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.57, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" + +Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001 +Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." +srcdir=$srcdir +INSTALL="$INSTALL" +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If no file are specified by the user, then we need to provide default +# value. By we need to know if files were specified by the user. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "x$1" : 'x\([^=]*\)='` + ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + ac_shift=: + ;; + -*) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + *) # This is not an option, so the user has probably given explicit + # arguments. + ac_option=$1 + ac_need_defaults=false;; + esac + + case $ac_option in + # Handling of the options. +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --vers* | -V ) + echo "$ac_cs_version"; exit 0 ;; + --he | --h) + # Conflict between --help and --header + { { echo "$as_me:$LINENO: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; };; + --help | --hel | -h ) + echo "$ac_cs_usage"; exit 0 ;; + --debug | --d* | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + ac_need_defaults=false;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; } ;; + + *) ac_config_targets="$ac_config_targets $1" ;; + + esac + shift done -if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +if \$ac_cs_recheck; then + echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi -EOF -cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF -for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` - ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - *) ac_file_in="${ac_file}.in" ;; + + + + +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_config_target in $ac_config_targets +do + case "$ac_config_target" in + # Handling of arguments. + "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "etc/Makefile" ) CONFIG_FILES="$CONFIG_FILES etc/Makefile" ;; + "lisp/Makefile" ) CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;; + "texi/Makefile" ) CONFIG_FILES="$CONFIG_FILES texi/Makefile" ;; + "texi/gnusconfig.tex" ) CONFIG_FILES="$CONFIG_FILES texi/gnusconfig.tex" ;; + "texi/ps/Makefile" ) CONFIG_FILES="$CONFIG_FILES texi/ps/Makefile" ;; + "lisp/dgnuspath.el" ) CONFIG_FILES="$CONFIG_FILES lisp/dgnuspath.el" ;; + *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; esac +done - # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason to put it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Create a temporary directory, and hook for its removal unless debugging. +$debug || +{ + trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 +} + +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" - # A "../" for each directory in $ac_dir_suffix. - ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` - else - ac_dir_suffix= ac_dots= +# +# CONFIG_FILES section. +# + +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@GNUS_PRODUCT_NAME@,$GNUS_PRODUCT_NAME,;t t +s,@SET_MAKE@,$SET_MAKE,;t t +s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t +s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t +s,@INSTALL_DATA@,$INSTALL_DATA,;t t +s,@MAKEINFO@,$MAKEINFO,;t t +s,@EMACS@,$EMACS,;t t +s,@XEMACS@,$XEMACS,;t t +s,@lispdir@,$lispdir,;t t +s,@etcdir@,$etcdir,;t t +s,@info_dir@,$info_dir,;t t +s,@HAVE_url@,$HAVE_url,;t t +s,@URL@,$URL,;t t +s,@HAVE_w3_forms@,$HAVE_w3_forms,;t t +s,@W3@,$W3,;t t +s,@FLAGS@,$FLAGS,;t t +s,@LATEX@,$LATEX,;t t +s,@WITH_FONTS_bembo@,$WITH_FONTS_bembo,;t t +s,@WITHOUT_FONTS_bembo@,$WITHOUT_FONTS_bembo,;t t +s,@WITH_FONTS_pfu@,$WITH_FONTS_pfu,;t t +s,@WITHOUT_FONTS_pfu@,$WITHOUT_FONTS_pfu,;t t +s,@WITH_FONTS_bcr@,$WITH_FONTS_bcr,;t t +s,@WITHOUT_FONTS_bcr@,$WITHOUT_FONTS_bcr,;t t +s,@USE_FONTS@,$USE_FONTS,;t t +s,@PACKAGEDIR@,$PACKAGEDIR,;t t +s,@ADDITIONAL_LOAD_PATH@,$ADDITIONAL_LOAD_PATH,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@LTLIBOBJS@,$LTLIBOBJS,;t t +CEOF + +_ACEOF + + cat >>$CONFIG_STATUS <<\_ACEOF + # Split the substitutions into bite-sized pieces for seds with + # small command number limits, like on Digital OSF/1 and HP-UX. + ac_max_sed_lines=48 + ac_sed_frag=1 # Number of current file. + ac_beg=1 # First line for current file. + ac_end=$ac_max_sed_lines # Line after last line for current file. + ac_more_lines=: + ac_sed_cmds= + while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + else + sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + fi + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (echo ':t + /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + else + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + fi + ac_sed_frag=`expr $ac_sed_frag + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat fi +fi # test -n "$CONFIG_FILES" - case "$ac_given_srcdir" in - .) srcdir=. - if test -z "$ac_dots"; then top_srcdir=. - else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; - /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; - *) # Relative path. - srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" - top_srcdir="$ac_dots$ac_given_srcdir" ;; +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case $ac_file in + - | *:- | *:-:* ) # input from stdin + cat >$tmp/stdin + ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + * ) ac_file_in=$ac_file.in ;; esac - case "$ac_given_INSTALL" in - [/$]*) INSTALL="$ac_given_INSTALL" ;; - *) INSTALL="$ac_dots$ac_given_INSTALL" ;; - esac + # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. + ac_dir=`(dirname "$ac_file") 2>/dev/null || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + as_dirs="$as_dir $as_dirs" + as_dir=`(dirname "$as_dir") 2>/dev/null || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } + + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi - echo creating "$ac_file" - rm -f "$ac_file" - configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." - case "$ac_file" in - *Makefile*) ac_comsub="1i\\ -# $configure_input" ;; - *) ac_comsub= ;; +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac +# Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be +# absolute. +ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd` +ac_abs_top_builddir=`cd "$ac_dir" && cd ${ac_top_builddir}. && pwd` +ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd` +ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd` + + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_builddir$INSTALL ;; esac - ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` - sed -e "$ac_comsub -s%@configure_input@%$configure_input%g -s%@srcdir@%$srcdir%g -s%@top_srcdir@%$top_srcdir%g -s%@INSTALL@%$INSTALL%g -" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file -fi; done -rm -f conftest.s* + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + if test x"$ac_file" = x-; then + configure_input= + else + configure_input="$ac_file. " + fi + configure_input=$configure_input"Generated from `echo $ac_file_in | + sed 's,.*/,,'` by configure." + + # First look for the input files in the build tree, otherwise in the + # src tree. + ac_file_inputs=`IFS=: + for f in $ac_file_in; do + case $f in + -) echo $tmp/stdin ;; + [\\/$]*) + # Absolute (can't be DOS-style, as IFS=:) + test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + echo $f;; + *) # Relative + if test -f "$f"; then + # Build tree + echo $f + elif test -f "$srcdir/$f"; then + # Source tree + echo $srcdir/$f + else + # /dev/null tree + { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + fi;; + esac + done` || { (exit 1); exit 1; } +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s,@configure_input@,$configure_input,;t t +s,@srcdir@,$ac_srcdir,;t t +s,@abs_srcdir@,$ac_abs_srcdir,;t t +s,@top_srcdir@,$ac_top_srcdir,;t t +s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t +s,@builddir@,$ac_builddir,;t t +s,@abs_builddir@,$ac_abs_builddir,;t t +s,@top_builddir@,$ac_top_builddir,;t t +s,@abs_top_builddir@,$ac_abs_top_builddir,;t t +s,@INSTALL@,$ac_INSTALL,;t t +" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out + rm -f $tmp/stdin + if test x"$ac_file" != x-; then + mv $tmp/out $ac_file + else + cat $tmp/out + rm -f $tmp/out + fi -EOF -cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +cat >>$CONFIG_STATUS <<\_ACEOF -exit 0 -EOF +{ (exit 0); exit 0; } +_ACEOF chmod +x $CONFIG_STATUS -rm -fr confdefs* $ac_clean_files -test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 +ac_clean_files=$ac_clean_files_save + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || { (exit 1); exit 1; } +fi diff --git a/configure.in b/configure.in index e648a4e..92f7eae 100644 --- a/configure.in +++ b/configure.in @@ -5,7 +5,13 @@ AC_PROG_INSTALL AC_CHECK_PROG(MAKEINFO, makeinfo, makeinfo, no) AC_CHECK_EMACS AC_PATH_LISPDIR +AC_PATH_ETCDIR +AC_PATH_INFO_DIR +AC_CHECK_URL AC_CHECK_W3 +AC_SET_BUILD_FLAGS +GNUS_CHECK_FONTS AC_PATH_PACKAGEDIR AC_ADD_LOAD_PATH -AC_OUTPUT(Makefile lisp/Makefile lisp/dgnuspath.el texi/Makefile) +AC_OUTPUT(Makefile etc/Makefile lisp/Makefile texi/Makefile \ + texi/gnusconfig.tex texi/ps/Makefile lisp/dgnuspath.el) diff --git a/contrib/ChangeLog b/contrib/ChangeLog new file mode 100644 index 0000000..e290ca9 --- /dev/null +++ b/contrib/ChangeLog @@ -0,0 +1,220 @@ +2003-05-01 Vasily Korytov + + * gpg.el (gpg-passphrase-forget): Check that gpg-passphrase is + set. + +2003-04-17 Steve Youngs + + * hashcash.el (hashcash-point-at-bol): Move the fbound test + outside of the defalias. + (hashcash-point-at-eol): Ditto. + +2003-03-19 Simon Josefsson + + * gnus-idna.el: Update. + +2003-03-11 Teodor Zlatanov + + * hashcash.el (hashcash-version, hashcash-insert-payment): patch + from Paul Foley + +2003-03-07 Simon Josefsson + + * gnus-idna.el (gnus-idna-to-ascii-rhs-1): Narrow to + head (otherwise forwarded mail break havoc). + +2003-03-07 Teodor Zlatanov + + * hashcash.el: New version from Paul Foley with better variable + names, executable-find support, and no errors in GNU Emacs + (hashcash-version): return nil when invoked with a + nil token + +2003-02-21 Simon Josefsson + + * hashcash.el (hashcash-point-at-bol): + (hashcash-point-at-eol): Defalias. + (hashcash-generate-payment): + (mail-check-payment): Use it. + +2002-12-30 Lars Magne Ingebrigtsen + + * hashcash.el: New version from Paul Foley with new + mail-check-payment function. + +2002-06-22 Simon Josefsson + + * hashcash.el: New file. + (hashcash-default-payment, hashcash-payment-alist, hashcash): + Defcustom. + (hashcash-generate-payment): Update to recent hashcode command + line syntax. + (hashcash-insert-payment): Use X-Hashcode:. + (mail-add-payment): Also look at Newsgroups. + (top-level): Add provide and EOF comment. + (mail-add-payment): Autoload. + (hashcash-insert-payment): s/Hashcode/Hashcash/ + (mail-add-payment): Doc fix. + +2002-05-20 Lars Magne Ingebrigtsen + + * gnus-mdrtn.el (gnus-moderated-groups): Removed (require 'gnus-load). + +2002-04-24 Kai Gro,A_(Bjohann + + * ucs-tables.el (featurep): Barf on XEmacs. + +2002-03-06 ShengHuo ZHU + + * ucs-tables.el: Copy from Emacs 21. + +2002-03-05 ShengHuo ZHU + + * xml.el: Sync with Emacs 21. + +2002-01-25 Josh Huber + + * gpg.el (gpg-command-decrypt): Enable the status-fd command line + option to gpg when decrypting so `mml2015-mailcrypt-decrypt' can + parse and display the output. + +2002-01-01 Lars Magne Ingebrigtsen + + * gnus-mdrtn.el (gnus-moderation-cancel-article): Insert an extra + newline. + +2001-12-26 Florian Weimer + + * gpg.el (gpg-command-default-alist): Using gpg-2comp is no longer + the default. + +2001-12-18 Josh Huber + + * ChangeLog: changed buffer-file-coding-system back to + coding. (oops) + +2001-12-17 Josh Huber + + * ChangeLog: changed coding to buffer-file-coding-system + +2001-11-22 Simon Josefsson + + * sha1.el: Removed. (A FSF copyrighted sha1-el.el file is in + ../lisp/). + +2001-10-30 21:00:00 ShengHuo ZHU + + * canlock.el, hex-util.el, sha1-el.el: Move to lisp. + +2001-10-30 Katsumi Yamaoka + + * canlock.el: (canlock-base64-encode-function): Removed. + (canlock-mmencode-program): Removed. + (canlock-mmencode-args-for-encoding): Removed. + (canlock-openssl-program): Renamed from `canlock-ssleay-program'. + (canlock-openssl-args): Renamed from `canlock-ssleay-args'. + (canlock-load-hook): Removed. + (canlock-base64-encode-string-with-mmencode): Removed. + (canlock-sha1-with-openssl): Renamed from + `canlock-sha1-with-ssleay'. + (canlock-hex-string-to-int): Removed. + (canlock-fetch-fields): Don't use `mapcar'. + (canlock-fetch-id-for-key): Don't use Cancel header if there is no + cancel command. + (gnus-summary-canlock-verify): Removed. + (wl-summary-canlock-verify): Removed. + (canlock-mew-summary-display): Removed. + (mew-summary-canlock-verify): Removed. + (mh-summary-canlock-verify): Removed. + (vm-summary-canlock-verify): Removed. + (cmail-summary-canlock-verify): Removed. + (rmail-summary-canlock-verify): Removed. + +2001-10-25 Simon Josefsson + + * canlock.el (canlock-password, canlock-password-for-verify) + (canlock-force-insert-header): Defcustom. + +2001-10-17 Simon Josefsson + + * canlock.el (sha1-binary): Autoload `sha1-binary'. + (canlock-sha1-function): Use it. + (canlock-sha1-function-for-verify): Ditto. + + * sha1-el.el: New file. + + * hex-util.el: Ditto. + +2001-08-24 16:09:14 Fabien Penso + + * gpg.el (gpg-command-sign-detached): Doc fix. + +2001-08-07 Andreas Jaeger + + * gpg.el (gpg-passphrase-forget): Don't cache + gpg-passphrase-timer. + (gpg-passphrase-store): Check if gpg-passphrase-timer is + initialized already. + +2001-07-30 16:00:00 ShengHuo ZHU + From Andreas Fuchs + + * gpg.el (gpg-command-verify): --status-fd 1 + (gpg-unabbrev-trust-alist): New. + +2001-01-18 Colin Marquardt + + * gpg.el (gpg-make-temp-file): Error info. + +2001-01-13 23:00:00 ShengHuo ZHU + + * gpg.el (gpg-build-arg-list): Use copy-sequence. + +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/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/gnus-idna.el b/contrib/gnus-idna.el new file mode 100644 index 0000000..15c47b6 --- /dev/null +++ b/contrib/gnus-idna.el @@ -0,0 +1,154 @@ +;;; gnus-idna.el --- Internationalized domain names support for Gnus. + +;; Copyright (C) 2003 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: news, 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 package implement crude support for internationalized domain +;; names in Gnus. + +;; Theory of Operation: + +;; RFC 2822 RHS's inside the From:, To:, and CC: headers are encoded +;; using IDNA ToASCII() when you send mail using Message. The hook +;; used is message-send-hook. +;; +;; For incoming articles, when QP in headers are decoded (i.e., when +;; gnus-article-decode-hook is invoked), it searches for "xn--" +;; prefixes and decode them if they are found inside (heuristically +;; determined) RHS in From:, To: and Cc:, using IDNA ToUnicode(). + +;; Usage: + +;; You need to install GNU Libidn (0.1.11 or later) and make sure the +;; idna.el installed by it is found by emacs. + +;; If you use an older Gnus, you may need to put the following in your +;; init scripts too, but keep in mind that most older Gnuses either +;; doesn't have these hooks or are buggy in other regards so it +;; doesn't work anyway. (The window of Gnus versions that this works +;; on is a few weeks during the Oort CVS in winter 2003.) Update to a +;; recent Gnus instead, then you don't have to do anything. + +;; (add-hook 'message-send-hook 'message-idna-to-ascii-rhs) +;; (add-hook 'gnus-article-decode-hook 'gnus-idna-to-unicode-rhs 'append) + +;; Revision history: + +;; 2003-02-26 Initial release +;; +;; 2003-03-19 Cleanup. Fixes a bug that may corrupt outgoing mail if +;; it contains From:, To: or Cc: headers in the body. + +;;; Code: + +(require 'gnus) +(require 'gnus-util) +(require 'rfc822) +(autoload 'idna-to-ascii "idna") +(autoload 'idna-to-unicode "idna") + +(defcustom message-use-idna 'ask + "Whether to encode non-ASCII in domain names into ASCII according to IDNA." + :type '(choice (const :tag "Ask" ask) + (const :tag "Never" nil) + (const :tag "Always" t))) + +(defun message-idna-inside-rhs-p () + "Return t iff point is inside a RHS (heuristically). +Only works properly if header contains mailbox-list or address-list. +I.e., calling it on a Subject: header is useless." + (if (re-search-backward + "[\\\n\r\t ]" (save-excursion (search-backward "@" nil t)) t) + ;; whitespace between @ and point + nil + (let ((dquote 1) (paren 1)) + (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote)) + (incf dquote)) + (while (save-excursion (re-search-backward "[^\\]\(" nil t paren)) + (incf paren)) + (and (= (% dquote 2) 1) (= (% paren 2) 1))))) + +(defun message-idna-to-ascii-rhs-1 (header) + "Interactively potentially IDNA encode domain names in HEADER." + (let (rhs ace start end startpos endpos) + (goto-char (point-min)) + (setq start (re-search-forward (concat "^" header) nil t) + end (or (save-excursion (re-search-forward "^[ \t]" nil t)) + (point-max))) + (when (and start end) + (while (re-search-forward "@\\([^ \t\r\n>]+\\)" end t) + (setq rhs (match-string-no-properties 1) + startpos (match-beginning 1) + endpos (match-end 1)) + (when (save-match-data + (and (message-idna-inside-rhs-p) + (setq ace (idna-to-ascii rhs)) + (not (string= rhs ace)) + (if (eq message-use-idna 'ask) + (unwind-protect + (progn + (replace-highlight startpos endpos) + (y-or-n-p + (format "Replace with `%s'? " ace))) + (message "") + (replace-dehighlight)) + message-use-idna))) + (replace-match (concat "@" ace))))))) + +;;;###autoload +(defun message-idna-to-ascii-rhs () + "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. +See `message-idna-encode'." + (interactive) + (when (condition-case nil (require 'idna) (file-error)) + (save-excursion + (save-restriction + (message-narrow-to-head) + (message-idna-to-ascii-rhs-1 "From") + (message-idna-to-ascii-rhs-1 "To") + (message-idna-to-ascii-rhs-1 "Cc"))))) + +;;;###autoload +(defun gnus-idna-to-unicode-rhs () + "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer." + (when (condition-case nil (require 'idna) (file-error)) + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (article-narrow-to-head) + (goto-char (point-min)) + (while (re-search-forward "\\(xn--.*\\)[ \t\n\r,>]" nil t) + (let (ace unicode) + (when (save-match-data + (and (setq ace (match-string 1)) + (save-excursion (and (re-search-backward "^[^ \t]" nil t) + (looking-at "From\\|To\\|Cc"))) + (save-excursion (backward-char) + (message-idna-inside-rhs-p)) + (setq unicode (idna-to-unicode ace)))) + (unless (string= ace unicode) + (replace-match unicode nil nil nil 1)))))))) + +(provide 'gnus-idna) + +;; gnus-idna.el ends here diff --git a/contrib/gpg-ring.el b/contrib/gpg-ring.el new file mode 100644 index 0000000..dd223bf --- /dev/null +++ b/contrib/gpg-ring.el @@ -0,0 +1,481 @@ +;;; 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 + +;; 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 diff --git a/contrib/gpg.el b/contrib/gpg.el new file mode 100644 index 0000000..9362788 --- /dev/null +++ b/contrib/gpg.el @@ -0,0 +1,1322 @@ +;;; 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. +;; * Optionally, Gero Treuner's gpg-2comp script is supported, +;; to generate data which is compatible with PGP 2.6.3. + +;; 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")) + "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-2comp\" +for `gpg-2comp' if you have obtained this script, in order to gain +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 . ("--status-fd" "1" "--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 . ("--status-fd" "1" "--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 . ("--status-fd" "2" "--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 \"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 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-sequence 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 (%s) must have mode 0700" gpg-temp-directory)) + (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) + (when gpg-passphrase + (cancel-timer gpg-passphrase-timer) + (setq gpg-passphrase-timer nil) + (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) + (if (null gpg-passphrase-timer) + (setq gpg-passphrase-timer (timer-create))) + (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.") + +(defconst gpg-unabbrev-trust-alist + '(("TRUST_UNDEFINED" . trust-undefined) + ("TRUST_NEVER" . trust-none) + ("TRUST_MARGINAL" . trust-marginal) + ("TRUST_FULLY" . trust-full) + ("TRUST_ULTIMATE" . trust-ultimate)) + "Alist mapping capitalized GnuPG trust values 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/hashcash.el b/contrib/hashcash.el new file mode 100644 index 0000000..6702faf --- /dev/null +++ b/contrib/hashcash.el @@ -0,0 +1,219 @@ +;;; hashcash.el --- Add hashcash payments to email + +;; Copyright (C) 1997--2002 Paul E. Foley +;; Copyright (C) 2003 Free Software Foundation + +;; Maintainer: Paul Foley +;; Keywords: mail, hashcash + +;; Released under the GNU General Public License +;; (http://www.gnu.org/licenses/gpl.html) + +;;; Commentary: + +;; The hashcash binary is at http://www.cypherspace.org/hashcash/ +;; +;; Call mail-add-payment to add a hashcash payment to a mail message +;; in the current buffer. +;; +;; To automatically add payments to all outgoing mail: +;; (add-hook 'message-send-hook 'mail-add-payment) + +;;; Code: + +(eval-when-compile (require 'cl)) + +(eval-and-compile + (autoload 'executable-find "executable")) + +(defcustom hashcash-default-payment 0 + "*The default number of bits to pay to unknown users. +If this is zero, no payment header will be generated. +See `hashcash-payment-alist'." + :type 'integer) + +(defcustom hashcash-payment-alist '() + "*An association list mapping email addresses to payment amounts. +Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where +ADDR is the email address of the intended recipient and AMOUNT is +the value of hashcash payment to be made to that user. STRING, if +present, is the string to be hashed; if not present ADDR will be used.") + +(defcustom hashcash-default-accept-payment 10 + "*The default minimum number of bits to accept on incoming payments." + :type 'integer) + +(defcustom hashcash-accept-resources `((,user-mail-address nil)) + "*An association list mapping hashcash resources to payment amounts. +Resources named here are to be accepted in incoming payments. If the +corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment' +is used instead.") + +(defcustom hashcash-path (executable-find "hashcash") + "*The path to the hashcash binary.") + +(defcustom hashcash-double-spend-database "hashcash.db" + "*The path to the double-spending database.") + +(defcustom hashcash-in-news nil + "*Specifies whether or not hashcash payments should be made to newsgroups." + :type 'boolean) + +(require 'mail-utils) + +(if (fboundp 'point-at-bol) + (defalias 'hashcash-point-at-bol 'point-at-bol) + (defalias 'hashcash-point-at-bol 'line-beginning-position)) + +(if (fboundp 'point-at-eol) + (defalias 'hashcash-point-at-eol 'point-at-eol) + (defalias 'hashcash-point-at-eol 'line-end-position)) + +(defun hashcash-strip-quoted-names (addr) + (setq addr (mail-strip-quoted-names addr)) + (if (and addr (string-match "^[^+@]+\\(\\+[^@]*\\)@" addr)) + (concat (substring addr 0 (match-beginning 1)) + (substring addr (match-end 1))) + addr)) + +(defun hashcash-payment-required (addr) + "Return the hashcash payment value required for the given address." + (let ((val (assoc addr hashcash-payment-alist))) + (if val + (if (cddr val) + (caddr val) + (cadr val)) + hashcash-default-payment))) + +(defun hashcash-payment-to (addr) + "Return the string with which hashcash payments should collide." + (let ((val (assoc addr hashcash-payment-alist))) + (if val + (if (cddr val) + (cadr val) + (car val)) + addr))) + +(defun hashcash-generate-payment (str val) + "Generate a hashcash payment by finding a VAL-bit collison on STR." + (if (> val 0) + (save-excursion + (set-buffer (get-buffer-create " *hashcash*")) + (erase-buffer) + (call-process hashcash-path nil t nil + (concat "-b " (number-to-string val)) str) + (goto-char (point-min)) + (buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol))) + nil)) + +(defun hashcash-check-payment (token str val) + "Check the validity of a hashcash payment." + (zerop (call-process hashcash-path nil nil nil "-c" + "-d" "-f" hashcash-double-spend-database + "-b" (number-to-string val) + "-r" str + token))) + +(defun hashcash-version (token) + "Find the format version of a hashcash token." + ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; This carries its own version number embedded in the token, + ;; so no further format number changes should be necessary + ;; in the X-Payment header. + ;; + ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; You need to upgrade your hashcash binary. + ;; + ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx + ;; This is no longer supported. + (cond ((equal (aref token 1) ?:) 1.2) + ((equal (aref token 6) ?:) 1.1) + (t (error "Unknown hashcash format version")))) + +;;;###autoload +(defun hashcash-insert-payment (arg) + "Insert X-Payment and X-Hashcash headers with a payment for ARG" + (interactive "sPay to: ") + (let ((pay (hashcash-generate-payment (hashcash-payment-to arg) + (hashcash-payment-required arg)))) + (when pay + (insert-before-markers "X-Payment: hashcash " + (number-to-string (hashcash-version pay)) " " + pay "\n") + (insert-before-markers "X-Hashcash: " pay "\n")))) + +;;;###autoload +(defun hashcash-verify-payment (token &optional resource amount) + "Verify a hashcash payment" + (let ((key (if (< (hashcash-version token) 1.2) + (cadr (split-string token ":")) + (caddr (split-string token ":"))))) + (cond ((null resource) + (let ((elt (assoc key hashcash-accept-resources))) + (and elt (hashcash-check-payment token (car elt) + (or (cadr elt) hashcash-default-accept-payment))))) + ((equal token key) + (hashcash-check-payment token resource + (or amount hashcash-default-accept-payment))) + (t nil)))) + +;;;###autoload +(defun mail-add-payment (&optional arg) + "Add X-Payment: and X-Hashcash: headers with a hashcash payment +for each recipient address. Prefix arg sets default payment temporarily." + (interactive "P") + (let ((hashcash-default-payment (if arg (prefix-numeric-value arg) + hashcash-default-payment)) + (addrlist nil)) + (save-excursion + (save-restriction + (goto-char (point-min)) + (re-search-forward (concat "^\\(" + (regexp-quote mail-header-separator) + "\\)?$")) + (beginning-of-line) + (narrow-to-region (point-min) (point)) + (let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t))) + (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t))) + (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups" + nil t)))) + (when to + (setq addrlist (split-string to ",[ \t\n]*"))) + (when cc + (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*")))) + (when (and hashcash-in-news ng) + (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) + (while addrlist + (hashcash-insert-payment (pop addrlist)))))) + t) + +;;;###autoload +(defun mail-check-payment (&optional arg) + "Look for a valid X-Payment: or X-Hashcash: header. +Prefix arg sets default accept amount temporarily." + (interactive "P") + (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg) + hashcash-default-accept-payment)) + (version (hashcash-version (hashcash-generate-payment "x" 1)))) + (save-excursion + (goto-char (point-min)) + (search-forward "\n\n") + (beginning-of-line) + (let ((end (point)) + (ok nil)) + (goto-char (point-min)) + (while (and (not ok) (search-forward "X-Payment: hashcash " end t)) + (let ((value (split-string + (buffer-substring (point) (hashcash-point-at-eol)) + " "))) + (when (equal (car value) (number-to-string version)) + (setq ok (hashcash-verify-payment (cadr value)))))) + (goto-char (point-min)) + (while (and (not ok) (search-forward "X-Hashcash: " end t)) + (setq ok (hashcash-verify-payment + (buffer-substring (point) (hashcash-point-at-eol))))) + (when ok + (message "Payment valid")) + ok)))) + +(provide 'hashcash) diff --git a/contrib/md5.el b/contrib/md5.el new file mode 100644 index 0000000..a036819 --- /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/mml-smime.el b/contrib/mml-smime.el deleted file mode 100644 index a216fe8..0000000 --- a/contrib/mml-smime.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; mml-smime.el --- S/MIME support for MML -;; Copyright (c) 2000 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Keywords: Gnus, MIME, SMIME, 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: - -;; This support creation of S/MIME parts in MML. - -;; Usage: -;; (mml-smime-setup) -;; -;; Insert an attribute, postprocess=smime-sign (or smime-encrypt), into -;; the mml tag to be signed (or encrypted). -;; -;; It is based on rfc2015.el by Shenghuo Zhu. - -;;; Code: - -(require 'smime) - -(defun mml-smime-sign (cont) - ;; FIXME: You have to input the sender. - (when (null smime-keys) - (error "Please use M-x customize RET smime RET to configure SMIME")) - (smime-sign-buffer) - (goto-char (point-min)) - (when (looking-at "^MIME-Version: 1.0") - (forward-line 1) - (delete-region (point-min) (point))) - (goto-char (point-max))) - -(defun mml-smime-encrypt (cont) - ;; FIXME: You have to input the receiptant. - ;; FIXME: Should encrypt to myself so I can read it?? - (smime-encrypt-buffer) - (goto-char (point-min)) - (when (looking-at "^MIME-Version: 1.0") - (forward-line 1) - (delete-region (point-min) (point))) - (goto-char (point-max))) - -;; The following code might be moved into mml.el or gnus-art.el. - -(defvar mml-postprocess-alist - '(("smime-sign" . mml-smime-sign) - ("smime-encrypt" . mml-smime-encrypt)) - "Alist of postprocess functions.") - -(defun mml-postprocess (cont) - (let ((pp (cdr (or (assq 'postprocess cont) - (assq 'pp cont)))) - item) - (if (and pp (setq item (assoc pp mml-postprocess-alist))) - (funcall (cdr item) cont)))) - -(defun mml-smime-setup () - (setq mml-generate-mime-postprocess-function 'mml-postprocess)) - -(provide 'mml-smime) - -;;; mml-smime.el ends here diff --git a/contrib/passwd.el b/contrib/passwd.el new file mode 100644 index 0000000..0257469 --- /dev/null +++ b/contrib/passwd.el @@ -0,0 +1,386 @@ +;;; passwd.el --- Prompting for passwords semi-securely + +;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Keywords: comm, extensions + +;; Author: Jamie Zawinski + +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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. + +;;; Synched up with: Not in FSF. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Change Log: +;; +;; Sun Jun 12 04:19:30 1994 by sandy on ibm550.sissa.it +;; Added support for password histories and (provide 'passwd) +;; (jwz says: this "history" thing is completely undocumented, you loser!) +;; 2-Jan-95 (mon); 4:13 AM by jwz@netscape.com +;; Fixed Sandy's extreme keymap bogosity. Made it invert the screen when +;; reading securely (this could be better; maybe use red text or something +;; instead...) +;; 9-Jul-95 (fri); 4:55 AM by jwz@netscape.com +;; Made it work with XEmacs 19.12. +;; 7-Jul-95 by cthomp@cs.uiuc.edu +;; Added variable to control inverting frame when keyboard grabbed + +;;; Code: + +(defvar passwd-invert-frame-when-keyboard-grabbed t + "*If non-nil swap the foreground and background colors of all faces. +This is done while the keyboard is grabbed in order to give a visual +clue that a grab is in effect.") + +(defvar passwd-echo ?. + "*The character which should be echoed when typing a password, +or nil, meaning echo nothing.") + +(defvar read-passwd-map + (let ((i 0) + (s (make-string 1 0)) + map) + (cond ((fboundp 'set-keymap-parent) + (setq map (make-keymap)) + (set-keymap-parent map minibuffer-local-map)) + (t ; v18/FSFmacs compatibility + (setq map (copy-keymap minibuffer-local-map)))) + (if (fboundp 'set-keymap-name) + (set-keymap-name map 'read-passwd-map)) + + (while (< i 127) + (aset s 0 i) + (or (and (boundp 'meta-prefix-char) (eq i meta-prefix-char)) + (define-key map s 'self-insert-command)) + (setq i (1+ i))) + + (define-key map "\C-g" 'keyboard-quit) + (define-key map "\C-h" 'delete-backward-char) + (define-key map "\r" 'exit-minibuffer) + (define-key map "\n" 'exit-minibuffer) + (define-key map "\C-u" 'passwd-erase-buffer) + (define-key map "\C-q" 'quoted-insert) + (define-key map "\177" 'delete-backward-char) + (define-key map "\M-n" 'passwd-next-history-element) + (define-key map "\M-p" 'passwd-previous-history-element) + map) + "Keymap used for reading passwords in the minibuffer. +The \"bindings\" in this map are not real commands; only a limited +number of commands are understood. The important bindings are: +\\ + \\[passwd-erase-buffer] Erase all input. + \\[quoted-insert] Insert the next character literally. + \\[delete-backward-char] Delete the previous character. + \\[exit-minibuffer] Accept what you have typed. + \\[keyboard-quit] Abort the command. + +All other characters insert themselves (but do not echo.)") + +;;; internal variables + +(defvar passwd-history nil) +(defvar passwd-history-posn 0) + +;;;###autoload +(defun read-passwd (prompt &optional confirm default) + "Prompts for a password in the minibuffer, and returns it as a string. +If PROMPT may be a prompt string or an alist of elements +'\(prompt . default\). +If optional arg CONFIRM is true, then ask the user to type the password +again to confirm that they typed it correctly. +If optional arg DEFAULT is provided, then it is a string to insert as +the default choice (it is not, of course, displayed.) + +If running under X, the keyboard will be grabbed (with XGrabKeyboard()) +to reduce the possibility that evesdropping is occuring. + +When reading a password, all keys self-insert, except for: +\\ + \\[read-passwd-erase-line] Erase the entire line. + \\[quoted-insert] Insert the next character literally. + \\[delete-backward-char] Delete the previous character. + \\[exit-minibuffer] Accept what you have typed. + \\[keyboard-quit] Abort the command. + +The returned value is always a newly-created string. No additional copies +of the password remain after this function has returned. + +NOTE: unless great care is taken, the typed password will exist in plaintext +form in the running image for an arbitrarily long time. Priveleged users may +be able to extract it from memory. If emacs crashes, it may appear in the +resultant core file. + +Some steps you can take to prevent the password from being copied around: + + - as soon as you are done with the returned string, destroy it with + (fillarray string 0). The same goes for any default passwords + or password histories. + + - do not copy the string, as with concat or substring - if you do, be + sure to keep track of and destroy all copies. + + - do not insert the password into a buffer - if you do, be sure to + overwrite the buffer text before killing it, as with the functions + `passwd-erase-buffer' or `passwd-kill-buffer'. Note that deleting + the text from the buffer does NOT necessarily remove the text from + memory. + + - be careful of the undo history - if you insert the password into a + buffer which has undo recording turned on, the password will be + copied onto the undo list, and thus recoverable. + + - do not pass it as an argument to a shell command - anyone will be + able to see it if they run `ps' at the right time. + +Note that the password will be temporarily recoverable with the `view-lossage' +command. This data will not be overwritten until another hundred or so +characters are typed. There's not currently a way around this." + + (save-excursion + (let ((input (get-buffer-create " *password*")) + (passwd-history-posn 0) + passwd-history) + (if (listp prompt) + (setq passwd-history prompt + default (cdr (car passwd-history)))) + (set-buffer input) + (buffer-disable-undo input) + (use-local-map read-passwd-map) + (unwind-protect + (progn + (if (passwd-grab-keyboard) + (passwd-secure-display)) + (read-passwd-1 input prompt nil default) + (set-buffer input) + + (if (not confirm) + (buffer-string) + (let ((ok nil) + passwd) + (while (not ok) + (set-buffer input) + (setq passwd (buffer-string)) + (read-passwd-1 input prompt "[Retype to confirm]") + (if (passwd-compare-string-to-buffer passwd input) + (setq ok t) + (fillarray passwd 0) + (setq passwd nil) + (beep) + (read-passwd-1 input prompt "[Mismatch. Start over]") + )) + passwd))) + ;; protected + (passwd-ungrab-keyboard) + (passwd-insecure-display) + (passwd-kill-buffer input) + (if (fboundp 'clear-message) ;XEmacs + (clear-message) + (message "")) + )))) + + +(defun read-passwd-1 (buffer prompt &optional prompt2 default) + (set-buffer buffer) + (passwd-erase-buffer) + (if default (insert default)) + (catch 'exit ; exit-minibuffer throws here + (while t + (set-buffer buffer) + (let* ((minibuffer-completion-table nil) + (cursor-in-echo-area t) + (echo-keystrokes 0) + (key (passwd-read-key-sequence + (concat (if (listp prompt) + (car (nth passwd-history-posn passwd-history)) + prompt) + prompt2 + (if passwd-echo + (make-string (buffer-size) passwd-echo))))) + (binding (key-binding key))) + (setq prompt2 nil) + (set-buffer buffer) ; just in case... + (if (fboundp 'event-to-character) ;; lemacs + (setq last-command-event (aref key (1- (length key))) + last-command-char (event-to-character last-command-event)) + ;; v18/FSFmacs compatibility + (setq last-command-char (aref key (1- (length key))))) + (setq this-command binding) + (condition-case c + (command-execute binding) + (error + (beep) + (if (fboundp 'display-error) + (display-error c t) + ;; v18/FSFmacs compatibility + (message (concat (or (get (car-safe c) 'error-message) "???") + (if (cdr-safe c) ": ") + (mapconcat + (function (lambda (x) (format "%s" x))) + (cdr-safe c) ", ")))) + (sit-for 2))) + )))) + +(defun passwd-previous-history-element (n) + (interactive "p") + (or passwd-history + (error "Password history is empty.")) + (let ((l (length passwd-history))) + (setq passwd-history-posn + (% (+ n passwd-history-posn) l)) + (if (< passwd-history-posn 0) + (setq passwd-history-posn (+ passwd-history-posn l)))) + (let ((obuff (current-buffer))) ; want to move point in passwd buffer + (unwind-protect + (progn + (set-buffer " *password*") + (passwd-erase-buffer) + (insert (cdr (nth passwd-history-posn passwd-history)))) + (set-buffer obuff)))) + +(defun passwd-next-history-element (n) + (interactive "p") + (passwd-previous-history-element (- n))) + +(defun passwd-erase-buffer () + ;; First erase the buffer, which will simply enlarge the gap. + ;; Then insert null characters until the gap is filled with them + ;; to prevent the old text from being visible in core files or kmem. + ;; (Actually use 3x the size of the buffer just to be safe - a longer + ;; passwd might have been typed and backspaced over.) + (interactive) + (widen) + (let ((s (* (buffer-size) 3))) + (erase-buffer) + (while (> s 0) + (insert ?\000) + (setq s (1- s))) + (erase-buffer))) + +(defun passwd-kill-buffer (buffer) + (save-excursion + (set-buffer buffer) + (buffer-disable-undo buffer) + (passwd-erase-buffer) + (set-buffer-modified-p nil)) + (kill-buffer buffer)) + + +(defun passwd-compare-string-to-buffer (string buffer) + ;; same as (equal string (buffer-string)) but with no dangerous consing. + (save-excursion + (set-buffer buffer) + (goto-char (point-min)) + (let ((L (length string)) + (i 0)) + (if (/= L (- (point-max) (point-min))) + nil + (while (not (eobp)) + (if (/= (following-char) (aref string i)) + (goto-char (point-max)) + (setq i (1+ i)) + (forward-char))) + (= (point) (+ i (point-min))))))) + + +(defvar passwd-face-data nil) +(defun passwd-secure-display () + ;; Inverts the screen - used to indicate secure input, like xterm. + (cond + ((and passwd-invert-frame-when-keyboard-grabbed + (fboundp 'set-face-foreground)) + (setq passwd-face-data + (delq nil (mapcar (function + (lambda (face) + (let ((fg (face-foreground face)) + (bg (face-background face))) + (if (or fg bg) + (if (fboundp 'color-name) + (list face + (color-name fg) + (color-name bg)) + (list face fg bg)) + nil)))) + (if (fboundp 'list-faces) + (list-faces) ; lemacs + (face-list) ; FSFmacs + )))) + (let ((rest passwd-face-data)) + (while rest + (set-face-foreground (nth 0 (car rest)) (nth 2 (car rest))) + (set-face-background (nth 0 (car rest)) (nth 1 (car rest))) + (setq rest (cdr rest)))))) + nil) + +(defun passwd-insecure-display () + ;; Undoes the effect of `passwd-secure-display'. + (cond + (passwd-invert-frame-when-keyboard-grabbed + (while passwd-face-data + (set-face-foreground (nth 0 (car passwd-face-data)) + (nth 1 (car passwd-face-data))) + (set-face-background (nth 0 (car passwd-face-data)) + (nth 2 (car passwd-face-data))) + (setq passwd-face-data (cdr passwd-face-data))) + nil))) + +(defun passwd-grab-keyboard () + (cond ((not (and (fboundp 'x-grab-keyboard) ; lemacs 19.10+ + (eq 'x (if (fboundp 'frame-type) + (frame-type (selected-frame)) + (live-screen-p (selected-screen)))))) + nil) + ((x-grab-keyboard) + t) + (t + (message "Unable to grab keyboard - waiting a second...") + (sleep-for 1) + (cond ((x-grab-keyboard) + (message "Keyboard grabbed on second try.") + t) + (t + (beep) + (message "WARNING: keyboard is insecure (unable to grab!)") + (sleep-for 3) + nil))))) + +(defun passwd-ungrab-keyboard () + (if (and (fboundp 'x-ungrab-keyboard) ; lemacs 19.10+ + (eq 'x (if (fboundp 'frame-type) + (frame-type (selected-frame)) + (live-screen-p (selected-screen))))) + (x-ungrab-keyboard))) + +;; v18 compatibility +(or (fboundp 'buffer-disable-undo) + (fset 'buffer-disable-undo 'buffer-flush-undo)) + +;; read-key-sequence echoes the key sequence in Emacs 18. +(defun passwd-read-key-sequence (prompt) + (let ((inhibit-quit t) + str) + (while (or (null str) (keymapp (key-binding str))) + (if (fboundp 'display-message) + (display-message 'prompt prompt) + (message prompt)) + (setq str (concat str (char-to-string (read-char))))) + (setq quit-flag nil) + str)) + +(or (string-match "^18" emacs-version) + (fset 'passwd-read-key-sequence 'read-key-sequence)) + +(provide 'passwd) + +;;; passwd.el ends here diff --git a/contrib/regexp-opt.el b/contrib/regexp-opt.el new file mode 100644 index 0000000..589f1b7 --- /dev/null +++ b/contrib/regexp-opt.el @@ -0,0 +1,238 @@ +;;; regexp-opt.el --- generate efficient regexps to match strings. + +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + +;; Author: Simon Marshall +;; Keywords: strings, regexps + +;; 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: + +;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i\\(se\\|ze\\)\\)". +;; +;; This package generates a regexp from a given list of strings (which matches +;; one of those strings) so that the regexp generated by: +;; +;; (regexp-opt strings) +;; +;; is equivalent to, but more efficient than, the regexp generated by: +;; +;; (mapconcat 'regexp-quote strings "\\|") +;; +;; For example: +;; +;; (let ((strings '("cond" "if" "when" "unless" "while" +;; "let" "let*" "progn" "prog1" "prog2" +;; "save-restriction" "save-excursion" "save-window-excursion" +;; "save-current-buffer" "save-match-data" +;; "catch" "throw" "unwind-protect" "condition-case"))) +;; (concat "(" (regexp-opt strings t) "\\>")) +;; => "(\\(c\\(atch\\|ond\\(ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)\\>" +;; +;; Searching using the above example `regexp-opt' regexp takes approximately +;; two-thirds of the time taken using the equivalent `mapconcat' regexp. + +;; Since this package was written to produce efficient regexps, not regexps +;; efficiently, it is probably not a good idea to in-line too many calls in +;; your code, unless you use the following trick with `eval-when-compile': +;; +;; (defvar definition-regexp +;; (eval-when-compile +;; (concat "^(" +;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias" +;; "defvar" "defconst") t) +;; "\\>"))) +;; +;; The `byte-compile' code will be as if you had defined the variable thus: +;; +;; (defvar definition-regexp +;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>") +;; +;; Note that if you use this trick for all instances of `regexp-opt' and +;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded +;; at compile time. But note also that using this trick means that should +;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to +;; improve the efficiency of `regexp-opt' regexps, you would have to recompile +;; your code for such changes to have effect in your code. + +;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with +;; thanks for ideas also to Michael Ernst, Bob Glickstein and Dan Nicolaescu. +;; Please don't tell me that it doesn't produce optimal regexps; I know that +;; already. For example, the above explanation for the meaning of "opt" would +;; be more efficient as "optim\\(al\\|i[sz]e\\)", but this requires complex +;; forward looking. But (ideas or) code to improve things (are) is welcome. + +;;; Code: + +;;;###autoload +(defun 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. +The returned regexp is typically more efficient than the equivalent regexp: + + (let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN \"\\\\)\" \"\"))) + (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren)) + +but typically contains more regexp grouping constructs. +Use `regexp-opt-depth' to count them." + (save-match-data + ;; Recurse on the sorted list. + (let ((max-lisp-eval-depth (* 1024 1024)) + (completion-ignore-case nil)) + (regexp-opt-group (sort (copy-sequence strings) 'string-lessp) paren)))) + +;;;###autoload +(defun regexp-opt-depth (regexp) + "Return the depth of REGEXP. +This means the number of regexp grouping constructs (parenthesised expressions) +in REGEXP." + (save-match-data + ;; Hack to signal an error if REGEXP does not have balanced parentheses. + (string-match regexp "") + ;; Count the number of open parentheses in REGEXP. + (let ((count 0) start) + (while (string-match "\\\\(" regexp start) + (setq count (1+ count) start (match-end 0))) + count))) + +;;; Workhorse functions. + +(eval-when-compile + (require 'cl)) + +(unless (fboundp 'make-bool-vector) + (defalias 'make-bool-vector 'make-vector)) + +(defun regexp-opt-group (strings &optional paren lax) + ;; + ;; Return a regexp to match a string in STRINGS. + ;; If PAREN non-nil, output regexp parentheses around returned regexp. + ;; If LAX non-nil, don't output parentheses if it doesn't require them. + ;; Merges keywords to avoid backtracking in Emacs' regexp matcher. + ;; + ;; The basic idea is to find the shortest common prefix, remove it and + ;; recurse. If there is no prefix, we divide the list into two so that (at + ;; least) one half will have at least a one-character common prefix. + ;; + ;; Also we delay the addition of grouping parenthesis as long as possible + ;; until we're sure we need them, and try to remove one-character sequences + ;; so we can use character sets rather than grouping parenthesis. + ;; + (let* ((open-group (if paren "\\(" "")) + (close-group (if paren "\\)" "")) + (open-charset (if lax "" open-group)) + (close-charset (if lax "" close-group))) + (cond + ;; + ;; If there is only one string, just return it. + ((= (length strings) 1) + (if (= (length (car strings)) 1) + (concat open-charset (regexp-quote (car strings)) close-charset) + (concat open-group (regexp-quote (car strings)) close-group))) + ;; + ;; If there is an empty string, remove it and recurse on the rest. + ((= (length (car strings)) 0) + (concat open-charset + (regexp-opt-group (cdr strings) t t) "?" + close-charset)) + ;; + ;; If all are one-character strings, just return a character set. + ((= (length strings) (apply '+ (mapcar 'length strings))) + (concat open-charset + (regexp-opt-charset strings) + close-charset)) + ;; + ;; We have a list of different length strings. + (t + (let ((prefix (try-completion "" (mapcar 'list strings))) + (letters (let ((completion-regexp-list '("^.$"))) + (all-completions "" (mapcar 'list strings))))) + (cond + ;; + ;; If there is a common prefix, remove it and recurse on the suffixes. + ((> (length prefix) 0) + (let* ((length (length prefix)) + (suffixes (mapcar (lambda (s) (substring s length)) strings))) + (concat open-group + (regexp-quote prefix) (regexp-opt-group suffixes t t) + close-group))) + ;; + ;; If there are several one-character strings, remove them and recurse + ;; on the rest (first so the final regexp finds the longest match). + ((> (length letters) 1) + (let ((rest (let ((completion-regexp-list '("^..+$"))) + (all-completions "" (mapcar 'list strings))))) + (concat open-group + (regexp-opt-group rest) "\\|" (regexp-opt-charset letters) + close-group))) + ;; + ;; Otherwise, divide the list into those that start with a particular + ;; letter and those that do not, and recurse on them. + (t + (let* ((char (substring (car strings) 0 1)) + (half1 (all-completions char (mapcar 'list strings))) + (half2 (nthcdr (length half1) strings))) + (concat open-group + (regexp-opt-group half1) "\\|" (regexp-opt-group half2) + close-group))))))))) + +(defun regexp-opt-charset (chars) + ;; + ;; Return a regexp to match a character in CHARS. + ;; + ;; The basic idea is to find character ranges. Also we take care in the + ;; position of character set meta characters in the character set regexp. + ;; + (let* ((charwidth 256) ; Yeah, right. + (charmap (make-bool-vector charwidth nil)) + (charset "") + (bracket "") (dash "") (caret "")) + ;; + ;; Make a character map but extract character set meta characters. + (dolist (char (mapcar 'string-to-char chars)) + (case char + (?\] + (setq bracket "]")) + (?^ + (setq caret "^")) + (?- + (setq dash "-")) + (otherwise + (aset charmap char t)))) + ;; + ;; Make a character set from the map using ranges where applicable. + (dotimes (char charwidth) + (let ((start char)) + (while (and (< char charwidth) (aref charmap char)) + (incf char)) + (cond ((> char (+ start 3)) + (setq charset (format "%s%c-%c" charset start (1- char)))) + ((> char start) + (setq charset (format "%s%c" charset (setq char start))))))) + ;; + ;; Make sure a caret is not first and a dash is first or last. + (if (and (string-equal charset "") (string-equal bracket "")) + (concat "[" dash caret "]") + (concat "[" bracket charset caret dash "]")))) + +(provide 'regexp-opt) + +;;; regexp-opt.el ends here diff --git a/contrib/rfc2015.el b/contrib/rfc2015.el deleted file mode 100644 index d182bbb..0000000 --- a/contrib/rfc2015.el +++ /dev/null @@ -1,188 +0,0 @@ -;;; rfc2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (c) 2000 Shenghuo Zhu - -;; Author: Shenghuo Zhu -;; Keywords: PGP MIME - -;; This file is not (yet) a part of GNU Emacs. Hope it -;; will be a part of oGnus distribution, then GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 2, or (at your -;; option) any later version. - -;; This file is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; 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: - -;; Installation: put the following statements in ~/.gnus: -;; (require 'rfc2015) -;; (require 'gnus-art) -;; (rfc2015-setup) -;; You may have to make sure that the directory where this file lives -;; is mentioned in `load-path'. -;; -;; Insert an attribute, postprocess=pgp-sign (or pgp-encrypt), into -;; the mml tag to be signed (or encrypted). - -;;; Code: - -(defvar rfc2015-decrypt-function 'mailcrypt-decrypt) -(defvar rfc2015-verify-function 'mailcrypt-verify) - -(defun rfc2015-decrypt (handle) - (let (child) - (cond - ((setq child (mm-find-part-by-type (cdr handle) - "application/octet-stream")) - (let (handles result) - (with-temp-buffer - (mm-insert-part child) - (setq result (funcall rfc2015-decrypt-function)) - (unless (car result) - (error "Decrypting error.")) - (setq handles (mm-dissect-buffer t))) - (setq gnus-article-mime-handles - (append (if (listp (car gnus-article-mime-handles)) - gnus-article-mime-handles - (list gnus-article-mime-handles)) - (if (listp (car handles)) - handles - (list handles)))) - (gnus-mime-display-part handles))) - (t - (if (y-or-n-p "Corrupted pgp-encrypted part. Abort?" ) - (error "Corrupted pgp-encrypted part.") - (gnus-mime-display-mixed (cdr handle))))))) - -;; FIXME: mm-dissect-buffer loses information of micalg and the -;; original header of signed part. - -(defun rfc2015-verify (handle) - (if (y-or-n-p "Verify signed part?" ) - (let (child result hash) - (with-temp-buffer - (unless (setq child (mm-find-part-by-type - (cdr handle) "application/pgp-signature" t)) - (error "Corrupted pgp-signature part.")) - (insert "-----BEGIN PGP SIGNED MESSAGE-----\n") - (insert (format "Hash: %s\n\n" (read-string "Hash: " "SHA1"))) - (mm-insert-part child) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (unless (setq child (mm-find-part-by-type - (cdr handle) "application/pgp-signature")) - (error "Corrupted pgp-signature part.")) - (mm-insert-part child) - (setq result (funcall rfc2015-verify-function)) - (unless result - (error "Verify error."))))) - (gnus-mime-display-part - (mm-find-part-by-type - (cdr handle) "application/pgp-signature" t))) - -(defvar rfc2015-mailcrypt-prefix 0) - -(defun rfc2015-mailcrypt-sign (cont) - (mailcrypt-sign rfc2015-mailcrypt-prefix) - (let ((boundary - (funcall mml-boundary-function (incf mml-multipart-number))) - (scheme-alist (funcall (or mc-default-scheme - (cdr (car mc-schemes))))) - hash) - (goto-char (point-min)) - (unless (re-search-forward (cdr (assq 'signed-begin-line scheme-alist))) - (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" - hash)) - (insert "\n") - (insert (format "--%s\n" boundary)) - (unless (re-search-forward (cdr (assq 'signed-end-line scheme-alist))) - (error "Cannot find signature part." )) - (goto-char (match-beginning 0)) - (unless (re-search-backward "^-+BEGIN" nil t) - (error "Cannot find signature part." )) - (goto-char (match-beginning 0)) - (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 rfc2015-mailcrypt-encrypt (cont) - ;; FIXME: - ;; You have to input the receiptant. - (mailcrypt-encrypt rfc2015-mailcrypt-prefix) - (let ((boundary - (funcall mml-boundary-function (incf mml-multipart-number)))) - (goto-char (point-min)) - (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)))) - -;; The following code might be moved into mml.el or gnus-art.el. - -(defvar mml-postprocess-alist - '(("pgp-sign" . rfc2015-mailcrypt-sign) - ("pgp-encrypt" . rfc2015-mailcrypt-encrypt)) - "Alist of postprocess functions.") - -(defun mml-postprocess (cont) - (let ((pp (cdr (or (assq 'postprocess cont) - (assq 'pp cont)))) - item) - (if (and pp (setq item (assoc pp mml-postprocess-alist))) - (funcall (cdr item) cont)))) - -(defun rfc2015-setup () - (setq mml-generate-mime-postprocess-function 'mml-postprocess) -; (push '("multipart/signed" . rfc2015-verify) -; gnus-mime-multipart-functions) - (push '("multipart/encrypted" . rfc2015-decrypt) - gnus-mime-multipart-functions)) - -;; The following code might be moved into mm-decode.el. - -(defun mm-find-part-by-type (handles type &optional notp) - (let (handle) - (while handles - (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)) - -(provide 'rfc2015) - -;;; rfc2015.el ends here diff --git a/contrib/smime.el b/contrib/smime.el deleted file mode 100644 index fb76337..0000000 --- a/contrib/smime.el +++ /dev/null @@ -1,279 +0,0 @@ -;;; smime.el --- S/MIME support library -;; Copyright (c) 2000 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Keywords: SMIME X.509 PEM OpenSSL - -;; 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 library perform S/MIME operations from within Emacs. -;; -;; Functions for fetching certificates from public repositories are -;; NOT provided (yet). -;; -;; It uses OpenSSL (tested with version 0.9.5a) for signing, -;; encryption and decryption. -;; -;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is -;; probably required to use this library in any useful way. -;; Especially, don't expect this library to buy security for you. If -;; you don't understand what you are doing, you're as likely to lose -;; security than gain any by using this library. - -;;; Quick introduction: - -;; Get your S/MIME certificate from VeriSign or someplace. I used -;; Netscape to generate the key and certificate request and stuff, and -;; Netscape can export the key into PKCS#12 format. -;; -;; Enter OpenSSL. To be able to use this library, it need to have the -;; SMIME key readable in PEM format. OpenSSL is used to convert the -;; key: -;; -;; $ openssl pkcs12 -in mykey.p12 -clcerts -nodes > mykey.pem -;; ... -;; -;; Now, use M-x customize-variable smime-keys and add mykey.pem as -;; a key. -;; -;; Now you should be able to sign messages! Create a buffer and write -;; something and run M-x smime-sign-buffer RET RET and you should see -;; your message MIME armoured and a signature. Encryption, M-x -;; smime-encrypt-buffer, should also work. -;; -;; To be able to verify messages you need to build up trust with -;; someone. Perhaps you trust the CA that issued your certificate, at -;; least I did, so I export it's certificates from my PKCS#12 -;; certificate with: -;; -;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem -;; ... -;; -;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a -;; CA certificate. -;; -;; You should now be able to sign messages, and even verify messages -;; sent by others that use the same CA as you. - -;; Bugs: -;; -;; Don't complain that this package doesn't do encrypted PEM files, -;; submit a patch instead. I store my keys in a safe place, so I -;; didn't need the encryption. Also, programming this was made a lot -;; easier by that decision. One might think that this even influenced -;; were I store my keys, and one would probably be right. :-) -;; -;; Suggestions and comments are appreciated, mail me at simon@josefsson.org. - -;; -;; -;; I would include pointers to introductory text on concepts used in -;; this library here, but the material I've read are so horrible I -;; don't want to recomend them. -;; -;; Why can't someone write a simple introduction to all this stuff? -;; Until then, much of this resemble security by obscurity. -;; -;; Also, I'm not going to mention anything about the wonders of -;; cryptopolitics. Oops, I just did. -;; -;; - -;;; Revision history: - -;; version 0 not released - -;;; Code: - -(defgroup smime nil - "S/MIME configuration.") - -(defcustom smime-keys nil - "Map your mail addresses to a file with your certified key. -The file is assumed to be in PEM format and not encrypted." - :type '(repeat (list (string :tag "Mail address") - (file :tag "File name"))) - :group 'smime) - -(defcustom smime-CAs nil - "List of directories/files containing certificates for CAs you trust. -Files should be in PEM format. -Directories should contain files (in PEM format) named to the X.509 -hash of the certificate." - :type '(repeat (radio (directory :tag "Trusted CA directory") - (file :tag "Trusted CA file"))) - :group 'smime) - -(defcustom smime-certificate-directory "~/Mail/certs/" - "Directory containing other people's certificates. -It should contain files named to the X.509 hash of the certificate, -and the files themself should be in PEM format. -The S/MIME library provide simple functionality for fetching -certificates into this directory, so there is no need to populate it -manually." - :type 'directory - :group 'smime) - -(defcustom smime-openssl-program "openssl" - "Name of OpenSSL binary." - :type 'string - :group 'smime) - -;; OpenSSL wrappers. - -(defun smime-call-openssl-region (b e buf &rest args) - (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) - (0 t) - (1 (error "OpenSSL: An error occurred parsing the command options.")) - (2 (error "OpenSSL: One of the input files could not be read.")) - (3 (error "OpenSSL: an error occurred creating the PKCS#7 file or when reading the MIME message.")) - (4 (error "OpenSSL: an error occurred decrypting or verifying the message.")) - (t (error "Unknown OpenSSL exitcode %s" exitcode)))) - -(defun smime-sign-region (b e keyfile) - "Sign region with certified key in KEYFILE. -If signing fails, the buffer is not modified. Region is assumed to -have proper MIME tags. KEYFILE is expected to contain a PEM encoded -private key and certificate." - (let* ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))) - (when (smime-call-openssl-region b e buffer "smime" "-sign" - "-signer" (expand-file-name keyfile)) - (delete-region b e) - (insert-buffer buffer) - (kill-buffer buffer) - t))) - -(defun smime-encrypt-region (b e certfiles) - "Encrypt region for recipients specified in CERTFILES. -If encryption fails, the buffer is not modified. Region is assumed to -have proper MIME tags. CERTFILES is a list of filenames, each file -is expected to contain of a PEM encoded certificate." - (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))) - (when (apply 'smime-call-openssl-region b e buffer "smime" "-encrypt" - (mapcar 'expand-file-name certfiles)) - (delete-region b e) - (insert-buffer buffer) - (kill-buffer buffer) - t))) - -(defun smime-sign-buffer (&optional keyfile buffer) - "S/MIME sign BUFFER with key in KEYFILE. -KEYFILE should contain a PEM encoded key and certificate." - (interactive) - (with-current-buffer (or buffer (current-buffer)) - (smime-sign-region - (point-min) (point-max) - (or keyfile - (smime-get-key-by-email - (completing-read "Sign using which signature? " smime-keys nil nil - (and (listp (car-safe smime-keys)) (caar smime-keys)))))))) - -(defun smime-encrypt-buffer (&optional certfiles buffer) - "S/MIME encrypt BUFFER for recipients specified in CERTFILES. -CERTFILES is a list of filenames, each file is expected to consist of -a PEM encoded key and certificate. Uses current buffer if BUFFER is -nil." - (interactive) - (with-current-buffer (or buffer (current-buffer)) - (smime-encrypt-region - (point-min) (point-max) - (or certfiles - (list (read-file-name "Recipient's S/MIME certificate: " - smime-certificate-directory nil)))))) - -;; User interface. - -(defvar smime-buffer "*SMIME*") - -(defvar smime-mode-map nil) -(put 'smime-mode 'mode-class 'special) - -(unless smime-mode-map - (setq smime-mode-map (make-sparse-keymap)) - (suppress-keymap smime-mode-map) - - (define-key smime-mode-map "q" 'smime-exit) - (define-key smime-mode-map "f" 'smime-certificate-info)) - -(defun smime-mode () - "Major mode for browsing, viewing and fetching certificates. - -All normal editing commands are switched off. -\\ - -The following commands are available: - -\\{smime-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'smime-mode) - (setq mode-name "SMIME") - (setq mode-line-process nil) - (use-local-map smime-mode-map) - (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t)) - -(defun smime-certificate-info (certfile) - (interactive "fCertificate file: ") - (let ((buffer (get-buffer-create (format "*certificate %s*" certfile)))) - (switch-to-buffer buffer) - (erase-buffer) - (call-process smime-openssl-program nil buffer 'display - "x509" "-in" (expand-file-name certfile) "-text") - (fundamental-mode) - (set-buffer-modified-p nil) - (toggle-read-only t) - (goto-char (point-min)))) - -(defun smime-draw-buffer () - (with-current-buffer smime-buffer - (let (buffer-read-only) - (erase-buffer) - (insert "\nYour keys:\n") - (dolist (key smime-keys) - (insert - (format "\t\t%s: %s\n" (car key) (cadr key)))) - (insert "\nTrusted Certificate Authoritys:\n") - (insert "\nKnown Certificates:\n")))) - -(defun smime () - "Go to the SMIME buffer." - (interactive) - (unless (get-buffer smime-buffer) - (save-excursion - (set-buffer (get-buffer-create smime-buffer)) - (smime-mode))) - (smime-draw-buffer) - (switch-to-buffer smime-buffer)) - -(defun smime-exit () - "Quit the S/MIME buffer." - (interactive) - (kill-buffer (current-buffer))) - -;; Other functions - -(defun smime-get-key-by-email (email) - (cadr (assoc email smime-keys))) - -(provide 'smime) - -;;; smime.el ends here diff --git a/contrib/ssl.el b/contrib/ssl.el new file mode 100644 index 0000000..fcb2509 --- /dev/null +++ b/contrib/ssl.el @@ -0,0 +1,201 @@ +;;; ssl.el,v --- ssl functions for emacsen without them builtin +;; Author: #Author: zsh # +;; Created: #Date: 2001/07/13 19:31:09 # +;; Version: #Revision: 1.2 # +;; Keywords: comm + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1995, 1996 by William M. Perry +;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. +;;; +;;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(eval-when-compile (require 'cl)) +(require 'base64) + +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup ssl nil + "Support for `Secure Sockets Layer' encryption." + :group 'comm) + +(defcustom ssl-certificate-directory "~/.w3/certs/" + "*Directory to store CA certificates in" + :group 'ssl + :type 'directory) + +(defcustom ssl-rehash-program-name "c_rehash" + "*Program to run after adding a cert to a directory . +Run with one argument, the directory name." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-name "x509" + "*The program to run to provide a human-readable view of a certificate." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER") + "*Arguments that should be passed to the certificate viewing program. +The certificate is piped to it. +Maybe a way of passing a file should be implemented" + :group 'ssl + :type 'list) + +(defcustom ssl-certificate-directory-style 'ssleay + "*Style of cert database to use, the only valid value right now is `ssleay'. +This means a directory of pem encoded certificates with hash symlinks." + :group 'ssl + :type '(choice (const :tag "SSLeay" :value ssleay) + (const :tag "OpenSSL" :value openssl))) + +(defcustom ssl-certificate-verification-policy 0 + "*How far up the certificate chain we should verify." + :group 'ssl + :type '(choice (const :tag "No verification" :value 0) + (const :tag "Verification required" :value 1) + (const :tag "Reject connection if verification fails" :value 3) + (const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5))) + +(defcustom ssl-program-name "openssl" + "*The program to run in a subprocess to open an SSL connection." + :group 'ssl + :type 'string) + +(defcustom ssl-program-arguments + '("s_client" + "-quiet" + "-host" host + "-port" service + "-verify" (int-to-string ssl-certificate-verification-policy) + "-CApath" ssl-certificate-directory + ) + "*Arguments that should be passed to the program `ssl-program-name'. +This should be used if your SSL program needs command line switches to +specify any behaviour (certificate file locations, etc). +The special symbols 'host and 'port may be used in the list of arguments +and will be replaced with the hostname and service/port that will be connected +to." + :group 'ssl + :type 'list) + +(defun ssl-certificate-information (der) + "Return an assoc list of information about a certificate in DER format." + (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" + (base64-encode-string der) + "\n-----END CERTIFICATE-----\n")) + (exit-code 0)) + (save-excursion + (set-buffer (get-buffer-create " *openssl*")) + (erase-buffer) + (insert certificate) + (setq exit-code (condition-case () + (call-process-region (point-min) (point-max) + ssl-program-name + t (list (current-buffer) nil) t + "x509" + "-subject" ; Print the subject DN + "-issuer" ; Print the issuer DN + "-dates" ; Both before and after dates + "-serial" ; print out serial number + "-noout" ; Don't spit out the certificate + ) + (error -1))) + (if (/= exit-code 0) + nil + (let ((vals nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\([^=\n\r]+\\)\\s *=\\s *\\(.*\\)" nil t) + (push (cons (match-string 1) (match-string 2)) vals)) + vals))))) + +(defun ssl-accept-ca-certificate () + "Ask if the user is willing to accept a new CA certificate. The buffer-name +should be the intended name of the certificate, and the buffer should probably +be in DER encoding" + ;; TODO, check if it is really new or if we already know it + (let* ((process-connection-type nil) + (tmpbuf (generate-new-buffer "X509 CA Certificate Information")) + (response (save-excursion + (and (eq 0 + (apply 'call-process-region + (point-min) (point-max) + ssl-view-certificate-program-name + nil tmpbuf t + ssl-view-certificate-program-arguments)) + (switch-to-buffer tmpbuf) + (goto-char (point-min)) + (or (recenter) t) + (yes-or-no-p + "Accept this CA to vouch for secure server identities? ") + (kill-buffer tmpbuf))))) + (if (not response) + nil + (if (not (file-directory-p ssl-certificate-directory)) + (make-directory ssl-certificate-directory)) + (case ssl-certificate-directory-style + (ssleay + (base64-encode-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "-----BEGIN CERTIFICATE-----\n") + (goto-char (point-max)) + (insert "-----END CERTIFICATE-----\n") + (let ((f (expand-file-name + (concat (file-name-sans-extension (buffer-name)) ".pem") + ssl-certificate-directory))) + (write-file f) + (call-process ssl-rehash-program-name + nil nil nil + (expand-file-name ssl-certificate-directory)))))))) + +(defun open-ssl-stream (name buffer host service) + "Open a SSL connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (if (integerp service) (setq service (int-to-string service))) + (let* ((process-connection-type nil) + (port service) + (proc (eval + (` + (start-process name buffer ssl-program-name + (,@ ssl-program-arguments)))))) + (process-kill-without-query proc) + proc)) + +(provide 'ssl) diff --git a/contrib/ucs-tables.el b/contrib/ucs-tables.el new file mode 100644 index 0000000..0255053 --- /dev/null +++ b/contrib/ucs-tables.el @@ -0,0 +1,2479 @@ +;;; ucs-tables.el --- translation to, from and via Unicode -*- coding: iso-2022-7bit -*- + +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: Dave Love +;; Keywords: i18n + +;; This file is part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; 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 file provides tables mapping between Unicode numbers and +;; emacs-mule characters from the iso-8859 charsets (and others). It +;; also provides some auxiliary functions. + +;; These tables are used to construct other mappings between the Mule +;; iso8859 charsets and the emacs-unicode charsets and a table that +;; unifies iso8859 characters using a single charset as far as +;; possible. These tables are used by latin1-disp.el to display some +;; Unicode characters without a Unicode font and by utf-8.el to unify +;; Latin-N as far as possible on encoding. + +;; More drastically, they can be used to unify 8859 into Latin-1 plus +;; mule-unicode-0100-24ff on decoding, with the corresponding +;; adjustments on encoding; see `ucs-unify-8859'. Be wary of using +;; unification when, for instance, editing Lisp files such as this one +;; which are supposed to contain distinct 8859 charsets. Also, it can +;; make reading and writing of emacs-mule and iso-2022-based encodings +;; not idempotent. + +;; Global minor modes are provided to unify on encoding and decoding. + +;; The translation table `ucs-mule-to-mule-unicode' is populated. +;; This is used by the `mule-utf-8' coding system to encode extra +;; characters. + +;; Command `ucs-insert' is convenient for inserting a given Unicode. +;; (See also the `ucs' input method.) + +;;; Code: + +(when (featurep 'xemacs) + (error "This file cannot be used with XEmacs. For XEmacs, use latin-unity instead")) + +;;; Define tables, to be populated later. + +(defvar ucs-mule-8859-to-ucs-table (make-translation-table) + "Translation table from Emacs ISO-8859 characters to Unicode. +This maps Emacs characters from the non-Latin-1 +...-iso8859-... charsets to their Unicode code points. This is a +many-to-one mapping.") + +(defvar ucs-mule-8859-to-mule-unicode (make-translation-table) + "Translation table from Emacs ISO-8859 characters to Mule Unicode. +This maps Emacs characters from the non-Latin-1 +...-iso8859-... charsets to characters from the +mule-unicode-... charsets. This is a many-to-one mapping. The +characters translated to are suitable for encoding using the +`mule-utf-8' coding system.") + +;; (defvar ucs-ucs-to-mule-8859-table (make-translation-table) +;; "Translation table from Unicode to Emacs ISO-8859 characters. +;; This maps Unicode code points to corresponding Emacs characters from +;; the ...-iso8859-... charsets. This is made a one-to-one mapping where +;; the same character occurs in more than one set by preferring the Emacs +;; iso-8859-N character with lowest N.") + +;; (defvar ucs-mule-unicode-to-mule-8859 (make-translation-table) +;; "Translation table from Mule Unicode to Emacs ISO-8859 characters. +;; This maps non-Latin-1 Emacs characters from the +;; mule-unicode-... charsets used by the `mule-utf-8' coding system to +;; characters from the ...-iso8859-... charsets. This is made a +;; one-to-one mapping where the same character occurs in more than one +;; set by preferring the Emacs iso-8859-N character with lowest N.") + +(defvar ucs-8859-1-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-2. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-2-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-2. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-3-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-3. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-4-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-4. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-5-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-5. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-7-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-7. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-8-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-8. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-9-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-9. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-14-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-14. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +(defvar ucs-8859-15-encode-table nil + "Used as `translation-table-for-encode' for iso-8859-15. +Translates from the iso8859 charsets and `mule-unicode-0100-24ff'.") + +;; Probably defined by utf-8.el. +(defvar ucs-mule-to-mule-unicode (make-translation-table)) +(unless (get 'ucs-mule-to-mule-unicode 'translation-table) + (define-translation-table 'ucs-mule-to-mule-unicode ucs-mule-to-mule-unicode)) +;;; Set up the tables. + +;; Most of these tables were derived from ones in Mule-UCS. + +;; There doesn't seem to be a need to make these let bindings into +;; defvars, so we'll let the data get GC'ed. +(let ((ucs-8859-2-alist + '((?\,B (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,B!(B . ?\x0104) ;; LATIN CAPITAL LETTER A WITH OGONEK + (?\,B"(B . ?\x02D8) ;; BREVE + (?\,B#(B . ?\x0141) ;; LATIN CAPITAL LETTER L WITH STROKE + (?\,B$(B . ?\x00A4) ;; CURRENCY SIGN + (?\,B%(B . ?\x013D) ;; LATIN CAPITAL LETTER L WITH CARON + (?\,B&(B . ?\x015A) ;; LATIN CAPITAL LETTER S WITH ACUTE + (?\,B'(B . ?\x00A7) ;; SECTION SIGN + (?\,B((B . ?\x00A8) ;; DIAERESIS + (?\,B)(B . ?\x0160) ;; LATIN CAPITAL LETTER S WITH CARON + (?\,B*(B . ?\x015E) ;; LATIN CAPITAL LETTER S WITH CEDILLA + (?\,B+(B . ?\x0164) ;; LATIN CAPITAL LETTER T WITH CARON + (?\,B,(B . ?\x0179) ;; LATIN CAPITAL LETTER Z WITH ACUTE + (?\,B-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,B.(B . ?\x017D) ;; LATIN CAPITAL LETTER Z WITH CARON + (?\,B/(B . ?\x017B) ;; LATIN CAPITAL LETTER Z WITH DOT ABOVE + (?\,B0(B . ?\x00B0) ;; DEGREE SIGN + (?\,B1(B . ?\x0105) ;; LATIN SMALL LETTER A WITH OGONEK + (?\,B2(B . ?\x02DB) ;; OGONEK + (?\,B3(B . ?\x0142) ;; LATIN SMALL LETTER L WITH STROKE + (?\,B4(B . ?\x00B4) ;; ACUTE ACCENT + (?\,B5(B . ?\x013E) ;; LATIN SMALL LETTER L WITH CARON + (?\,B6(B . ?\x015B) ;; LATIN SMALL LETTER S WITH ACUTE + (?\,B7(B . ?\x02C7) ;; CARON + (?\,B8(B . ?\x00B8) ;; CEDILLA + (?\,B9(B . ?\x0161) ;; LATIN SMALL LETTER S WITH CARON + (?\,B:(B . ?\x015F) ;; LATIN SMALL LETTER S WITH CEDILLA + (?\,B;(B . ?\x0165) ;; LATIN SMALL LETTER T WITH CARON + (?\,B<(B . ?\x017A) ;; LATIN SMALL LETTER Z WITH ACUTE + (?\,B=(B . ?\x02DD) ;; DOUBLE ACUTE ACCENT + (?\,B>(B . ?\x017E) ;; LATIN SMALL LETTER Z WITH CARON + (?\,B?(B . ?\x017C) ;; LATIN SMALL LETTER Z WITH DOT ABOVE + (?\,B@(B . ?\x0154) ;; LATIN CAPITAL LETTER R WITH ACUTE + (?\,BA(B . ?\x00C1) ;; LATIN CAPITAL LETTER A WITH ACUTE + (?\,BB(B . ?\x00C2) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX + (?\,BC(B . ?\x0102) ;; LATIN CAPITAL LETTER A WITH BREVE + (?\,BD(B . ?\x00C4) ;; LATIN CAPITAL LETTER A WITH DIAERESIS + (?\,BE(B . ?\x0139) ;; LATIN CAPITAL LETTER L WITH ACUTE + (?\,BF(B . ?\x0106) ;; LATIN CAPITAL LETTER C WITH ACUTE + (?\,BG(B . ?\x00C7) ;; LATIN CAPITAL LETTER C WITH CEDILLA + (?\,BH(B . ?\x010C) ;; LATIN CAPITAL LETTER C WITH CARON + (?\,BI(B . ?\x00C9) ;; LATIN CAPITAL LETTER E WITH ACUTE + (?\,BJ(B . ?\x0118) ;; LATIN CAPITAL LETTER E WITH OGONEK + (?\,BK(B . ?\x00CB) ;; LATIN CAPITAL LETTER E WITH DIAERESIS + (?\,BL(B . ?\x011A) ;; LATIN CAPITAL LETTER E WITH CARON + (?\,BM(B . ?\x00CD) ;; LATIN CAPITAL LETTER I WITH ACUTE + (?\,BN(B . ?\x00CE) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX + (?\,BO(B . ?\x010E) ;; LATIN CAPITAL LETTER D WITH CARON + (?\,BP(B . ?\x0110) ;; LATIN CAPITAL LETTER D WITH STROKE + (?\,BQ(B . ?\x0143) ;; LATIN CAPITAL LETTER N WITH ACUTE + (?\,BR(B . ?\x0147) ;; LATIN CAPITAL LETTER N WITH CARON + (?\,BS(B . ?\x00D3) ;; LATIN CAPITAL LETTER O WITH ACUTE + (?\,BT(B . ?\x00D4) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX + (?\,BU(B . ?\x0150) ;; LATIN CAPITAL LETTER O WITH DOUBLE ACUTE + (?\,BV(B . ?\x00D6) ;; LATIN CAPITAL LETTER O WITH DIAERESIS + (?\,BW(B . ?\x00D7) ;; MULTIPLICATION SIGN + (?\,BX(B . ?\x0158) ;; LATIN CAPITAL LETTER R WITH CARON + (?\,BY(B . ?\x016E) ;; LATIN CAPITAL LETTER U WITH RING ABOVE + (?\,BZ(B . ?\x00DA) ;; LATIN CAPITAL LETTER U WITH ACUTE + (?\,B[(B . ?\x0170) ;; LATIN CAPITAL LETTER U WITH DOUBLE ACUTE + (?\,B\(B . ?\x00DC) ;; LATIN CAPITAL LETTER U WITH DIAERESIS + (?\,B](B . ?\x00DD) ;; LATIN CAPITAL LETTER Y WITH ACUTE + (?\,B^(B . ?\x0162) ;; LATIN CAPITAL LETTER T WITH CEDILLA + (?\,B_(B . ?\x00DF) ;; LATIN SMALL LETTER SHARP S + (?\,B`(B . ?\x0155) ;; LATIN SMALL LETTER R WITH ACUTE + (?\,Ba(B . ?\x00E1) ;; LATIN SMALL LETTER A WITH ACUTE + (?\,Bb(B . ?\x00E2) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX + (?\,Bc(B . ?\x0103) ;; LATIN SMALL LETTER A WITH BREVE + (?\,Bd(B . ?\x00E4) ;; LATIN SMALL LETTER A WITH DIAERESIS + (?\,Be(B . ?\x013A) ;; LATIN SMALL LETTER L WITH ACUTE + (?\,Bf(B . ?\x0107) ;; LATIN SMALL LETTER C WITH ACUTE + (?\,Bg(B . ?\x00E7) ;; LATIN SMALL LETTER C WITH CEDILLA + (?\,Bh(B . ?\x010D) ;; LATIN SMALL LETTER C WITH CARON + (?\,Bi(B . ?\x00E9) ;; LATIN SMALL LETTER E WITH ACUTE + (?\,Bj(B . ?\x0119) ;; LATIN SMALL LETTER E WITH OGONEK + (?\,Bk(B . ?\x00EB) ;; LATIN SMALL LETTER E WITH DIAERESIS + (?\,Bl(B . ?\x011B) ;; LATIN SMALL LETTER E WITH CARON + (?\,Bm(B . ?\x00ED) ;; LATIN SMALL LETTER I WITH ACUTE + (?\,Bn(B . ?\x00EE) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX + (?\,Bo(B . ?\x010F) ;; LATIN SMALL LETTER D WITH CARON + (?\,Bp(B . ?\x0111) ;; LATIN SMALL LETTER D WITH STROKE + (?\,Bq(B . ?\x0144) ;; LATIN SMALL LETTER N WITH ACUTE + (?\,Br(B . ?\x0148) ;; LATIN SMALL LETTER N WITH CARON + (?\,Bs(B . ?\x00F3) ;; LATIN SMALL LETTER O WITH ACUTE + (?\,Bt(B . ?\x00F4) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX + (?\,Bu(B . ?\x0151) ;; LATIN SMALL LETTER O WITH DOUBLE ACUTE + (?\,Bv(B . ?\x00F6) ;; LATIN SMALL LETTER O WITH DIAERESIS + (?\,Bw(B . ?\x00F7) ;; DIVISION SIGN + (?\,Bx(B . ?\x0159) ;; LATIN SMALL LETTER R WITH CARON + (?\,By(B . ?\x016F) ;; LATIN SMALL LETTER U WITH RING ABOVE + (?\,Bz(B . ?\x00FA) ;; LATIN SMALL LETTER U WITH ACUTE + (?\,B{(B . ?\x0171) ;; LATIN SMALL LETTER U WITH DOUBLE ACUTE + (?\,B|(B . ?\x00FC) ;; LATIN SMALL LETTER U WITH DIAERESIS + (?\,B}(B . ?\x00FD) ;; LATIN SMALL LETTER Y WITH ACUTE + (?\,B~(B . ?\x0163) ;; LATIN SMALL LETTER T WITH CEDILLA + (?\,B(B . ?\x02D9) ;; DOT ABOVE + )) + + (ucs-8859-3-alist + '((?\,C (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,C!(B . ?\x0126) ;; LATIN CAPITAL LETTER H WITH STROKE + (?\,C"(B . ?\x02D8) ;; BREVE + (?\,C#(B . ?\x00A3) ;; POUND SIGN + (?\,C$(B . ?\x00A4) ;; CURRENCY SIGN + (?\,C&(B . ?\x0124) ;; LATIN CAPITAL LETTER H WITH CIRCUMFLEX + (?\,C'(B . ?\x00A7) ;; SECTION SIGN + (?\,C((B . ?\x00A8) ;; DIAERESIS + (?\,C)(B . ?\x0130) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE + (?\,C*(B . ?\x015E) ;; LATIN CAPITAL LETTER S WITH CEDILLA + (?\,C+(B . ?\x011E) ;; LATIN CAPITAL LETTER G WITH BREVE + (?\,C,(B . ?\x0134) ;; LATIN CAPITAL LETTER J WITH CIRCUMFLEX + (?\,C-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,C/(B . ?\x017B) ;; LATIN CAPITAL LETTER Z WITH DOT ABOVE + (?\,C0(B . ?\x00B0) ;; DEGREE SIGN + (?\,C1(B . ?\x0127) ;; LATIN SMALL LETTER H WITH STROKE + (?\,C2(B . ?\x00B2) ;; SUPERSCRIPT TWO + (?\,C3(B . ?\x00B3) ;; SUPERSCRIPT THREE + (?\,C4(B . ?\x00B4) ;; ACUTE ACCENT + (?\,C5(B . ?\x00B5) ;; MICRO SIGN + (?\,C6(B . ?\x0125) ;; LATIN SMALL LETTER H WITH CIRCUMFLEX + (?\,C7(B . ?\x00B7) ;; MIDDLE DOT + (?\,C8(B . ?\x00B8) ;; CEDILLA + (?\,C9(B . ?\x0131) ;; LATIN SMALL LETTER DOTLESS I + (?\,C:(B . ?\x015F) ;; LATIN SMALL LETTER S WITH CEDILLA + (?\,C;(B . ?\x011F) ;; LATIN SMALL LETTER G WITH BREVE + (?\,C<(B . ?\x0135) ;; LATIN SMALL LETTER J WITH CIRCUMFLEX + (?\,C=(B . ?\x00BD) ;; VULGAR FRACTION ONE HALF + (?\,C?(B . ?\x017C) ;; LATIN SMALL LETTER Z WITH DOT ABOVE + (?\,C@(B . ?\x00C0) ;; LATIN CAPITAL LETTER A WITH GRAVE + (?\,CA(B . ?\x00C1) ;; LATIN CAPITAL LETTER A WITH ACUTE + (?\,CB(B . ?\x00C2) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX + (?\,CD(B . ?\x00C4) ;; LATIN CAPITAL LETTER A WITH DIAERESIS + (?\,CE(B . ?\x010A) ;; LATIN CAPITAL LETTER C WITH DOT ABOVE + (?\,CF(B . ?\x0108) ;; LATIN CAPITAL LETTER C WITH CIRCUMFLEX + (?\,CG(B . ?\x00C7) ;; LATIN CAPITAL LETTER C WITH CEDILLA + (?\,CH(B . ?\x00C8) ;; LATIN CAPITAL LETTER E WITH GRAVE + (?\,CI(B . ?\x00C9) ;; LATIN CAPITAL LETTER E WITH ACUTE + (?\,CJ(B . ?\x00CA) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX + (?\,CK(B . ?\x00CB) ;; LATIN CAPITAL LETTER E WITH DIAERESIS + (?\,CL(B . ?\x00CC) ;; LATIN CAPITAL LETTER I WITH GRAVE + (?\,CM(B . ?\x00CD) ;; LATIN CAPITAL LETTER I WITH ACUTE + (?\,CN(B . ?\x00CE) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX + (?\,CO(B . ?\x00CF) ;; LATIN CAPITAL LETTER I WITH DIAERESIS + (?\,CQ(B . ?\x00D1) ;; LATIN CAPITAL LETTER N WITH TILDE + (?\,CR(B . ?\x00D2) ;; LATIN CAPITAL LETTER O WITH GRAVE + (?\,CS(B . ?\x00D3) ;; LATIN CAPITAL LETTER O WITH ACUTE + (?\,CT(B . ?\x00D4) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX + (?\,CU(B . ?\x0120) ;; LATIN CAPITAL LETTER G WITH DOT ABOVE + (?\,CV(B . ?\x00D6) ;; LATIN CAPITAL LETTER O WITH DIAERESIS + (?\,CW(B . ?\x00D7) ;; MULTIPLICATION SIGN + (?\,CX(B . ?\x011C) ;; LATIN CAPITAL LETTER G WITH CIRCUMFLEX + (?\,CY(B . ?\x00D9) ;; LATIN CAPITAL LETTER U WITH GRAVE + (?\,CZ(B . ?\x00DA) ;; LATIN CAPITAL LETTER U WITH ACUTE + (?\,C[(B . ?\x00DB) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX + (?\,C\(B . ?\x00DC) ;; LATIN CAPITAL LETTER U WITH DIAERESIS + (?\,C](B . ?\x016C) ;; LATIN CAPITAL LETTER U WITH BREVE + (?\,C^(B . ?\x015C) ;; LATIN CAPITAL LETTER S WITH CIRCUMFLEX + (?\,C_(B . ?\x00DF) ;; LATIN SMALL LETTER SHARP S + (?\,C`(B . ?\x00E0) ;; LATIN SMALL LETTER A WITH GRAVE + (?\,Ca(B . ?\x00E1) ;; LATIN SMALL LETTER A WITH ACUTE + (?\,Cb(B . ?\x00E2) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX + (?\,Cd(B . ?\x00E4) ;; LATIN SMALL LETTER A WITH DIAERESIS + (?\,Ce(B . ?\x010B) ;; LATIN SMALL LETTER C WITH DOT ABOVE + (?\,Cf(B . ?\x0109) ;; LATIN SMALL LETTER C WITH CIRCUMFLEX + (?\,Cg(B . ?\x00E7) ;; LATIN SMALL LETTER C WITH CEDILLA + (?\,Ch(B . ?\x00E8) ;; LATIN SMALL LETTER E WITH GRAVE + (?\,Ci(B . ?\x00E9) ;; LATIN SMALL LETTER E WITH ACUTE + (?\,Cj(B . ?\x00EA) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX + (?\,Ck(B . ?\x00EB) ;; LATIN SMALL LETTER E WITH DIAERESIS + (?\,Cl(B . ?\x00EC) ;; LATIN SMALL LETTER I WITH GRAVE + (?\,Cm(B . ?\x00ED) ;; LATIN SMALL LETTER I WITH ACUTE + (?\,Cn(B . ?\x00EE) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX + (?\,Co(B . ?\x00EF) ;; LATIN SMALL LETTER I WITH DIAERESIS + (?\,Cq(B . ?\x00F1) ;; LATIN SMALL LETTER N WITH TILDE + (?\,Cr(B . ?\x00F2) ;; LATIN SMALL LETTER O WITH GRAVE + (?\,Cs(B . ?\x00F3) ;; LATIN SMALL LETTER O WITH ACUTE + (?\,Ct(B . ?\x00F4) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX + (?\,Cu(B . ?\x0121) ;; LATIN SMALL LETTER G WITH DOT ABOVE + (?\,Cv(B . ?\x00F6) ;; LATIN SMALL LETTER O WITH DIAERESIS + (?\,Cw(B . ?\x00F7) ;; DIVISION SIGN + (?\,Cx(B . ?\x011D) ;; LATIN SMALL LETTER G WITH CIRCUMFLEX + (?\,Cy(B . ?\x00F9) ;; LATIN SMALL LETTER U WITH GRAVE + (?\,Cz(B . ?\x00FA) ;; LATIN SMALL LETTER U WITH ACUTE + (?\,C{(B . ?\x00FB) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX + (?\,C|(B . ?\x00FC) ;; LATIN SMALL LETTER U WITH DIAERESIS + (?\,C}(B . ?\x016D) ;; LATIN SMALL LETTER U WITH BREVE + (?\,C~(B . ?\x015D) ;; LATIN SMALL LETTER S WITH CIRCUMFLEX + (?\,C(B . ?\x02D9) ;; DOT ABOVE + )) + + (ucs-8859-4-alist + '((?\,D (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,D!(B . ?\x0104) ;; LATIN CAPITAL LETTER A WITH OGONEK + (?\,D"(B . ?\x0138) ;; LATIN SMALL LETTER KRA + (?\,D#(B . ?\x0156) ;; LATIN CAPITAL LETTER R WITH CEDILLA + (?\,D$(B . ?\x00A4) ;; CURRENCY SIGN + (?\,D%(B . ?\x0128) ;; LATIN CAPITAL LETTER I WITH TILDE + (?\,D&(B . ?\x013B) ;; LATIN CAPITAL LETTER L WITH CEDILLA + (?\,D'(B . ?\x00A7) ;; SECTION SIGN + (?\,D((B . ?\x00A8) ;; DIAERESIS + (?\,D)(B . ?\x0160) ;; LATIN CAPITAL LETTER S WITH CARON + (?\,D*(B . ?\x0112) ;; LATIN CAPITAL LETTER E WITH MACRON + (?\,D+(B . ?\x0122) ;; LATIN CAPITAL LETTER G WITH CEDILLA + (?\,D,(B . ?\x0166) ;; LATIN CAPITAL LETTER T WITH STROKE + (?\,D-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,D.(B . ?\x017D) ;; LATIN CAPITAL LETTER Z WITH CARON + (?\,D/(B . ?\x00AF) ;; MACRON + (?\,D0(B . ?\x00B0) ;; DEGREE SIGN + (?\,D1(B . ?\x0105) ;; LATIN SMALL LETTER A WITH OGONEK + (?\,D2(B . ?\x02DB) ;; OGONEK + (?\,D3(B . ?\x0157) ;; LATIN SMALL LETTER R WITH CEDILLA + (?\,D4(B . ?\x00B4) ;; ACUTE ACCENT + (?\,D5(B . ?\x0129) ;; LATIN SMALL LETTER I WITH TILDE + (?\,D6(B . ?\x013C) ;; LATIN SMALL LETTER L WITH CEDILLA + (?\,D7(B . ?\x02C7) ;; CARON + (?\,D8(B . ?\x00B8) ;; CEDILLA + (?\,D9(B . ?\x0161) ;; LATIN SMALL LETTER S WITH CARON + (?\,D:(B . ?\x0113) ;; LATIN SMALL LETTER E WITH MACRON + (?\,D;(B . ?\x0123) ;; LATIN SMALL LETTER G WITH CEDILLA + (?\,D<(B . ?\x0167) ;; LATIN SMALL LETTER T WITH STROKE + (?\,D=(B . ?\x014A) ;; LATIN CAPITAL LETTER ENG + (?\,D>(B . ?\x017E) ;; LATIN SMALL LETTER Z WITH CARON + (?\,D?(B . ?\x014B) ;; LATIN SMALL LETTER ENG + (?\,D@(B . ?\x0100) ;; LATIN CAPITAL LETTER A WITH MACRON + (?\,DA(B . ?\x00C1) ;; LATIN CAPITAL LETTER A WITH ACUTE + (?\,DB(B . ?\x00C2) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX + (?\,DC(B . ?\x00C3) ;; LATIN CAPITAL LETTER A WITH TILDE + (?\,DD(B . ?\x00C4) ;; LATIN CAPITAL LETTER A WITH DIAERESIS + (?\,DE(B . ?\x00C5) ;; LATIN CAPITAL LETTER A WITH RING ABOVE + (?\,DF(B . ?\x00C6) ;; LATIN CAPITAL LETTER AE + (?\,DG(B . ?\x012E) ;; LATIN CAPITAL LETTER I WITH OGONEK + (?\,DH(B . ?\x010C) ;; LATIN CAPITAL LETTER C WITH CARON + (?\,DI(B . ?\x00C9) ;; LATIN CAPITAL LETTER E WITH ACUTE + (?\,DJ(B . ?\x0118) ;; LATIN CAPITAL LETTER E WITH OGONEK + (?\,DK(B . ?\x00CB) ;; LATIN CAPITAL LETTER E WITH DIAERESIS + (?\,DL(B . ?\x0116) ;; LATIN CAPITAL LETTER E WITH DOT ABOVE + (?\,DM(B . ?\x00CD) ;; LATIN CAPITAL LETTER I WITH ACUTE + (?\,DN(B . ?\x00CE) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX + (?\,DO(B . ?\x012A) ;; LATIN CAPITAL LETTER I WITH MACRON + (?\,DP(B . ?\x0110) ;; LATIN CAPITAL LETTER D WITH STROKE + (?\,DQ(B . ?\x0145) ;; LATIN CAPITAL LETTER N WITH CEDILLA + (?\,DR(B . ?\x014C) ;; LATIN CAPITAL LETTER O WITH MACRON + (?\,DS(B . ?\x0136) ;; LATIN CAPITAL LETTER K WITH CEDILLA + (?\,DT(B . ?\x00D4) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX + (?\,DU(B . ?\x00D5) ;; LATIN CAPITAL LETTER O WITH TILDE + (?\,DV(B . ?\x00D6) ;; LATIN CAPITAL LETTER O WITH DIAERESIS + (?\,DW(B . ?\x00D7) ;; MULTIPLICATION SIGN + (?\,DX(B . ?\x00D8) ;; LATIN CAPITAL LETTER O WITH STROKE + (?\,DY(B . ?\x0172) ;; LATIN CAPITAL LETTER U WITH OGONEK + (?\,DZ(B . ?\x00DA) ;; LATIN CAPITAL LETTER U WITH ACUTE + (?\,D[(B . ?\x00DB) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX + (?\,D\(B . ?\x00DC) ;; LATIN CAPITAL LETTER U WITH DIAERESIS + (?\,D](B . ?\x0168) ;; LATIN CAPITAL LETTER U WITH TILDE + (?\,D^(B . ?\x016A) ;; LATIN CAPITAL LETTER U WITH MACRON + (?\,D_(B . ?\x00DF) ;; LATIN SMALL LETTER SHARP S + (?\,D`(B . ?\x0101) ;; LATIN SMALL LETTER A WITH MACRON + (?\,Da(B . ?\x00E1) ;; LATIN SMALL LETTER A WITH ACUTE + (?\,Db(B . ?\x00E2) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX + (?\,Dc(B . ?\x00E3) ;; LATIN SMALL LETTER A WITH TILDE + (?\,Dd(B . ?\x00E4) ;; LATIN SMALL LETTER A WITH DIAERESIS + (?\,De(B . ?\x00E5) ;; LATIN SMALL LETTER A WITH RING ABOVE + (?\,Df(B . ?\x00E6) ;; LATIN SMALL LETTER AE + (?\,Dg(B . ?\x012F) ;; LATIN SMALL LETTER I WITH OGONEK + (?\,Dh(B . ?\x010D) ;; LATIN SMALL LETTER C WITH CARON + (?\,Di(B . ?\x00E9) ;; LATIN SMALL LETTER E WITH ACUTE + (?\,Dj(B . ?\x0119) ;; LATIN SMALL LETTER E WITH OGONEK + (?\,Dk(B . ?\x00EB) ;; LATIN SMALL LETTER E WITH DIAERESIS + (?\,Dl(B . ?\x0117) ;; LATIN SMALL LETTER E WITH DOT ABOVE + (?\,Dm(B . ?\x00ED) ;; LATIN SMALL LETTER I WITH ACUTE + (?\,Dn(B . ?\x00EE) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX + (?\,Do(B . ?\x012B) ;; LATIN SMALL LETTER I WITH MACRON + (?\,Dp(B . ?\x0111) ;; LATIN SMALL LETTER D WITH STROKE + (?\,Dq(B . ?\x0146) ;; LATIN SMALL LETTER N WITH CEDILLA + (?\,Dr(B . ?\x014D) ;; LATIN SMALL LETTER O WITH MACRON + (?\,Ds(B . ?\x0137) ;; LATIN SMALL LETTER K WITH CEDILLA + (?\,Dt(B . ?\x00F4) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX + (?\,Du(B . ?\x00F5) ;; LATIN SMALL LETTER O WITH TILDE + (?\,Dv(B . ?\x00F6) ;; LATIN SMALL LETTER O WITH DIAERESIS + (?\,Dw(B . ?\x00F7) ;; DIVISION SIGN + (?\,Dx(B . ?\x00F8) ;; LATIN SMALL LETTER O WITH STROKE + (?\,Dy(B . ?\x0173) ;; LATIN SMALL LETTER U WITH OGONEK + (?\,Dz(B . ?\x00FA) ;; LATIN SMALL LETTER U WITH ACUTE + (?\,D{(B . ?\x00FB) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX + (?\,D|(B . ?\x00FC) ;; LATIN SMALL LETTER U WITH DIAERESIS + (?\,D}(B . ?\x0169) ;; LATIN SMALL LETTER U WITH TILDE + (?\,D~(B . ?\x016B) ;; LATIN SMALL LETTER U WITH MACRON + (?\,D(B . ?\x02D9) ;; DOT ABOVE + )) + + (ucs-8859-5-alist + '((?\,L (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,L!(B . ?\x0401) ;; CYRILLIC CAPITAL LETTER IO + (?\,L"(B . ?\x0402) ;; CYRILLIC CAPITAL LETTER DJE + (?\,L#(B . ?\x0403) ;; CYRILLIC CAPITAL LETTER GJE + (?\,L$(B . ?\x0404) ;; CYRILLIC CAPITAL LETTER UKRAINIAN IE + (?\,L%(B . ?\x0405) ;; CYRILLIC CAPITAL LETTER DZE + (?\,L&(B . ?\x0406) ;; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I + (?\,L'(B . ?\x0407) ;; CYRILLIC CAPITAL LETTER YI + (?\,L((B . ?\x0408) ;; CYRILLIC CAPITAL LETTER JE + (?\,L)(B . ?\x0409) ;; CYRILLIC CAPITAL LETTER LJE + (?\,L*(B . ?\x040A) ;; CYRILLIC CAPITAL LETTER NJE + (?\,L+(B . ?\x040B) ;; CYRILLIC CAPITAL LETTER TSHE + (?\,L,(B . ?\x040C) ;; CYRILLIC CAPITAL LETTER KJE + (?\,L-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,L.(B . ?\x040E) ;; CYRILLIC CAPITAL LETTER SHORT U + (?\,L/(B . ?\x040F) ;; CYRILLIC CAPITAL LETTER DZHE + (?\,L0(B . ?\x0410) ;; CYRILLIC CAPITAL LETTER A + (?\,L1(B . ?\x0411) ;; CYRILLIC CAPITAL LETTER BE + (?\,L2(B . ?\x0412) ;; CYRILLIC CAPITAL LETTER VE + (?\,L3(B . ?\x0413) ;; CYRILLIC CAPITAL LETTER GHE + (?\,L4(B . ?\x0414) ;; CYRILLIC CAPITAL LETTER DE + (?\,L5(B . ?\x0415) ;; CYRILLIC CAPITAL LETTER IE + (?\,L6(B . ?\x0416) ;; CYRILLIC CAPITAL LETTER ZHE + (?\,L7(B . ?\x0417) ;; CYRILLIC CAPITAL LETTER ZE + (?\,L8(B . ?\x0418) ;; CYRILLIC CAPITAL LETTER I + (?\,L9(B . ?\x0419) ;; CYRILLIC CAPITAL LETTER SHORT I + (?\,L:(B . ?\x041A) ;; CYRILLIC CAPITAL LETTER KA + (?\,L;(B . ?\x041B) ;; CYRILLIC CAPITAL LETTER EL + (?\,L<(B . ?\x041C) ;; CYRILLIC CAPITAL LETTER EM + (?\,L=(B . ?\x041D) ;; CYRILLIC CAPITAL LETTER EN + (?\,L>(B . ?\x041E) ;; CYRILLIC CAPITAL LETTER O + (?\,L?(B . ?\x041F) ;; CYRILLIC CAPITAL LETTER PE + (?\,L@(B . ?\x0420) ;; CYRILLIC CAPITAL LETTER ER + (?\,LA(B . ?\x0421) ;; CYRILLIC CAPITAL LETTER ES + (?\,LB(B . ?\x0422) ;; CYRILLIC CAPITAL LETTER TE + (?\,LC(B . ?\x0423) ;; CYRILLIC CAPITAL LETTER U + (?\,LD(B . ?\x0424) ;; CYRILLIC CAPITAL LETTER EF + (?\,LE(B . ?\x0425) ;; CYRILLIC CAPITAL LETTER HA + (?\,LF(B . ?\x0426) ;; CYRILLIC CAPITAL LETTER TSE + (?\,LG(B . ?\x0427) ;; CYRILLIC CAPITAL LETTER CHE + (?\,LH(B . ?\x0428) ;; CYRILLIC CAPITAL LETTER SHA + (?\,LI(B . ?\x0429) ;; CYRILLIC CAPITAL LETTER SHCHA + (?\,LJ(B . ?\x042A) ;; CYRILLIC CAPITAL LETTER HARD SIGN + (?\,LK(B . ?\x042B) ;; CYRILLIC CAPITAL LETTER YERU + (?\,LL(B . ?\x042C) ;; CYRILLIC CAPITAL LETTER SOFT SIGN + (?\,LM(B . ?\x042D) ;; CYRILLIC CAPITAL LETTER E + (?\,LN(B . ?\x042E) ;; CYRILLIC CAPITAL LETTER YU + (?\,LO(B . ?\x042F) ;; CYRILLIC CAPITAL LETTER YA + (?\,LP(B . ?\x0430) ;; CYRILLIC SMALL LETTER A + (?\,LQ(B . ?\x0431) ;; CYRILLIC SMALL LETTER BE + (?\,LR(B . ?\x0432) ;; CYRILLIC SMALL LETTER VE + (?\,LS(B . ?\x0433) ;; CYRILLIC SMALL LETTER GHE + (?\,LT(B . ?\x0434) ;; CYRILLIC SMALL LETTER DE + (?\,LU(B . ?\x0435) ;; CYRILLIC SMALL LETTER IE + (?\,LV(B . ?\x0436) ;; CYRILLIC SMALL LETTER ZHE + (?\,LW(B . ?\x0437) ;; CYRILLIC SMALL LETTER ZE + (?\,LX(B . ?\x0438) ;; CYRILLIC SMALL LETTER I + (?\,LY(B . ?\x0439) ;; CYRILLIC SMALL LETTER SHORT I + (?\,LZ(B . ?\x043A) ;; CYRILLIC SMALL LETTER KA + (?\,L[(B . ?\x043B) ;; CYRILLIC SMALL LETTER EL + (?\,L\(B . ?\x043C) ;; CYRILLIC SMALL LETTER EM + (?\,L](B . ?\x043D) ;; CYRILLIC SMALL LETTER EN + (?\,L^(B . ?\x043E) ;; CYRILLIC SMALL LETTER O + (?\,L_(B . ?\x043F) ;; CYRILLIC SMALL LETTER PE + (?\,L`(B . ?\x0440) ;; CYRILLIC SMALL LETTER ER + (?\,La(B . ?\x0441) ;; CYRILLIC SMALL LETTER ES + (?\,Lb(B . ?\x0442) ;; CYRILLIC SMALL LETTER TE + (?\,Lc(B . ?\x0443) ;; CYRILLIC SMALL LETTER U + (?\,Ld(B . ?\x0444) ;; CYRILLIC SMALL LETTER EF + (?\,Le(B . ?\x0445) ;; CYRILLIC SMALL LETTER HA + (?\,Lf(B . ?\x0446) ;; CYRILLIC SMALL LETTER TSE + (?\,Lg(B . ?\x0447) ;; CYRILLIC SMALL LETTER CHE + (?\,Lh(B . ?\x0448) ;; CYRILLIC SMALL LETTER SHA + (?\,Li(B . ?\x0449) ;; CYRILLIC SMALL LETTER SHCHA + (?\,Lj(B . ?\x044A) ;; CYRILLIC SMALL LETTER HARD SIGN + (?\,Lk(B . ?\x044B) ;; CYRILLIC SMALL LETTER YERU + (?\,Ll(B . ?\x044C) ;; CYRILLIC SMALL LETTER SOFT SIGN + (?\,Lm(B . ?\x044D) ;; CYRILLIC SMALL LETTER E + (?\,Ln(B . ?\x044E) ;; CYRILLIC SMALL LETTER YU + (?\,Lo(B . ?\x044F) ;; CYRILLIC SMALL LETTER YA + (?\,Lp(B . ?\x2116) ;; NUMERO SIGN + (?\,Lq(B . ?\x0451) ;; CYRILLIC SMALL LETTER IO + (?\,Lr(B . ?\x0452) ;; CYRILLIC SMALL LETTER DJE + (?\,Ls(B . ?\x0453) ;; CYRILLIC SMALL LETTER GJE + (?\,Lt(B . ?\x0454) ;; CYRILLIC SMALL LETTER UKRAINIAN IE + (?\,Lu(B . ?\x0455) ;; CYRILLIC SMALL LETTER DZE + (?\,Lv(B . ?\x0456) ;; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I + (?\,Lw(B . ?\x0457) ;; CYRILLIC SMALL LETTER YI + (?\,Lx(B . ?\x0458) ;; CYRILLIC SMALL LETTER JE + (?\,Ly(B . ?\x0459) ;; CYRILLIC SMALL LETTER LJE + (?\,Lz(B . ?\x045A) ;; CYRILLIC SMALL LETTER NJE + (?\,L{(B . ?\x045B) ;; CYRILLIC SMALL LETTER TSHE + (?\,L|(B . ?\x045C) ;; CYRILLIC SMALL LETTER KJE + (?\,L}(B . ?\x00A7) ;; SECTION SIGN + (?\,L~(B . ?\x045E) ;; CYRILLIC SMALL LETTER SHORT U + (?\,L(B . ?\x045F) ;; CYRILLIC SMALL LETTER DZHE + )) + + ;; Arabic probably isn't so useful in the absence of Arabic + ;; language support. + (ucs-8859-6-alist + '((?,G (B . ?\x00A0) ;; NO-BREAK SPACE + (?,G$(B . ?\x00A4) ;; CURRENCY SIGN + (?,G,(B . ?\x060C) ;; ARABIC COMMA + (?,G-(B . ?\x00AD) ;; SOFT HYPHEN + (?,G;(B . ?\x061B) ;; ARABIC SEMICOLON + (?,G?(B . ?\x061F) ;; ARABIC QUESTION MARK + (?,GA(B . ?\x0621) ;; ARABIC LETTER HAMZA + (?,GB(B . ?\x0622) ;; ARABIC LETTER ALEF WITH MADDA ABOVE + (?,GC(B . ?\x0623) ;; ARABIC LETTER ALEF WITH HAMZA ABOVE + (?,GD(B . ?\x0624) ;; ARABIC LETTER WAW WITH HAMZA ABOVE + (?,GE(B . ?\x0625) ;; ARABIC LETTER ALEF WITH HAMZA BELOW + (?,GF(B . ?\x0626) ;; ARABIC LETTER YEH WITH HAMZA ABOVE + (?,GG(B . ?\x0627) ;; ARABIC LETTER ALEF + (?,GH(B . ?\x0628) ;; ARABIC LETTER BEH + (?,GI(B . ?\x0629) ;; ARABIC LETTER TEH MARBUTA + (?,GJ(B . ?\x062A) ;; ARABIC LETTER TEH + (?,GK(B . ?\x062B) ;; ARABIC LETTER THEH + (?,GL(B . ?\x062C) ;; ARABIC LETTER JEEM + (?,GM(B . ?\x062D) ;; ARABIC LETTER HAH + (?,GN(B . ?\x062E) ;; ARABIC LETTER KHAH + (?,GO(B . ?\x062F) ;; ARABIC LETTER DAL + (?,GP(B . ?\x0630) ;; ARABIC LETTER THAL + (?,GQ(B . ?\x0631) ;; ARABIC LETTER REH + (?,GR(B . ?\x0632) ;; ARABIC LETTER ZAIN + (?,GS(B . ?\x0633) ;; ARABIC LETTER SEEN + (?,GT(B . ?\x0634) ;; ARABIC LETTER SHEEN + (?,GU(B . ?\x0635) ;; ARABIC LETTER SAD + (?,GV(B . ?\x0636) ;; ARABIC LETTER DAD + (?,GW(B . ?\x0637) ;; ARABIC LETTER TAH + (?,GX(B . ?\x0638) ;; ARABIC LETTER ZAH + (?,GY(B . ?\x0639) ;; ARABIC LETTER AIN + (?,GZ(B . ?\x063A) ;; ARABIC LETTER GHAIN + (?,G`(B . ?\x0640) ;; ARABIC TATWEEL + (?,Ga(B . ?\x0641) ;; ARABIC LETTER FEH + (?,Gb(B . ?\x0642) ;; ARABIC LETTER QAF + (?,Gc(B . ?\x0643) ;; ARABIC LETTER KAF + (?,Gd(B . ?\x0644) ;; ARABIC LETTER LAM + (?,Ge(B . ?\x0645) ;; ARABIC LETTER MEEM + (?,Gf(B . ?\x0646) ;; ARABIC LETTER NOON + (?,Gg(B . ?\x0647) ;; ARABIC LETTER HEH + (?,Gh(B . ?\x0648) ;; ARABIC LETTER WAW + (?,Gi(B . ?\x0649) ;; ARABIC LETTER ALEF MAKSURA + (?,Gj(B . ?\x064A) ;; ARABIC LETTER YEH + (?,Gk(B . ?\x064B) ;; ARABIC FATHATAN + (?,Gl(B . ?\x064C) ;; ARABIC DAMMATAN + (?,Gm(B . ?\x064D) ;; ARABIC KASRATAN + (?,Gn(B . ?\x064E) ;; ARABIC FATHA + (?,Go(B . ?\x064F) ;; ARABIC DAMMA + (?,Gp(B . ?\x0650) ;; ARABIC KASRA + (?,Gq(B . ?\x0651) ;; ARABIC SHADDA + (?,Gr(B . ?\x0652) ;; ARABIC SUKUN + )) + + (ucs-8859-7-alist + '((?\,F (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,F!(B . ?\x2018) ;; LEFT SINGLE QUOTATION MARK + (?\,F"(B . ?\x2019) ;; RIGHT SINGLE QUOTATION MARK + (?\,F#(B . ?\x00A3) ;; POUND SIGN + (?\,F&(B . ?\x00A6) ;; BROKEN BAR + (?\,F'(B . ?\x00A7) ;; SECTION SIGN + (?\,F((B . ?\x00A8) ;; DIAERESIS + (?\,F)(B . ?\x00A9) ;; COPYRIGHT SIGN + (?\,F+(B . ?\x00AB) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,F,(B . ?\x00AC) ;; NOT SIGN + (?\,F-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,F/(B . ?\x2015) ;; HORIZONTAL BAR + (?\,F0(B . ?\x00B0) ;; DEGREE SIGN + (?\,F1(B . ?\x00B1) ;; PLUS-MINUS SIGN + (?\,F2(B . ?\x00B2) ;; SUPERSCRIPT TWO + (?\,F3(B . ?\x00B3) ;; SUPERSCRIPT THREE + (?\,F4(B . ?\x0384) ;; GREEK TONOS + (?\,F5(B . ?\x0385) ;; GREEK DIALYTIKA TONOS + (?\,F6(B . ?\x0386) ;; GREEK CAPITAL LETTER ALPHA WITH TONOS + (?\,F7(B . ?\x00B7) ;; MIDDLE DOT + (?\,F8(B . ?\x0388) ;; GREEK CAPITAL LETTER EPSILON WITH TONOS + (?\,F9(B . ?\x0389) ;; GREEK CAPITAL LETTER ETA WITH TONOS + (?\,F:(B . ?\x038A) ;; GREEK CAPITAL LETTER IOTA WITH TONOS + (?\,F;(B . ?\x00BB) ;; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,F<(B . ?\x038C) ;; GREEK CAPITAL LETTER OMICRON WITH TONOS + (?\,F=(B . ?\x00BD) ;; VULGAR FRACTION ONE HALF + (?\,F>(B . ?\x038E) ;; GREEK CAPITAL LETTER UPSILON WITH TONOS + (?\,F?(B . ?\x038F) ;; GREEK CAPITAL LETTER OMEGA WITH TONOS + (?\,F@(B . ?\x0390) ;; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS + (?\,FA(B . ?\x0391) ;; GREEK CAPITAL LETTER ALPHA + (?\,FB(B . ?\x0392) ;; GREEK CAPITAL LETTER BETA + (?\,FC(B . ?\x0393) ;; GREEK CAPITAL LETTER GAMMA + (?\,FD(B . ?\x0394) ;; GREEK CAPITAL LETTER DELTA + (?\,FE(B . ?\x0395) ;; GREEK CAPITAL LETTER EPSILON + (?\,FF(B . ?\x0396) ;; GREEK CAPITAL LETTER ZETA + (?\,FG(B . ?\x0397) ;; GREEK CAPITAL LETTER ETA + (?\,FH(B . ?\x0398) ;; GREEK CAPITAL LETTER THETA + (?\,FI(B . ?\x0399) ;; GREEK CAPITAL LETTER IOTA + (?\,FJ(B . ?\x039A) ;; GREEK CAPITAL LETTER KAPPA + (?\,FK(B . ?\x039B) ;; GREEK CAPITAL LETTER LAMDA + (?\,FL(B . ?\x039C) ;; GREEK CAPITAL LETTER MU + (?\,FM(B . ?\x039D) ;; GREEK CAPITAL LETTER NU + (?\,FN(B . ?\x039E) ;; GREEK CAPITAL LETTER XI + (?\,FO(B . ?\x039F) ;; GREEK CAPITAL LETTER OMICRON + (?\,FP(B . ?\x03A0) ;; GREEK CAPITAL LETTER PI + (?\,FQ(B . ?\x03A1) ;; GREEK CAPITAL LETTER RHO + (?\,FS(B . ?\x03A3) ;; GREEK CAPITAL LETTER SIGMA + (?\,FT(B . ?\x03A4) ;; GREEK CAPITAL LETTER TAU + (?\,FU(B . ?\x03A5) ;; GREEK CAPITAL LETTER UPSILON + (?\,FV(B . ?\x03A6) ;; GREEK CAPITAL LETTER PHI + (?\,FW(B . ?\x03A7) ;; GREEK CAPITAL LETTER CHI + (?\,FX(B . ?\x03A8) ;; GREEK CAPITAL LETTER PSI + (?\,FY(B . ?\x03A9) ;; GREEK CAPITAL LETTER OMEGA + (?\,FZ(B . ?\x03AA) ;; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA + (?\,F[(B . ?\x03AB) ;; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA + (?\,F\(B . ?\x03AC) ;; GREEK SMALL LETTER ALPHA WITH TONOS + (?\,F](B . ?\x03AD) ;; GREEK SMALL LETTER EPSILON WITH TONOS + (?\,F^(B . ?\x03AE) ;; GREEK SMALL LETTER ETA WITH TONOS + (?\,F_(B . ?\x03AF) ;; GREEK SMALL LETTER IOTA WITH TONOS + (?\,F`(B . ?\x03B0) ;; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS + (?\,Fa(B . ?\x03B1) ;; GREEK SMALL LETTER ALPHA + (?\,Fb(B . ?\x03B2) ;; GREEK SMALL LETTER BETA + (?\,Fc(B . ?\x03B3) ;; GREEK SMALL LETTER GAMMA + (?\,Fd(B . ?\x03B4) ;; GREEK SMALL LETTER DELTA + (?\,Fe(B . ?\x03B5) ;; GREEK SMALL LETTER EPSILON + (?\,Ff(B . ?\x03B6) ;; GREEK SMALL LETTER ZETA + (?\,Fg(B . ?\x03B7) ;; GREEK SMALL LETTER ETA + (?\,Fh(B . ?\x03B8) ;; GREEK SMALL LETTER THETA + (?\,Fi(B . ?\x03B9) ;; GREEK SMALL LETTER IOTA + (?\,Fj(B . ?\x03BA) ;; GREEK SMALL LETTER KAPPA + (?\,Fk(B . ?\x03BB) ;; GREEK SMALL LETTER LAMDA + (?\,Fl(B . ?\x03BC) ;; GREEK SMALL LETTER MU + (?\,Fm(B . ?\x03BD) ;; GREEK SMALL LETTER NU + (?\,Fn(B . ?\x03BE) ;; GREEK SMALL LETTER XI + (?\,Fo(B . ?\x03BF) ;; GREEK SMALL LETTER OMICRON + (?\,Fp(B . ?\x03C0) ;; GREEK SMALL LETTER PI + (?\,Fq(B . ?\x03C1) ;; GREEK SMALL LETTER RHO + (?\,Fr(B . ?\x03C2) ;; GREEK SMALL LETTER FINAL SIGMA + (?\,Fs(B . ?\x03C3) ;; GREEK SMALL LETTER SIGMA + (?\,Ft(B . ?\x03C4) ;; GREEK SMALL LETTER TAU + (?\,Fu(B . ?\x03C5) ;; GREEK SMALL LETTER UPSILON + (?\,Fv(B . ?\x03C6) ;; GREEK SMALL LETTER PHI + (?\,Fw(B . ?\x03C7) ;; GREEK SMALL LETTER CHI + (?\,Fx(B . ?\x03C8) ;; GREEK SMALL LETTER PSI + (?\,Fy(B . ?\x03C9) ;; GREEK SMALL LETTER OMEGA + (?\,Fz(B . ?\x03CA) ;; GREEK SMALL LETTER IOTA WITH DIALYTIKA + (?\,F{(B . ?\x03CB) ;; GREEK SMALL LETTER UPSILON WITH DIALYTIKA + (?\,F|(B . ?\x03CC) ;; GREEK SMALL LETTER OMICRON WITH TONOS + (?\,F}(B . ?\x03CD) ;; GREEK SMALL LETTER UPSILON WITH TONOS + (?\,F~(B . ?\x03CE) ;; GREEK SMALL LETTER OMEGA WITH TONOS + )) + + (ucs-8859-8-alist + '((?\,H (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,H"(B . ?\x00A2) ;; CENT SIGN + (?\,H#(B . ?\x00A3) ;; POUND SIGN + (?\,H$(B . ?\x00A4) ;; CURRENCY SIGN + (?\,H%(B . ?\x00A5) ;; YEN SIGN + (?\,H&(B . ?\x00A6) ;; BROKEN BAR + (?\,H'(B . ?\x00A7) ;; SECTION SIGN + (?\,H((B . ?\x00A8) ;; DIAERESIS + (?\,H)(B . ?\x00A9) ;; COPYRIGHT SIGN + (?\,H*(B . ?\x00D7) ;; MULTIPLICATION SIGN + (?\,H+(B . ?\x00AB) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,H,(B . ?\x00AC) ;; NOT SIGN + (?\,H-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,H.(B . ?\x00AE) ;; REGISTERED SIGN + (?\,H/(B . ?\x00AF) ;; MACRON + (?\,H0(B . ?\x00B0) ;; DEGREE SIGN + (?\,H1(B . ?\x00B1) ;; PLUS-MINUS SIGN + (?\,H2(B . ?\x00B2) ;; SUPERSCRIPT TWO + (?\,H3(B . ?\x00B3) ;; SUPERSCRIPT THREE + (?\,H4(B . ?\x00B4) ;; ACUTE ACCENT + (?\,H5(B . ?\x00B5) ;; MICRO SIGN + (?\,H6(B . ?\x00B6) ;; PILCROW SIGN + (?\,H7(B . ?\x00B7) ;; MIDDLE DOT + (?\,H8(B . ?\x00B8) ;; CEDILLA + (?\,H9(B . ?\x00B9) ;; SUPERSCRIPT ONE + (?\,H:(B . ?\x00F7) ;; DIVISION SIGN + (?\,H;(B . ?\x00BB) ;; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,H<(B . ?\x00BC) ;; VULGAR FRACTION ONE QUARTER + (?\,H=(B . ?\x00BD) ;; VULGAR FRACTION ONE HALF + (?\,H>(B . ?\x00BE) ;; VULGAR FRACTION THREE QUARTERS + ;; These are commented out since the current 8859-8 standard + ;; does not yet define these codepoints, although there are + ;; drafts which do). +; (?\,H@(B . ?\x05B0) ;; HEBREW POINT SHEVA +; (?\,HA(B . ?\x05B1) ;; HEBREW POINT HATAF SEGOL +; (?\,HB(B . ?\x05B2) ;; HEBREW POINT HATAF PATAH +; (?\,HC(B . ?\x05B3) ;; HEBREW POINT HATAF QAMATS +; (?\,HD(B . ?\x05B4) ;; HEBREW POINT HIRIQ +; (?\,HE(B . ?\x05B5) ;; HEBREW POINT TSERE +; (?\,HF(B . ?\x05B6) ;; HEBREW POINT SEGOL +; (?\,HG(B . ?\x05B7) ;; HEBREW POINT PATAH +; (?\,HH(B . ?\x05B8) ;; HEBREW POINT QAMATS +; (?\,HI(B . ?\x05B9) ;; HEBREW POINT HOLAM +; (?\,HK(B . ?\x05BB) ;; HEBREW POINT QUBUTS +; (?\,HL(B . ?\x05BC) ;; HEBREW POINT DAGESH +; (?\,HM(B . ?\x05BD) ;; HEBREW POINT METEG +; (?\,HN(B . ?\x05BE) ;; HEBREW POINT MAQAF +; (?\,HO(B . ?\x05BF) ;; HEBREW POINT RAFE +; (?\,HP(B . ?\x05C0) ;; HEBREW PUNCTUATION PASEQ +; (?\,HQ(B . ?\x05C1) ;; HEBREW POINT SHIN DOT +; (?\,HR(B . ?\x05C2) ;; HEBREW POINT SIN DOT +; (?\,HS(B . ?\x05C3) ;; HEBREW PUNCTUATION SOF PASUQ + (?\,H[(B . ?\x202D) ;; LEFT-TO-RIGHT OVERRIDE + (?\,H\(B . ?\x202E) ;; RIGHT-TO-LEFT OVERRIDE + (?\,H](B . ?\x202C) ;; POP DIRECTIONAL FORMATTING + (?\,H_(B . ?\x2017) ;; DOUBLE LOW LINE + (?\,H`(B . ?\x05D0) ;; HEBREW LETTER ALEF + (?\,Ha(B . ?\x05D1) ;; HEBREW LETTER BET + (?\,Hb(B . ?\x05D2) ;; HEBREW LETTER GIMEL + (?\,Hc(B . ?\x05D3) ;; HEBREW LETTER DALET + (?\,Hd(B . ?\x05D4) ;; HEBREW LETTER HE + (?\,He(B . ?\x05D5) ;; HEBREW LETTER VAV + (?\,Hf(B . ?\x05D6) ;; HEBREW LETTER ZAYIN + (?\,Hg(B . ?\x05D7) ;; HEBREW LETTER HET + (?\,Hh(B . ?\x05D8) ;; HEBREW LETTER TET + (?\,Hi(B . ?\x05D9) ;; HEBREW LETTER YOD + (?\,Hj(B . ?\x05DA) ;; HEBREW LETTER FINAL KAF + (?\,Hk(B . ?\x05DB) ;; HEBREW LETTER KAF + (?\,Hl(B . ?\x05DC) ;; HEBREW LETTER LAMED + (?\,Hm(B . ?\x05DD) ;; HEBREW LETTER FINAL MEM + (?\,Hn(B . ?\x05DE) ;; HEBREW LETTER MEM + (?\,Ho(B . ?\x05DF) ;; HEBREW LETTER FINAL NUN + (?\,Hp(B . ?\x05E0) ;; HEBREW LETTER NUN + (?\,Hq(B . ?\x05E1) ;; HEBREW LETTER SAMEKH + (?\,Hr(B . ?\x05E2) ;; HEBREW LETTER AYIN + (?\,Hs(B . ?\x05E3) ;; HEBREW LETTER FINAL PE + (?\,Ht(B . ?\x05E4) ;; HEBREW LETTER PE + (?\,Hu(B . ?\x05E5) ;; HEBREW LETTER FINAL TSADI + (?\,Hv(B . ?\x05E6) ;; HEBREW LETTER TSADI + (?\,Hw(B . ?\x05E7) ;; HEBREW LETTER QOF + (?\,Hx(B . ?\x05E8) ;; HEBREW LETTER RESH + (?\,Hy(B . ?\x05E9) ;; HEBREW LETTER SHIN + (?\,Hz(B . ?\x05EA) ;; HEBREW LETTER TAV + (?\,H{(B . ?\x202A) ;; LEFT-TO-RIGHT EMBEDDING + (?\,H|(B . ?\x202B) ;; RIGHT-TO-LEFT EMBEDDING + (?\,H}(B . ?\x200E) ;; LEFT-TO-RIGHT MARK + (?\,H~(B . ?\x200F) ;; RIGHT-TO-LEFT MARK + )) + + (ucs-8859-9-alist + '((?\,M (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,M!(B . ?\x00A1) ;; INVERTED EXCLAMATION MARK + (?\,M"(B . ?\x00A2) ;; CENT SIGN + (?\,M#(B . ?\x00A3) ;; POUND SIGN + (?\,M$(B . ?\x00A4) ;; CURRENCY SIGN + (?\,M%(B . ?\x00A5) ;; YEN SIGN + (?\,M&(B . ?\x00A6) ;; BROKEN BAR + (?\,M'(B . ?\x00A7) ;; SECTION SIGN + (?\,M((B . ?\x00A8) ;; DIAERESIS + (?\,M)(B . ?\x00A9) ;; COPYRIGHT SIGN + (?\,M*(B . ?\x00AA) ;; FEMININE ORDINAL INDICATOR + (?\,M+(B . ?\x00AB) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,M,(B . ?\x00AC) ;; NOT SIGN + (?\,M-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,M.(B . ?\x00AE) ;; REGISTERED SIGN + (?\,M/(B . ?\x00AF) ;; MACRON + (?\,M0(B . ?\x00B0) ;; DEGREE SIGN + (?\,M1(B . ?\x00B1) ;; PLUS-MINUS SIGN + (?\,M2(B . ?\x00B2) ;; SUPERSCRIPT TWO + (?\,M3(B . ?\x00B3) ;; SUPERSCRIPT THREE + (?\,M4(B . ?\x00B4) ;; ACUTE ACCENT + (?\,M5(B . ?\x00B5) ;; MICRO SIGN + (?\,M6(B . ?\x00B6) ;; PILCROW SIGN + (?\,M7(B . ?\x00B7) ;; MIDDLE DOT + (?\,M8(B . ?\x00B8) ;; CEDILLA + (?\,M9(B . ?\x00B9) ;; SUPERSCRIPT ONE + (?\,M:(B . ?\x00BA) ;; MASCULINE ORDINAL INDICATOR + (?\,M;(B . ?\x00BB) ;; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,M<(B . ?\x00BC) ;; VULGAR FRACTION ONE QUARTER + (?\,M=(B . ?\x00BD) ;; VULGAR FRACTION ONE HALF + (?\,M>(B . ?\x00BE) ;; VULGAR FRACTION THREE QUARTERS + (?\,M?(B . ?\x00BF) ;; INVERTED QUESTION MARK + (?\,M@(B . ?\x00C0) ;; LATIN CAPITAL LETTER A WITH GRAVE + (?\,MA(B . ?\x00C1) ;; LATIN CAPITAL LETTER A WITH ACUTE + (?\,MB(B . ?\x00C2) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX + (?\,MC(B . ?\x00C3) ;; LATIN CAPITAL LETTER A WITH TILDE + (?\,MD(B . ?\x00C4) ;; LATIN CAPITAL LETTER A WITH DIAERESIS + (?\,ME(B . ?\x00C5) ;; LATIN CAPITAL LETTER A WITH RING ABOVE + (?\,MF(B . ?\x00C6) ;; LATIN CAPITAL LETTER AE + (?\,MG(B . ?\x00C7) ;; LATIN CAPITAL LETTER C WITH CEDILLA + (?\,MH(B . ?\x00C8) ;; LATIN CAPITAL LETTER E WITH GRAVE + (?\,MI(B . ?\x00C9) ;; LATIN CAPITAL LETTER E WITH ACUTE + (?\,MJ(B . ?\x00CA) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX + (?\,MK(B . ?\x00CB) ;; LATIN CAPITAL LETTER E WITH DIAERESIS + (?\,ML(B . ?\x00CC) ;; LATIN CAPITAL LETTER I WITH GRAVE + (?\,MM(B . ?\x00CD) ;; LATIN CAPITAL LETTER I WITH ACUTE + (?\,MN(B . ?\x00CE) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX + (?\,MO(B . ?\x00CF) ;; LATIN CAPITAL LETTER I WITH DIAERESIS + (?\,MP(B . ?\x011E) ;; LATIN CAPITAL LETTER G WITH BREVE + (?\,MQ(B . ?\x00D1) ;; LATIN CAPITAL LETTER N WITH TILDE + (?\,MR(B . ?\x00D2) ;; LATIN CAPITAL LETTER O WITH GRAVE + (?\,MS(B . ?\x00D3) ;; LATIN CAPITAL LETTER O WITH ACUTE + (?\,MT(B . ?\x00D4) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX + (?\,MU(B . ?\x00D5) ;; LATIN CAPITAL LETTER O WITH TILDE + (?\,MV(B . ?\x00D6) ;; LATIN CAPITAL LETTER O WITH DIAERESIS + (?\,MW(B . ?\x00D7) ;; MULTIPLICATION SIGN + (?\,MX(B . ?\x00D8) ;; LATIN CAPITAL LETTER O WITH STROKE + (?\,MY(B . ?\x00D9) ;; LATIN CAPITAL LETTER U WITH GRAVE + (?\,MZ(B . ?\x00DA) ;; LATIN CAPITAL LETTER U WITH ACUTE + (?\,M[(B . ?\x00DB) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX + (?\,M\(B . ?\x00DC) ;; LATIN CAPITAL LETTER U WITH DIAERESIS + (?\,M](B . ?\x0130) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE + (?\,M^(B . ?\x015E) ;; LATIN CAPITAL LETTER S WITH CEDILLA + (?\,M_(B . ?\x00DF) ;; LATIN SMALL LETTER SHARP S + (?\,M`(B . ?\x00E0) ;; LATIN SMALL LETTER A WITH GRAVE + (?\,Ma(B . ?\x00E1) ;; LATIN SMALL LETTER A WITH ACUTE + (?\,Mb(B . ?\x00E2) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX + (?\,Mc(B . ?\x00E3) ;; LATIN SMALL LETTER A WITH TILDE + (?\,Md(B . ?\x00E4) ;; LATIN SMALL LETTER A WITH DIAERESIS + (?\,Me(B . ?\x00E5) ;; LATIN SMALL LETTER A WITH RING ABOVE + (?\,Mf(B . ?\x00E6) ;; LATIN SMALL LETTER AE + (?\,Mg(B . ?\x00E7) ;; LATIN SMALL LETTER C WITH CEDILLA + (?\,Mh(B . ?\x00E8) ;; LATIN SMALL LETTER E WITH GRAVE + (?\,Mi(B . ?\x00E9) ;; LATIN SMALL LETTER E WITH ACUTE + (?\,Mj(B . ?\x00EA) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX + (?\,Mk(B . ?\x00EB) ;; LATIN SMALL LETTER E WITH DIAERESIS + (?\,Ml(B . ?\x00EC) ;; LATIN SMALL LETTER I WITH GRAVE + (?\,Mm(B . ?\x00ED) ;; LATIN SMALL LETTER I WITH ACUTE + (?\,Mn(B . ?\x00EE) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX + (?\,Mo(B . ?\x00EF) ;; LATIN SMALL LETTER I WITH DIAERESIS + (?\,Mp(B . ?\x011F) ;; LATIN SMALL LETTER G WITH BREVE + (?\,Mq(B . ?\x00F1) ;; LATIN SMALL LETTER N WITH TILDE + (?\,Mr(B . ?\x00F2) ;; LATIN SMALL LETTER O WITH GRAVE + (?\,Ms(B . ?\x00F3) ;; LATIN SMALL LETTER O WITH ACUTE + (?\,Mt(B . ?\x00F4) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX + (?\,Mu(B . ?\x00F5) ;; LATIN SMALL LETTER O WITH TILDE + (?\,Mv(B . ?\x00F6) ;; LATIN SMALL LETTER O WITH DIAERESIS + (?\,Mw(B . ?\x00F7) ;; DIVISION SIGN + (?\,Mx(B . ?\x00F8) ;; LATIN SMALL LETTER O WITH STROKE + (?\,My(B . ?\x00F9) ;; LATIN SMALL LETTER U WITH GRAVE + (?\,Mz(B . ?\x00FA) ;; LATIN SMALL LETTER U WITH ACUTE + (?\,M{(B . ?\x00FB) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX + (?\,M|(B . ?\x00FC) ;; LATIN SMALL LETTER U WITH DIAERESIS + (?\,M}(B . ?\x0131) ;; LATIN SMALL LETTER DOTLESS I + (?\,M~(B . ?\x015F) ;; LATIN SMALL LETTER S WITH CEDILLA + (?\,M(B . ?\x00FF) ;; LATIN SMALL LETTER Y WITH DIAERESIS + )) + + (ucs-8859-14-alist + '((?\,_ (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,_!(B . ?\x1E02) ;; LATIN CAPITAL LETTER B WITH DOT ABOVE + (?\,_"(B . ?\x1E03) ;; LATIN SMALL LETTER B WITH DOT ABOVE + (?\,_#(B . ?\x00A3) ;; POUND SIGN + (?\,_$(B . ?\x010A) ;; LATIN CAPITAL LETTER C WITH DOT ABOVE + (?\,_%(B . ?\x010B) ;; LATIN SMALL LETTER C WITH DOT ABOVE + (?\,_&(B . ?\x1E0A) ;; LATIN CAPITAL LETTER D WITH DOT ABOVE + (?\,_'(B . ?\x00A7) ;; SECTION SIGN + (?\,_((B . ?\x1E80) ;; LATIN CAPITAL LETTER W WITH GRAVE + (?\,_)(B . ?\x00A9) ;; COPYRIGHT SIGN + (?\,_*(B . ?\x1E82) ;; LATIN CAPITAL LETTER W WITH ACUTE + (?\,_+(B . ?\x1E0B) ;; LATIN SMALL LETTER D WITH DOT ABOVE + (?\,_,(B . ?\x1EF2) ;; LATIN CAPITAL LETTER Y WITH GRAVE + (?\,_-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,_.(B . ?\x00AE) ;; REGISTERED SIGN + (?\,_/(B . ?\x0178) ;; LATIN CAPITAL LETTER Y WITH DIAERESIS + (?\,_0(B . ?\x1E1E) ;; LATIN CAPITAL LETTER F WITH DOT ABOVE + (?\,_1(B . ?\x1E1F) ;; LATIN SMALL LETTER F WITH DOT ABOVE + (?\,_2(B . ?\x0120) ;; LATIN CAPITAL LETTER G WITH DOT ABOVE + (?\,_3(B . ?\x0121) ;; LATIN SMALL LETTER G WITH DOT ABOVE + (?\,_4(B . ?\x1E40) ;; LATIN CAPITAL LETTER M WITH DOT ABOVE + (?\,_5(B . ?\x1E41) ;; LATIN SMALL LETTER M WITH DOT ABOVE + (?\,_6(B . ?\x00B6) ;; PILCROW SIGN + (?\,_7(B . ?\x1E56) ;; LATIN CAPITAL LETTER P WITH DOT ABOVE + (?\,_8(B . ?\x1E81) ;; LATIN SMALL LETTER W WITH GRAVE + (?\,_9(B . ?\x1E57) ;; LATIN SMALL LETTER P WITH DOT ABOVE + (?\,_:(B . ?\x1E83) ;; LATIN SMALL LETTER W WITH ACUTE + (?\,_;(B . ?\x1E60) ;; LATIN CAPITAL LETTER S WITH DOT ABOVE + (?\,_<(B . ?\x1EF3) ;; LATIN SMALL LETTER Y WITH GRAVE + (?\,_=(B . ?\x1E84) ;; LATIN CAPITAL LETTER W WITH DIAERESIS + (?\,_>(B . ?\x1E85) ;; LATIN SMALL LETTER W WITH DIAERESIS + (?\,_?(B . ?\x1E61) ;; LATIN SMALL LETTER S WITH DOT ABOVE + (?\,_@(B . ?\x00C0) ;; LATIN CAPITAL LETTER A WITH GRAVE + (?\,_A(B . ?\x00C1) ;; LATIN CAPITAL LETTER A WITH ACUTE + (?\,_B(B . ?\x00C2) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX + (?\,_C(B . ?\x00C3) ;; LATIN CAPITAL LETTER A WITH TILDE + (?\,_D(B . ?\x00C4) ;; LATIN CAPITAL LETTER A WITH DIAERESIS + (?\,_E(B . ?\x00C5) ;; LATIN CAPITAL LETTER A WITH RING ABOVE + (?\,_F(B . ?\x00C6) ;; LATIN CAPITAL LETTER AE + (?\,_G(B . ?\x00C7) ;; LATIN CAPITAL LETTER C WITH CEDILLA + (?\,_H(B . ?\x00C8) ;; LATIN CAPITAL LETTER E WITH GRAVE + (?\,_I(B . ?\x00C9) ;; LATIN CAPITAL LETTER E WITH ACUTE + (?\,_J(B . ?\x00CA) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX + (?\,_K(B . ?\x00CB) ;; LATIN CAPITAL LETTER E WITH DIAERESIS + (?\,_L(B . ?\x00CC) ;; LATIN CAPITAL LETTER I WITH GRAVE + (?\,_M(B . ?\x00CD) ;; LATIN CAPITAL LETTER I WITH ACUTE + (?\,_N(B . ?\x00CE) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX + (?\,_O(B . ?\x00CF) ;; LATIN CAPITAL LETTER I WITH DIAERESIS + (?\,_P(B . ?\x0174) ;; LATIN CAPITAL LETTER W WITH CIRCUMFLEX + (?\,_Q(B . ?\x00D1) ;; LATIN CAPITAL LETTER N WITH TILDE + (?\,_R(B . ?\x00D2) ;; LATIN CAPITAL LETTER O WITH GRAVE + (?\,_S(B . ?\x00D3) ;; LATIN CAPITAL LETTER O WITH ACUTE + (?\,_T(B . ?\x00D4) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX + (?\,_U(B . ?\x00D5) ;; LATIN CAPITAL LETTER O WITH TILDE + (?\,_V(B . ?\x00D6) ;; LATIN CAPITAL LETTER O WITH DIAERESIS + (?\,_W(B . ?\x1E6A) ;; LATIN CAPITAL LETTER T WITH DOT ABOVE + (?\,_X(B . ?\x00D8) ;; LATIN CAPITAL LETTER O WITH STROKE + (?\,_Y(B . ?\x00D9) ;; LATIN CAPITAL LETTER U WITH GRAVE + (?\,_Z(B . ?\x00DA) ;; LATIN CAPITAL LETTER U WITH ACUTE + (?\,_[(B . ?\x00DB) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX + (?\,_\(B . ?\x00DC) ;; LATIN CAPITAL LETTER U WITH DIAERESIS + (?\,_](B . ?\x00DD) ;; LATIN CAPITAL LETTER Y WITH ACUTE + (?\,_^(B . ?\x0176) ;; LATIN CAPITAL LETTER Y WITH CIRCUMFLEX + (?\,__(B . ?\x00DF) ;; LATIN SMALL LETTER SHARP S + (?\,_`(B . ?\x00E0) ;; LATIN SMALL LETTER A WITH GRAVE + (?\,_a(B . ?\x00E1) ;; LATIN SMALL LETTER A WITH ACUTE + (?\,_b(B . ?\x00E2) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX + (?\,_c(B . ?\x00E3) ;; LATIN SMALL LETTER A WITH TILDE + (?\,_d(B . ?\x00E4) ;; LATIN SMALL LETTER A WITH DIAERESIS + (?\,_e(B . ?\x00E5) ;; LATIN SMALL LETTER A WITH RING ABOVE + (?\,_f(B . ?\x00E6) ;; LATIN SMALL LETTER AE + (?\,_g(B . ?\x00E7) ;; LATIN SMALL LETTER C WITH CEDILLA + (?\,_h(B . ?\x00E8) ;; LATIN SMALL LETTER E WITH GRAVE + (?\,_i(B . ?\x00E9) ;; LATIN SMALL LETTER E WITH ACUTE + (?\,_j(B . ?\x00EA) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX + (?\,_k(B . ?\x00EB) ;; LATIN SMALL LETTER E WITH DIAERESIS + (?\,_l(B . ?\x00EC) ;; LATIN SMALL LETTER I WITH GRAVE + (?\,_m(B . ?\x00ED) ;; LATIN SMALL LETTER I WITH ACUTE + (?\,_n(B . ?\x00EE) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX + (?\,_o(B . ?\x00EF) ;; LATIN SMALL LETTER I WITH DIAERESIS + (?\,_p(B . ?\x0175) ;; LATIN SMALL LETTER W WITH CIRCUMFLEX + (?\,_q(B . ?\x00F1) ;; LATIN SMALL LETTER N WITH TILDE + (?\,_r(B . ?\x00F2) ;; LATIN SMALL LETTER O WITH GRAVE + (?\,_s(B . ?\x00F3) ;; LATIN SMALL LETTER O WITH ACUTE + (?\,_t(B . ?\x00F4) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX + (?\,_u(B . ?\x00F5) ;; LATIN SMALL LETTER O WITH TILDE + (?\,_v(B . ?\x00F6) ;; LATIN SMALL LETTER O WITH DIAERESIS + (?\,_w(B . ?\x1E6B) ;; LATIN SMALL LETTER T WITH DOT ABOVE + (?\,_x(B . ?\x00F8) ;; LATIN SMALL LETTER O WITH STROKE + (?\,_y(B . ?\x00F9) ;; LATIN SMALL LETTER U WITH GRAVE + (?\,_z(B . ?\x00FA) ;; LATIN SMALL LETTER U WITH ACUTE + (?\,_{(B . ?\x00FB) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX + (?\,_|(B . ?\x00FC) ;; LATIN SMALL LETTER U WITH DIAERESIS + (?\,_}(B . ?\x00FD) ;; LATIN SMALL LETTER Y WITH ACUTE + (?\,_~(B . ?\x0177) ;; LATIN SMALL LETTER Y WITH CIRCUMFLEX + (?\,_(B . ?\x00FF) ;; LATIN SMALL LETTER Y WITH DIAERESIS + )) + + (ucs-8859-15-alist + '((?\,b (B . ?\x00A0) ;; NO-BREAK SPACE + (?\,b!(B . ?\x00A1) ;; INVERTED EXCLAMATION MARK + (?\,b"(B . ?\x00A2) ;; CENT SIGN + (?\,b#(B . ?\x00A3) ;; POUND SIGN + (?\,b$(B . ?\x20AC) ;; EURO SIGN + (?\,b%(B . ?\x00A5) ;; YEN SIGN + (?\,b&(B . ?\x0160) ;; LATIN CAPITAL LETTER S WITH CARON + (?\,b'(B . ?\x00A7) ;; SECTION SIGN + (?\,b((B . ?\x0161) ;; LATIN SMALL LETTER S WITH CARON + (?\,b)(B . ?\x00A9) ;; COPYRIGHT SIGN + (?\,b*(B . ?\x00AA) ;; FEMININE ORDINAL INDICATOR + (?\,b+(B . ?\x00AB) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,b,(B . ?\x00AC) ;; NOT SIGN + (?\,b-(B . ?\x00AD) ;; SOFT HYPHEN + (?\,b.(B . ?\x00AE) ;; REGISTERED SIGN + (?\,b/(B . ?\x00AF) ;; MACRON + (?\,b0(B . ?\x00B0) ;; DEGREE SIGN + (?\,b1(B . ?\x00B1) ;; PLUS-MINUS SIGN + (?\,b2(B . ?\x00B2) ;; SUPERSCRIPT TWO + (?\,b3(B . ?\x00B3) ;; SUPERSCRIPT THREE + (?\,b4(B . ?\x017D) ;; LATIN CAPITAL LETTER Z WITH CARON + (?\,b5(B . ?\x00B5) ;; MICRO SIGN + (?\,b6(B . ?\x00B6) ;; PILCROW SIGN + (?\,b7(B . ?\x00B7) ;; MIDDLE DOT + (?\,b8(B . ?\x017E) ;; LATIN SMALL LETTER Z WITH CARON + (?\,b9(B . ?\x00B9) ;; SUPERSCRIPT ONE + (?\,b:(B . ?\x00BA) ;; MASCULINE ORDINAL INDICATOR + (?\,b;(B . ?\x00BB) ;; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK + (?\,b<(B . ?\x0152) ;; LATIN CAPITAL LIGATURE OE + (?\,b=(B . ?\x0153) ;; LATIN SMALL LIGATURE OE + (?\,b>(B . ?\x0178) ;; LATIN CAPITAL LETTER Y WITH DIAERESIS + (?\,b?(B . ?\x00BF) ;; INVERTED QUESTION MARK + (?\,b@(B . ?\x00C0) ;; LATIN CAPITAL LETTER A WITH GRAVE + (?\,bA(B . ?\x00C1) ;; LATIN CAPITAL LETTER A WITH ACUTE + (?\,bB(B . ?\x00C2) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX + (?\,bC(B . ?\x00C3) ;; LATIN CAPITAL LETTER A WITH TILDE + (?\,bD(B . ?\x00C4) ;; LATIN CAPITAL LETTER A WITH DIAERESIS + (?\,bE(B . ?\x00C5) ;; LATIN CAPITAL LETTER A WITH RING ABOVE + (?\,bF(B . ?\x00C6) ;; LATIN CAPITAL LETTER AE + (?\,bG(B . ?\x00C7) ;; LATIN CAPITAL LETTER C WITH CEDILLA + (?\,bH(B . ?\x00C8) ;; LATIN CAPITAL LETTER E WITH GRAVE + (?\,bI(B . ?\x00C9) ;; LATIN CAPITAL LETTER E WITH ACUTE + (?\,bJ(B . ?\x00CA) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX + (?\,bK(B . ?\x00CB) ;; LATIN CAPITAL LETTER E WITH DIAERESIS + (?\,bL(B . ?\x00CC) ;; LATIN CAPITAL LETTER I WITH GRAVE + (?\,bM(B . ?\x00CD) ;; LATIN CAPITAL LETTER I WITH ACUTE + (?\,bN(B . ?\x00CE) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX + (?\,bO(B . ?\x00CF) ;; LATIN CAPITAL LETTER I WITH DIAERESIS + (?\,bP(B . ?\x00D0) ;; LATIN CAPITAL LETTER ETH + (?\,bQ(B . ?\x00D1) ;; LATIN CAPITAL LETTER N WITH TILDE + (?\,bR(B . ?\x00D2) ;; LATIN CAPITAL LETTER O WITH GRAVE + (?\,bS(B . ?\x00D3) ;; LATIN CAPITAL LETTER O WITH ACUTE + (?\,bT(B . ?\x00D4) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX + (?\,bU(B . ?\x00D5) ;; LATIN CAPITAL LETTER O WITH TILDE + (?\,bV(B . ?\x00D6) ;; LATIN CAPITAL LETTER O WITH DIAERESIS + (?\,bW(B . ?\x00D7) ;; MULTIPLICATION SIGN + (?\,bX(B . ?\x00D8) ;; LATIN CAPITAL LETTER O WITH STROKE + (?\,bY(B . ?\x00D9) ;; LATIN CAPITAL LETTER U WITH GRAVE + (?\,bZ(B . ?\x00DA) ;; LATIN CAPITAL LETTER U WITH ACUTE + (?\,b[(B . ?\x00DB) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX + (?\,b\(B . ?\x00DC) ;; LATIN CAPITAL LETTER U WITH DIAERESIS + (?\,b](B . ?\x00DD) ;; LATIN CAPITAL LETTER Y WITH ACUTE + (?\,b^(B . ?\x00DE) ;; LATIN CAPITAL LETTER THORN + (?\,b_(B . ?\x00DF) ;; LATIN SMALL LETTER SHARP S + (?\,b`(B . ?\x00E0) ;; LATIN SMALL LETTER A WITH GRAVE + (?\,ba(B . ?\x00E1) ;; LATIN SMALL LETTER A WITH ACUTE + (?\,bb(B . ?\x00E2) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX + (?\,bc(B . ?\x00E3) ;; LATIN SMALL LETTER A WITH TILDE + (?\,bd(B . ?\x00E4) ;; LATIN SMALL LETTER A WITH DIAERESIS + (?\,be(B . ?\x00E5) ;; LATIN SMALL LETTER A WITH RING ABOVE + (?\,bf(B . ?\x00E6) ;; LATIN SMALL LETTER AE + (?\,bg(B . ?\x00E7) ;; LATIN SMALL LETTER C WITH CEDILLA + (?\,bh(B . ?\x00E8) ;; LATIN SMALL LETTER E WITH GRAVE + (?\,bi(B . ?\x00E9) ;; LATIN SMALL LETTER E WITH ACUTE + (?\,bj(B . ?\x00EA) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX + (?\,bk(B . ?\x00EB) ;; LATIN SMALL LETTER E WITH DIAERESIS + (?\,bl(B . ?\x00EC) ;; LATIN SMALL LETTER I WITH GRAVE + (?\,bm(B . ?\x00ED) ;; LATIN SMALL LETTER I WITH ACUTE + (?\,bn(B . ?\x00EE) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX + (?\,bo(B . ?\x00EF) ;; LATIN SMALL LETTER I WITH DIAERESIS + (?\,bp(B . ?\x00F0) ;; LATIN SMALL LETTER ETH + (?\,bq(B . ?\x00F1) ;; LATIN SMALL LETTER N WITH TILDE + (?\,br(B . ?\x00F2) ;; LATIN SMALL LETTER O WITH GRAVE + (?\,bs(B . ?\x00F3) ;; LATIN SMALL LETTER O WITH ACUTE + (?\,bt(B . ?\x00F4) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX + (?\,bu(B . ?\x00F5) ;; LATIN SMALL LETTER O WITH TILDE + (?\,bv(B . ?\x00F6) ;; LATIN SMALL LETTER O WITH DIAERESIS + (?\,bw(B . ?\x00F7) ;; DIVISION SIGN + (?\,bx(B . ?\x00F8) ;; LATIN SMALL LETTER O WITH STROKE + (?\,by(B . ?\x00F9) ;; LATIN SMALL LETTER U WITH GRAVE + (?\,bz(B . ?\x00FA) ;; LATIN SMALL LETTER U WITH ACUTE + (?\,b{(B . ?\x00FB) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX + (?\,b|(B . ?\x00FC) ;; LATIN SMALL LETTER U WITH DIAERESIS + (?\,b}(B . ?\x00FD) ;; LATIN SMALL LETTER Y WITH ACUTE + (?\,b~(B . ?\x00FE) ;; LATIN SMALL LETTER THORN + (?\,b(B . ?\x00FF) ;; LATIN SMALL LETTER Y WITH DIAERESIS + )) + + (ucs-8859-1-alist + (let ((i 160) + l) + (while (< i 256) + (push (cons (make-char 'latin-iso8859-1 (- i 128)) i) + l) + (setq i (1+ i))) + (nreverse l))) + +;; (case-table (standard-case-table)) +;; (syntax-table (standard-syntax-table)) + ) + + ;; Convert the lists to the basic char tables. + (dolist (n (list 15 14 9 8 7 5 4 3 2 1)) + (let ((alist (symbol-value (intern (format "ucs-8859-%d-alist" n))))) + (dolist (pair alist) + (let ((mule (car pair)) + (uc (cdr pair)) + (mu (decode-char 'ucs (cdr pair)))) + (aset ucs-mule-8859-to-ucs-table mule uc) + ;; (aset ucs-ucs-to-mule-8859-table uc mule) + ;; (aset ucs-mule-unicode-to-mule-8859 mu mule) + (aset ucs-mule-8859-to-mule-unicode mule mu) + (aset ucs-mule-to-mule-unicode mule mu))) +;; I think this is actually done OK in characters.el. +;; Probably things like accents shouldn't have word syntax, but the +;; Latin-N syntax tables currently aren't consistent for such +;; characters anyhow. +;; ;; Make the mule-unicode characters inherit syntax and case info +;; ;; if they don't already have it. +;; (dolist (pair alist) +;; (let ((mule (car pair)) +;; (uc (cdr pair)) +;; (mu (decode-char 'ucs (cdr pair)))) +;; (let ((syntax (aref syntax-table mule))) +;; (if (eq mule (downcase mule)) +;; (if (eq mule (upcase mule)) ; non-letter or uncased letter +;; (progn +;; (if (= 4 (car syntax)) ; left delim +;; (progn +;; (aset syntax-table +;; mu +;; (cons 4 (aref ucs-mule-8859-to-mule-unicode +;; (cdr syntax)))) +;; (aset syntax-table +;; (aref ucs-mule-8859-to-mule-unicode +;; (cdr syntax)) +;; (cons 5 mu))) +;; (aset syntax-table mu syntax)) +;; (aset case-table mu mu))) +;; ;; Upper case letter +;; (let ((lower (aref ucs-mule-8859-to-mule-unicode +;; (aref case-table mule)))) +;; (aset case-table mu lower) +;; (aset case-table lower lower) +;; (modify-syntax-entry lower "w " syntax-table) +;; (modify-syntax-entry mu "w " syntax-table)))))) + )) + ;; Derive tables that can be used as per-coding-system + ;; `translation-table-for-encode's. + (dolist (n (list 15 14 9 8 7 5 4 3 2 1)) + (let* ((alist (symbol-value (intern (format "ucs-8859-%d-alist" n)))) + (encode-translator (set (intern (format "ucs-8859-%d-encode-table" + n)) + (make-translation-table))) + elt) + ;; Start with the mule-unicode component. + (dolist (pair alist) + (let ((mule (car pair)) + (mu (decode-char 'ucs (cdr pair)))) + (aset encode-translator mu mule))) + ;; Find characters from other 8859 sets which map to the same + ;; unicode as some character in this set. + (map-char-table (lambda (k v) + (if (and (setq elt (rassq v alist)) + (not (assq k alist))) + (aset encode-translator k (car elt)))) + ucs-mule-8859-to-ucs-table)))) + +;; Register for use in CCL. +(define-translation-table 'ucs-mule-8859-to-mule-unicode + ucs-mule-8859-to-mule-unicode) + +;; Fixme: Make this reversible, which means frobbing +;; `char-coding-system-table' directly to remove what we added -- see +;; codepages.el. Also make it a user option. +(defun ucs-unify-8859 (&optional encode-only) + "Set up translation tables for unifying characters from ISO 8859. + +On decoding, non-ASCII characters are mapped into the `iso-latin-1' +and `mule-unicode-0100-24ff' charsets. On encoding, these are mapped +back appropriate for the coding system. + +With prefix arg, do unification on encoding only, i.e. don't unify +everything on input operations." + (interactive "P") + (unless encode-only + ;; Unify 8859 on decoding. (Non-CCL coding systems only.) + (set-char-table-parent standard-translation-table-for-decode + ucs-mule-8859-to-mule-unicode)) + ;; Adjust the 8859 coding systems to fragment the unified characters + ;; on encoding. + (dolist (n '(1 2 3 4 5 7 8 9 14 15)) + (let* ((coding-system + (coding-system-base (intern (format "iso-8859-%d" n)))) + (table (symbol-value + (intern (format "ucs-8859-%d-encode-table" n)))) + (safe (coding-system-get coding-system 'safe-chars))) + ;; Actually, the coding system's safe-chars are not normally + ;; used after they've been registered, but we might as well + ;; record them. Setting the parent here is a convenience. + (set-char-table-parent safe table) + ;; Update the table of what encodes to what. + (register-char-codings coding-system table) + (coding-system-put coding-system 'translation-table-for-encode table))) + +;;; The following works for the bundled coding systems, but it's +;;; better to use the Unicode-based ones and make it irrelevant. + +;;; ;; Update the Cyrillic special cases. +;;; ;; `translation-table-for-encode' doesn't work for CCL coding +;;; ;; systems, and `standard-translation-table-for-decode' isn't +;;; ;; applied. +;;; (let ((table (get 'cyrillic-koi8-r-encode-table 'translation-table))) +;;; (map-char-table +;;; (lambda (k v) +;;; (aset table +;;; (or (aref ucs-8859-5-encode-table k) +;;; k) +;;; v)) +;;; table) +;;; (register-char-codings 'cyrillic-koi8 table)) +;;; (let ((table (get 'cyrillic-koi8-r-nonascii-translation-table +;;; 'translation-table))) +;;; (map-char-table +;;; (lambda (k v) +;;; (if v (aset table k (or (aref ucs-mule-8859-to-mule-unicode v) +;;; v)))) +;;; table)) +;;; ;; Redefine this, since the orginal only translated 8859-5. +;;; (define-ccl-program ccl-encode-koi8 +;;; `(1 +;;; ((loop +;;; (read-multibyte-character r0 r1) +;;; (translate-character cyrillic-koi8-r-encode-table r0 r1) +;;; (write-repeat r1)))) +;;; "CCL program to encode KOI8.") +;;; (let ((table (get 'cyrillic-alternativnyj-encode-table 'translation-table))) +;;; (map-char-table +;;; (lambda (k v) +;;; (aset table +;;; (or (aref ucs-8859-5-encode-table k) +;;; k) +;;; v)) +;;; table) +;;; (register-char-codings 'cyrillic-alternativnyj table)) +;;; (let ((table (get 'cyrillic-alternativnyj-nonascii-translation-table +;;; 'translation-table))) +;;; (map-char-table +;;; (lambda (k v) +;;; (if v (aset table +;;; k +;;; (or (aref ucs-mule-8859-to-mule-unicode v) +;;; v)))) +;;; table)) + ) + +(defun ucs-fragment-8859 (&optional encode-only) + "Undo the unification done by `ucs-unify-8859'. +With prefix arg, undo unification on encoding only, i.e. don't undo +unification on input operations." + (interactive "P") + ;; Maybe fix decoding. + (unless encode-only + ;; Unify 8859 on decoding. (Non-CCL coding systems only.) + (set-char-table-parent standard-translation-table-for-decode nil)) + ;; Fix encoding. For each charset, remove the entries in + ;; `char-coding-system-table' added to its safe-chars table (as its + ;; parent). + (dolist (n '(1 2 3 4 5 7 8 9 14 15)) + (let* ((coding-system + (coding-system-base (intern (format "iso-8859-%d" n)))) + (table (symbol-value + (intern (format "ucs-8859-%d-encode-table" n)))) + (safe (coding-system-get coding-system 'safe-chars))) + (map-char-table + (lambda (key val) + (if (and (>= key 128) val) + (let ((codings (aref char-coding-system-table key))) + (aset char-coding-system-table key + (delq coding-system codings))))) + (char-table-parent safe)) + (set-char-table-parent safe nil) + (coding-system-put coding-system 'translation-table-for-encode nil)))) + +;;;###autoload +(define-minor-mode unify-8859-on-encoding-mode + "Set up translation tables for unifying ISO 8859 characters on encoding. + +The ISO 8859 characters sets overlap, e.g. 8859-1 (Latin-1) and +8859-15 (Latin-9) differ only in a few characters. Emacs normally +distinguishes equivalent characters from those ISO-8859 character sets +which are built in to Emacs. This behaviour is essentially inherited +from the European-originated international standards. Treating them +equivalently, by translating to and from a single representation is +called `unification'. (The `utf-8' coding system treats the +characters of European scripts in a unified manner.) + +In this mode, on encoding -- i.e. output operations -- non-ASCII +characters from the built-in ISO 8859 and `mule-unicode-0100-24ff' +charsets are handled automatically by the coding system used if it can +represent them. Thus, say, an e-acute from the Latin-1 charset (the +unified representation) in a buffer saved as Latin-9 will be encoded +directly to a byte value 233. By default, in contrast, you would be +prompted for a general coding system to use for saving the file, which +can cope with separate Latin-1 and Latin-9 representations of e-acute. + +See also command `unify-8859-on-decoding-mode'." + :group 'mule + :global t + :version 21.3 ; who knows...? + :init-value nil + (if unify-8859-on-encoding-mode + (ucs-unify-8859 t) + (ucs-fragment-8859 t))) + +;;;###autoload +(define-minor-mode unify-8859-on-decoding-mode + "Set up translation table for unifying ISO 8859 characters on decoding. +On decoding -- i.e. input operations -- non-ASCII characters from the +built-in ISO 8859 charsets are unified by mapping them into the +`iso-latin-1' and `mule-unicode-0100-24ff' charsets. + +This sets the parent of `standard-translation-table-for-decode'. + +See also command `unify-8859-on-encoding-mode'." + :group 'mule + :global t + :version 21.3 ; who knows...? + :init-value nil + (if unify-8859-on-decoding-mode + (set-char-table-parent standard-translation-table-for-decode + ucs-mule-8859-to-mule-unicode) + (set-char-table-parent standard-translation-table-for-decode nil))) + +(defun ucs-insert (arg) + "Insert the Emacs character representation of the given Unicode. +Interactively, prompts for a hex string giving the code." + (interactive "sUnicode (hex): ") + (insert (decode-char 'ucs (if (integerp arg) + arg + (string-to-number arg 16))))) + +;;; Dealing with non-8859 character sets. + +;; We only set up translation on encoding to utf-8. Also translation +;; tables ucs-CS-encode-table are constructed for some coding systems +;; CS which could be used as `translation-table-for-encode', currently +;; for indian-is13194, lao, thai, tibetan-iso-8bit and +;; vietnamese-viscii. + +;; The alists here cover both coding systems (external charsets), like +;; VISCII, and individual Emacs charsets, like `ipa'. +(let ((vietnamese-viscii + '((?,1!(B . ?$,1o/(B) + (?,1"(B . ?$,1o1(B) + (?,1#(B . ?$,1o7(B) + (?,1$(B . ?$,1o%(B) + (?,1%(B . ?$,1o'(B) + (?,1&(B . ?$,1o)(B) + (?,1'(B . ?$,1o-(B) + (?,1((B . ?$,1o=(B) + (?,1)(B . ?$,1o9(B) + (?,1*(B . ?$,1o?(B) + (?,1+(B . ?$,1oA(B) + (?,1,(B . ?$,1oC(B) + (?,1-(B . ?$,1oE(B) + (?,1.(B . ?$,1oG(B) + (?,1/(B . ?$,1oQ(B) + (?,10(B . ?$,1oS(B) + (?,11(B . ?$,1oU(B) + (?,12(B . ?$,1oW(B) + (?,15(B . ?$,1oY(B) + (?,16(B . ?$,1o](B) + (?,17(B . ?$,1o_(B) + (?,18(B . ?$,1oK(B) + (?,1=(B . ?$,1!a(B) + (?,1>(B . ?$,1o[(B) + (?,1F(B . ?$,1o3(B) + (?,1G(B . ?$,1o5(B) + (?,1O(B . ?$,1os(B) + (?,1Q(B . ?$,1oi(B) + (?,1U(B . ?$,1o!(B) + (?,1V(B . ?$,1ow(B) + (?,1W(B . ?$,1ok(B) + (?,1X(B . ?$,1om(B) + (?,1[(B . ?$,1oy(B) + (?,1\(B . ?$,1ou(B) + (?,1^(B . ?$,1oa(B) + (?,1_(B . ?$,1!p(B) + (?,1`(B . ?,A`(B) + (?,1a(B . ?,Aa(B) + (?,1b(B . ?,Ab(B) + (?,1c(B . ?,Ac(B) + (?,1d(B . ?$,1o#(B) + (?,1e(B . ?$,1 #(B) + (?,1f(B . ?$,1oo(B) + (?,1g(B . ?$,1o+(B) + (?,1h(B . ?,Ah(B) + (?,1i(B . ?,Ai(B) + (?,1j(B . ?,Aj(B) + (?,1k(B . ?$,1o;(B) + (?,1l(B . ?,Al(B) + (?,1m(B . ?,Am(B) + (?,1n(B . ?$,1 I(B) + (?,1o(B . ?$,1oI(B) + (?,1p(B . ?$,1 1(B) + (?,1q(B . ?$,1oq(B) + (?,1r(B . ?,Ar(B) + (?,1s(B . ?,As(B) + (?,1t(B . ?,At(B) + (?,1u(B . ?,Au(B) + (?,1v(B . ?$,1oO(B) + (?,1w(B . ?$,1oM(B) + (?,1x(B . ?$,1oe(B) + (?,1y(B . ?,Ay(B) + (?,1z(B . ?,Az(B) + (?,1{(B . ?$,1!)(B) + (?,1|(B . ?$,1og(B) + (?,1}(B . ?,A}(B) + (?,1~(B . ?$,1oc(B) + + (?,2!(B . ?$,1o.(B) + (?,2"(B . ?$,1o0(B) + (?,2#(B . ?$,1o6(B) + (?,2$(B . ?$,1o$(B) + (?,2%(B . ?$,1o&(B) + (?,2&(B . ?$,1o((B) + (?,2'(B . ?$,1o,(B) + (?,2((B . ?$,1o<(B) + (?,2)(B . ?$,1o8(B) + (?,2*(B . ?$,1o>(B) + (?,2+(B . ?$,1o@(B) + (?,2,(B . ?$,1oB(B) + (?,2-(B . ?$,1oD(B) + (?,2.(B . ?$,1oF(B) + (?,2/(B . ?$,1oP(B) + (?,20(B . ?$,1oR(B) + (?,21(B . ?$,1oT(B) + (?,22(B . ?$,1oV(B) + (?,25(B . ?$,1oX(B) + (?,26(B . ?$,1o\(B) + (?,27(B . ?$,1o^(B) + (?,28(B . ?$,1oJ(B) + (?,2=(B . ?$,1!`(B) + (?,2>(B . ?$,1oZ(B) + (?,2F(B . ?$,1o2(B) + (?,2G(B . ?$,1o4(B) + (?,2O(B . ?$,1or(B) + (?,2Q(B . ?$,1oh(B) + (?,2U(B . ?$,1o (B) + (?,2V(B . ?$,1ov(B) + (?,2W(B . ?$,1oj(B) + (?,2X(B . ?$,1ol(B) + (?,2[(B . ?$,1ox(B) + (?,2\(B . ?$,1ot(B) + (?,2^(B . ?$,1o`(B) + (?,2_(B . ?$,1!o(B) + (?,2`(B . ?,A@(B) + (?,2a(B . ?,AA(B) + (?,2b(B . ?,AB(B) + (?,2c(B . ?,AC(B) + (?,2d(B . ?$,1o"(B) + (?,2e(B . ?$,1 "(B) + (?,2f(B . ?$,1on(B) + (?,2g(B . ?$,1o*(B) + (?,2h(B . ?,AH(B) + (?,2i(B . ?,AI(B) + (?,2j(B . ?,AJ(B) + (?,2k(B . ?$,1o:(B) + (?,2l(B . ?,AL(B) + (?,2m(B . ?,AM(B) + (?,2n(B . ?$,1 H(B) + (?,2o(B . ?$,1oH(B) + (?,2p(B . ?$,1 0(B) + (?,2q(B . ?$,1op(B) + (?,2r(B . ?,AR(B) + (?,2s(B . ?,AS(B) + (?,2t(B . ?,AT(B) + (?,2u(B . ?,AU(B) + (?,2v(B . ?$,1oN(B) + (?,2w(B . ?$,1oL(B) + (?,2x(B . ?$,1od(B) + (?,2y(B . ?,AY(B) + (?,2z(B . ?,AZ(B) + (?,2{(B . ?$,1!((B) + (?,2|(B . ?$,1of(B) + (?,2}(B . ?,A](B) + (?,2~(B . ?$,1ob(B))) + + (thai-tis620 + '((?,T!(B . ?$,1Ba(B) + (?,T"(B . ?$,1Bb(B) + (?,T#(B . ?$,1Bc(B) + (?,T$(B . ?$,1Bd(B) + (?,T%(B . ?$,1Be(B) + (?,T&(B . ?$,1Bf(B) + (?,T'(B . ?$,1Bg(B) + (?,T((B . ?$,1Bh(B) + (?,T)(B . ?$,1Bi(B) + (?,T*(B . ?$,1Bj(B) + (?,T+(B . ?$,1Bk(B) + (?,T,(B . ?$,1Bl(B) + (?,T-(B . ?$,1Bm(B) + (?,T.(B . ?$,1Bn(B) + (?,T/(B . ?$,1Bo(B) + (?,T0(B . ?$,1Bp(B) + (?,T1(B . ?$,1Bq(B) + (?,T2(B . ?$,1Br(B) + (?,T3(B . ?$,1Bs(B) + (?,T4(B . ?$,1Bt(B) + (?,T5(B . ?$,1Bu(B) + (?,T6(B . ?$,1Bv(B) + (?,T7(B . ?$,1Bw(B) + (?,T8(B . ?$,1Bx(B) + (?,T9(B . ?$,1By(B) + (?,T:(B . ?$,1Bz(B) + (?,T;(B . ?$,1B{(B) + (?,T<(B . ?$,1B|(B) + (?,T=(B . ?$,1B}(B) + (?,T>(B . ?$,1B~(B) + (?,T?(B . ?$,1B(B) + (?,T@(B . ?$,1C (B) + (?,TA(B . ?$,1C!(B) + (?,TB(B . ?$,1C"(B) + (?,TC(B . ?$,1C#(B) + (?,TD(B . ?$,1C$(B) + (?,TE(B . ?$,1C%(B) + (?,TF(B . ?$,1C&(B) + (?,TG(B . ?$,1C'(B) + (?,TH(B . ?$,1C((B) + (?,TI(B . ?$,1C)(B) + (?,TJ(B . ?$,1C*(B) + (?,TK(B . ?$,1C+(B) + (?,TL(B . ?$,1C,(B) + (?,TM(B . ?$,1C-(B) + (?,TN(B . ?$,1C.(B) + (?,TO(B . ?$,1C/(B) + (?,TP(B . ?$,1C0(B) + (?,TQ(B . ?$,1C1(B) + (?,TR(B . ?$,1C2(B) + (?,TS(B . ?$,1C3(B) + (?,TT(B . ?$,1C4(B) + (?,TU(B . ?$,1C5(B) + (?,TV(B . ?$,1C6(B) + (?,TW(B . ?$,1C7(B) + (?,TX(B . ?$,1C8(B) + (?,TY(B . ?$,1C9(B) + (?,TZ(B . ?$,1C:(B) + (?,T_(B . ?$,1C?(B) + (?,T`(B . ?$,1C@(B) + (?,Ta(B . ?$,1CA(B) + (?,Tb(B . ?$,1CB(B) + (?,Tc(B . ?$,1CC(B) + (?,Td(B . ?$,1CD(B) + (?,Te(B . ?$,1CE(B) + (?,Tf(B . ?$,1CF(B) + (?,Tg(B . ?$,1CG(B) + (?,Th(B . ?$,1CH(B) + (?,Ti(B . ?$,1CI(B) + (?,Tj(B . ?$,1CJ(B) + (?,Tk(B . ?$,1CK(B) + (?,Tl(B . ?$,1CL(B) + (?,Tm(B . ?$,1CM(B) + (?,Tn(B . ?$,1CN(B) + (?,To(B . ?$,1CO(B) + (?,Tp(B . ?$,1CP(B) + (?,Tq(B . ?$,1CQ(B) + (?,Tr(B . ?$,1CR(B) + (?,Ts(B . ?$,1CS(B) + (?,Tt(B . ?$,1CT(B) + (?,Tu(B . ?$,1CU(B) + (?,Tv(B . ?$,1CV(B) + (?,Tw(B . ?$,1CW(B) + (?,Tx(B . ?$,1CX(B) + (?,Ty(B . ?$,1CY(B) + (?,Tz(B . ?$,1CZ(B) + (?,T{(B . ?$,1C[(B))) + + (tibetan-iso-8bit + '((?$(7!0(B . ?$,1E@(B) + (?$(7!1(B . ?$,1EA(B) + (?$(7!2(B . ?$,1EB(B) + (?$(7!3(B . ?$,1EC(B) + (?$(7!4(B . ?$,1ED(B) + (?$(7!5(B . ?$,1EE(B) + (?$(7!6(B . ?$,1EF(B) + (?$(7!7(B . ?$,1EG(B) + (?$(7!8(B . ?$,1EH(B) + (?$(7!9(B . ?$,1EI(B) + (?$(7!:(B . ?$,1EJ(B) + (?$(7!;(B . ?$,1EK(B) + (?$(7!<(B . ?$,1EL(B) + (?$(7!=(B . ?$,1EM(B) + (?$(7!>(B . ?$,1EN(B) + (?$(7!?(B . ?$,1EO(B) + (?$(7!@(B . ?$,1EP(B) + (?$(7!A(B . ?$,1EQ(B) + (?$(7!B(B . ?$,1ER(B) + (?$(7!C(B . ?$,1ES(B) + (?$(7!D(B . ?$,1ET(B) + (?$(7!E(B . ?$,1EU(B) + (?$(7!F(B . ?$,1EV(B) + (?$(7!G(B . ?$,1EW(B) + (?$(7!H(B . ?$,1EX(B) + (?$(7!I(B . ?$,1EY(B) + (?$(7!J(B . ?$,1EZ(B) + (?$(7!K(B . ?$,1E[(B) + (?$(7!L(B . ?$,1E\(B) + (?$(7!M(B . ?$,1E](B) + (?$(7!N(B . ?$,1E^(B) + (?$(7!O(B . ?$,1E_(B) + (?$(7!P(B . ?$,1E`(B) + (?$(7!Q(B . ?$,1Ea(B) + (?$(7!R(B . ?$,1Eb(B) + (?$(7!S(B . ?$,1Ec(B) + (?$(7!T(B . ?$,1Ed(B) + (?$(7!U(B . ?$,1Ee(B) + (?$(7!V(B . ?$,1Ef(B) + (?$(7!W(B . ?$,1Eg(B) + (?$(7!X(B . ?$,1Eh(B) + (?$(7!Y(B . ?$,1Ei(B) + (?$(7!Z(B . ?$,1Ej(B) + (?$(7![(B . ?$,1Ek(B) + (?$(7!\(B . ?$,1El(B) + (?$(7!](B . ?$,1Em(B) + (?$(7!^(B . ?$,1En(B) + (?$(7!_(B . ?$,1Eo(B) + (?$(7!`(B . ?$,1Ep(B) + (?$(7!a(B . ?$,1Eq(B) + (?$(7!b(B . ?$,1Er(B) + (?$(7!c(B . ?$,1Es(B) + (?$(7!d(B . ?$,1Et(B) + (?$(7!e(B . ?$,1Eu(B) + (?$(7!f(B . ?$,1Ev(B) + (?$(7!g(B . ?$,1Ew(B) + (?$(7!h(B . ?$,1Ex(B) + (?$(7!i(B . ?$,1Ey(B) + (?$(7!j(B . ?$,1Ez(B) + (?$(7!k(B . ?$,1E{(B) + (?$(7!l(B . ?$,1E|(B) + (?$(7!m(B . ?$,1E}(B) + (?$(7!n(B . ?$,1E~(B) + (?$(7!o(B . ?$,1E(B) + (?$(7"!(B . ?$,1F (B) + (?$(7""(B . ?$,1F!(B) + (?$(7"#(B . ?$,1F"(B) + (?$(7"$(B . ?$,1F#(B) + (?$(7"%(B . ?$,1F$(B) + (?$(7"&(B . ?$,1F%(B) + (?$(7"'(B . ?$,1F&(B) + (?$(7"((B . ?$,1F'(B) + (?$(7"*(B . ?$,1F)(B) + (?$(7"+(B . ?$,1F*(B) + (?$(7",(B . ?$,1F+(B) + (?$(7"-(B . ?$,1F,(B) + (?$(7".(B . ?$,1F-(B) + (?$(7"/(B . ?$,1F.(B) + (?$(7"0(B . ?$,1F/(B) + (?$(7"1(B . ?$,1F0(B) + (?$(7"2(B . ?$,1F1(B) + (?$(7"3(B . ?$,1F2(B) + (?$(7"4(B . ?$,1F3(B) + (?$(7"5(B . ?$,1F4(B) + (?$(7"6(B . ?$,1F5(B) + (?$(7"7(B . ?$,1F6(B) + (?$(7"8(B . ?$,1F7(B) + (?$(7"9(B . ?$,1F8(B) + (?$(7":(B . ?$,1F9(B) + (?$(7";(B . ?$,1F:(B) + (?$(7"<(B . ?$,1F;(B) + (?$(7"=(B . ?$,1F<(B) + (?$(7">(B . ?$,1F=(B) + (?$(7"?(B . ?$,1F>(B) + (?$(7"@(B . ?$,1F?(B) + (?$(7"A(B . ?$,1F@(B) + (?$(7"B(B . ?$,1FA(B) + (?$(7"C(B . ?$,1FB(B) + (?$(7"D(B . ?$,1FC(B) + (?$(7"E(B . ?$,1FD(B) + (?$(7"F(B . ?$,1FE(B) + (?$(7"G(B . ?$,1FF(B) + (?$(7"H(B . ?$,1FG(B) + (?$(7"I(B . ?$,1FH(B) + (?$(7"J(B . ?$,1FI(B) + (?$(7"K(B . ?$,1FJ(B) + (?$(7"R(B . ?$,1FQ(B) + (?$(7"S(B . ?$,1FR(B) + (?$(7"T(B . ?$,1FS(B) + (?$(7"U(B . ?$,1FT(B) + (?$(7"V(B . ?$,1FU(B) + (?$(7"W(B . ?$,1FV(B) + (?$(7"X(B . ?$,1FW(B) + (?$(7"Y(B . ?$,1FX(B) + (?$(7"Z(B . ?$,1FY(B) + (?$(7"[(B . ?$,1FZ(B) + (?$(7"\(B . ?$,1F[(B) + (?$(7"](B . ?$,1F\(B) + (?$(7"^(B . ?$,1F](B) + (?$(7"_(B . ?$,1F^(B) + (?$(7"`(B . ?$,1F_(B) + (?$(7"a(B . ?$,1F`(B) + (?$(7"b(B . ?$,1Fa(B) + (?$(7"c(B . ?$,1Fb(B) + (?$(7"d(B . ?$,1Fc(B) + (?$(7"e(B . ?$,1Fd(B) + (?$(7"f(B . ?$,1Fe(B) + (?$(7"g(B . ?$,1Ff(B) + (?$(7"h(B . ?$,1Fg(B) + (?$(7"i(B . ?$,1Fh(B) + (?$(7"j(B . ?$,1Fi(B) + (?$(7"k(B . ?$,1Fj(B) + (?$(7"l(B . ?$,1Fk(B) + (?$(7#!(B . ?$,1Fp(B) + (?$(7#"(B . ?$,1Fq(B) + (?$(7##(B . ?$,1Fr(B) + (?$(7#$(B . ?$,1Fs(B) + (?$(7#%(B . ?$,1Ft(B) + (?$(7#&(B . ?$,1Fu(B) + (?$(7#'(B . ?$,1Fv(B) + (?$(7#((B . ?$,1Fw(B) + (?$(7#*(B . ?$,1Fy(B) + (?$(7#+(B . ?$,1Fz(B) + (?$(7#,(B . ?$,1F{(B) + (?$(7#-(B . ?$,1F|(B) + (?$(7#.(B . ?$,1F}(B) + (?$(7#/(B . ?$,1F~(B) + (?$(7#0(B . ?$,1F(B) + (?$(7#1(B . ?$,1G (B) + (?$(7#2(B . ?$,1G!(B) + (?$(7#3(B . ?$,1G"(B) + (?$(7#4(B . ?$,1G#(B) + (?$(7#5(B . ?$,1G$(B) + (?$(7#6(B . ?$,1G%(B) + (?$(7#7(B . ?$,1G&(B) + (?$(7#8(B . ?$,1G'(B) + (?$(7#9(B . ?$,1G((B) + (?$(7#:(B . ?$,1G)(B) + (?$(7#;(B . ?$,1G*(B) + (?$(7#<(B . ?$,1G+(B) + (?$(7#=(B . ?$,1G,(B) + (?$(7#>(B . ?$,1G-(B) + (?$(7#?(B . ?$,1G.(B) + (?$(7#@(B . ?$,1G/(B) + (?$(7#A(B . ?$,1G0(B) + (?$(7#B(B . ?$,1G1(B) + (?$(7#C(B . ?$,1G2(B) + (?$(7#D(B . ?$,1G3(B) + (?$(7#E(B . ?$,1G4(B) + (?$(7#F(B . ?$,1G5(B) + (?$(7#G(B . ?$,1G6(B) + (?$(7#H(B . ?$,1G7(B) + (?$(7#I(B . ?$,1G8(B) + (?$(7#J(B . ?$,1G9(B) + (?$(7#K(B . ?$,1G:(B) + (?$(7#L(B . ?$,1G;(B) + (?$(7#M(B . ?$,1G<(B) + (?$(7#O(B . ?$,1G>(B) + (?$(7#P(B . ?$,1G?(B) + (?$(7#Q(B . ?$,1G@(B) + (?$(7#R(B . ?$,1GA(B) + (?$(7#S(B . ?$,1GB(B) + (?$(7#T(B . ?$,1GC(B) + (?$(7#U(B . ?$,1GD(B) + (?$(7#V(B . ?$,1GE(B) + (?$(7#W(B . ?$,1GF(B) + (?$(7#X(B . ?$,1GG(B) + (?$(7#Y(B . ?$,1GH(B) + (?$(7#Z(B . ?$,1GI(B) + (?$(7#[(B . ?$,1GJ(B) + (?$(7#\(B . ?$,1GK(B) + (?$(7#](B . ?$,1GL(B) + (?$(7#`(B . ?$,1GO(B))) + + (ipa + '((?,0 (B . ?i) + (?,0!(B . ?$,1#j(B) + (?,0"(B . ?e) + (?,0#(B . ?$,1#[(B) + (?,0$(B . ?,Af(B) + (?,0%(B . ?a) + (?,0&(B . ?$,1#h(B) + (?,0'(B . ?$,1#Y(B) + (?,0((B . ?$,1#P(B) + (?,0)(B . ?$,1#o(B) + (?,0*(B . ?$,1#d(B) + (?,0+(B . ?$,1$,(B) + (?,0,(B . ?$,1#Q(B) + (?,0-(B . ?y) + (?,0.(B . ?$,1$/(B) + (?,0/(B . ?,Ax(B) + (?,00(B . ?$,1 s(B) + (?,01(B . ?$,1#v(B) + (?,02(B . ?$,1$)(B) + (?,03(B . ?$,1#u(B) + (?,04(B . ?u) + (?,05(B . ?$,1$*(B) + (?,06(B . ?o) + (?,07(B . ?$,1#T(B) + (?,08(B . ?$,1#R(B) + (?,0:(B . ?$,1#Z(B) + (?,0@(B . ?p) + (?,0A(B . ?b) + (?,0B(B . ?t) + (?,0C(B . ?d) + (?,0D(B . ?k) + (?,0E(B . ?g) + (?,0F(B . ?f) + (?,0G(B . ?v) + (?,0H(B . ?$,1'8(B) + (?,0I(B . ?,Ap(B) + (?,0J(B . ?s) + (?,0K(B . ?z) + (?,0L(B . ?$,1$#(B) + (?,0M(B . ?$,1$2(B) + (?,0N(B . ?,Ag(B) + (?,0O(B . ?x) + (?,0P(B . ?$,1$!(B) + (?,0Q(B . ?h) + (?,0R(B . ?m) + (?,0S(B . ?n) + (?,0T(B . ?$,1#r(B) + (?,0U(B . ?$,1 k(B) + (?,0V(B . ?r) + (?,0W(B . ?$,1$ (B) + (?,0X(B . ?$,1#y(B) + (?,0Y(B . ?j) + (?,0Z(B . ?l) + (?,0[(B . ?$,1$.(B) + (?,0\(B . ?$,1$?(B) + (?,0](B . ?$,1#e(B) + (?,0^(B . ?w) + (?,0_(B . ?$,1$-(B) + (?,0p(B . ?$,1$h(B) + (?,0q(B . ?$,1$l(B) + (?,0r(B . ?$,1$p(B))) + + (ethiopic + '((?$(3!!(B . ?$,1M@(B) + (?$(3!"(B . ?$,1MA(B) + (?$(3!#(B . ?$,1MB(B) + (?$(3!$(B . ?$,1MC(B) + (?$(3!%(B . ?$,1MD(B) + (?$(3!&(B . ?$,1ME(B) + (?$(3!'(B . ?$,1MF(B) + (?$(3!)(B . ?$,1MH(B) + (?$(3!*(B . ?$,1MI(B) + (?$(3!+(B . ?$,1MJ(B) + (?$(3!,(B . ?$,1MK(B) + (?$(3!-(B . ?$,1ML(B) + (?$(3!.(B . ?$,1MM(B) + (?$(3!/(B . ?$,1MN(B) + (?$(3!0(B . ?$,1MO(B) + (?$(3!1(B . ?$,1MP(B) + (?$(3!2(B . ?$,1MQ(B) + (?$(3!3(B . ?$,1MR(B) + (?$(3!4(B . ?$,1MS(B) + (?$(3!5(B . ?$,1MT(B) + (?$(3!6(B . ?$,1MU(B) + (?$(3!7(B . ?$,1MV(B) + (?$(3!8(B . ?$,1MW(B) + (?$(3!9(B . ?$,1MX(B) + (?$(3!:(B . ?$,1MY(B) + (?$(3!;(B . ?$,1MZ(B) + (?$(3!<(B . ?$,1M[(B) + (?$(3!=(B . ?$,1M\(B) + (?$(3!>(B . ?$,1M](B) + (?$(3!?(B . ?$,1M^(B) + (?$(3!@(B . ?$,1M_(B) + (?$(3!A(B . ?$,1M`(B) + (?$(3!B(B . ?$,1Ma(B) + (?$(3!C(B . ?$,1Mb(B) + (?$(3!D(B . ?$,1Mc(B) + (?$(3!E(B . ?$,1Md(B) + (?$(3!F(B . ?$,1Me(B) + (?$(3!G(B . ?$,1Mf(B) + (?$(3!H(B . ?$,1Mg(B) + (?$(3!I(B . ?$,1Mh(B) + (?$(3!J(B . ?$,1Mi(B) + (?$(3!K(B . ?$,1Mj(B) + (?$(3!L(B . ?$,1Mk(B) + (?$(3!M(B . ?$,1Ml(B) + (?$(3!N(B . ?$,1Mm(B) + (?$(3!O(B . ?$,1Mn(B) + (?$(3!P(B . ?$,1Mo(B) + (?$(3!Q(B . ?$,1Mp(B) + (?$(3!R(B . ?$,1Mq(B) + (?$(3!S(B . ?$,1Mr(B) + (?$(3!T(B . ?$,1Ms(B) + (?$(3!U(B . ?$,1Mt(B) + (?$(3!V(B . ?$,1Mu(B) + (?$(3!W(B . ?$,1Mv(B) + (?$(3!X(B . ?$,1Mw(B) + (?$(3!Y(B . ?$,1Mx(B) + (?$(3!Z(B . ?$,1My(B) + (?$(3![(B . ?$,1Mz(B) + (?$(3!\(B . ?$,1M{(B) + (?$(3!](B . ?$,1M|(B) + (?$(3!^(B . ?$,1M}(B) + (?$(3!_(B . ?$,1M~(B) + (?$(3!`(B . ?$,1M(B) + (?$(3!a(B . ?$,1N (B) + (?$(3!b(B . ?$,1N!(B) + (?$(3!c(B . ?$,1N"(B) + (?$(3!d(B . ?$,1N#(B) + (?$(3!e(B . ?$,1N$(B) + (?$(3!f(B . ?$,1N%(B) + (?$(3!g(B . ?$,1N&(B) + (?$(3!i(B . ?$,1N((B) + (?$(3!k(B . ?$,1N*(B) + (?$(3!l(B . ?$,1N+(B) + (?$(3!m(B . ?$,1N,(B) + (?$(3!n(B . ?$,1N-(B) + (?$(3!q(B . ?$,1N0(B) + (?$(3!r(B . ?$,1N1(B) + (?$(3!s(B . ?$,1N2(B) + (?$(3!t(B . ?$,1N3(B) + (?$(3!u(B . ?$,1N4(B) + (?$(3!v(B . ?$,1N5(B) + (?$(3!w(B . ?$,1N6(B) + (?$(3!y(B . ?$,1N8(B) + (?$(3!{(B . ?$,1N:(B) + (?$(3!|(B . ?$,1N;(B) + (?$(3!}(B . ?$,1N<(B) + (?$(3!~(B . ?$,1N=(B) + (?$(3"#(B . ?$,1N@(B) + (?$(3"$(B . ?$,1NA(B) + (?$(3"%(B . ?$,1NB(B) + (?$(3"&(B . ?$,1NC(B) + (?$(3"'(B . ?$,1ND(B) + (?$(3"((B . ?$,1NE(B) + (?$(3")(B . ?$,1NF(B) + (?$(3"*(B . ?$,1NG(B) + (?$(3"+(B . ?$,1NH(B) + (?$(3",(B . ?$,1NI(B) + (?$(3"-(B . ?$,1NJ(B) + (?$(3".(B . ?$,1NK(B) + (?$(3"/(B . ?$,1NL(B) + (?$(3"0(B . ?$,1NM(B) + (?$(3"1(B . ?$,1NN(B) + (?$(3"2(B . ?$,1NO(B) + (?$(3"3(B . ?$,1NP(B) + (?$(3"4(B . ?$,1NQ(B) + (?$(3"5(B . ?$,1NR(B) + (?$(3"6(B . ?$,1NS(B) + (?$(3"7(B . ?$,1NT(B) + (?$(3"8(B . ?$,1NU(B) + (?$(3"9(B . ?$,1NV(B) + (?$(3":(B . ?$,1NW(B) + (?$(3";(B . ?$,1NX(B) + (?$(3"<(B . ?$,1NY(B) + (?$(3"=(B . ?$,1NZ(B) + (?$(3">(B . ?$,1N[(B) + (?$(3"?(B . ?$,1N\(B) + (?$(3"@(B . ?$,1N](B) + (?$(3"A(B . ?$,1N^(B) + (?$(3"B(B . ?$,1N_(B) + (?$(3"C(B . ?$,1N`(B) + (?$(3"D(B . ?$,1Na(B) + (?$(3"E(B . ?$,1Nb(B) + (?$(3"F(B . ?$,1Nc(B) + (?$(3"G(B . ?$,1Nd(B) + (?$(3"H(B . ?$,1Ne(B) + (?$(3"I(B . ?$,1Nf(B) + (?$(3"K(B . ?$,1Nh(B) + (?$(3"M(B . ?$,1Nj(B) + (?$(3"N(B . ?$,1Nk(B) + (?$(3"O(B . ?$,1Nl(B) + (?$(3"P(B . ?$,1Nm(B) + (?$(3"S(B . ?$,1Np(B) + (?$(3"T(B . ?$,1Nq(B) + (?$(3"U(B . ?$,1Nr(B) + (?$(3"V(B . ?$,1Ns(B) + (?$(3"W(B . ?$,1Nt(B) + (?$(3"X(B . ?$,1Nu(B) + (?$(3"Y(B . ?$,1Nv(B) + (?$(3"Z(B . ?$,1Nw(B) + (?$(3"[(B . ?$,1Nx(B) + (?$(3"\(B . ?$,1Ny(B) + (?$(3"](B . ?$,1Nz(B) + (?$(3"^(B . ?$,1N{(B) + (?$(3"_(B . ?$,1N|(B) + (?$(3"`(B . ?$,1N}(B) + (?$(3"a(B . ?$,1N~(B) + (?$(3"b(B . ?$,1N(B) + (?$(3"c(B . ?$,1O (B) + (?$(3"d(B . ?$,1O!(B) + (?$(3"e(B . ?$,1O"(B) + (?$(3"f(B . ?$,1O#(B) + (?$(3"g(B . ?$,1O$(B) + (?$(3"h(B . ?$,1O%(B) + (?$(3"i(B . ?$,1O&(B) + (?$(3"j(B . ?$,1O'(B) + (?$(3"k(B . ?$,1O((B) + (?$(3"l(B . ?$,1O)(B) + (?$(3"m(B . ?$,1O*(B) + (?$(3"n(B . ?$,1O+(B) + (?$(3"o(B . ?$,1O,(B) + (?$(3"p(B . ?$,1O-(B) + (?$(3"q(B . ?$,1O.(B) + (?$(3"s(B . ?$,1O0(B) + (?$(3"u(B . ?$,1O2(B) + (?$(3"v(B . ?$,1O3(B) + (?$(3"w(B . ?$,1O4(B) + (?$(3"x(B . ?$,1O5(B) + (?$(3"{(B . ?$,1O8(B) + (?$(3"|(B . ?$,1O9(B) + (?$(3"}(B . ?$,1O:(B) + (?$(3"~(B . ?$,1O;(B) + (?$(3#!(B . ?$,1O<(B) + (?$(3#"(B . ?$,1O=(B) + (?$(3##(B . ?$,1O>(B) + (?$(3#%(B . ?$,1O@(B) + (?$(3#'(B . ?$,1OB(B) + (?$(3#((B . ?$,1OC(B) + (?$(3#)(B . ?$,1OD(B) + (?$(3#*(B . ?$,1OE(B) + (?$(3#-(B . ?$,1OH(B) + (?$(3#.(B . ?$,1OI(B) + (?$(3#/(B . ?$,1OJ(B) + (?$(3#0(B . ?$,1OK(B) + (?$(3#1(B . ?$,1OL(B) + (?$(3#2(B . ?$,1OM(B) + (?$(3#3(B . ?$,1ON(B) + (?$(3#5(B . ?$,1OP(B) + (?$(3#6(B . ?$,1OQ(B) + (?$(3#7(B . ?$,1OR(B) + (?$(3#8(B . ?$,1OS(B) + (?$(3#9(B . ?$,1OT(B) + (?$(3#:(B . ?$,1OU(B) + (?$(3#;(B . ?$,1OV(B) + (?$(3#=(B . ?$,1OX(B) + (?$(3#>(B . ?$,1OY(B) + (?$(3#?(B . ?$,1OZ(B) + (?$(3#@(B . ?$,1O[(B) + (?$(3#A(B . ?$,1O\(B) + (?$(3#B(B . ?$,1O](B) + (?$(3#C(B . ?$,1O^(B) + (?$(3#D(B . ?$,1O_(B) + (?$(3#E(B . ?$,1O`(B) + (?$(3#F(B . ?$,1Oa(B) + (?$(3#G(B . ?$,1Ob(B) + (?$(3#H(B . ?$,1Oc(B) + (?$(3#I(B . ?$,1Od(B) + (?$(3#J(B . ?$,1Oe(B) + (?$(3#K(B . ?$,1Of(B) + (?$(3#L(B . ?$,1Og(B) + (?$(3#M(B . ?$,1Oh(B) + (?$(3#N(B . ?$,1Oi(B) + (?$(3#O(B . ?$,1Oj(B) + (?$(3#P(B . ?$,1Ok(B) + (?$(3#Q(B . ?$,1Ol(B) + (?$(3#R(B . ?$,1Om(B) + (?$(3#S(B . ?$,1On(B) + (?$(3#U(B . ?$,1Op(B) + (?$(3#V(B . ?$,1Oq(B) + (?$(3#W(B . ?$,1Or(B) + (?$(3#X(B . ?$,1Os(B) + (?$(3#Y(B . ?$,1Ot(B) + (?$(3#Z(B . ?$,1Ou(B) + (?$(3#[(B . ?$,1Ov(B) + (?$(3#\(B . ?$,1Ow(B) + (?$(3#](B . ?$,1Ox(B) + (?$(3#^(B . ?$,1Oy(B) + (?$(3#_(B . ?$,1Oz(B) + (?$(3#`(B . ?$,1O{(B) + (?$(3#a(B . ?$,1O|(B) + (?$(3#b(B . ?$,1O}(B) + (?$(3#c(B . ?$,1O~(B) + (?$(3#d(B . ?$,1O(B) + (?$(3#e(B . ?$,1P (B) + (?$(3#f(B . ?$,1P!(B) + (?$(3#g(B . ?$,1P"(B) + (?$(3#h(B . ?$,1P#(B) + (?$(3#i(B . ?$,1P$(B) + (?$(3#j(B . ?$,1P%(B) + (?$(3#k(B . ?$,1P&(B) + (?$(3#l(B . ?$,1P'(B) + (?$(3#m(B . ?$,1P((B) + (?$(3#n(B . ?$,1P)(B) + (?$(3#o(B . ?$,1P*(B) + (?$(3#p(B . ?$,1P+(B) + (?$(3#q(B . ?$,1P,(B) + (?$(3#r(B . ?$,1P-(B) + (?$(3#s(B . ?$,1P.(B) + (?$(3#u(B . ?$,1P0(B) + (?$(3#w(B . ?$,1P2(B) + (?$(3#x(B . ?$,1P3(B) + (?$(3#y(B . ?$,1P4(B) + (?$(3#z(B . ?$,1P5(B) + (?$(3#}(B . ?$,1P8(B) + (?$(3#~(B . ?$,1P9(B) + (?$(3$!(B . ?$,1P:(B) + (?$(3$"(B . ?$,1P;(B) + (?$(3$#(B . ?$,1P<(B) + (?$(3$$(B . ?$,1P=(B) + (?$(3$%(B . ?$,1P>(B) + (?$(3$'(B . ?$,1P@(B) + (?$(3$((B . ?$,1PA(B) + (?$(3$)(B . ?$,1PB(B) + (?$(3$*(B . ?$,1PC(B) + (?$(3$+(B . ?$,1PD(B) + (?$(3$,(B . ?$,1PE(B) + (?$(3$-(B . ?$,1PF(B) + (?$(3$.(B . ?$,1PG(B) + (?$(3$/(B . ?$,1PH(B) + (?$(3$0(B . ?$,1PI(B) + (?$(3$1(B . ?$,1PJ(B) + (?$(3$2(B . ?$,1PK(B) + (?$(3$3(B . ?$,1PL(B) + (?$(3$4(B . ?$,1PM(B) + (?$(3$5(B . ?$,1PN(B) + (?$(3$6(B . ?$,1PO(B) + (?$(3$7(B . ?$,1PP(B) + (?$(3$8(B . ?$,1PQ(B) + (?$(3$9(B . ?$,1PR(B) + (?$(3$:(B . ?$,1PS(B) + (?$(3$;(B . ?$,1PT(B) + (?$(3$<(B . ?$,1PU(B) + (?$(3$=(B . ?$,1PV(B) + (?$(3$>(B . ?$,1PW(B) + (?$(3$?(B . ?$,1PX(B) + (?$(3$@(B . ?$,1PY(B) + (?$(3$A(B . ?$,1PZ(B) + (?$(3$B(B . ?$,1P[(B) + (?$(3$C(B . ?$,1P\(B) + (?$(3$D(B . ?$,1P](B) + (?$(3$E(B . ?$,1P^(B) + (?$(3$F(B . ?$,1P_(B) + (?$(3$G(B . ?$,1P`(B) + (?$(3$H(B . ?$,1Pa(B) + (?$(3$I(B . ?$,1Pb(B) + (?$(3$J(B . ?$,1Pc(B) + (?$(3$K(B . ?$,1Pd(B) + (?$(3$L(B . ?$,1Pe(B) + (?$(3$M(B . ?$,1Pf(B) + (?$(3$O(B . ?$,1Ph(B) + (?$(3$P(B . ?$,1Pi(B) + (?$(3$Q(B . ?$,1Pj(B) + (?$(3$R(B . ?$,1Pk(B) + (?$(3$S(B . ?$,1Pl(B) + (?$(3$T(B . ?$,1Pm(B) + (?$(3$U(B . ?$,1Pn(B) + (?$(3$V(B . ?$,1Po(B) + (?$(3$W(B . ?$,1Pp(B) + (?$(3$X(B . ?$,1Pq(B) + (?$(3$Y(B . ?$,1Pr(B) + (?$(3$Z(B . ?$,1Ps(B) + (?$(3$[(B . ?$,1Pt(B) + (?$(3$\(B . ?$,1Pu(B) + (?$(3$](B . ?$,1Pv(B) + (?$(3$^(B . ?$,1Pw(B) + (?$(3$_(B . ?$,1Px(B) + (?$(3$`(B . ?$,1Py(B) + (?$(3$a(B . ?$,1Pz(B) + (?$(3$h(B . ?$,1Q!(B) + (?$(3$i(B . ?$,1Q"(B) + (?$(3$j(B . ?$,1Q#(B) + (?$(3$k(B . ?$,1Q$(B) + (?$(3$l(B . ?$,1Q%(B) + (?$(3$m(B . ?$,1Q&(B) + (?$(3$n(B . ?$,1Q'(B) + (?$(3$o(B . ?$,1Q((B) + (?$(3$p(B . ?$,1Q)(B) + (?$(3$q(B . ?$,1Q*(B) + (?$(3$r(B . ?$,1Q+(B) + (?$(3$s(B . ?$,1Q,(B) + (?$(3$t(B . ?$,1Q-(B) + (?$(3$u(B . ?$,1Q.(B) + (?$(3$v(B . ?$,1Q/(B) + (?$(3$w(B . ?$,1Q0(B) + (?$(3$x(B . ?$,1Q1(B) + (?$(3$y(B . ?$,1Q2(B) + (?$(3$z(B . ?$,1Q3(B) + (?$(3${(B . ?$,1Q4(B) + (?$(3$|(B . ?$,1Q5(B) + (?$(3$}(B . ?$,1Q6(B) + (?$(3$~(B . ?$,1Q7(B) + (?$(3%!(B . ?$,1Q8(B) + (?$(3%"(B . ?$,1Q9(B) + (?$(3%#(B . ?$,1Q:(B) + (?$(3%$(B . ?$,1Q;(B) + (?$(3%%(B . ?$,1Q<(B))) + + (indian-is13194 + '((?(5!(B . ?$,15A(B) + (?(5"(B . ?$,15B(B) + (?(5#(B . ?$,15C(B) + (?(5$(B . ?$,15E(B) + (?(5%(B . ?$,15F(B) + (?(5&(B . ?$,15G(B) + (?(5'(B . ?$,15H(B) + (?(5((B . ?$,15I(B) + (?(5)(B . ?$,15J(B) + (?(5*(B . ?$,15K(B) + (?(5+(B . ?$,15N(B) + (?(5,(B . ?$,15O(B) + (?(5-(B . ?$,15P(B) + (?(5.(B . ?$,15M(B) + (?(5/(B . ?$,15R(B) + (?(50(B . ?$,15S(B) + (?(51(B . ?$,15T(B) + (?(52(B . ?$,15M(B) + (?(53(B . ?$,15U(B) + (?(54(B . ?$,15V(B) + (?(55(B . ?$,15W(B) + (?(56(B . ?$,15X(B) + (?(57(B . ?$,15Y(B) + (?(58(B . ?$,15Z(B) + (?(59(B . ?$,15[(B) + (?(5:(B . ?$,15\(B) + (?(5;(B . ?$,15](B) + (?(5<(B . ?$,15^(B) + (?(5=(B . ?$,15_(B) + (?(5>(B . ?$,15`(B) + (?(5?(B . ?$,15a(B) + (?(5@(B . ?$,15b(B) + (?(5A(B . ?$,15c(B) + (?(5B(B . ?$,15d(B) + (?(5C(B . ?$,15e(B) + (?(5D(B . ?$,15f(B) + (?(5E(B . ?$,15g(B) + (?(5F(B . ?$,15h(B) + (?(5G(B . ?$,15i(B) + (?(5H(B . ?$,15j(B) + (?(5I(B . ?$,15k(B) + (?(5J(B . ?$,15l(B) + (?(5K(B . ?$,15m(B) + (?(5L(B . ?$,15n(B) + (?(5M(B . ?$,15o(B) + (?(5N(B . ?$,16?(B) + (?(5O(B . ?$,15p(B) + (?(5P(B . ?$,15q(B) + (?(5Q(B . ?$,15r(B) + (?(5R(B . ?$,15s(B) + (?(5S(B . ?$,15t(B) + (?(5T(B . ?$,15u(B) + (?(5U(B . ?$,15v(B) + (?(5V(B . ?$,15w(B) + (?(5W(B . ?$,15x(B) + (?(5X(B . ?$,15y(B) + (?(5Z(B . ?$,15~(B) + (?(5[(B . ?$,15(B) + (?(5\(B . ?$,16 (B) + (?(5](B . ?$,16!(B) + (?(5^(B . ?$,16"(B) + (?(5_(B . ?$,16#(B) + (?(5`(B . ?$,16&(B) + (?(5a(B . ?$,16'(B) + (?(5b(B . ?$,16((B) + (?(5c(B . ?$,16%(B) + (?(5d(B . ?$,16*(B) + (?(5e(B . ?$,16+(B) + (?(5f(B . ?$,16,(B) + (?(5g(B . ?$,16)(B) + (?(5h(B . ?$,16-(B) + (?(5i(B . ?$,15|(B) + (?(5j(B . ?$,16D(B) + (?(5q(B . ?$,16F(B) + (?(5r(B . ?$,16G(B) + (?(5s(B . ?$,16H(B) + (?(5t(B . ?$,16I(B) + (?(5u(B . ?$,16J(B) + (?(5v(B . ?$,16K(B) + (?(5w(B . ?$,16L(B) + (?(5x(B . ?$,16M(B) + (?(5y(B . ?$,16N(B) + (?(5z(B . ?$,16O(B))) + + (katakana-jisx0201 + '((?(I!(B . ?$,3sa(B) + (?\(I"(B . ?\$,3sb(B) + (?\(I#(B . ?\$,3sc(B) + (?(I$(B . ?$,3sd(B) + (?(I%(B . ?$,3se(B) + (?(I&(B . ?$,3sf(B) + (?(I'(B . ?$,3sg(B) + (?(I((B . ?$,3sh(B) + (?(I)(B . ?$,3si(B) + (?(I*(B . ?$,3sj(B) + (?(I+(B . ?$,3sk(B) + (?(I,(B . ?$,3sl(B) + (?(I-(B . ?$,3sm(B) + (?(I.(B . ?$,3sn(B) + (?(I/(B . ?$,3so(B) + (?(I0(B . ?$,3sp(B) + (?(I1(B . ?$,3sq(B) + (?(I2(B . ?$,3sr(B) + (?(I3(B . ?$,3ss(B) + (?(I4(B . ?$,3st(B) + (?(I5(B . ?$,3su(B) + (?(I6(B . ?$,3sv(B) + (?(I7(B . ?$,3sw(B) + (?(I8(B . ?$,3sx(B) + (?(I9(B . ?$,3sy(B) + (?(I:(B . ?$,3sz(B) + (?(I;(B . ?$,3s{(B) + (?(I<(B . ?$,3s|(B) + (?(I=(B . ?$,3s}(B) + (?(I>(B . ?$,3s~(B) + (?(I?(B . ?$,3s(B) + (?(I@(B . ?$,3t (B) + (?(IA(B . ?$,3t!(B) + (?(IB(B . ?$,3t"(B) + (?(IC(B . ?$,3t#(B) + (?(ID(B . ?$,3t$(B) + (?(IE(B . ?$,3t%(B) + (?(IF(B . ?$,3t&(B) + (?(IG(B . ?$,3t'(B) + (?(IH(B . ?$,3t((B) + (?(II(B . ?$,3t)(B) + (?(IJ(B . ?$,3t*(B) + (?(IK(B . ?$,3t+(B) + (?(IL(B . ?$,3t,(B) + (?(IM(B . ?$,3t-(B) + (?(IN(B . ?$,3t.(B) + (?(IO(B . ?$,3t/(B) + (?(IP(B . ?$,3t0(B) + (?(IQ(B . ?$,3t1(B) + (?(IR(B . ?$,3t2(B) + (?(IS(B . ?$,3t3(B) + (?(IT(B . ?$,3t4(B) + (?(IU(B . ?$,3t5(B) + (?(IV(B . ?$,3t6(B) + (?(IW(B . ?$,3t7(B) + (?(IX(B . ?$,3t8(B) + (?(IY(B . ?$,3t9(B) + (?(IZ(B . ?$,3t:(B) + (?(I[(B . ?$,3t;(B) + (?(I\(B . ?$,3t<(B) + (?(I](B . ?$,3t=(B) + (?(I^(B . ?$,3t>(B) + (?(I_(B . ?$,3t?(B))) + + (chinese-sisheng + '((?(0!(B . ?$,1 !(B) + (?(0"(B . ?,Aa(B) + (?(0#(B . ?$,1".(B) + (?(0$(B . ?,A`(B) + (?(0%(B . ?$,1 3(B) + (?(0&(B . ?,Ai(B) + (?(0'(B . ?$,1 ;(B) + (?(0((B . ?,Ah(B) + (?(0)(B . ?$,1 K(B) + (?(0*(B . ?,Am(B) + (?(0+(B . ?$,1"0(B) + (?(0,(B . ?,Al(B) + (?(0-(B . ?$,1 m(B) + (?(0.(B . ?,As(B) + (?(0/(B . ?$,1"2(B) + (?(00(B . ?,Ar(B) + (?(01(B . ?$,1!+(B) + (?(02(B . ?,Az(B) + (?(03(B . ?$,1"4(B) + (?(04(B . ?,Ay(B) + (?(05(B . ?$,1"6(B) + (?(06(B . ?$,1"8(B) + (?(07(B . ?$,1":(B) + (?(08(B . ?$,1"<(B) + (?(09(B . ?,A|(B) + (?(0:(B . ?,Aj(B) + (?(0<(B . ?$,1m(B) + (?(0=(B . ?$,1 d(B) + (?(0>(B . ?$,1 h(B) + (?(0?(B . ?$,1"Y(B) + (?(0A(B . ?$,1$i(B) + (?(0B(B . ?$,1$j(B) + (?(0C(B . ?$,1$g(B) + (?(0D(B . ?$,1$k(B) + (?(0E(B . ?$,2@%(B) + (?(0F(B . ?$,2@&(B) + (?(0G(B . ?$,2@'(B) + (?(0H(B . ?$,2@((B) + (?(0I(B . ?$,2@)(B) + (?(0J(B . ?$,2@*(B) + (?(0K(B . ?$,2@+(B) + (?(0L(B . ?$,2@,(B) + (?(0M(B . ?$,2@-(B) + (?(0N(B . ?$,2@.(B) + (?(0O(B . ?$,2@/(B) + (?(0P(B . ?$,2@0(B) + (?(0Q(B . ?$,2@1(B) + (?(0R(B . ?$,2@2(B) + (?(0S(B . ?$,2@3(B) + (?(0T(B . ?$,2@4(B) + (?(0U(B . ?$,2@5(B) + (?(0V(B . ?$,2@6(B) + (?(0W(B . ?$,2@7(B) + (?(0X(B . ?$,2@8(B) + (?(0Y(B . ?$,2@9(B) + (?(0Z(B . ?$,2@:(B) + (?(0[(B . ?$,2@;(B) + (?(0\(B . ?$,2@<(B) + (?(0](B . ?$,2@=(B) + (?(0^(B . ?$,2@>(B) + (?(0_(B . ?$,2@?(B) + (?(0`(B . ?$,2@@(B) + (?(0a(B . ?$,2@A(B) + (?(0b(B . ?$,2@B(B) + (?(0c(B . ?$,2@C(B) + (?(0d(B . ?$,2@D(B) + (?(0e(B . ?$,2@E(B) + (?(0f(B . ?$,2@F(B) + (?(0g(B . ?$,2@G(B) + (?(0h(B . ?$,2@H(B) + (?(0i(B . ?$,2@I(B))) + + (lao + '((?(1!(B . ?$,1D!(B) + (?(1"(B . ?$,1D"(B) + (?(1$(B . ?$,1D$(B) + (?(1'(B . ?$,1D'(B) + (?(1((B . ?$,1D((B) + (?(1*(B . ?$,1D*(B) + (?(1-(B . ?$,1D-(B) + (?(14(B . ?$,1D4(B) + (?(15(B . ?$,1D5(B) + (?(16(B . ?$,1D6(B) + (?(17(B . ?$,1D7(B) + (?(19(B . ?$,1D9(B) + (?(1:(B . ?$,1D:(B) + (?(1;(B . ?$,1D;(B) + (?(1<(B . ?$,1D<(B) + (?(1=(B . ?$,1D=(B) + (?(1>(B . ?$,1D>(B) + (?(1?(B . ?$,1D?(B) + (?(1A(B . ?$,1DA(B) + (?(1B(B . ?$,1DB(B) + (?(1C(B . ?$,1DC(B) + (?(1E(B . ?$,1DE(B) + (?(1G(B . ?$,1DG(B) + (?(1J(B . ?$,1DJ(B) + (?(1K(B . ?$,1DK(B) + (?(1M(B . ?$,1DM(B) + (?(1N(B . ?$,1DN(B) + (?(1O(B . ?$,1DO(B) + (?(1P(B . ?$,1DP(B) + (?(1Q(B . ?$,1DQ(B) + (?(1R(B . ?$,1DR(B) + (?(1S(B . ?$,1DS(B) + (?(1T(B . ?$,1DT(B) + (?(1U(B . ?$,1DU(B) + (?(1V(B . ?$,1DV(B) + (?(1W(B . ?$,1DW(B) + (?(1X(B . ?$,1DX(B) + (?(1Y(B . ?$,1DY(B) + (?(1[(B . ?$,1D[(B) + (?(1\(B . ?$,1D\(B) + (?(1](B . ?$,1D](B) + (?(1`(B . ?$,1D`(B) + (?(1a(B . ?$,1Da(B) + (?(1b(B . ?$,1Db(B) + (?(1c(B . ?$,1Dc(B) + (?(1d(B . ?$,1Dd(B) + (?(1f(B . ?$,1Df(B) + (?(1h(B . ?$,1Dh(B) + (?(1i(B . ?$,1Di(B) + (?(1j(B . ?$,1Dj(B) + (?(1k(B . ?$,1Dk(B) + (?(1l(B . ?$,1Dl(B) + (?(1m(B . ?$,1Dm(B) + (?(1p(B . ?$,1Dp(B) + (?(1q(B . ?$,1Dq(B) + (?(1r(B . ?$,1Dr(B) + (?(1s(B . ?$,1Ds(B) + (?(1t(B . ?$,1Dt(B) + (?(1u(B . ?$,1Du(B) + (?(1v(B . ?$,1Dv(B) + (?(1w(B . ?$,1Dw(B) + (?(1x(B . ?$,1Dx(B) + (?(1y(B . ?$,1Dy(B) + (?(1|(B . ?$,1D|(B) + (?(1}(B . ?$,1D}(B)))) + (let ((table (make-char-table 'safe-chars)) + safe-charsets) + (dolist (cs '(vietnamese-viscii lao chinese-sisheng ipa + katakana-jisx0201 thai-tis620 tibetan-iso-8bit + indian-is13194 ethiopic)) + ;; These tables could be used as translation-table-for-encode by + ;; the relevant coding systems. + (let ((encode-translator + (if (coding-system-p cs) + (set (intern (format "ucs-%s-encode-table" cs)) + (make-translation-table))))) + (dolist (pair (symbol-value cs)) + (aset ucs-mule-to-mule-unicode (car pair) (cdr pair)) + (if encode-translator + (aset encode-translator (cdr pair) (car pair)))) + (if (charsetp cs) + (push cs safe-charsets) + (setq safe-charsets + (append (delq 'ascii (coding-system-get cs 'safe-charsets)) + safe-charsets))))) + (dolist (c safe-charsets) + (aset table (make-char c) t)) + (coding-system-put 'mule-utf-8 'safe-charsets + (append (coding-system-get 'mule-utf-8 'safe-charsets) + safe-charsets)) + (register-char-codings 'mule-utf-8 table))) + +(provide 'ucs-tables) + +;;; ucs-tables.el ends here diff --git a/contrib/vcard.el b/contrib/vcard.el index 000da5e..22f032c 100644 --- a/contrib/vcard.el +++ b/contrib/vcard.el @@ -305,4 +305,4 @@ presentation buffer." (provide 'vcard) -;;; vcard.el ends here. +;;; vcard.el ends here diff --git a/contrib/xml.el b/contrib/xml.el new file mode 100644 index 0000000..a495721 --- /dev/null +++ b/contrib/xml.el @@ -0,0 +1,501 @@ +;;; xml.el --- XML parser + +;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. + +;; Author: Emmanuel Briot +;; Maintainer: Emmanuel Briot +;; Keywords: xml + +;; 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 file contains a full XML parser. It parses a file, and returns a list +;; that can be used internally by any other lisp file. +;; See some example in todo.el + +;;; FILE FORMAT + +;; It does not parse the DTD, if present in the XML file, but knows how to +;; ignore it. The XML file is assumed to be well-formed. In case of error, the +;; parsing stops and the XML file is shown where the parsing stopped. +;; +;; It also knows how to ignore comments, as well as the special ?xml? tag +;; in the XML file. +;; +;; The XML file should have the following format: +;; value +;; value2 +;; value3 +;; +;; Of course, the name of the nodes and attributes can be anything. There can +;; be any number of attributes (or none), as well as any number of children +;; below the nodes. +;; +;; There can be only top level node, but with any number of children below. + +;;; LIST FORMAT + +;; The functions `xml-parse-file' and `xml-parse-tag' return a list with +;; the following format: +;; +;; xml-list ::= (node node ...) +;; node ::= (tag_name attribute-list . child_node_list) +;; child_node_list ::= child_node child_node ... +;; child_node ::= node | string +;; tag_name ::= string +;; attribute_list ::= (("attribute" . "value") ("attribute" . "value") ...) +;; | nil +;; string ::= "..." +;; +;; Some macros are provided to ease the parsing of this list + +;;; Code: + +;;******************************************************************* +;;** +;;** Macros to parse the list +;;** +;;******************************************************************* + +(defsubst xml-node-name (node) + "Return the tag associated with NODE. +The tag is a lower-case symbol." + (car node)) + +(defsubst xml-node-attributes (node) + "Return the list of attributes of NODE. +The list can be nil." + (nth 1 node)) + +(defsubst xml-node-children (node) + "Return the list of children of NODE. +This is a list of nodes, and it can be nil." + (cddr node)) + +(defun xml-get-children (node child-name) + "Return the children of NODE whose tag is CHILD-NAME. +CHILD-NAME should be a lower case symbol." + (let ((match ())) + (dolist (child (xml-node-children node)) + (if child + (if (equal (xml-node-name child) child-name) + (push child match)))) + (nreverse match))) + +(defun xml-get-attribute (node attribute) + "Get from NODE the value of ATTRIBUTE. +An empty string is returned if the attribute was not found." + (if (xml-node-attributes node) + (let ((value (assoc attribute (xml-node-attributes node)))) + (if value + (cdr value) + "")) + "")) + +;;******************************************************************* +;;** +;;** Creating the list +;;** +;;******************************************************************* + +(defun xml-parse-file (file &optional parse-dtd) + "Parse the well-formed XML FILE. +If FILE is already edited, this will keep the buffer alive. +Returns the top node with all its children. +If PARSE-DTD is non-nil, the DTD is parsed rather than skipped." + (let ((keep)) + (if (get-file-buffer file) + (progn + (set-buffer (get-file-buffer file)) + (setq keep (point))) + (find-file file)) + + (let ((xml (xml-parse-region (point-min) + (point-max) + (current-buffer) + parse-dtd))) + (if keep + (goto-char keep) + (kill-buffer (current-buffer))) + xml))) + +(defun xml-parse-region (beg end &optional buffer parse-dtd) + "Parse the region from BEG to END in BUFFER. +If BUFFER is nil, it defaults to the current buffer. +Returns the XML list for the region, or raises an error if the region +is not a well-formed XML file. +If PARSE-DTD is non-nil, the DTD is parsed rather than skipped, +and returned as the first element of the list" + (let (xml result dtd) + (save-excursion + (if buffer + (set-buffer buffer)) + (goto-char beg) + (while (< (point) end) + (if (search-forward "<" end t) + (progn + (forward-char -1) + (if (null xml) + (progn + (setq result (xml-parse-tag end parse-dtd)) + (cond + ((null result)) + ((listp (car result)) + (setq dtd (car result)) + (add-to-list 'xml (cdr result))) + (t + (add-to-list 'xml result)))) + + ;; translation of rule [1] of XML specifications + (error "XML files can have only one toplevel tag"))) + (goto-char end))) + (if parse-dtd + (cons dtd (reverse xml)) + (reverse xml))))) + + +(defun xml-parse-tag (end &optional parse-dtd) + "Parse the tag that is just in front of point. +The end tag must be found before the position END in the current buffer. +If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and +returned as the first element in the list. +Returns one of: + - a list : the matching node + - nil : the point is not looking at a tag. + - a cons cell: the first element is the DTD, the second is the node" + (cond + ;; Processing instructions (like the tag at the + ;; beginning of a document) + ((looking-at "<\\?") + (search-forward "?>" end) + (skip-chars-forward " \t\n") + (xml-parse-tag end)) + ;; Character data (CDATA) sections, in which no tag should be interpreted + ((looking-at "" end t) + (error "CDATA section does not end anywhere in the document")) + (buffer-substring-no-properties pos (match-beginning 0)))) + ;; DTD for the document + ((looking-at "" end) + nil) + ;; end tag + ((looking-at " \t\n]+\\)") + (goto-char (match-end 1)) + (let* ((case-fold-search nil) ;; XML is case-sensitive. + (node-name (match-string 1)) + ;; Parse the attribute list. + (children (list (xml-parse-attlist end) (intern node-name))) + pos) + + ;; is this an empty element ? + (if (looking-at "/>") + (progn + (forward-char 2) + (nreverse (cons '("") children))) + + ;; is this a valid start tag ? + (if (eq (char-after) ?>) + (progn + (forward-char 1) + ;; Now check that we have the right end-tag. Note that this + ;; one might contain spaces after the tag name + (while (not (looking-at (concat ""))) + (cond + ((looking-at " (point) end) + (error "XML: End tag for %s not found before end of region" + node-name)) + (nreverse children)) + + ;; This was an invalid start tag + (error "XML: Invalid attribute list") + )))) + (t ;; This is not a tag. + (error "XML: Invalid character")) + )) + +(defun xml-parse-attlist (end) + "Return the attribute-list that point is looking at. +The search for attributes end at the position END in the current buffer. +Leaves the point on the first non-blank character after the tag." + (let ((attlist ()) + name) + (skip-chars-forward " \t\n") + (while (looking-at "\\([a-zA-Z_:][-a-zA-Z0-9._:]*\\)[ \t\n]*=[ \t\n]*") + (setq name (intern (match-string 1))) + (goto-char (match-end 0)) + + ;; Do we have a string between quotes (or double-quotes), + ;; or a simple word ? + (unless (looking-at "\"\\([^\"]*\\)\"") + (unless (looking-at "'\\([^']*\\)'") + (error "XML: Attribute values must be given between quotes"))) + + ;; Each attribute must be unique within a given element + (if (assoc name attlist) + (error "XML: each attribute must be unique within an element")) + + (push (cons name (match-string-no-properties 1)) attlist) + (goto-char (match-end 0)) + (skip-chars-forward " \t\n") + (if (> (point) end) + (error "XML: end of attribute list not found before end of region")) + ) + (nreverse attlist))) + +;;******************************************************************* +;;** +;;** The DTD (document type declaration) +;;** The following functions know how to skip or parse the DTD of +;;** a document +;;** +;;******************************************************************* + +(defun xml-skip-dtd (end) + "Skip the DTD that point is looking at. +The DTD must end before the position END in the current buffer. +The point must be just before the starting tag of the DTD. +This follows the rule [28] in the XML specifications." + (forward-char (length "") + (error "XML: invalid DTD (excepting name of the document)")) + (condition-case nil + (progn + (forward-word 1) ;; name of the document + (skip-chars-forward " \t\n") + (if (looking-at "\\[") + (re-search-forward "\\][ \t\n]*>" end) + (search-forward ">" end))) + (error (error "XML: No end to the DTD")))) + +(defun xml-parse-dtd (end) + "Parse the DTD that point is looking at. +The DTD must end before the position END in the current buffer." + (forward-char (length "") + (error "XML: invalid DTD (excepting name of the document)")) + + ;; Get the name of the document + (looking-at "\\sw+") + (let ((dtd (list (match-string-no-properties 0) 'dtd)) + type element end-pos) + (goto-char (match-end 0)) + + (skip-chars-forward " \t\n") + + ;; External DTDs => don't know how to handle them yet + (if (looking-at "SYSTEM") + (error "XML: Don't know how to handle external DTDs")) + + (if (not (= (char-after) ?\[)) + (error "XML: Unknown declaration in the DTD")) + + ;; Parse the rest of the DTD + (forward-char 1) + (while (and (not (looking-at "[ \t\n]*\\]")) + (<= (point) end)) + (cond + + ;; Translation of rule [45] of XML specifications + ((looking-at + "[\t \n]*]+\\)>") + + (setq element (intern (match-string-no-properties 1)) + type (match-string-no-properties 2)) + (setq end-pos (match-end 0)) + + ;; Translation of rule [46] of XML specifications + (cond + ((string-match "^EMPTY[ \t\n]*$" type) ;; empty declaration + (setq type 'empty)) + ((string-match "^ANY[ \t\n]*$" type) ;; any type of contents + (setq type 'any)) + ((string-match "^(\\(.*\\))[ \t\n]*$" type) ;; children ([47]) + (setq type (xml-parse-elem-type (match-string-no-properties 1 type)))) + ((string-match "^%[^;]+;[ \t\n]*$" type) ;; substitution + nil) + (t + (error "XML: Invalid element type in the DTD"))) + + ;; rule [45]: the element declaration must be unique + (if (assoc element dtd) + (error "XML: elements declaration must be unique in a DTD (<%s>)" + (symbol-name element))) + + ;; Store the element in the DTD + (push (list element type) dtd) + (goto-char end-pos)) + + + (t + (error "XML: Invalid DTD item")) + ) + ) + + ;; Skip the end of the DTD + (search-forward ">" end) + (nreverse dtd))) + + +(defun xml-parse-elem-type (string) + "Convert a STRING for an element type into an elisp structure." + + (let (elem modifier) + (if (string-match "(\\([^)]+\\))\\([+*?]?\\)" string) + (progn + (setq elem (match-string 1 string) + modifier (match-string 2 string)) + (if (string-match "|" elem) + (setq elem (cons 'choice + (mapcar 'xml-parse-elem-type + (split-string elem "|")))) + (if (string-match "," elem) + (setq elem (cons 'seq + (mapcar 'xml-parse-elem-type + (split-string elem ",")))) + ))) + (if (string-match "[ \t\n]*\\([^+*?]+\\)\\([+*?]?\\)" string) + (setq elem (match-string 1 string) + modifier (match-string 2 string)))) + + (if (and (stringp elem) (string= elem "#PCDATA")) + (setq elem 'pcdata)) + + (cond + ((string= modifier "+") + (list '+ elem)) + ((string= modifier "*") + (list '* elem)) + ((string= modifier "?") + (list '? elem)) + (t + elem)))) + + +;;******************************************************************* +;;** +;;** Substituting special XML sequences +;;** +;;******************************************************************* + +(defun xml-substitute-special (string) + "Return STRING, after subsituting special XML sequences." + (while (string-match "&" string) + (setq string (replace-match "&" t nil string))) + (while (string-match "<" string) + (setq string (replace-match "<" t nil string))) + (while (string-match ">" string) + (setq string (replace-match ">" t nil string))) + (while (string-match "'" string) + (setq string (replace-match "'" t nil string))) + (while (string-match """ string) + (setq string (replace-match "\"" t nil string))) + string) + +;;******************************************************************* +;;** +;;** Printing a tree. +;;** This function is intended mainly for debugging purposes. +;;** +;;******************************************************************* + +(defun xml-debug-print (xml) + (dolist (node xml) + (xml-debug-print-internal node ""))) + +(defun xml-debug-print-internal (xml indent-string) + "Outputs the XML tree in the current buffer. +The first line indented with INDENT-STRING." + (let ((tree xml) + attlist) + (insert indent-string "<" (symbol-name (xml-node-name tree))) + + ;; output the attribute list + (setq attlist (xml-node-attributes tree)) + (while attlist + (insert " ") + (insert (symbol-name (caar attlist)) "=\"" (cdar attlist) "\"") + (setq attlist (cdr attlist))) + + (insert ">") + + (setq tree (xml-node-children tree)) + + ;; output the children + (dolist (node tree) + (cond + ((listp node) + (insert "\n") + (xml-debug-print-internal node (concat indent-string " "))) + ((stringp node) (insert node)) + (t + (error "Invalid XML tree")))) + + (insert "\n" indent-string + ""))) + +(provide 'xml) + +;;; xml.el ends here diff --git a/etc/Makefile.in b/etc/Makefile.in new file mode 100644 index 0000000..8ef7da1 --- /dev/null +++ b/etc/Makefile.in @@ -0,0 +1,60 @@ +datadir = @datadir@ +infodir = @infodir@ +prefix = @prefix@ +srcdir = @srcdir@ +subdir = etc +top_srcdir = @top_srcdir@ +lispdir = @lispdir@ +etcdir = @etcdir@ + +VPATH=$(srcdir) +EMACS=@EMACS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +SHELL = /bin/sh + +all: + +install: + $(SHELL) $(top_srcdir)/mkinstalldirs $(etcdir) + cd $(srcdir) \ + && for p in gnus-tut.txt; do \ + echo " $(INSTALL_DATA) $$p $(etcdir)/$$p"; \ + $(INSTALL_DATA) $$p $(etcdir)/$$p; \ + done + $(SHELL) $(top_srcdir)/mkinstalldirs $(etcdir)/gnus + cd $(srcdir) \ + && for p in gnus/*.xpm gnus/*.pbm gnus/*.xbm gnus/x-splash; do \ + echo " $(INSTALL_DATA) $$p $(etcdir)/$$p"; \ + $(INSTALL_DATA) $$p $(etcdir)/$$p; \ + done + $(SHELL) $(top_srcdir)/mkinstalldirs $(etcdir)/smilies + cd $(srcdir) \ + && for p in smilies/*.pbm smilies/*.xpm; do \ + echo " $(INSTALL_DATA) $$p $(etcdir)/$$p"; \ + $(INSTALL_DATA) $$p $(etcdir)/$$p; \ + done + +uninstall: + rm -f $(etcdir)/gnus-tut.txt + cd $(srcdir) \ + && for p in gnus/*.xpm gnus/*.pbm gnus/*.xbm gnus/x-splash; do \ + rm -f "$(etcdir)/$$p"; \ + done + rmdir $(etcdir)/gnus 2> /dev/null || true + cd $(srcdir) \ + && for p in smilies/*.pbm smilies/*.xpm; do \ + rm -f "$(etcdir)/$$p"; \ + done + rmdir $(etcdir)/smilies 2> /dev/null || true + +Makefile: $(srcdir)/Makefile.in ../config.status + cd .. \ + && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status + +distclean: + rm -f *~ Makefile + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt index 50f90f8..9149610 100644 --- a/etc/gnus-tut.txt +++ b/etc/gnus-tut.txt @@ -1,5 +1,5 @@ From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: So you want to use the new Gnus Message-ID: @@ -22,7 +22,8 @@ people started. Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite was done by moi, yours truly, your humble servant, Lars Magne Ingebrigtsen. If you have a WWW browser, you can investigate to your -heart's delight at . +heart's delight at and +. ;; Copyright (C) 1995 Free Software Foundation, Inc. @@ -47,7 +48,7 @@ heart's delight at . ;; Boston, MA 02111-1307, USA. From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Starting up Message-ID: @@ -76,7 +77,7 @@ the "Foreign groups" article for that. From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Where are all the groups, then? Message-ID: @@ -109,7 +110,7 @@ prompted for groups to subscribe to.) From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: I want to read my mail! Message-ID: @@ -147,7 +148,7 @@ these variables and re-start Gnus. From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Foreign newsgroups Message-ID: @@ -170,7 +171,7 @@ the info pages to find out more. From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Low level changes in GNUS, or, Wrong type argument: stringp, nil Message-ID: @@ -194,11 +195,11 @@ which are both faster and more accurated. There is absolutely no chance, whatsoever, of getting Gnus to work with Emacs 18. It won't even work on Emacsen older than Emacs -19.30/XEmacs 19.13. Upgrade your Emacs or die. +20.7/XEmacs 21.1. Upgrade your Emacs or die. From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: How do I re-scan my mail groups? Message-ID: @@ -212,7 +213,7 @@ You can also re-scan all the mail groups by putting them on level 1 From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: How do I set up virtual newsgroups? Message-ID: @@ -222,7 +223,7 @@ want this is beyond me, but here goes: Create the group by saying -`M-a my.virtual.newsgroupnnvirtual^rec\.aquaria\.*' +`G V my.virtual.newsgroupnnvirtual^rec\.aquaria\.*' This will create the group "nnvirtual:my.virtual.newsgroup", which will collect all articles from all the groups in the "rec.aquaria" @@ -266,7 +267,7 @@ the lines of: From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) +From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 Subject: Bugs & stuff Message-ID: @@ -286,9 +287,1603 @@ report. If I am not able to reproduce the bug, I won't be able to fix it. I would, of course, prefer that you locate the bug, fix it, and mail -me the patches, but one can't have everything. +me the patches, but one can't have everything. -If you have any questions on usage, the "ding@gnus.org" mailing list +If you have any questions on usage, the "ding@ifi.uio.no" mailing list is where to post the questions. +From fschmitt Sat Mar 22 18:13:00 2003 +From: faq@my.gnus.org (Gnus FAQ team) +Date: Sat Mar 22 18:13:00 2003 +Subject: Gnus FAQ +Message-ID: + +This is the text version of the Gnus FAQ, see http://my.gnus.org for +the up to date version of this document, there you can also find a +html version and various other formats. There's also a texinfo version +of the FAQ distributed with Gnus. + +Table of Contents + +Introduction +Frequently Asked Questions with Answers +Glossary + +Abstract + +This is the new Gnus Frequently Asked Questions list. If you have a +Web browser, the official hypertext version is at http:// +my.gnus.org/FAQ/ [http://my.gnus.org/FAQ/], the Docbook source is +available from http://sourceforge.net [http://sourceforge.net/ +projects/gnus/]. + +Please submit features and suggestions to the FAQ discussion list +[mailto:faq-discuss@my.gnus.org]. The list is protected against +junk mail with qconfirm [http://smarden.org/qconfirm/index.html]. +As a subscriber, your submissions will automatically pass. You can +also subscribe to the list by sending a blank email to +faq-discuss-subscribe@my.gnus.org +[mailto:faq-discuss-subscribe@my.gnus.org] and browse the archive. + +Introduction + +This is the Gnus Frequently Asked Questions list. + +Gnus is a Usenet Newsreader and Electronic Mail User Agent +implemented as a part of Emacs. It's been around in some form for +almost a decade now, and has been distributed as a standard part of +Emacs for much of that time. Gnus 5 is the latest (and greatest) +incarnation. The original version was called GNUS, and was written +by Masanobu UMEDA. When autumn crept up in '94, Lars Magne +Ingebrigtsen grew bored and decided to rewrite Gnus. + +Its biggest strength is the fact that it is extremely customizable. +It is somewhat intimidating at first glance, but most of the +complexity can be ignored until you're ready to take advantage of +it. If you receive a reasonable volume of e-mail (you're on various +mailing lists), or you would like to read high-volume mailing lists +but cannot keep up with them, or read high volume newsgroups or are +just bored, then Gnus is what you want. + +This FAQ was maintained by Justin Sheehy until March 2002. He would +like to thank Steve Baur and Per Abrahamsen for doing a wonderful +job with this FAQ before him. We would like to do the same - +thanks, Justin! + +If you have a Web browser, the official hypertext version is at: +http://my.gnus.org/FAQ/ [http://my.gnus.org/FAQ/]. This version is +much nicer than the unofficial hypertext versions that are archived +at Utrecht, Oxford, Smart Pages, Ohio State, and other FAQ +archives. See the resources question below if you want information +on obtaining it in another format. + +The information contained here was compiled with the assistance of +the Gnus development mailing list, and any errors or misprints are +the my.gnus.org team's fault, sorry. + +Frequently Asked Questions with Answers + +1. Installation FAQ + + 1.1. What is the latest version of Gnus? + 1.2. What's new in 5.10.0? + 1.3. Where and how to get Gnus? + 1.4. What to do with the tarball now? + 1.5. Which version of Emacs do I need? + 1.6. How do I run Gnus on both Emacs and XEmacs? + +2. Startup / Group buffer + + 2.1. Every time I start Gnus I get a message "Gnus auto-save + file exists. Do you want to read it?", what does this mean + and how to prevent it? + 2.2. Gnus doesn't remember which groups I'm subscribed to, + what's this? + 2.3. How to change the format of the lines in Group buffer? + 2.4. My group buffer becomes a bit crowded, is there a way to + sort my groups into categories so I can easier browse + through them? + 2.5. How to manually sort the groups in Group buffer? How to + sort the groups in a topic? + +3. Getting Messages + + 3.1. I just installed Gnus, started it via M-x gnus but it only + says "nntp (news) open error", what to do? + 3.2. I'm working under Windows and have no idea what ~/.gnus + means. + 3.3. My news server requires authentication, how to store user + name and password on disk? + 3.4. Gnus seems to start up OK, but I can't find out how to + subscribe to a group. + 3.5. Gnus doesn't show all groups / Gnus says I'm not allowed + to post on this server as well as I am, what's that? + 3.6. I want Gnus to fetch news from several servers, is this + possible? + 3.7. And how about local spool files? + 3.8. OK, reading news works now, but I want to be able to read + my mail with Gnus, too. How to do it? + 3.9. And what about IMAP? + 3.10. At the office we use one of those MS Exchange servers, + can I use Gnus to read my mail from it? + 3.11. Can I tell Gnus not to delete the mails on the server it + retrieves via POP3? + +4. Reading messages + + 4.1. When I enter a group, all read messages are gone. How to + view them again? + 4.2. How to tell Gnus to show an important message every time I + enter a group, even when it's read? + 4.3. How to view the headers of a message? + 4.4. How to view the raw unformatted message? + 4.5. How can I change the headers Gnus displays by default at + the top of the article buffer? + 4.6. I'd like Gnus NOT to render HTML-mails but show me the + text part if it's available. How to do it? + 4.7. Can I use some other browser than w3 to render my + HTML-mails? + 4.8. Is there anything I can do to make poorly formatted mails + more readable? + 4.9. Is there a way to automatically ignore posts by specific + authors or with specific words in the subject? And can I + highlight more interesting ones in some way? + 4.10. How can I disable threading in some (e.g. mail-) groups, + or set other variables specific for some groups? + 4.11. Can I highlight messages written by me and follow-ups to + those? + 4.12. The number of total messages in a group which Gnus + displays in group buffer is by far to high, especially in + mail groups. Is this a bug? + 4.13. I don't like the layout of summary and article buffer, + how to change it? Perhaps even a three pane display? + 4.14. I don't like the way the Summary buffer looks, how to + tweak it? + 4.15. How to split incoming mails in several groups? + +5. Composing messages + + 5.1. What are the basic commands I need to know for sending + mail and postings? + 5.2. How to enable automatic word-wrap when composing messages? + 5.3. How to set stuff like From, Organization, Reply-To, + signature...? + 5.4. Can I set things like From, Signature etc group based on + the group I post too? + 5.5. Is there a spell-checker? Perhaps even on-the-fly + spell-checking? + 5.6. Can I set the dictionary based on the group I'm posting + to? + 5.7. Is there some kind of address-book, so I needn't remember + all those email addresses? + 5.8. Sometimes I see little images at the top of article + buffer. What's that and how can I send one with my + postings, too? + 5.9. Sometimes I accidentally hit r instead of f in newsgroups. + Can Gnus warn me, when I'm replying by mail in newsgroups? + 5.10. How to tell Gnus not to generate a sender header? + 5.11. I want gnus to locally store copies of my send mail and + news, how to do it? + 5.12. People tell me my Message-IDs are not correct, why aren't + they and how to fix it? + +6. Old messages + + 6.1. How to import my old mail into Gnus? + 6.2. How to archive interesting messages? + 6.3. How to search for a specific message? + 6.4. How to get rid of old unwanted mail? + 6.5. I want that all read messages are expired (at least in + some groups). How to do it? + 6.6. I don't want expiration to delete my mails but to move + them to another group. + +7. Gnus in a dial-up environment + + 7.1. I don't have a permanent connection to the net, how can I + minimize the time I've got to be connected? + 7.2. So what was this thing about the Agent? + 7.3. I want to store article bodies on disk, too. How to do it? + 7.4. How to tell Gnus not to try to send mails / postings while + I'm offline? + +8. Getting help + + 8.1. How to find information and help inside Emacs? + 8.2. I can't find anything in the Gnus manual about X (e.g. + attachments, PGP, MIME...), is it not documented? + 8.3. Which websites should I know? + 8.4. Which mailing lists and newsgroups are there? + 8.5. Where to report bugs? + 8.6. I need real-time help, where to find it? + +9. Tuning Gnus + + 9.1. Starting Gnus is really slow, how to speed it up? + 9.2. How to speed up the process of entering a group? + 9.3. Sending mail becomes slower and slower, what's up? + +1. Installation FAQ + +1.1. What is the latest version of Gnus? + + Jingle please: Gnus 5.10.0 is released, get it while it's hot! As + well as the step in version number is rather small, Gnus 5.10 has + tons of new features which you shouldn't miss, however if you are + cautious, you might prefer to stay with 5.8.8 respectively 5.9 + (they are basically the same) until some bugfix releases are out. + +1.2. What's new in 5.10.0? + + First of all, you should have a look into the file GNUS-NEWS in the + toplevel directory of the Gnus tarball, there the most important + changes are listed. Here's a short list of the changes I find + especially important/interesting: + + * Major rewrite of the Gnus agent, Gnus agent is now active by + default. + + Many new article washing functions for dealing with ugly + formatted articles. + + Anti Spam features. + + message-utils now included in Gnus. + + New format specifiers for summary lines, e.g. %B for a complex + trn-style thread tree. + +1.3. Where and how to get Gnus? + + The latest released version of Gnus isn't included in Emacs 21 and + until now it also isn't available through the package system of + XEmacs 21.4, therefor you should get the Gnus tarball from http:// + www.gnus.org/dist/gnus.tar.gz [http://www.gnus.org/dist/ + gnus.tar.gz] or via anonymous FTP from ftp://ftp.gnus.org/pub/gnus/ + gnus.tar.gz [ftp://ftp.gnus.org/pub/gnus/gnus.tar.gz]. + +1.4. What to do with the tarball now? + + Untar it via tar xvzf gnus.tar.gz and do the common ./configure; + make; make install circle. (under MS-Windows either get the Cygwin + environment from http://www.cygwin.com [http://www.cygwin.com] + which allows you to do what's described above or unpack the tarball + with some packer (e.g. Winace from http://www.winace.com [http:// + www.winace.com]) and use the batch-file make.bat included in the + tarball to install Gnus. If you don't want to (or aren't allowed + to) install Gnus system-wide, you can install it in your home + directory and add the following lines to your ~/.xemacs/init.el or + ~/.emacs: + + (add-to-list 'load-path "/path/to/gnus/lisp") + (if (featurep 'xemacs) + (add-to-list 'Info-directory-list "/path/to/gnus/texi/") + (add-to-list 'Info-default-directory-list "/path/to/gnus/texi/")) + + + Make sure that you don't have any gnus related stuff before this + line, on MS Windows use something like "C:/path/to/lisp" (yes, "/ + "). + +1.5. Which version of Emacs do I need? + + Gnus 5.10.0 requires an Emacs version that is greater than or equal + to Emacs 20.7 or XEmacs 21.1. + +1.6. How do I run Gnus on both Emacs and XEmacs? + + You can't use the same copy of Gnus in both as the Lisp files are + byte-compiled to a format which is different depending on which + Emacs did the compilation. Get one copy of Gnus for Emacs and one + for XEmacs. + +2. Startup / Group buffer + +2.1. Every time I start Gnus I get a message "Gnus auto-save file + exists. Do you want to read it?", what does this mean and how to + prevent it? + + This message means that the last time you used Gnus, it wasn't + properly exited and therefor couldn't write its informations to + disk (e.g. which messages you read), you are now asked if you want + to restore those informations from the auto-save file. + + To prevent this message make sure you exit Gnus via q in group + buffer instead of just killing Emacs. + +2.2. Gnus doesn't remember which groups I'm subscribed to, what's this? + + You get the message described in the q/a pair above while starting + Gnus, right? It's an other symptom for the same problem, so read + the answer above. + +2.3. How to change the format of the lines in Group buffer? + + You've got to tweak the value of the variable + gnus-group-line-format. See the manual node "Group Line + Specification" for information on how to do this. An example for + this (guess from whose .gnus :-)): + + (setq gnus-group-line-format "%P%M%S[%5t]%5y : %(%g%)\n") + + +2.4. My group buffer becomes a bit crowded, is there a way to sort my + groups into categories so I can easier browse through them? + + Gnus offers the topic mode, it allows you to sort your groups in, + well, topics, e.g. all groups dealing with Linux under the topic + linux, all dealing with music under the topic music and all dealing + with scottish music under the topic scottish which is a subtopic of + music. + + To enter topic mode, just hit t while in Group buffer. Now you can + use T n to create a topic at point and T m to move a group to a + specific topic. For more commands see the manual or the menu. You + might want to include the %P specifier at the beginning of your + gnus-group-line-format variable to have the groups nicely indented. + +2.5. How to manually sort the groups in Group buffer? How to sort the + groups in a topic? + + Move point over the group you want to move and hit C-k, now move + point to the place where you want the group to be and hit C-y. + +3. Getting Messages + +3.1. I just installed Gnus, started it via M-x gnus but it only says + "nntp (news) open error", what to do? + + You've got to tell Gnus where to fetch the news from. Read the + documentation for information on how to do this. As a first start, + put those lines in ~/.gnus: + + (setq gnus-select-method '(nntp "news.yourprovider.net")) + (setq user-mail-address "you@yourprovider.net") + (setq user-full-name "Your Name") + + +3.2. I'm working under Windows and have no idea what ~/.gnus means. + + The ~/ means the home directory where Gnus and Emacs look for the + configuration files. However, you don't really need to know what + this means, it suffices that Emacs knows what it means :-) You can + type C-x C-f ~/.gnus RET (yes, with the forward slash, even on + Windows), and Emacs will open the right file for you. (It will most + likely be new, and thus empty.) However, I'd discourage you from + doing so, since the directory Emacs chooses will most certainly not + be what you want, so let's do it the correct way. The first thing + you've got to do is to create a suitable directory (no blanks in + directory name please) e.g. c:\myhome. Then you must set the + environment variable HOME to this directory. To do this under Win9x + or Me include the line + + SET HOME=C:\myhome + + + in your autoexec.bat and reboot. Under NT, 2000 and XP, hit + Winkey+Pause/Break to enter system options (if it doesn't work, go + to Control Panel -> System). There you'll find the possibility to + set environment variables, create a new one with name HOME and + value C:\myhome, a reboot is not necessary. + + Now to create ~/.gnus, say C-x C-f ~/.gnus RET C-x C-s. in Emacs. + +3.3. My news server requires authentication, how to store user name and + password on disk? + + Create a file ~/.authinfo which includes for each server a line + like this + + machine news.yourprovider.net login YourUserName password YourPassword + + . Make sure that the file isn't readable to others if you work on a + OS which is capable of doing so. (Under Unix say + + chmod 600 ~/.authinfo + + in a shell.) + +3.4. Gnus seems to start up OK, but I can't find out how to subscribe to + a group. + + If you know the name of the group say U name.of.group RET in group + buffer (use the tab-completion Luke). Otherwise hit ^ in group + buffer, this brings you to the server buffer. Now place point (the + cursor) over the server which carries the group you want, hit RET, + move point to the group you want to subscribe to and say u to + subscribe to it. + +3.5. Gnus doesn't show all groups / Gnus says I'm not allowed to post on + this server as well as I am, what's that? + + Some providers allow restricted anonymous access and full access + only after authorization. To make Gnus send authinfo to those + servers append + + force yes + + to the line for those servers in ~/.authinfo. + +3.6. I want Gnus to fetch news from several servers, is this possible? + + Of course. You can specify more sources for articles in the + variable gnus-secondary-select-methods. Add something like this in + ~/.gnus: + + (add-to-list 'gnus-secondary-select-methods '(nntp "news.yourSecondProvider.net")) + (add-to-list 'gnus-secondary-select-methods '(nntp "news.yourThirdProvider.net")) + + +3.7. And how about local spool files? + + No problem, this is just one more select method called nnspool, so + you want this: + + (add-to-list 'gnus-secondary-select-methods '(nnspool "")) + + + Or this if you don't want an NNTP Server as primary news source: + + (setq gnus-select-method '(nnspool "")) + + + Gnus will look for the spool file in /usr/spool/news, if you want + something different, change the line above to something like this: + + (add-to-list 'gnus-secondary-select-methods + '(nnspool "" (nnspool-directory "/usr/local/myspoolddir"))) + + + This sets the spool directory for this server only. You might have + to specify more stuff like the program used to post articles, see + the Gnus manual on how to do this. + +3.8. OK, reading news works now, but I want to be able to read my mail + with Gnus, too. How to do it? + + That's a bit harder since there are many possible sources for mail, + many possible ways for storing mail and many different ways for + sending mail. The most common cases are these: 1: You want to read + your mail from a pop3 server and send them directly to a SMTP + Server 2: Some program like fetchmail retrieves your mail and + stores it on disk from where Gnus shall read it. Outgoing mail is + sent by Sendmail, Postfix or some other MTA. Sometimes, you even + need a combination of the above cases. + + However, the first thing to do is to tell Gnus in which way it + should store the mail, in Gnus terminology which back end to use. + Gnus supports many different back ends, the most commonly used one + is nnml. It stores every mail in one file and is therefor quite + fast. However you might prefer a one file per group approach if + your file system has problems with many small files, the nnfolder + back end is then probably the choice for you. To use nnml add the + following to ~/.gnus: + + (add-to-list 'gnus-secondary-select-methods '(nnml "")) + + + As you might have guessed, if you want nnfolder, it's + + (add-to-list 'gnus-secondary-select-methods '(nnfolder "")) + + + Now we need to tell Gnus, where to get it's mail from. If it's a + POP3 server, then you need something like this: + + (eval-after-load "mail-source" + '(add-to-list 'mail-sources '(pop :server "pop.YourProvider.net" + :user "yourUserName" + :password "yourPassword")) + + + Make sure ~/.gnus isn't readable to others if you store your + password there. If you want to read your mail from a traditional + spool file on your local machine, it's + + (eval-after-load "mail-source" + '(add-to-list 'mail-sources '(file :path "/path/to/spool/file")) + + + If it's a Maildir, with one file per message as used by postfix, + Qmail and (optionally) fetchmail it's + + (eval-after-load "mail-source" + '(add-to-list 'mail-sources '(maildir :path "/path/to/Maildir/" + :subdirs ("cur" "new"))) + + + And finally if you want to read your mail from several files in one + directory, for example because procmail already split your mail, + it's + + (eval-after-load "mail-source" + '(add-to-list 'mail-sources '(directory :path "/path/to/procmail-dir/" + :suffix ".prcml")) + + + Where :suffix ".prcml" tells Gnus only to use files with the suffix + .prcml. + + OK, now you only need to tell Gnus how to send mail. If you want to + send mail via sendmail (or whichever MTA is playing the role of + sendmail on your system), you don't need to do anything. However, + if you want to send your mail to an SMTP Server you need the + following in your ~/.gnus + + (setq send-mail-function 'smtpmail-send-it) + (setq message-send-mail-function 'smtpmail-send-it) + (setq smtpmail-default-smtp-server "smtp.yourProvider.net") + + +3.9. And what about IMAP? + + There are two ways of using IMAP with Gnus. The first one is to use + IMAP like POP3, that means Gnus fetches the mail from the IMAP + server and stores it on disk. If you want to do this (you don't + really want to do this) add the following to ~/.gnus + + (add-to-list 'mail-sources '(imap :server "mail.mycorp.com" + :user "username" + :pass "password" + :stream network + :authentication login + :mailbox "INBOX" + :fetchflag "\\Seen")) + + + You might have to tweak the values for stream and/or + authentification, see the Gnus manual node "Mail Source Specifiers" + for possible values. + + If you want to use IMAP the way it's intended, you've got to follow + a different approach. You've got to add the nnimap back end to your + select method and give the information about the server there. + + (add-to-list 'gnus-secondary-select-methods + '(nnimap "Give the baby a name" + (nnimap-address "imap.yourProvider.net") + (nnimap-port 143) + (nnimap-list-pattern "archive.*"))) + + + Again, you might have to specify how to authenticate to the server + if Gnus can't guess the correct way, see the Manual Node "IMAP" for + detailed information. + +3.10. At the office we use one of those MS Exchange servers, can I use + Gnus to read my mail from it? + + Offer your administrator a pair of new running shoes for activating + IMAP on the server and follow the instructions above. + +3.11. Can I tell Gnus not to delete the mails on the server it retrieves + via POP3? + + First of all, that's not the way POP3 is intended to work, if you + have the possibility, you should use the IMAP Protocol if you want + your messages to stay on the server. Nevertheless there might be + situations where you need the feature, but sadly Gnus itself has no + predefined functionality to do so. + + However this is Gnus county so there are possibilities to achieve + what you want. The easiest way is to get an external program which + retrieves copies of the mail and stores them on disk, so Gnus can + read it from there. On Unix systems you could use e.g. fetchmail + for this, on MS Windows you can use Hamster, an excellent local + news and mail server. + + The other solution would be, to replace the method Gnus uses to get + mail from POP3 servers by one which is capable of leaving the mail + on the server. If you use XEmacs, get the package mail-lib, it + includes an enhanced pop3.el, look in the file, there's + documentation on how to tell Gnus to use it and not to delete the + retrieved mail. For GNU Emacs look for the file epop3.el which can + do the same (If you know the home of this file, please send me an + e-mail). You can also tell Gnus to use an external program (e.g. + fetchmail) to fetch your mail, see the info node "Mail Source + Specifiers" in the Gnus manual on how to do it. + +4. Reading messages + +4.1. When I enter a group, all read messages are gone. How to view them + again? + + If you enter the group by saying RET in summary buffer with point + over the group, only unread and ticked messages are loaded. Say C-u + RET instead to load all available messages. If you want only the + e.g. 300 newest say C-u 300 RET + + Loading only unread messages can be annoying if you have threaded + view enabled, say + + (setq gnus-fetch-old-headers 'some) + + + in ~/.gnus to load enough old articles to prevent teared threads, + replace 'some with t to load all articles (Warning: Both settings + enlarge the amount of data which is fetched when you enter a group + and slow down the process of entering a group). + + If you already use Gnus 5.10.0, you can say /o N In summary buffer + to load the last N messages, this feature is not available in 5.8.8 + + If you don't want all old messages, but the parent of the message + you're just reading, you can say ^, if you want to retrieve the + whole thread the message you're just reading belongs to, A T is + your friend. + +4.2. How to tell Gnus to show an important message every time I enter a + group, even when it's read? + + You can tick important messages. To do this hit u while point is in + summary buffer over the message. When you want to remove the mark, + hit either d (this deletes the tick mark and set's unread mark) or + M c (which deletes all marks for the message). + +4.3. How to view the headers of a message? + + Say t to show all headers, one more t hides them again. + +4.4. How to view the raw unformatted message? + + Say C-u g to show the raw message g returns to normal view. + +4.5. How can I change the headers Gnus displays by default at the top of + the article buffer? + + The variable gnus-visible-headers controls which headers are shown, + its value is a regular expression, header lines which match it are + shown. So if you want author, subject, date, and if the header + exists, Followup-To and MUA / NUA say this in ~/.gnus: + + (setq gnus-visible-headers + "^\\(From:\\|Subject:\\|Date:\\|Followup-To:\\|X-Newsreader:\\|User-Agent:\\|X-Mailer:\\)") + + +4.6. I'd like Gnus NOT to render HTML-mails but show me the text part if + it's available. How to do it? + + Say + + (eval-after-load "mm-decode" + '(progn + (add-to-list 'mm-discouraged-alternatives "text/html") + (add-to-list 'mm-discouraged-alternatives "text/richtext"))) + + + in ~/.gnus. If you don't want HTML rendered, even if there's no + text alternative add + + (setq mm-automatic-display (remove "text/html" mm-automatic-display)) + + + too. + +4.7. Can I use some other browser than w3 to render my HTML-mails? + + Only if you use Gnus 5.10.0 or younger. In this case you've got the + choice between w3, w3m, links, lynx and html2text, which one is + used can be specified in the variable mm-text-html-renderer, so if + you want links to render your mail say + + (setq mm-text-html-renderer 'links) + + +4.8. Is there anything I can do to make poorly formatted mails more + readable? + + Gnus offers you several functions to "wash" incoming mail, you can + find them if you browse through the menu, item Article->Washing. + The most interesting ones are probably "Wrap long lines" ( W w ), + "Decode ROT13" ( W r ) and "Outlook Deuglify" which repairs the + dumb quoting used by many users of Microsoft products ( W Y f gives + you full deuglify. See W Y C-h or have a look at the menus for + other deuglifications). Outlook deuglify is only available since + Gnus 5.10.0. + +4.9. Is there a way to automatically ignore posts by specific authors or + with specific words in the subject? And can I highlight more + interesting ones in some way? + + You want Scoring. Scoring means, that you define rules which assign + each message an integer value. Depending on the value the message + is highlighted in summary buffer (if it's high, say +2000) or + automatically marked read (if the value is low, say -800) or some + other action happens. + + There are basically three ways of setting up rules which assign the + scoring-value to messages. The first and easiest way is to set up + rules based on the article you are just reading. Say you're reading + a message by a guy who always writes nonsense and you want to + ignore his messages in the future. Hit L, to set up a rule which + lowers the score. Now Gnus asks you which the criteria for lowering + the Score shall be. Hit ? twice to see all possibilities, we want a + which means the author (the from header). Now Gnus wants to know + which kind of matching we want. Hit either e for an exact match or + s for substring-match and delete afterwards everything but the name + to score down all authors with the given name no matter which email + address is used. Now you need to tell Gnus when to apply the rule + and how long it should last, hit e.g. p to apply the rule now and + let it last forever. If you want to raise the score instead of + lowering it say I instead of L. + + You can also set up rules by hand. To do this say V f in summary + buffer. Then you are asked for the name of the score file, it's + name.of.group.SCORE for rules valid in only one group or all.Score + for rules valid in all groups. See the Gnus manual for the exact + syntax, basically it's one big list whose elements are lists again. + the first element of those lists is the header to score on, then + one more list with what to match, which score to assign, when to + expire the rule and how to do the matching. If you find me very + interesting, you could e.g. add the following to your all.Score: + + (("references" ("hschmi22.userfqdn.rz-online.de" 500 nil s)) + ("message-id" ("hschmi22.userfqdn.rz-online.de" 999 nil s))) + + + This would add 999 to the score of messages written by me and 500 + to the score of messages which are a (possibly indirect) answer to + a message written by me. Of course nobody with a sane mind would do + this :-) + + The third alternative is adaptive scoring. This means Gnus watches + you and tries to find out what you find interesting and what + annoying and sets up rules which reflect this. Adaptive scoring can + be a huge help when reading high traffic groups. If you want to + activate adaptive scoring say + + (setq gnus-use-adaptive-scoring t) + + + in ~/.gnus. + +4.10. How can I disable threading in some (e.g. mail-) groups, or set + other variables specific for some groups? + + While in group buffer move point over the group and hit G c, this + opens a buffer where you can set options for the group. At the + bottom of the buffer you'll find an item that allows you to set + variables locally for the group. To disable threading enter + gnus-show-threads as name of variable and nil as value. Hit button + done at the top of the buffer when you're ready. + +4.11. Can I highlight messages written by me and follow-ups to those? + + Stop those "Can I ..." questions, the answer is always yes in Gnus + Country :-). It's a three step process: First we make faces + (specifications of how summary-line shall look like) for those + postings, then we'll give them some special score and finally we'll + tell Gnus to use the new faces. You can find detailed instructions + on how to do it on my.gnus.org [http://my.gnus.org/Members/dzimmerm + /HowTo%2C2002-07-25%2C1027619165012198456/view] + +4.12. The number of total messages in a group which Gnus displays in + group buffer is by far to high, especially in mail groups. Is this + a bug? + + No, that's a matter of design of Gnus, fixing this would mean + reimplementation of major parts of Gnus' back ends. Gnus thinks + "highest-article-number - lowest-article-number = + total-number-of-articles". This works OK for Usenet groups, but if + you delete and move many messages in mail groups, this fails. To + cure the symptom, enter the group via C-u RET (this makes Gnus get + all messages), then hit M P b to mark all messages and then say B m + name.of.group to move all messages to the group they have been in + before, they get new message numbers in this process and the count + is right again (until you delete and move your mail to other groups + again). + +4.13. I don't like the layout of summary and article buffer, how to + change it? Perhaps even a three pane display? + + You can control the windows configuration by calling the function + gnus-add-configuration. The syntax is a bit complicated but + explained very well in the manual node "Window Layout". Some + popular examples: + + Instead 25% summary 75% article buffer 35% summary and 65% article + (the 1.0 for article means "take the remaining space"): + + (gnus-add-configuration '(article (vertical 1.0 (summary .35 point) (article 1.0)))) + + + A three pane layout, Group buffer on the left, summary buffer + top-right, article buffer bottom-right: + + (gnus-add-configuration + '(article + (horizontal 1.0 + (vertical 25 + (group 1.0)) + (vertical 1.0 + (summary 0.25 point) + (article 1.0))))) + (gnus-add-configuration + '(summary + (horizontal 1.0 + (vertical 25 + (group 1.0)) + (vertical 1.0 + (summary 1.0 point))))) + + +4.14. I don't like the way the Summary buffer looks, how to tweak it? + + You've got to play around with the variable + gnus-summary-line-format. It's value is a string of symbols which + stand for things like author, date, subject etc. A list of the + available specifiers can be found in the manual node "Summary + Buffer Lines" and the often forgotten node "Formatting Variables" + and it's sub-nodes. There you'll find useful things like + positioning the cursor and tabulators which allow you a summary in + table form, but sadly hard tabulators are broken in 5.8.8. + + Since 5.10.0, Gnus offers you some very nice new specifiers, e.g. + %B which draws a thread-tree and %&user-date which gives you a date + where the details are dependent of the articles age. Here's an + example which uses both: + + (setq gnus-summary-line-format ":%U%R %B %s %-60=|%4L |%-20,20f |%&user-date; \n") + + + resulting in: + + :O Re: [Richard Stallman] rfc2047.el | 13 |Lars Magne Ingebrigt |Sat 23:06 + :O Re: Revival of the ding-patches list | 13 |Lars Magne Ingebrigt |Sat 23:12 + :R > Re: Find correct list of articles for a gro| 25 |Lars Magne Ingebrigt |Sat 23:16 + :O \-> ... | 21 |Kai Grossjohann | 0:01 + :R > Re: Cry for help: deuglify.el - moving stuf| 28 |Lars Magne Ingebrigt |Sat 23:34 + :O \-> ... | 115 |Raymond Scholz | 1:24 + :O \-> ... | 19 |Lars Magne Ingebrigt |15:33 + :O Slow mailing list | 13 |Lars Magne Ingebrigt |Sat 23:49 + :O Re: `@' mark not documented | 13 |Lars Magne Ingebrigt |Sat 23:50 + :R > Re: Gnus still doesn't count messages prope| 23 |Lars Magne Ingebrigt |Sat 23:57 + :O \-> ... | 18 |Kai Grossjohann | 0:35 + :O \-> ... | 13 |Lars Magne Ingebrigt | 0:56 + + +4.15. How to split incoming mails in several groups? + + Gnus offers two possibilities for splitting mail, the easy + nnmail-split-methods and the more powerful Fancy Mail Splitting. + I'll only talk about the first one, refer to the manual, node + "Fancy Mail Splitting" for the latter. + + The value of nnmail-split-methods is a list, each element is a list + which stands for a splitting rule. Each rule has the form "group + where matching articles should go to", "regular expression which + has to be matched", the first rule which matches wins. The last + rule must always be a general rule (regular expression .*) which + denotes where articles should go which don't match any other rule. + If the folder doesn't exist yet, it will be created as soon as an + article lands there. By default the mail will be send to all groups + whose rules match. If you don't want that (you probably don't + want), say + + (setq nnmail-crosspost nil) + + + in ~/.gnus. + + An example might be better than thousand words, so here's my + nnmail-split-methods. Note that I send duplicates in a special + group and that the default group is spam, since I filter all mails + out which are from some list I'm subscribed to or which are + addressed directly to me before. Those rules kill about 80% of the + Spam which reaches me (Email addresses are changed to prevent + spammers from using them): + + (setq nnmail-split-methods + '(("duplicates" "^Gnus-Warning:.*duplicate") + ("XEmacs-NT" "^\\(To:\\|CC:\\).*localpart@xemacs.bla.*") + ("Gnus-Tut" "^\\(To:\\|CC:\\).*localpart@socha.bla.*") + ("tcsh" "^\\(To:\\|CC:\\).*localpart@mx.gw.bla.*") + ("BAfH" "^\\(To:\\|CC:\\).*localpart@.*uni-muenchen.bla.*") + ("Hamster-src" "^\\(CC:\\|To:\\).*hamster-sourcen@yahoogroups.\\(de\\|com\\).*") + ("Tagesschau" "^From: tagesschau $") + ("Replies" "^\\(CC:\\|To:\\).*localpart@Frank-Schmitt.bla.*") + ("EK" "^From:.*\\(localpart@privateprovider.bla\\|localpart@workplace.bla\\).*") + ("Spam" "^Content-Type:.*\\(ks_c_5601-1987\\|EUC-KR\\|big5\\|iso-2022-jp\\).*") + ("Spam" "^Subject:.*\\(This really work\\|XINGA\\|ADV:\\|XXX\\|adult\\|sex\\).*") + ("Spam" "^Subject:.*\\(\=\?ks_c_5601-1987\?\\|\=\?euc-kr\?\\|\=\?big5\?\\).*") + ("Spam" "^X-Mailer:\\(.*BulkMailer.*\\|.*MIME::Lite.*\\|\\)") + ("Spam" "^X-Mailer:\\(.*CyberCreek Avalanche\\|.*http\:\/\/GetResponse\.com\\)") + ("Spam" "^From:.*\\(verizon\.net\\|prontomail\.com\\|money\\|ConsumerDirect\\).*") + ("Spam" "^Delivered-To: GMX delivery to spamtrap@gmx.bla$") + ("Spam" "^Received: from link2buy.com") + ("Spam" "^CC: .*azzrael@t-online.bla") + ("Spam" "^X-Mailer-Version: 1.50 BETA") + ("Uni" "^\\(CC:\\|To:\\).*localpart@uni-koblenz.bla.*") + ("Inbox" "^\\(CC:\\|To:\\).*\\(my\ name\\|address@one.bla\\|adress@two.bla\\)") + ("Spam" ""))) + + +5. Composing messages + +5.1. What are the basic commands I need to know for sending mail and + postings? + + To start composing a new mail hit m either in Group or Summary + buffer, for a posting, it's either a in Group buffer and filling + the Newsgroups header manually or a in the Summary buffer of the + group where the posting shall be send to. Replying by mail is r if + you don't want to cite the author, or import the cited text + manually and R to cite the text of the original message. For a + follow up to a newsgroup, it's f and F (analog to r and R. + + Enter new headers above the line saying "--text follows this + line--", enter the text below the line. When ready hit C-c C-c, to + send the message, if you want to finish it later hit C-c C-d to + save it in the drafts group, where you can start editing it again + by saying D e. + +5.2. How to enable automatic word-wrap when composing messages? + + Say + + (add-hook 'message-mode-hook + (lambda () + (setq fill-column 72) + (turn-on-auto-fill))) + + + in ~/.gnus. You can reformat a paragraph by hitting M-q (as usual) + +5.3. How to set stuff like From, Organization, Reply-To, signature...? + + There are other ways, but you should use posting styles for this. + (See below why). This example should make the syntax clear: + + (setq gnus-posting-styles + '((".*" + (name "Frank Schmitt") + (address "me@there.bla") + (organization "Hamme net, kren mer och nimmi") + (signature-file "~/.signature") + ("X-SampleHeader" "foobar") + (eval (setq some-variable "Foo bar"))))) + + + The ".*" means that this settings are the default ones (see below), + valid values for the first element of the following lists are + signature, signature-file, organization, address, name or body. The + attribute name can also be a string. In that case, this will be + used as a header name, and the value will be inserted in the + headers of the article; if the value is `nil', the header name will + be removed. You can also say (eval (foo bar)), then the function + foo will be evaluated with argument bar and the result will be + thrown away. + +5.4. Can I set things like From, Signature etc group based on the group + I post too? + + That's the strength of posting styles. Before, we used ".*" to set + the default for all groups. You can use a regexp like "^gmane" and + the following settings are only applied to postings you send to the + gmane hierarchy, use ".*binaries" instead and they will be applied + to postings send to groups containing the string binaries in their + name etc. + + You can instead of specifying a regexp specify a function which is + evaluated, only if it returns true, the corresponding settings take + effect. Two interesting candidates for this are message-news-p + which returns t if the current Group is a newsgroup and the + corresponding message-mail-p. + + Note that all forms that match are applied, that means in the + example below, when I post to gmane.mail.spam.spamassassin.general, + the settings under ".*" are applied and the settings under + message-news-p and those under "^gmane" and those under "^gmane\ + \.mail\\.spam\\.spamassassin\\.general$". Because of this put + general settings at the top and specific ones at the bottom. + + (setq gnus-posting-styles + '((".*" ;;default + (name "Frank Schmitt") + (organization "Hamme net, kren mer och nimmi") + (signature-file "~/.signature") ) + ((message-news-p) ;;Usenet news? + (address "mySpamTrap@Frank-Schmitt.bla") + ("Reply-To" "hereRealRepliesOnlyPlease@Frank-Schmitt.bla") ) + ((message-mail-p) ;;mail? + (address "usedForMails@Frank-Schmitt.bla") ) + ("^gmane" ;;this is mail, too in fact + (address "usedForMails@Frank-Schmitt.net") + ("Reply-To" nil) ) + ("^gmane.mail.spam.spamassassin.general$" + (eval (setq mail-envelope-from "Azzrael@rz-online.de")) + (address "Azzrael@rz-online.de")) )) + + +5.5. Is there a spell-checker? Perhaps even on-the-fly spell-checking? + + You can use ispell.el to spell-check stuff in Emacs. So the first + thing to do is to make sure that you've got either ispell [http:// + fmg-www.cs.ucla.edu/fmg-members/geoff/ispell.html] or aspell [http: + //aspell.sourceforge.net/] installed and in your Path. Then you + need ispell.el [http://www.kdstevens.com/~stevens/ispell-page.html] + and for on-the-fly spell-checking flyspell.el [http:// + www-sop.inria.fr/mimosa/personnel/Manuel.Serrano/flyspell/ + flyspell.html]. Ispell.el is shipped with Gnus Emacs and available + through the Emacs package system, flyspell.el is shipped with Emacs + and part of XEmacs text-modes package which is available through + the package system, so there should be no need to install them + manually. + + Ispell.el assumes you use ispell, if you choose aspell say + + (setq ispell-program-name "aspell") + + in your Emacs configuration file. + + If you want your outgoing messages to be spell-checked, say + + (add-hook 'message-send-hook 'ispell-message) + + In your ~/.gnus, if you prefer on-the-fly spell-checking say + + (add-hook 'message-mode-hook (lambda () (flyspell-mode 1))) + +5.6. Can I set the dictionary based on the group I'm posting to? + + Yes, say something like + + (add-hook 'gnus-select-group-hook + (lambda () + (cond + ((string-match + "^de\\." (gnus-group-real-name gnus-newsgroup-name)) + (ispell-change-dictionary "deutsch8")) + (t + (ispell-change-dictionary "english"))))) + + + in ~/.gnus. Change "^de\\." and "deutsch8" to something that suits + your needs. + +5.7. Is there some kind of address-book, so I needn't remember all those + email addresses? + + There's an very basic solution for this, mail aliases. You can + store your mail addresses in a ~/.mailrc file using a simple alias + syntax: + + alias al "Al " + + + Then typing your alias (followed by a space or punctuation + character) on a To: or Cc: line in the message buffer will cause + gnus to insert the full address for you. See the node "Mail + Aliases" in Message (not Gnus) manual for details. + + However, what you really want is the Insidious Big Brother Database + bbdb. Get it through the XEmacs package system or from bbdb's + homepage [http://bbdb.sourceforge.net/]. Now place the following in + ~/.gnus, to activate bbdb for Gnus: + + (require 'bbdb) + (bbdb-initialize 'gnus 'message) + + + Now you probably want some general bbdb configuration, place them + in ~/.emacs: + + (require 'bbdb) + ;;If you don't live in Northern America, you should disable the + ;;syntax check for telephone numbers by saying + (setq bbdb-north-american-phone-numbers-p nil) + ;;Tell bbdb about your email address: + (setq bbdb-user-mail-names + (regexp-opt '("Your.Email@here.bla" + "Your.other@mail.there.bla"))) + ;;cycling while completing email addresses + (setq bbdb-complete-name-allow-cycling t) + ;;No popup-buffers + (setq bbdb-use-pop-up nil) + + + Now you should be ready to go. Say M-x bbdb RET RET to open a bbdb + buffer showing all entries. Say c to create a new entry, b to + search your BBDB and C-o to add a new field to an entry. If you + want to add a sender to the BBDB you can also just hit `:' on the + posting in the summary buffer and you are done. When you now + compose a new mail, hit TAB to cycle through know recipients. + +5.8. Sometimes I see little images at the top of article buffer. What's + that and how can I send one with my postings, too? + + Those images are called X-Faces. They are 48*48 pixel b/w pictures, + encoded in a header line. If you want to include one in your posts, + you've got to convert some image to a X-Face. So fire up some image + manipulation program (say Gimp), open the image you want to + include, cut out the relevant part, reduce color depth to 1 bit, + resize to 48*48 and save as bitmap. Now you should get the compface + package from this site [ftp://ftp.cs.indiana.edu:/pub/faces/]. and + create the actual X-face by saying + + cat file.xbm | xbm2ikon |compface > file.face + cat ./file.face | sed 's/\\/\\\\/g' | sed 's/\"/\\\"/g' > ./file.face.quoted + + + if you can't use compface, there's an online X-face converter at + http://www.dairiki.org/xface/ [http://www.dairiki.org/xface/]. If + you use MS Windows, you could also use the WinFace program from + http://www.xs4all.nl/~walterln/winface/ [http://www.xs4all.nl/ + ~walterln/winface/]. Now you only have to tell Gnus to include the + X-face in your postings by saying + + (setq message-default-headers + (with-temp-buffer + (insert "X-Face: ") + (insert-file-contents "~/.xemacs/xface") + (buffer-string))) + + + in ~/.gnus. + +5.9. Sometimes I accidentally hit r instead of f in newsgroups. Can Gnus + warn me, when I'm replying by mail in newsgroups? + + Put this in ~/.gnus: + + (setq gnus-confirm-mail-reply-to-news t) + + + if you already use Gnus 5.10.0, if you still use 5.8.8 or 5.9 try + this instead: + + (defadvice gnus-summary-reply (around reply-in-news activate) + (interactive) + (when (or (not (gnus-news-group-p gnus-newsgroup-name)) + (y-or-n-p "Really reply? ")) + ad-do-it)) + + +5.10. How to tell Gnus not to generate a sender header? + + Since 5.10.0 Gnus doesn't generate a sender header by default. For + older Gnus' try this in ~/.gnus: + + (eval-after-load "message" + '(add-to-list 'message-syntax-checks '(sender . disabled))) + + +5.11. I want gnus to locally store copies of my send mail and news, how + to do it? + + You must set the variable gnus-message-archive-group to do this. + You can set it to a string giving the name of the group where the + copies shall go or like in the example below use a function which + is evaluated and which returns the group to use. + + (setq gnus-message-archive-group + '((if (message-news-p) + "nnml:Send-News" + "nnml:Send-Mail"))) + + +5.12. People tell me my Message-IDs are not correct, why aren't they and + how to fix it? + + The message-ID is an unique identifier for messages you send. To + make it unique, Gnus need to know which machine name to put after + the "@". If the name of the machine where Gnus is running isn't + suitable (it probably isn't at most private machines) you can tell + Gnus what to use by saying: + + (defun message-make-message-id() + (concat "<"(message-unique-id)"@yourmachine.yourdomain.tld>")) + + + in ~/.gnus. If you have no idea what to insert for + "yourmachine.yourdomain.tld", you've got several choices. You can + either ask your provider if he allows you to use something like + yourUserName.userfqdn.provider.net, or you can use + somethingUnique.yourdomain.tld if you own the domain + yourdomain.tld, or you can register at a service which gives + private users a FQDN for free, e.g. http://www.stura.tu-freiberg.de + /~dlx/addfqdn.html [http://www.stura.tu-freiberg.de/~dlx/ + addfqdn.html]. (Sorry but this website is in German, if you know of + an English one offering the same, drop me a note). + + Finally you can tell Gnus not to generate a Message-ID for News at + all (and letting the server do the job) by saying + + (setq message-required-news-headers + (remove' Message-ID message-required-news-headers)) + + + you can also tell Gnus not to generate Message-IDs for mail by + saying + + (setq message-required-mail-headers + (remove' Message-ID message-required-mail-headers)) + + + , however some mail servers don't generate proper Message-IDs, too, + so test if your Mail Server behaves correctly by sending yourself a + Mail and looking at the Message-ID. + +6. Old messages + +6.1. How to import my old mail into Gnus? + + The easiest way is to tell your old mail program to export the + messages in mbox format. Most Unix mailers are able to do this, if + you come from the MS Windows world, you may find tools at http:// + mbx2mbox.sourceforge.net/ [http://mbx2mbox.sourceforge.net/]. + + Now you've got to import this mbox file into Gnus. To do this, + create a nndoc group based on the mbox file by saying G f /path/ + file.mbox RET in Group buffer. You now have read-only access to + your mail. If you want to import the messages to your normal Gnus + mail groups hierarchy, enter the nndoc group you've just created by + saying C-u RET (thus making sure all messages are retrieved), mark + all messages by saying M P b and either copy them to the desired + group by saying B c name.of.group RET or send them through + nnmail-split-methods (respool them) by saying B r. + +6.2. How to archive interesting messages? + + If you stumble across an interesting message, say in gnu.emacs.gnus + and want to archive it there are several solutions. The first and + easiest is to save it to a file by saying O f. However, wouldn't it + be much more convenient to have more direct access to the archived + message from Gnus? If you say yes, put this snippet by Frank Haun + in ~/.gnus: + + (defun my-archive-article (&optional n) + "Copies one or more article(s) to a corresponding `nnml:' group, e.g. + `gnus.ding' goes to `nnml:1.gnus.ding'. And `nnml:List-gnus.ding' goes + to `nnml:1.List-gnus-ding'. + + Use process marks or mark a region in the summary buffer to archive + more then one article." + (interactive "P") + (let ((archive-name + (format + "nnml:1.%s" + (if (featurep 'xemacs) + (replace-in-string gnus-newsgroup-name "^.*:" "") + (replace-regexp-in-string "^.*:" "" gnus-newsgroup-name))))) + (gnus-summary-copy-article n archive-name))) + + + You can now say M-x my-archive-article in summary buffer to archive + the article under the cursor in a nnml group. (Change nnml to your + preferred back end) + + Of course you can also make sure the cache is enabled by saying + + (setq gnus-use-cache t) + + + then you only have to set either the tick or the dormant mark for + articles you want to keep, setting the read mark will remove them + from cache. + +6.3. How to search for a specific message? + + There are several ways for this, too. For a posting from a Usenet + group the easiest solution is probably to ask groups.google.com + [http://groups.google.com], if you found the posting there, tell + Google to display the raw message, look for the message-id, and say + M-^ the@message.id RET in a summary buffer. Since Gnus 5.10.0 + there's also a Gnus interface for groups.google.com which you can + call with G W) in group buffer. + + Another idea which works for both mail and news groups is to enter + the group where the message you are searching is and use the + standard Emacs search C-s, it's smart enough to look at articles in + collapsed threads, too. If you want to search bodies, too try M-s + instead. Further on there are the gnus-summary-limit-to-foo + functions, which can help you, too. + + Of course you can also use grep to search through your local mail, + but this is both slow for big archives and inconvenient since you + are not displaying the found mail in Gnus. Here comes nnir into + action. Nnir is a front end to search engines like swish-e or + swish++ and others. You index your mail with one of those search + engines and with the help of nnir you can search trough the indexed + mail and generate a temporary group with all messages which met + your search criteria. If this sound cool to you get nnir.el from + ftp://ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/ [ftp:// + ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/] or ftp:// + ftp.is.informatik.uni-duisburg.de/pub/src/emacs/ [ftp:// + ftp.is.informatik.uni-duisburg.de/pub/src/emacs/]. Instructions on + how to use it are at the top of the file. + +6.4. How to get rid of old unwanted mail? + + You can of course just mark the mail you don't need anymore by + saying # with point over the mail and then say B DEL to get rid of + them forever. You could also instead of actually deleting them, + send them to a junk-group by saying B m nnml:trash-bin which you + clear from time to time, but both are not the intended way in Gnus. + + In Gnus, we let mail expire like news expires on a news server. + That means you tell Gnus the message is expirable (you tell Gnus "I + don't need this mail anymore") by saying E with point over the mail + in summary buffer. Now when you leave the group, Gnus looks at all + messages which you marked as expirable before and if they are old + enough (default is older than a week) they are deleted. + +6.5. I want that all read messages are expired (at least in some + groups). How to do it? + + If you want all read messages to be expired (e.g. in mailing lists + where there's an online archive), you've got two choices: + auto-expire and total-expire. Auto-expire means, that every article + which has no marks set and is selected for reading is marked as + expirable, Gnus hits E for you every time you read a message. + Total-expire follows a slightly different approach, here all + article where the read mark is set are expirable. + + To activate auto-expire, include auto-expire in the Group + parameters for the group. (Hit G c in summary buffer with point + over the group to change group parameters). For total-expire add + total-expire to the group-parameters. + + Which method you choose is merely a matter of taste: Auto-expire is + faster, but it doesn't play together with Adaptive Scoring, so if + you want to use this feature, you should use total-expire. + + If you want a message to be excluded from expiration in a group + where total or auto expire is active, set either tick (hit u) or + dormant mark (hit u), when you use auto-expire, you can also set + the read mark (hit d). + +6.6. I don't want expiration to delete my mails but to move them to + another group. + + Say something like this in ~/.gnus: + + (setq nnmail-expiry-target "nnml:expired") + + + (If you want to change the value of nnmail-expiry-target on a per + group basis see the question "How can I disable threading in some + (e.g. mail-) groups, or set other variables specific for some + groups?") + +7. Gnus in a dial-up environment + +7.1. I don't have a permanent connection to the net, how can I minimize + the time I've got to be connected? + + You've got basically two options: Either you use the Gnus Agent + (see below) for this, or you can install programs which fetch your + news and mail to your local disk and Gnus reads the stuff from your + local machine. + + If you want to follow the second approach, you need a program which + fetches news and offers them to Gnus, a program which does the same + for mail and a program which receives the mail you write from Gnus + and sends them when you're online. + + Let's talk about Unix systems first: For the news part, the easiest + solution is a small nntp server like Leafnode [http:// + www.leafnode.org/] or sn [http://infa.abo.fi/~patrik/sn/], of + course you can also install a full featured news server like inn + [http://www.isc.org/products/INN/]. Then you want to fetch your + Mail, popular choices are fetchmail [http://www.catb.org/~esr/ + fetchmail/] and getmail [http://www.qcc.ca/~charlesc/software/ + getmail-3.0/]. You should tell those to write the mail to your disk + and Gnus to read it from there. Last but not least the mail sending + part: This can be done with every MTA like sendmail [http:// + www.sendmail.org/], postfix [http://www.qmail.org/], exim [http:// + www.exim.org/] or qmail [http://www.qmail.org/]. + + On windows boxes I'd vote for Hamster [http://www.tglsoft.de/], + it's a small freeware, open-source program which fetches your mail + and news from remote servers and offers them to Gnus (or any other + mail and/or news reader) via nntp respectively POP3 or IMAP. It + also includes a smtp server for receiving mails from Gnus. + +7.2. So what was this thing about the Agent? + + The Gnus agent is part of Gnus, it allows you to fetch mail and + news and store them on disk for reading them later when you're + offline. It kind of mimics offline newsreaders like e.g. Forte + Agent. If you want to use the Agent place the following in ~/.gnus + if you are still using 5.8.8 or 5.9 (it's the default since + 5.10.0): + + (setq gnus-agent t) + + + Now you've got to select the servers whose groups can be stored + locally. To do this, open the server buffer (that is press ^ while + in the group buffer). Now select a server by moving point to the + line naming that server. Finally, agentize the server by typing J a + . If you make a mistake, or change your mind, you can undo this + action by typing J r. When you're done, type 'q' to return to the + group buffer. Now the next time you enter a group on a agentized + server, the headers will be stored on disk and read from there the + next time you enter the group. + +7.3. I want to store article bodies on disk, too. How to do it? + + You can tell the agent to automatically fetch the bodies of + articles which fulfill certain predicates, this is done in a + special buffer which can be reached by saying J c in group buffer. + Please refer to the documentation for information which predicates + are possible and how exactly to do it. + + Further on you can tell the agent manually which articles to store + on disk. There are two ways to do this: Number one: In the summary + buffer, process mark a set of articles that shall be stored in the + agent by saying # with point over the article and then type J s. + The other possibility is to set, again in the summary buffer, + downloadable (%) marks for the articles you want by typing @ with + point over the article and then typing J u. What's the difference? + Well, process marks are erased as soon as you exit the summary + buffer while downloadable marks are permanent. You can actually set + downloadable marks in several groups then use fetch session ('J s' + in the GROUP buffer) to fetch all of those articles. The only + downside is that fetch session also fetches all of the headers for + every selected group on an agentized server. Depending on the + volume of headers, the initial fetch session could take hours. + +7.4. How to tell Gnus not to try to send mails / postings while I'm + offline? + + All you've got to do is to tell Gnus when you are online (plugged) + and when you are offline (unplugged), the rest works automatically. + You can toggle plugged/unplugged state by saying J j in group + buffer. To start Gnus unplugged say M-x gnus-unplugged instead of + M-x gnus. Note that for this to work, the agent must be active. + +8. Getting help + +8.1. How to find information and help inside Emacs? + + The first stop should be the Gnus manual (Say C-h i d m Gnus RET to + start the Gnus manual, then walk through the menus or do a + full-text search with s). Then there are the general Emacs help + commands starting with C-h, type C-h ? ? to get a list of all + available help commands and their meaning. Finally M-x + apropos-command lets you search through all available functions and + M-x apropos searches the bound variables. + +8.2. I can't find anything in the Gnus manual about X (e.g. attachments, + PGP, MIME...), is it not documented? + + There's not only the Gnus manual but also the manuals for message, + emacs-mime, sieve and pgg. Those packages are distributed with Gnus + and used by Gnus but aren't really part of core Gnus, so they are + documented in different info files, you should have a look in those + manuals, too. + +8.3. Which websites should I know? + + The two most important ones are the official Gnus website [http:// + www.gnus.org]. and it's sister site my.gnus.org (MGO) [http:// + my.gnus.org], hosting an archive of lisp snippets, howtos, a (not + really finished) tutorial and this FAQ. + + Tell me about other sites which are interesting. + +8.4. Which mailing lists and newsgroups are there? + + There's the newsgroup gnu.emacs.gnus (pull it from e.g. + news.gnus.org) which deals with general questions and the ding + mailing list (ding@gnus.org) dealing with development of Gnus. You + can read the ding list via NNTP, too under the name gnus.ding from + news.gnus.org. + + If you want to stay in the big8, news.software.newssreaders is also + read by some Gnus users (but chances for qualified help are much + better in the above groups) and if you speak German, there's + de.comm.software.gnus. + +8.5. Where to report bugs? + + Say M-x gnus-bug, this will start a message to the gnus bug mailing + list [mailto:bugs@gnus.org] including information about your + environment which make it easier to help you. + +8.6. I need real-time help, where to find it? + + Point your IRC client to irc.my.gnus.org channel #mygnus. Don't be + afraid if people there speak German, they are willing and capable + of switching to English when people from outside Germany enter. + +9. Tuning Gnus + +9.1. Starting Gnus is really slow, how to speed it up? + + The reason for this could be the way Gnus reads it's active file, + see the node "The Active File" in the Gnus manual for things you + might try to speed the process up. An other idea would be to byte + compile your ~/.gnus (say M-x byte-compile-file RET ~/.gnus RET to + do it). Finally, if you have require statements in your .gnus, you + could replace them with eval-after-load, which loads the stuff not + at startup time, but when it's needed. Say you've got this in your + ~/.gnus: + + (require 'message) + (add-to-list 'message-syntax-checks '(sender . disabled)) + + + then as soon as you start Gnus, message.el is loaded. If you + replace it with + + (eval-after-load "message" + '(add-to-list 'message-syntax-checks '(sender . disabled))) + + + it's loaded when it's needed. + +9.2. How to speed up the process of entering a group? + + A speed killer is setting the variable gnus-fetch-old-headers to + anything different from nil, so don't do this if speed is an issue. + To speed up building of summary say + + (gnus-compile) + + + at the bottom of your ~/.gnus, this will make gnus byte-compile + things like gnus-summary-line-format. then you could increase the + value of gc-cons-threshold by saying something like + + (setq gc-cons-threshold 3500000) + + + in ~/.emacs. If you don't care about width of CJK characters or use + Gnus 5.10.0 or younger together with a recent GNU Emacs, you should + say + + (setq gnus-use-correct-string-widths nil) + + + in ~/.gnus (thanks to Jesper harder for the last two suggestions). + Finally if you are still using 5.8.8 or 5.9 and experience speed + problems with summary buffer generation, you definitely should + update to 5.10.0 since there quite some work on improving it has + been done. + +9.3. Sending mail becomes slower and slower, what's up? + + The reason could be that you told Gnus to archive the messages you + wrote by setting gnus-message-archive-group. Try to use a nnml + group instead of an archive group, this should bring you back to + normal speed. + +Glossary + +~/.gnus + + When the term ~/.gnus is used it just means your Gnus + configuration file. You might as well call it ~/.gnus.el or + specify another name. + +Back End + + In Gnus terminology a back end is a virtual server, a layer + between core Gnus and the real NNTP-, POP3-, IMAP- or + whatever-server which offers Gnus a standardized interface to + functions like "get message", "get Headers" etc. + +Emacs + + When the term Emacs is used in this FAQ, it means either GNU + Emacs or XEmacs. + +Message + + In this FAQ message means a either a mail or a posting to a + Usenet Newsgroup or to some other fancy back end, no matter of + which kind it is. + +MUA + + MUA is an acronym for Mail User Agent, it's the program you use + to read and write e-mails. + +NUA + + NUA is an acronym for News User Agent, it's the program you use + to read and write Usenet news. diff --git a/etc/gnus/catchup.pbm b/etc/gnus/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;en0AXjG+z;K|m6u07U+0 PV7$)2@Q;BZ1Y`sNnq~{( literal 0 HcmV?d00001 diff --git a/etc/gnus/cu-exit.xpm b/etc/gnus/cu-exit.xpm new file mode 100644 index 0000000..1723622 --- /dev/null +++ b/etc/gnus/cu-exit.xpm @@ -0,0 +1,31 @@ +/* XPM */ +static char * cu_exit_xpm[] = { +"24 24 4 1", +" c None", +". c #000000000000", +"X c #FFFFFFFFFFFF", +"o c #999999999999", +" ", +" ", +" ", +" ", +" ", +" ..... ", +" .. .XXX. ", +" ..X..XXXX... ", +" .XXXX.XXXX.X... ", +" ..XXXX.XXX.XXX.. ", +" .XXX.......... ", +" .XXX.XXX.XXX.. ", +" .XX.XXX.XXX. ", +" .XX.XXX.XX.. ", +" ............ ", +" .X.X.X.X.. ", +"ooooooo..........ooooooo", +"ooooooo.X.X.X.X.oooooooo", +"ooooooo.........oooooooo", +"ooooooo..X...X..oooooooo", +"ooooooo...X.X...oooooooo", +"ooooooo........ooooooooo", +"ooooooooo.....oooooooooo", +"oooooooooooooooooooooooo"}; diff --git a/etc/gnus/describe-group.pbm b/etc/gnus/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/etc/gnus/describe-group.xpm b/etc/gnus/describe-group.xpm new file mode 100644 index 0000000..b4a6f42 --- /dev/null +++ b/etc/gnus/describe-group.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * describe_group_xpm[] = { +"24 24 5 1", +". c None", +" c #000000000000", +"o c #FFFFF5F5ACAC", +"+ c #E1E1E0E0E0E0", +"@ c #C7C7C6C6C6C6", +"........................", +"........................", +".................oooo...", +" .. .. .. .. .. oo oo o.", +"..............oooooooooo", +".............ooooooooooo", +" .. .. .. .. oo oo oo oo", +"............oooooooooooo", +"............oooooooooooo", +" .. .. .. .. oo oo oo oo", +"............oooooooooooo", +"............oooooooooooo", +" .. .. .. .. oo oo oo oo", +"............oooooooooooo", +"..... ...oooooooooooo", +" .. ++ .. .o oo oo oo", +"... @@@+ ....ooooooooo", +"... @ ....oooooooo.", +" . . .. .. .. ..", +". ..............", +" ................", +" .. .. .. .. .. ..", +" ..................", +" ...................."}; diff --git a/etc/gnus/exit-gnus.pbm b/etc/gnus/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/etc/gnus/exit-gnus.xpm b/etc/gnus/exit-gnus.xpm new file mode 100644 index 0000000..534f3c2 --- /dev/null +++ b/etc/gnus/exit-gnus.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * exit_gnus_xpm[] = { +"24 24 6 1", +" c None", +". c #8686ADAD7D7D", +"X c #919187876969", +"o c #C2C2B9B99C9C", +"O c #A8A8F0F0ECEC", +"+ c #EFEFEFEFEFEF", +" ", +" .... . ", +" .. .. . ", +" ............. ", +" . . . .... ", +" ............. ", +" .............. .. ", +" . . .......... . ", +" .XXXX... .. ", +" o.XXX. . .. ", +" oo.X. .. ... ", +" ooX. . ... ", +" oXo. .. ", +" ooX . . ", +" ooX ", +"OOOOoXXOOOOOOOOOOOOOOOOO", +"OOOoXoXOOOOOOOOOOOOOOOOO", +"OOOooXXOOOO+OOOOOOOOOOOO", +"O+OoooXOO+OOO+OO+OOO+OOO", +"OXXoXoXoXOO++O++OO++OO+O", +"XXXXXXXXXXXX+OOOOOOOOOOO", +"XXXXXXXXXXXXXX+O++OO++OO", +"XXXXXXXXXXXXXXXXOOOOOOOO", +"O++O++++O+OO++OOOO++OOO+"}; diff --git a/etc/gnus/exit-summ.pbm b/etc/gnus/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/etc/gnus/exit-summ.xpm b/etc/gnus/exit-summ.xpm new file mode 100644 index 0000000..5234ccb --- /dev/null +++ b/etc/gnus/exit-summ.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * exit_summ_xpm[] = { +"24 24 3 1", +". c None", +" c #000000000000", +"X c #E1E1E0E0E0E0", +" .. .. .. .. .. .. .. ..", +"........................", +"........................", +" .. .. .. ..", +"...... XXXX .....", +"...... XXXXXXX .....", +" .. .. XX XX XX .. ..", +"...... XXXXXXXX .....", +"...... XXXXXXX .....", +" .. .. X XX .. ..", +"...... XXXX .....", +"...... XXXX .....", +" .. .. X XXXXX .. ..", +"...... XXXXXXX .....", +"...... XXXXX XX .....", +" .. .. X XXXXX .. ..", +"...... XXXXX .....", +"...... X .....", +" .. . . .. ..", +"........................", +"........................", +" .. .. .. .. .. .. .. ..", +"........................", +"........................"}; diff --git a/etc/gnus/followup.pbm b/etc/gnus/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#VTB28I|0Q4R(U5e7m1|F2y`LKzqs0K2vjGynhq literal 0 HcmV?d00001 diff --git a/etc/gnus/kill-group.xpm b/etc/gnus/kill-group.xpm new file mode 100644 index 0000000..1ee4fa4 --- /dev/null +++ b/etc/gnus/kill-group.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * kill_group_xpm[] = { +"24 24 3 1", +". c None", +"o c #000000000000", +"+ c #9A9A6C6C4E4E", +"o..o..o..o..o..o..o..o..", +"........................", +"........................", +"o..o..o..o..o..o..o..o..", +"........................", +"........................", +"o..o..o..o..++.o..o..o..", +".......++..++++.........", +"........++.+++..........", +"o..o..o.+++++..o..o..o..", +".........+++............", +".........++++...........", +"o..o..o.++++++.o..o..o..", +"........++.++++.........", +".......++...++++........", +"o..o...+.o...++o..o..o..", +"........................", +"........................", +"o..o..o..o..o..o..o..o..", +"........................", +"........................", +"o..o..o..o..o..o..o..o..", +"........................", +"........................"}; diff --git a/etc/gnus/mail-reply.pbm b/etc/gnus/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*v$E&(A-7Zex;1h_N| j1Y86h8aNzSB-EKV1h_Z|cqj-2C`fQ9xUybhVQ>Hd!Ws;4 literal 0 HcmV?d00001 diff --git a/etc/gnus/next-ur.xpm b/etc/gnus/next-ur.xpm new file mode 100644 index 0000000..bea1328 --- /dev/null +++ b/etc/gnus/next-ur.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * next_ur_xpm[] = { +"24 24 8 1", +". c None", +" c #000000000000", +"X c #A5A5A5A59595", +"o c #C7C7C6C6C6C6", +"O c #FFFF00000000", +"+ c #9A9A6C6C4E4E", +"@ c #E1E1E0E0E0E0", +"# c #FFFFFFFFFFFF", +" .. .. .. .. .. .. .. ..", +"........................", +"............X...........", +" .. .. .. .XXX. .. .. ..", +".........XXooOX.........", +".......XXooo+O@X........", +" .. XXXoooo++@@@X. .. ..", +"....X@Xoooooo@@@X.......", +"....X@@Xooo@@@@@@X......", +" .. X@@XXoo@@@@@@@X.. ..", +"....X@@Xoo@@@@@@@@@X....", +"....X@Xo@@@XX@@@@@@oX...", +" .. oXoo@XXooO@@@@@@X ..", +"....oXoXXooo+OX@@@@Xo...", +"....XXXoooo++@@X@@Xo....", +" .. X@Xoooooo@@@XX .. ..", +"....X@@Xooo@@@@@@X......", +"....X@@XXoo@@@@@@@X.....", +" .. X@@Xoo@@@@@@@@@X. ..", +"....X@Xo@ @@@@@@@ X...", +"... oXoo ## @@ @@ ## ...", +" .. oXo #### @ #### ..", +".....oX #### @@@ #### ..", +".....oX@ ## @@@@X ## ..."}; diff --git a/etc/gnus/oort.xface b/etc/gnus/oort.xface new file mode 100644 index 0000000..6444b55 --- /dev/null +++ b/etc/gnus/oort.xface @@ -0,0 +1,3 @@ +X-Face: $BP*2z+\?fNM."!*~JsIgw(Y]n?WG!KMc;^jL$SLrt@X4%uMguO/$3HO<5@43P@[~'kE'fG + #YdP[sb6IJ5|Sm[z#9sI|)iJ})U5;Rt-?jI3i24zoJmonTV}kTVOm/5wMCnc3P~d#+BF1c&N6mdF{u + CE+<;lN!v~JRyR"q0d5<\y]faXpTC4,wpQ{=<==?LRA`}3qqIgr diff --git a/etc/gnus/post.pbm b/etc/gnus/post.pbm new file mode 100644 index 0000000000000000000000000000000000000000..577d6236bfd0412cf6e0ae63c26a949e292638af GIT binary patch literal 81 zcmWGA;W9E&Ff!p1WE5afU}69QK8C(E({?|3<|;w2Fwgb fj0^${4IF_D5)2Lnj*c!I>I@7rAbo)@B0v%Vy;usB literal 0 HcmV?d00001 diff --git a/etc/gnus/post.xpm b/etc/gnus/post.xpm new file mode 100644 index 0000000..7a3eaa5 --- /dev/null +++ b/etc/gnus/post.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * post_xpm[] = { +"24 24 8 1", +". c None", +" c #434343434343", +"X c #A5A5A5A59595", +"O c #000000000000", +"+ c #C7C7C6C6C6C6", +"@ c #FFFF00000000", +"# c #9A9A6C6C4E4E", +"$ c #E1E1E0E0E0E0", +"O..O..O..O..O..O..O..O..", +"........................", +"............X...........", +"O..O..O..O.XXX.O..O..O..", +".........XX++@X.........", +".......XX+++#@$X........", +"O..OXXX++++##$$$X.O..O..", +"....X$X++++++$$$X.......", +"....X$$X+++$$$$$$X......", +"O..OX$$XX++$$$$$$$X..O..", +"....X$$X++$$$$$$$$$X....", +"....X$X+$$$$$$$$$$$+X...", +"O..O+X++$$$$$$$$$$$$XO..", +"....+X+$$$$$$$$$$$$X+...", +".....+X$$$$$$$$$$$X+....", +"O..O.+X$$$$$$$$$XXO..O..", +"......+X$$$$$$$X++......", +"......+X$$$$$XX+........", +"O..O..O+X$$$X++O..O..O..", +".......+X$$X++..........", +"........+XX+............", +"O..O..O..O+.O..O..O..O..", +"........................", +"........................"}; diff --git a/etc/gnus/prev-ur.pbm b/etc/gnus/prev-ur.pbm new file mode 100644 index 0000000000000000000000000000000000000000..49389198bdfe19f91dada91a4525e35083e4c3df GIT binary patch literal 81 zcmWGA;W9E&Ff!p1WE5avU}69QK8C*v%E&(BI7iNeGvT$j$ d2>7x%G|X^d2~c2a2w-Fo03(nZh7cA82LRz}3_<_^ literal 0 HcmV?d00001 diff --git a/etc/gnus/prev-ur.xpm b/etc/gnus/prev-ur.xpm new file mode 100644 index 0000000..8013133 --- /dev/null +++ b/etc/gnus/prev-ur.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * prev_ur_xpm[] = { +"24 24 8 1", +". c None", +" c #000000000000", +"X c #A5A5A5A59595", +"o c #C7C7C6C6C6C6", +"O c #FFFF00000000", +"+ c #9A9A6C6C4E4E", +"@ c #E1E1E0E0E0E0", +"# c #FFFFFFFFFFFF", +" .. .. .. .. .. .. .. ..", +"........................", +"............X...........", +" .. .. .. .XXX. .. .. ..", +".........XXooOX.........", +".......XXooo+O@X........", +" .. XXXoooo++@@@X. .. ..", +"....X@Xoooooo@@@X.......", +"....X@@Xooo@@@@@@X......", +" .. X@@XXoo@@@@@@@X.. ..", +"....X@@Xo @@@@@@ X....", +"....X@Xo ## X @ ## X...", +" .. oXo #XXXoO@ #### ..", +"....oXoXXooo+OX #### ...", +"....XXXoooo++@@X ## ....", +" .. X@Xoooooo@@@X .. ..", +"....X@@Xooo@@@@@@X......", +"....X@@XXoo@@@@@@@X.....", +" .. X@@Xoo@@@@@@@@@X. ..", +"....X@Xo@@@@@@@@@@@@X...", +"... oXoo@@@@@@@@@@@@X...", +" .. oXo@@@@@@@@@@@@X....", +".....oX@@@@@@@@@@@X.....", +".....oX@@@@@@@@@@X......"}; diff --git a/etc/gnus/preview.xbm b/etc/gnus/preview.xbm new file mode 100644 index 0000000..a42e153 --- /dev/null +++ b/etc/gnus/preview.xbm @@ -0,0 +1,10 @@ +#define preview_width 24 +#define preview_height 24 +static char preview_bits[] = { + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xc0,0x03,0x00,0x3e,0x06,0xf0,0x03,0x04,0x08,0x00,0x0a,0x78,0x00,0x09, + 0x88,0xf9,0x08,0x10,0xc6,0x10,0x10,0x3a,0x13,0x10,0x06,0x15,0x20,0x02,0x29, + 0x20,0x02,0x31,0x20,0xad,0x0f,0x40,0xf9,0x03,0xc0,0xb8,0x07,0x80,0x07,0x0e, + 0x80,0x01,0x1c,0x00,0x00,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc8,0x00, + 0x00,0x00,0x39,0x00,0x00,0x00,0x08,0xc0,0x12,0x42,0x00,0x00,0x00,0x00,0x38, + 0x82,0x18,0x08,0x00,0x00,0x00 }; diff --git a/etc/gnus/preview.xpm b/etc/gnus/preview.xpm new file mode 100644 index 0000000..f5743f9 --- /dev/null +++ b/etc/gnus/preview.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char *prev1[]={ +"24 24 6 1", +". c None", +"# c #000000", +"d c #46463e", +"a c #676663", +"c c #a8a7a3", +"b c #ebeae4", +"........................", +"........................", +"........................", +"........................", +"........................", +"..............####......", +".........#####abbc#.....", +"....#####acbbbbbbc#.....", +"...#acbbbbbbbbbbacc#....", +"...#baabbbbbbbbcacb#....", +"...#cbcaabbd##dacbb#....", +"....#bbbccdcbbcdabbc#...", +"....#bbbbdccaaccdacb#...", +"....#cbbb#abbbbb#bac#...", +".....#bbb#cbbbbc#bbac#..", +".....#bbbdcbbbbddbbc##..", +".....#cbccdcbbd#####....", +"......#babbd##dd##......", +"......#acbc###.####.....", +"......#aa##......###....", +".......##.........###...", +"...................##...", +"........................", +"........................"}; diff --git a/etc/gnus/receipt.xpm b/etc/gnus/receipt.xpm new file mode 100644 index 0000000..18caaf1 --- /dev/null +++ b/etc/gnus/receipt.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * receipt_xpm[] = { +"24 24 5 1", +" c None", +". c #FFFFFFFFFFFF", +"X c #676766666363", +"o c #FFFF00000000", +"O c #AEAE3E3E4848", +" ", +" ", +" .. ", +" . ", +" . ", +" . ", +" .. ", +" Xooo .. ", +" Xoooooooo.. ", +" Xoooooooooooooo ... ", +" oooooooooooOOoo . ", +" ooooooooooOOOOo. ", +" oooooooooOO...o ", +" ooooooooooOOooo ", +" ooooooooooooooo ", +" ooooooooooooooo ", +" oooooooooooooo ", +" ooooooooooo ", +" ooooooo ", +" oooo ", +" oo ", +" ", +" ", +" "}; diff --git a/etc/gnus/reply-wo.pbm b/etc/gnus/reply-wo.pbm new file mode 100644 index 0000000000000000000000000000000000000000..def54da8ede20b0f152e8ff1fd0b7b9b40450b53 GIT binary patch literal 81 zcmWGA;W9E&Ff!p{fCD}T22lnEg$70k2c`}MQT75O3lG--7dypSuFft@$C?~`Sr~Gd c90gez8JJucTsRn%3K&Eb7}!EXLx5%g0Na@iO8@`> literal 0 HcmV?d00001 diff --git a/etc/gnus/reply-wo.xpm b/etc/gnus/reply-wo.xpm new file mode 100644 index 0000000..370678a --- /dev/null +++ b/etc/gnus/reply-wo.xpm @@ -0,0 +1,31 @@ +/* XPM */ +static char * reply_wo_xpm[] = { +"24 24 4 1", +" c None", +". c #000000000000", +"X c #E1E1E0E0E0E0", +"O c #FFFFFFFFFFFF", +" ", +" ", +" ", +" .... ", +" ..X.... ", +" ..XX.XX.. ", +" .O.XX.XXXX.. ", +" ..O.XXX.XXXX... ", +" .OO.XXXX.X....... ", +" .OO.XXXX...XXX.OO.. ", +" ..OO.XX....XXXX.OOOO.. ", +" .......XX.XXXX.OOO.... ", +" .OOO.XXX.XXXX.OO..OOO. ", +" .OOOO....XXX....OOOOO. ", +" .OOOOOOO..XX..OOOOOOO. ", +" .OOOOOOO......OOOOOOO. ", +" .OOOOOO.OO..O..OOOOOO. ", +" .OOOOO.OOOOOOOO.OOOOO. ", +" .OOOO.OOOOOOOOOO.OOOO. ", +" .OOO.OOOOOOOOOOOO.OOO. ", +" .O..OOOOOOOOOOOOOO..O. ", +" ..OOOOOOOOOOOOOOOOOO.. ", +" ...................... ", +" "}; diff --git a/etc/gnus/reply.pbm b/etc/gnus/reply.pbm new file mode 100644 index 0000000000000000000000000000000000000000..ee181e663be77954bc10f855f980a40f8ebd3749 GIT binary patch literal 81 zcmWGA;W9E&Ff!p{KnAP~3dOJ Z7#Wyc7+g3QlnNL`6cp4#LqmXO006{n3oL52pfFfg&W28Qsz QS`mMMLH`wl{2h=H07hpDvj6}9 literal 0 HcmV?d00001 diff --git a/etc/gnus/save-aif.xpm b/etc/gnus/save-aif.xpm new file mode 100644 index 0000000..f0325ac --- /dev/null +++ b/etc/gnus/save-aif.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * save_aif_xpm[] = { +"24 24 6 1", +" c None", +". c #999999999999", +"X c #E1E1E0E0E0E0", +"o c #C7C7C6C6C6C6", +"O c #000000000000", +"+ c #FFFFFFFFFFFF", +" ", +" ", +" ............. ", +" .XXXXXXXXXX.X.. ", +" .XXXXXXXXXX.XX. ", +" .XXXXXXXXXX.... ", +" .XXXXXXXXXXooo. ", +" .XXXXXXXXXXXXX. ", +" .XXXXXXXXXXXXX. ", +" .XXXXXXXXXXXXX. ", +" OOOOOOOOOOOOOOXXXXXX. ", +" O..O+++++++O.OXXXXXX. ", +" O..O+++++++O.OXXXXXX. ", +" O..O+++++++O.OXXXXXX. ", +" O..O+++++++O.OXXXXXX. ", +" O..O+++++++O.OXXXXXX. ", +" O..OOOOOOOOO.OXXXXXX. ", +" O............OXXXXXX. ", +" O............OXXXXXX. ", +" O..OOOOOOOOO.O....... ", +" O..OoooooO++.O ", +" O..OoooooO++.O ", +" O.OoooooO++.O ", +" OOOOOOOOOOOO "}; diff --git a/etc/gnus/save-art.pbm b/etc/gnus/save-art.pbm new file mode 100644 index 0000000000000000000000000000000000000000..68fe0cb309873313e4960a10b3acd43a730879ea GIT binary patch literal 81 zcmWGA;W9E&Ff!p{00Y+0P&NiORtG^A11Ad j1PojS1T`jbg$4+62?)f1#5qI+1oi*Fb`1$-U|;|M?wb*{ literal 0 HcmV?d00001 diff --git a/etc/gnus/subscribe.xpm b/etc/gnus/subscribe.xpm new file mode 100644 index 0000000..ff193a9 --- /dev/null +++ b/etc/gnus/subscribe.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * subscribe_xpm[] = { +"24 24 5 1", +" c None", +". c #A5A5A5A59595", +"X c #E1E1E0E0E0E0", +"o c #C7C7C6C6C6C6", +"O c #8686ADAD7D7D", +" ", +" ", +" ", +" ... ", +" ..XXX..... ", +"...XXXXX..XXX. ... ", +".X.XX...XXXX...XXX. ", +".XX.X.X.XX...XXXXX. ", +".XX...XX.X.X.XXXXXX. ", +".XX.o.XX...XX.XXXXXX. ", +".X.oo.XX.o.XX..XXXXXX. ", +"o.ooo.X.oo.XX.XXXOXXX. ", +"o.oXXo.ooo.X.oXXOXXXXX. ", +" o.XXo.oXXo.ooXXOXXXXX. ", +" o.XXXo.XXo.oXXXOXXXXXX.", +" o.XXo.XXXo.XOOOOXXXXX.", +" o.XXoo.XXo.XXXOOXXXXX.", +" o.XXo.XXXo.XXXXXXX...", +" o.XX.o.XXo.XXXXXX.oo ", +" o..oo.XX.o.XXX..o ", +" oo o..oo.XX.oo ", +" oo o..o ", +" oo ", +" "}; diff --git a/etc/gnus/unimportant.xpm b/etc/gnus/unimportant.xpm new file mode 100644 index 0000000..4298224 --- /dev/null +++ b/etc/gnus/unimportant.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 2 1", +"! c blue", +"w c Gray75", +/* pixels */ +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"ww!!!wwwwww!!!wwwwww!!!w", +"www!!!wwwww!!!wwwww!!!ww", +"wwww!!!wwww!!!wwww!!!www", +"wwwww!!!www!!!www!!!wwww", +"wwwwww!!!ww!!!ww!!!wwwww", +"wwwwwww!!!w!!!w!!!wwwwww", +"wwwwwwww!!!!!!!!!wwwwwww", +"wwwwwwwww!!!!!!!wwwwwwww", +"wwwwwwwwww!!!!!wwwwwwwww", +"wwwwwwwwwww!!!wwwwwwwwww", +"wwwwwwwwwwwwwwwwwwwwwwww", +"wwwwwwwwwwwwwwwwwwwwwwww" +}; diff --git a/etc/gnus/unsubscribe.pbm b/etc/gnus/unsubscribe.pbm new file mode 100644 index 0000000000000000000000000000000000000000..7d869fb53fe7eac710c7d1a3af7ef5b72396e232 GIT binary patch literal 81 zcmWGA;W9E&Ff!o^6%AEjVsaI6)c=1vL@ +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.24 is released. + +2003-05-01 Lars Magne Ingebrigtsen + + * dgnushack.el (when): Check whether defadvice is fbound. + +2003-05-01 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-unregistered-group-regex): new variable + (gnus-registry-register-message-ids): use it + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + + * gnus.el: Update copyright for several files. + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.23 is released. + +2003-05-01 Lars Magne Ingebrigtsen + + * spam-stat.el (spam-stat-test-directory): Compare against zero. + +2003-05-01 Trey Jackson (tiny change) + + * spam-stat.el (spam-stat-test-directory): Skip 0 length files. + +2003-05-01 Lars Magne Ingebrigtsen + + * message.el (message-forward-subject-name-subject): Decode + string when forwarding. + +2003-05-01 Oystein Viggen + + * dgnushack.el (when): Add defadvice. + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.22 is released. + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.21 is released. + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.20 is released. + +2003-05-01 Vasily Korytov + + * gnus-dired.el (gnus-dired-mode-map): Move to C-c C-l. + +2003-04-30 Mark A. Hershberger + + * mm-url.el (mm-url-insert-file-contents): set url-current-object + in the case where mm-url-use-external is set. + + * nnrss.el (nnrss-request-article): Change the messages created to + multipart/alternative. Hopefully fixes a problem interaction with + w3m. + (nnrss-find-rss-via-syndic8): Better handling if xml-rpc.el isn't + around. + +2003-05-01 Lars Magne Ingebrigtsen + + * message.el (message-check-news-header-syntax): Alter "posting" + message. + + * nnrss.el (nnrss-node-text): Don't use char classes. + +2003-05-01 David Z. Maze + + * nnrss.el (nnrss-find-rss-via-syndic8): Have an `error' branch + in condition-case. + +2003-05-01 Lars Magne Ingebrigtsen + + * message.el (message-required-headers): Remove In-Reply-To. + + * gnus-int.el (gnus-open-server): Revert changes. + +2003-04-30 Kai Gro,A_(Bjohann + + * gnus-int.el (gnus-open-server): Try to open unagentized servers + even when unplugged. + +2003-04-30 Reiner Steib + + * gnus-art.el (gnus-button-prefer-mid-or-mail): Fixed typo in + doc-string. + +2003-05-01 Steve Youngs + + * lpath.el: Add a section for non-Mule XEmacsen. + fbind `find-charset-string' and `coding-system-base' in that + section. + + * gnus-util.el (gnus-completing-read-maybe-default): New. + (gnus-completing-read): Use it. + + * mm-view.el (mm-view-pkcs7-decrypt): Ditto. + + * gnus-art.el (gnus-read-string): New. + (gnus-summary-pipe-to-muttprint): Use it. + + * gnus-xmas.el (gnus-xmas-open-network-stream): New. + + * dns.el (dns-make-network-process): Use it. + + Take care of some differences between XEmacs 21.1 and newer + versions of XEmacs. + +2003-04-30 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): added + diagnostic message + (gnus-registry-grep-in-list): don't run when word is nil + (gnus-registry-fetch-message-id-fast): new function + (gnus-registry-delete-group, gnus-registry-add-group): make sure + the id and group are not nil + (gnus-registry-register-message-ids): new function + (gnus-register-action): optimized logical flow + (gnus-summary-prepare-hook): added gnus-registry-register-message-ids + +2003-04-30 Kai Gro,A_(Bjohann + + * gnus-delay.el (gnus-delay-article): Call + `gnus-agent-queue-setup' to create the delay group. + + * gnus-agent.el (gnus-agent-queue-setup): Support optional arg + for the (queue) group name. + +2003-04-30 Simon Josefsson + + * mm-util.el (mm-charset-to-coding-system): Use user specified + charset unless coding-system-get is fboundp. + +2003-04-30 Kevin Greiner + + * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-name): + Wrapped in eval-when-compile. + (gnus-agent-mode): Bind gnus-agent-go-online to nil as you + shouldn't be asked twice to go online with each server. + (gnus-agent-get-undownloaded-list, gnus-agent-fetch-articles, + gnus-agent-crosspost, gnus-agent-flush-cache, + gnus-agent-fetch-session, gnus-agent-unread-articles, + gnus-agent-uncached-articles, gnus-agent-regenerate-group, + gnus-agent-group-covered-p): Expanded pop macros used for + effect. Avoids compilation warning in emacs 21.3. + + * gnus-int.el (gnus-open-server): Restructured to only open + nnagent when gnus-plugged is nil. + +2003-04-30 Katsumi Yamaoka + + * lpath.el: Fbind string-to-multibyte. + +2003-04-30 Steve Youngs + + * dgnushack.el: Add some missing autoloads for XEmacs 21.1. + +2003-04-29 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-fetch-group): faster + (gnus-registry-delete-group): new function + (gnus-registry-add-group): new function + (gnus-register-spool-action): use it + (gnus-register-action): use it + (gnus-registry-translate-from-alist) + (gnus-registry-translate-to-alist): remove the headers registry + for now + +2003-04-29 Reiner Steib + + * gnus-art.el (gnus-button-alist): Fixed CTAN regexp. + +2003-04-29 Teodor Zlatanov + + * spam-report.el (spam-report-gmane): gnus-summary-article-number + is not necessary, just use the function parameter + +2003-04-29 Karl Pflysterer + + * spam-stat.el (spam-stat-save): No longer font-locks the file + when saving + +2003-04-29 Katsumi Yamaoka + + * canlock.el: Bind mail-header-separator when compiling (XEmacs + provides it in mail-lib/auto-autoloads.el). + +2003-04-29 Simon Josefsson + + * mml2015.el (mml2015-pgg-sign): Use mml-sender instead of + message-sender. + + * mml.el (mml-generate-mime-1): Set mml-sender too. + +2003-04-29 Jesper Harder + + * gnus-sum.el (gnus-summary-display-while-building): Docstring fix. + + * mm-url.el (mm-url-use-external): do. + +2003-04-29 Simon Josefsson + + * canlock.el (mail-fetch-field): Autoload it (fix xemacs compile + warnings). + + * sieve-mode.el (c-mode): Ditto. + + * pgg.el (run-at-time): Ditto. + + * mm-url.el (require): Require timer when compiling for + with-timeout macro (fix xemacs compile warnings). + +2003-04-28 Dave Love + + * gnus-util.el (nnheader): Don't require. + (Nnheader-narrow-to-headers, nnheader-replace-chars-in-string): + Autoload. + + * spam.el: Require cl when compiling. + + * dns.el: Require cl when compiling. + +2003-04-28 Jesper Harder + + * gnus-art.el (gnus-article-goto-next-page) + (gnus-article-goto-prev-page): Revert 2003-02-12 change to make + gnus-pick-mode work. + +2003-04-28 Steve Youngs + + * Makefile.in (FLAGS): Use @FLAGS@. + +2003-04-27 Reiner Steib + + * gnus-art.el (gnus-mime-display-multipart-as-mixed) + (gnus-mime-display-multipart-alternative-as-mixed) + (gnus-mime-display-multipart-related-as-mixed): Added doc-strings, + allow customization. + +2003-04-27 Kevin Greiner + + * dgnushack.el (dgnushack-compile-verbosely): New function. Not + currently called (See source for explanation). + +2003-04-27 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages. + (gnus-summary-mark-read-and-unread-as-read): Take an optional + mark. + + * gnus.el (gnus-version-number): Bump. + +2003-04-27 06:47:31 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.19 is released. + +2003-04-27 Kevin Greiner + + * gnus-registry.el (gnus-register-spool-action): Replaced literal + carriage-return character with its escape sequence. + +2003-04-27 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-catchup-from-here): Doc fix. + + * nnrss.el (nnrss-node-text): Use only one + gnus-replace-in-string. + + * gnus.el: Remove gnus-functionp throughout. + + * gnus-util.el (gnus-functionp): Removed. + + * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix. + + * message.el (message-required-headers): Add In-Reply-To. + +2003-04-27 Marshall T. Vandegrift + + * gnus-fun.el (gnus-face-from-file): Bind coding-system-for-read + to binary. + +2003-04-27 Jesper Harder + + * mml.el (mml-preview): do. + + * message.el (message-mode): do. + + * gnus-undo.el (gnus-undo-mode): do. + + * gnus-topic.el (gnus-topic-mode): do. + + * gnus-sum.el (gnus-summary-mode, gnus-summary-edit-article): do. + + * gnus-msg.el (gnus-setup-message) + (gnus-inews-add-send-actions, gnus-configure-posting-styles): do. + + * gnus-gl.el (gnus-grouplens-mode): do. + + * gnus-art.el (gnus-mime-save-part-and-strip) + (gnus-mime-delete-part): Use it. + + * gnus-util.el (gnus-make-local-hook): New function. + +2003-04-25 Simon Josefsson + + * nnrss.el (nnrss-node-text): Don't use a star. + (nnrss-node-text): Use g-r-i-s, not g-r-r-i-s which doesn't exist. + +2003-04-24 Dave Love + + * mm-encode.el (mm-long-lines-p): Autoload. + (mm-encode-content-transfer-encoding): Don't try to make buffer + unibyte before decoding. Don't ignore errors for base64 encoding. + + * qp.el (quoted-printable-decode-region): Use mm-insert-byte. + Signal error on malformed text, as for base64. + (quoted-printable-encode-region): DTRT in Emacs 22. + + * mm-util.el (mm-make-temp-file, mm-insert-byte): New. + (mm-auto-save-coding-system): Consider utf-8-emacs. + (mm-mime-mule-charset-alist, mm-mule-charset-to-mime-charset) + (mm-charset-to-coding-system, mm-mime-charset) + (mm-find-mime-charset-region): Check for :mime-charset coding + systems property. + + * mml-sec.el (mml2015, mml1991): Don't require. + (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt) + (message-goto-body, mml-insert-tag): Autoload. + + * mm-decode.el (mm-tmp-directory): Re-write to help avoid warnings. + + * gnus-start.el (message-make-date): Autoload rather than + requiring message. + + * gnus-group.el (gnus-group-name-charset-group-alist): Use + mm-coding-system-p. + (gnus-cache-active-altered): Defvar when compiling. + (gnus-group-delete-group): Re-write to help avoid warnings. + + * gnus-art.el (gnus-use-idna): Use mm-coding-system-p. + + * pgg.el: Split eval-when-compile forms. + +2003-04-24 Reiner Steib + + * gnus-group.el (gnus-large-ephemeral-newsgroup) + (gnus-fetch-old-ephemeral-headers): News variables. + (gnus-group-read-ephemeral-group): Use them. + +2003-04-24 Simon Josefsson + + * sieve.el (sieve-upload): Don't use replace-regexp-in-string. + + * nnrss.el (nnrss-node-text): Ditto. + +2003-04-24 Katsumi Yamaoka + + * gnus-msg.el (gnus-inews-do-gcc): Make sure the obsolete variable + gnus-inews-mark-gcc-as-read exists. + +2003-04-23 Simon Josefsson + + * gnus-sieve.el (gnus-sieve-generate): Rewrite regexp search so it + doesn't exceed the regexp stack space. + +2003-04-23 Jesper Harder + + * gnus-msg.el (gnus-inews-mark-gcc-as-read): Don't defvar it. + + * gnus-art.el (gnus-article-hide-pgp-hook): do. + +2003-04-23 Reiner Steib + + * mml.el (mml-preview): Bind `=', RET, and mouse-2. + +2003-04-23 Jesper Harder + + * mm-bodies.el (mm-decode-body): Don't override supplied charset. + +2003-04-23 Katsumi Yamaoka + + * dgnushack.el (merge, copy-list): Remove compiler macros. + (butlast): Add a compiler macro. + +2003-04-22 Paul Jarc + + * gnus-util.el (gnus-merge): Added "type" argument to match CL + merge and gnus-sum.el's expectations. + +2003-04-21 Reiner Steib + + * gnus-art.el (gnus-button-url-regexp): Added nntp. + + * message.el (message-generate-headers-first): Default to + '(references). + + * gnus-art.el (gnus-mime-delete-part): Require confirmation. + +2003-04-21 Jesper Harder + + * smime.el (smime-decrypt-region): Insert From header. + +2003-04-21 Kai Gro,A_(Bjohann + + * gnus-fun.el (gnus-face-from-file, gnus-convert-png-to-face): + Max length of header is 726, not 740. From Gaute B Strokkenes + . + +2003-04-20 Jesper Harder + + * nndb.el, mml1991.el: Fix license template. + +2003-04-20 Simon Josefsson + + * nnimap.el (nnimap-split-articles): Don't download body unless + required. + + * imap.el (imap-gssapi-open, imap-ssl-open): Erase buffer before + starting process, like imap-kerberos4-open does. + + * mml-smime.el, rfc1843.el, dig.el, smime.el, uudecode.el: Fix + license template. + + * mml-sec.el: Fix license template. + + * gnus-sieve.el, sieve.el, sieve-manage.el, sieve-mode.el: Fix + license template. + + * pgg-def.el, pgg.el, pgg-gpg.el, pgg-parse.el, pgg-pgp5.el, + pgg-pgp.el: Fix license template. + +2003-04-19 Jesper Harder + + * gnus-sum.el (gnus-summary-delete-article): Improve docstring. + +2003-04-19 Teodor Zlatanov + + * spam.el (spam-move-spam-nonspam-groups-only): dumb typo fix + +2003-04-18 Teodor Zlatanov + + * spam.el (spam-split): allow a particular check as a parameter, + e.g. (: spam-split 'spam-use-bogofilter) + (spam-mark-only-unseen-as-spam): new parameter, see doc + (spam-mark-junk-as-spam-routine): use + spam-mark-only-unseen-as-spam, simplify routine to take advantage + of gnus-newsgroup-unread as well as gnus-newsgroup-unseen + +2003-04-17 Teodor Zlatanov + + * gnus.el (gnus-group-short-name, gnus-group-prefixed-p): new functions + (gnus-group-guess-full-name): don't prefix the group twice + + * nnmail.el (nnmail-split-fancy-with-parent): docstring fix + + * gnus-registry.el (gnus-registry-clear) + (gnus-registry-fetch-group, gnus-registry-grep-in-list) + (gnus-registry-split-fancy-with-parent): new functions + (gnus-register-spool-action, gnus-register-action): simplified the format + (gnus-registry): new customization group + (gnus-registry-unfollowed-groups): new variable + +2003-04-17 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-alist): Add nntp: urls. + (gnus-header-button-alist): Ditto. + +2003-04-17 Dave Love + + * gnus-util.el (gnus-string-equal): Revert last change. + +2003-04-17 Lars Magne Ingebrigtsen + + * gnus-srvr.el (gnus-browse-make-menu-bar): Fix typo. + +2003-04-17 Mike Woolley + + * gnus-sum.el (gnus-sum-thread-tree-false-root): New variable. + +2003-04-15 Michael Shields + + * gnus-art.el (article-hide-boring-headers): Hide Reply-To: if + the broken-reply-to group parameter is set. Idea from Vasily + Korytov . + +2003-04-17 Steve Youngs + + * dgnushack.el: 'setenv' is in env.el for XEmacsen <= 21.4, but in + process.el in XEmacsen >= 21.5. + +2003-04-17 Steve Youngs + + * dgnushack.el: Add a whole swag of autoloads and defaliases to + satisfy the byte-compiler when building with XEmacs. + + * lpath.el (maybe-bind): Add 'w3-meta-content-type-charset-regexp' + and 'w3-meta-charset-content-type-regexp' in XEmacs. The upstream + W3 doesn't have these. + + * mailcap.el: Maybe require 'lpr in XEmacs. + +2003-04-16 Simon Josefsson + + * mml2015.el (mml2015-pgg-sign): Bind pgg-default-user-id to MML + sender tag, if available. + +2003-04-16 Teodor Zlatanov + + * gnus-registry.el (gnus-register-action) + (gnus-register-spool-action, hashtable-to-alist) + (gnus-registry-translate-from-alist, alist-to-hashtable) + (gnus-registry-translate-to-alist, gnus-registry-headers-hashtb): + new variables and function fixes + + * gnus.el (gnus-registry-headers-alist): new variable to hold + article header data + (gnus-variable-list): save gnus-registry-headers-alist + + * spam-report.el (Module): new module for spam reporting + + * gnus.el (spam-process): added + gnus-group-spam-exit-processor-report-gmane to the list of choices + (gnus-install-group-spam-parameters): defined new spam exit processor + + * spam.el (autoload): autoload spam-report-gmane when needed + (spam-report-gmane-register-routine): glue for spam-report.el + (spam-group-spam-processor-report-gmane-p): glue for the + gnus-group-spam-exit-processor-report-gmane spam processor + (spam-summary-prepare-exit): check the report-gmane spam processor + and run spam-report-gmane-register-routine if it's active + + From John Wiegley + + * spam.el (spam-bogofilter-score): check bogofilter headers before + checking bogofilter itself + +2003-04-16 Dave Love + + * gnus-agent.el: Wrap defsetf in eval-when-compile. + (gnus-agent-cat-defaccessor): Don't use gensym. + + * mml1991.el: Require cl, mm-util when compiling. + (quoted-printable-decode-region, quoted-printable-encode-region): + Autoload. + + * pgg.el: Require cl when compiling. + + * nnmail.el (gnus): Require. + + * gnus-util.el: Move provide to end. + (gnus-string-equal): Maybe use compare-strings. + (gnus-merge): New. + + * gnus-sum.el (gnus-summary-prepare-threads): Don't use copy-list. + (gnus-summary-insert-articles): Use gnus-merge. + + * gnus-fun.el: Require cl and mm-util when compiling. + + * gnus-diary.el (gnus-diary-delay-format-french) + (gnus-diary-delay-format-english): Don't use setf with nthcdr. + + * nndiary.el (nndiary-compute-reminders): Don't use setf with + nthcdr. + +2003-04-16 Kevin Greiner + + * gnus-agent.el (gnus-agent-make-cat): Added optional parameter to + specify a predicate other than false. + (gnus-category-read): Use the new feature to create a 'default' + category with a 'short' predicate. + +2003-04-16 Lars Magne Ingebrigtsen + + * message.el (message-unique-id): Comment change. + + * gnus-art.el (gnus-article-next-page-1): New function. + (gnus-article-next-page): Use it. + +2003-04-15 Teodor Zlatanov + + * spam.el (spam-split): added save-restriction to save-excursion + +2003-04-15 Reiner Steib + From Julien Avarre + + * gnus-fun.el: Fixed autoload cookie. + +2003-04-15 Paul Jarc + From Remi Letot + + * nnmaildir.el (nnmaildir-request-scan): Use gnus-remove-if + instead of remove-if. + +2003-04-14 Katsumi Yamaoka + + * gnus-msg.el (gnus-summary-news-other-window): Use delq and + copy-sequence instead of remove which is a cl run-time function in + Emacs 20. + +2003-04-14 Jesper Harder + + * gnus-msg.el (gnus-summary-news-other-window): Make a buffer + local copy of gnus-discouraged-post-methods with the current + method removed. + +2003-04-14 Simon Josefsson + + * mailcap.el (mailcap-mime-data): Add application/pgp-keys. + +2003-04-13 Reiner Steib + + * mm-util.el (mm-sort-coding-systems-predicate): Convert elements + of `mm-coding-system-priorities' to base coding system. + + * gnus-sum.el: Added coding cookie ("middle dot" in + gnus-summary-morse-message). + +2003-04-13 Simon Josefsson + + * gnus-art.el (article-fill-long-lines) + (article-verify-x-pgp-sig, article-decode-group-name) + (gnus-mime-button-menu): Split >80 character lines. + +2003-04-13 Jesper Harder + + * gnus-sum.el (gnus-summary-local-variables): Use defvar since + we're let-binding it. + + * nnmbox.el (nnmbox-mbox-buffer): It's not a constant. + +2003-04-13 Lars Magne Ingebrigtsen + + * message.el (message-hide-headers): Don't do intangible. + + * gnus.el (gnus-group-prefixed-name): Comment out the test for + colon. + + * gnus-srvr.el (gnus-browse-read-group): Don't give the real name + to the ephemeral entry, but the prefixed name. + + * gnus.el (gnus-group-prefixed-name): Clean up. + +2003-04-13 Kevin Greiner + + * gnus-agent.el (gnus-agent-group-pathname): Bind + gnus-command-method so that gnus-agent-directory will always + return a valid directory. + * gnus-cache.el (gnus-cache-enter-article): Remove article from + gnus-newsgroup-undownloaded so that the summary will display the + article as downloaded. + (gnus-cache-remove-article): If the article isn't in the agent, + remove it from gnus-newsgroup-undownloaded so that the summary + will display the article as undownloaded. + +2003-04-13 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + +2003-04-13 01:12:01 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.18 is released. + +2003-04-13 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-draft-send): Add message-hidden-headers. + +2003-04-12 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-next-page): Use + gnus-article-over-scroll. + (gnus-article-over-scroll): New variable. + + * message.el (message-newline-and-reformat): Place a boundary + before filling. + (message-make-forward-subject-function): Changed default to + message-forward-subject-name-subject. + (message-forward-subject-name-subject): New function. + + * nnimap.el (nnimap-split-fancy): Ditto. + + * gnus-sum.el (gnus-summary-line-message-size): Ditto. + + * gnus-cus.el (gnus-group-parameters): Removed "which see". + + * mml.el (mml-minibuffer-read-file): Bind + completion-ignored-extensions to nil. + + * message.el (message-fix-before-sending): Comment fix. + (message-fix-before-sending): Make hidden headers visible. + (message-hide-headers): Bind after-change-functions to nil. + (message-forbidden-properties): Put invisible and intangible + back. + (message-strip-forbidden-properties): Ignore message-hidden text. + + * gnus-msg.el: Hide headers. + + * message.el (message-hidden-headers): New variable. + (message-hide-headers): New function. + (message-hide-header-p): New function. + (message-hide-header-p): Change logic. + (message-forbidden-properties): Remove intangible nil invisible + nil. + (message-hide-headers): Narrow to headers. + + * lpath.el (featurep): Bind Info-directory, Info-menu. + +2003-04-12 Jesper Harder + + * mm-bodies.el (mm-body-charset-encoding-alist): UTF-16 *must* be + encoded. + (mm-encode-body): Don't corrupt UTF-16. + (mm-body-encoding): Pay attention to mm-body-charset-encoding-alist. + +2003-04-10 Kevin Greiner + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Articles in + the CACHE are now detected and handled the same as an article + downloaded into the agent. + (gnus-agent-group-path): Modified to match nnmail-group-pathname + so that the agent front-end and back-end (nnagent) always use the + same directory. + (gnus-agent-group-pathname): New function. Wrapper for + nnmail-group-pathname. + (gnus-agent-expire-unagentized-dirs): New variable. May be + customized to disable gnus-agent-expire-unagentized-dirs. + (gnus-agent-expire-unagentized-dirs): Expand gnus-agent-directory + as the directories in gnus-agent-expire-current-dirs were + expanded. + +2003-04-10 Jesper Harder + + * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Encrypt + body" entry in read only groups. + +2003-04-09 Jesper Harder + + * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Import file" + and "Create article" items in non-editable groups. + +2003-04-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-write-active): Added option of + replacing, rather than updating, the agent's active file. Do NOT + use the fully qualified group name as gnus-active-to-gnus-format + blindly prefixes group names with server names. + (gnus-agent-save-group-info): Merge BOTH min/max of current active + range, was just merging min, with specified active range. + (gnus-agent-expire): Save agent's active ranges after + expiring all groups. + (gnus-agent-expire-group-1): Update min of agent's active range to + min article currently fetched. + (gnus-agent-expire-unagentized-dirs): Avoid asking to delete the + same ancestor multiple times. + + * gnus-async.el (gnus-asynchronous): Moved defcustom of + gnus-asynchronous away from defgroup of gnus-asynchronous. This + seems to fix an intermittant error in which loading gnus-async + fails to define gnus-asynchronous (the variable). + + * gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is + non-essential. Removed on all platforms. + (gnus-select-newsgroup): When the agent is active, expand the + group's active range to include fetched articles that are no + longer in the server's active range. + + * gnus-util.el (gnus-with-output-to-file): Removed all of the + print-* bindings as they should be handled by the function doing + the printing. + +2003-04-09 Jesper Harder + + * mm-uu.el (mm-uu-copy-to-buffer): buffer-file-coding-system + might be unbound in non-MULE XEmacsen. + +2003-04-08 Jesper Harder + + * mm-uu.el (mm-uu-diff-groups-regexp, mm-uu-type-alist) + (mm-uu-diff-extract, mm-uu-diff-test): New functionality: + recognize diffs. + + * mm-bodies.el (mm-decode-body): Use the supplied charset + unconditionally if `code-pages' hasn't been loaded. + +2003-04-07 Jesper Harder + + * gnus-art.el (article-verify-x-pgp-sig): Don't use + `insert-buffer', the docstring says "This function is meant for + the user to run interactively. Don't call it from programs!" + + * mm-extern.el (mm-extern-mail-server): do. + + * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-sign) + (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign) + (mml1991-pgg-encrypt): do. + + * pgg.el (pgg-decrypt-region): do. + + * mm-view.el (mm-view-pkcs7-decrypt): do. + + * mml-smime.el (mml-smime-verify): do. + + * mml.el (mml-insert-mime, mml-preview): do. + + * mml2015.el (mml2015-gpg-decrypt-1, mml2015-gpg-sign) + (mml2015-gpg-encrypt, mml2015-pgg-clear-decrypt) + (mml2015-pgg-encrypt): do. + +2003-04-06 Katsumi Yamaoka + + * mm-bodies.el (mm-decode-body): Silence XEmacs when compiling. + +2003-04-06 Jesper Harder + + * mm-uu.el (mm-uu-copy-to-buffer): Copy + `buffer-file-coding-system' to the new buffer. + (mm-uu-pgp-signed-extract-1): Don't copy + `buffer-file-coding-system' here. + + * mm-bodies.el (mm-decode-body): last-coding-system-used doesn't + exist in XEmacs. + (mm-decode-body): Add missing quote. + + * mm-uu.el (mm-uu-pgp-signed-extract-1): Set + buffer-file-coding-system. + + * mm-bodies.el (mm-decode-body): Set buffer-file-coding-system to + last-coding-system-used. + + * mml2015.el (mml2015-pgg-clear-verify): Encode the text + according to buffer-file-coding-system. + + * pgg-gpg.el (pgg-gpg-process-region): Revert previous change. + + * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region) + (pgg-pgp-snarf-keys-region): do. + + * pgg-pgp5.el (pgg-pgp5-verify-region) + (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): do. + + * pgg.el (pgg-make-temp-file, pgg-temporary-file-directory): do. + +2003-04-05 Teodor Zlatanov + + * spam.el (spam-split): (save-excursion) around (widen) + (spam-ham-move-routine): Use spam-group-ham-mark-p, not + spam-group-spam-mark-p (from Michael Shields ) + +2003-04-05 Steve Youngs + + * gnus-sum.el: XEmacs doesn't support the 5th arg to 'load', so + don't use it when loading gnus-sum.el if we're in XEmacs. + +2003-04-05 Kevin Greiner + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound + print-escape-nonascii to fix more characters in compiled format + specs. + +2003-04-05 Jesper Harder + + * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): + Fix customization type. + +2003-04-04 Kevin Greiner + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound + print-quoted, print-readably, print-escape-multibyte, and + print-level to match original behavior of gnus-prin1. This should + repair the format of .newsrc.eld when using compiled format specs. + +2003-04-04 Jesper Harder + + * gnus-group.el (tool-bar-map): defvar it. + + * gnus-art.el (tool-bar-map): do. + + * gnus-sum.el (tool-bar-map): do. + +2003-04-03 Jesper Harder + + * earcon.el (earcon-regexp-alist): catmeow is a wav file. + +2003-04-03 Reiner Steib + + * gnus-art.el (gnus-button-ctan-directory-regexp): Changed meaning + and value. + (gnus-button-alist): Use it. + +2003-04-03 Jesper Harder + + * pgg-gpg.el (pgg-gpg-process-region): do. + + * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region) + (pgg-pgp-snarf-keys-region): do. + + * pgg-pgp5.el (pgg-pgp5-verify-region) + (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): Use it. + + * pgg.el (pgg-make-temp-file): New function. `make-temp-name' is + unsafe. + (pgg-temporary-file-directory): Remove. + +2003-04-02 Katsumi Yamaoka + + * lpath.el: Fbind Info-directory and Info-menu. + +2003-04-02 Reiner Steib + + * gnus-util.el (gnus-message): Added doc-string. + + * gnus-score.el (gnus-score-find-trace): Changed behavior of `q'. + (gnus-score-edit-file-at-point): Goto first match when using `e'. + +2003-04-01 Reiner Steib + + * gnus-art.el (gnus-button-ctan-directory-regexp): New variable. + (gnus-button-alist): Use it. Changed CTAN and "setq" entries. + +2003-04-01 Katsumi Yamaoka + + * nntp.el (nntp-via-rlogin-command-switches): Doc fix. + (nntp-open-via-rlogin-and-telnet): Disable the telnet linemode. + +2003-03-31 Kevin Greiner + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound + print-escape-newlines to print escape sequences rather than + literal newline characters. + +2003-03-31 Reiner Steib + + * gnus-art.el (gnus-button-valid-fqdn-regexp): Use + `message-valid-fqdn-regexp' for initialization. + (gnus-button-handle-info-url): Renamed and extended version of + `gnus-button-handle-info'. + (gnus-button-message-level): Renamed from `gnus-button-mail-level' + (gnus-button-handle-symbol, gnus-button-handle-library) + (gnus-button-handle-info-keystrokes): New functions. + (gnus-button-browse-level): New variable. + (gnus-button-alist): Use them. Added levels. + (gnus-header-button-alist): Added levels. + +2003-03-31 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + +2003-03-31 20:08:19 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.17 is released. + +2003-03-31 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-unload): Removed. + + * pop3.el (pop3-read-response): Use + nnheader-accept-process-output. + (pop3-retr): Ditto. + + * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx. + (mm-text-html-washer-alist): Ditto. + +2003-03-31 Simon Josefsson + + * imap.el (imap-gssapi-program): Also try GNU SASL. + (imap-gssapi-open): Accept GNU SASL greeting. + (imap-read-timeout): New. + (imap-wait-for-tag): Use it. + +2003-03-31 Lars Magne Ingebrigtsen + + * nntp.el (nntp-accept-process-output): Use new function. + + * nnheader.el (nnheader-read-timeout): New variable. + (nnheader-accept-process-output): New function. + + * nntp.el (nntp-read-timeout): Removed. + + * gnus-sum.el (gnus-summary-prepare-threads): Add comment. + +2003-03-30 Katsumi Yamaoka + + * gnus-cache.el (gnus-cache-braid-nov): Revoke last change. + +2003-03-30 Simon Josefsson + + * message.el (message-idna-inside-rhs-p): Narrow to header before + searching. + + * gnus-art.el (article-decode-idna-rhs): More restrictive regexp. + +2003-03-30 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-process-mmdf-mail-format): Indent. + +2003-03-28 Vasily Korytov + + * message.el (message-make-in-reply-to): Use + mail-extract-address-components to determine sender's + name/address. + +2003-03-30 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-type-alist): Move mime-parts further ahead. + + * gnus-registry.el (gnus-registry-translate-to-alist): Make a + valid lambda. + (gnus-registry-translate-from-alist): Ditto. + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind + print-length to nil. + + * gnus-sum.el (gnus-summary-highlight-line-0): Indent. + + * gnus-fun.el (gnus-fun-ppm-change-string): New function. + (gnus-grab-cam-face): Use it. + +2003-03-28 Paul Jarc + + * nnmaildir.el (nnmaildir-request-set-mark) + (nnmaildir-close-group): Allow each mark directory in a group to + have its own inode for mark files, to accommodate AFS. + +2003-03-28 Teodor Zlatanov + + * gnus-start.el (gnus-read-newsrc-el-hook): new hook called by + gnus-read-newsrc-el-file + (gnus-read-newsrc-el-file): call the gnus-read-newsrc-el-hook + + * gnus-registry.el (gnus-registry-translate-to-alist) + (gnus-registry-translate-from-alist, alist-to-hashtable) + (hashtable-to-alist): new functions + (gnus-register-spool-action): add a spool item to the registry + + * gnus.el (gnus-variable-list): added gnus-registry-alist to the + list of saved variables + (gnus-registry-alist): new variable + +2003-03-27 Simon Josefsson + + * gnus-art.el (article-decode-group-name): Be correct instead of + smart. + +2003-03-27 Katsumi Yamaoka + + * lpath.el: Bind url-current-object for Emacs; bind + gnus-agent-expire-current-dirs for XEmacs; fbind open-ssl-stream + for both Emacsen. + +2003-03-27 Jesper Harder + + * gnus-sum.el (gnus-article-loose-mime) + (gnus-article-emulate-mime): Move to gnus-article-mime customize + group. + + * gnus-msg.el (gnus-mailing-list-groups): Fix customize type and + doc string. + +2003-03-26 Kevin Ryde + + * gnus-sum.el (gnus-summary-find-for-reselect): Renamed from + gnus-summary-find-uncancelled, skip temporary articles inserted by + "refer" functions. + +2003-03-26 Vasily Korytov + + * smiley.el (smiley-buffer): New function. + +2003-03-26 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-selected-article): Replaced + gnus-summary-update-line (which updated the article's face) with + gnus-summary-update-download-mark (which updates the article's + face by calling gnus-summary-update-line AND updates the download + mark to show that the article was fetched). + +2003-03-23 Kevin Greiner + + * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Provides + option of deleting agent directories for groups/servers that are + not currently agentized. + (gnus-agent-expire): Use gnus-agent-expire-unagentized-dirs. + + * gnus-int.el (gnus-open-server): Report backend errors in + condition handler. + +2003-03-23 Simon Josefsson + + * message.el (message-idna-to-ascii-rhs-1): Don't continue outside + header. + + * rfc2047.el (rfc2047-header-encoding-alist): Make Followup-To + same as Newsgroups. + + * nntp.el (nntp-open-connection-function): Mention + nntp-open-tls-stream. + (nntp-open-tls-stream): New function. + + * tls.el: New file. + + * nnimap.el (nnimap-server-port, nnimap-stream): Say TLS/SSL + instead of SSL. + (nnimap-stream): Add other streams, link to imap variables. + (nnimap-authenticator): Add other authenticator, link to imap + variables. + + * imap.el: Autoload open-tls-stream. + (imap-streams): Add tls in front of ssl. + (imap-stream-alist): Add tls. + (imap-default-tls-port): New variable. + (imap-tls-p, imap-tls-open): New functions. + +2003-03-22 ShengHuo ZHU + + * mm-url.el (mm-url-insert-file-contents): parse url only if + results is a list. + +2003-03-22 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-imap): Revert. + +2003-03-22 Svend Tollak Munkejord + + * deuglify.el (gnus-outlook-repair-attribution-outlook): Use a + less strict regexp. + +2003-03-22 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-imap): Use buffer name for + more imap function. + +2003-03-21 Simon Josefsson + + * gnus-art.el (article-decode-group-name): Replace Newsgroups and + Followup-To data inline. + +2003-03-21 Jesper Harder + + * gnus-art.el (gnus-treat-display-xface): Don't enable if + icontopbm isn't available. + +2003-03-21 Kevin Greiner + + * gnus-int.el (gnus-open-server): Catch errors in backend's + open-server method. Returns nil rather than crashing startup. + + * gnus-sum.el (eval-when-compile): Modified to resolve + compile-time warnings. + + * gnus-uu.el (gnus-uu-mark-series): Added informative msg. + Reports length of series so that the user can compare N with a + subject that should, if the entire series is present, contain + '(.../N)'. + (gnus-uu-delete-work-dir): Avoid hanging when O/S forbids deletion + of temp file (Win-XP may leave the temp file locked when the + uudecode process fails). + +2003-03-20 ShengHuo ZHU + + * message.el (message-split-line): Ignore error. + + * lpath.el (split-line): Avoid split-line warning message. + +2003-03-20 Kim F. Storm + + * message.el (message-split-line): New function. + (message-mode-map): Remap split-line to message-split-line. + +2003-03-20 Katsumi Yamaoka + + * message.el (message-make-overlay): Defalias it to make-overlay. + (message-delete-overlay): Defalias it to delete-overlay. + (message-overlay-put): Defalias it to overlay-put. + (message-idna-to-ascii-rhs-1): Use them. + + * messagexmas.el (message-xmas-redefine): Defalias some overlay + functions to extent functions. + +2003-03-20 Reiner Steib + + * message.el (message-check-news-header-syntax): Fixed regexp. + +2003-03-20 ShengHuo ZHU + + * rfc2231.el (rfc2231-decode-encoded-string): Downcase charset. + + * mm-url.el (mm-url-insert): Move url-current-object stuff into + mm-url-insert-file-contents. + + * nnrss.el (nnrss-fetch): Fetch the local stuff. + (nnrss-check-group): Use it. + +2003-03-20 Mark A. Hershberger + + * nnrss.el: Primitive XML Name-space support. This means that RSS + feeds like Kevin Burton's[1] can now be read in Gnus. + + Implemented support for Mark Pilgrim's RSS Autodiscovery.[2] This + means that if you want to read the RSS feed for example.com, all + you have to do is hit "G R http://www.example.com/ RET" and + nnrss.el will find and the feed listed on the site or (if you have + loaded xml-rpc.el) look it up on syndic8.com. + + Marked the message as HTML (by adding a Content-Type header) so + that Gnus will render it as html if the user wants that. + + Implemented the ability to save nnrss-group-alist so that any new + feeds the you subscribe to will be found the next time you start + up. + + Implemented support for RSS 2.0 elements (author, pubDate). + + Prefer for over where both + elements exist. + + * mm-url.el (mm-url-insert): Set url-current-object. + + * gnus-group.el (gnus-group-make-rss-group): New function. + +2003-03-20 Katsumi Yamaoka + + * message.el (message-idna-to-ascii-rhs-1): Don't use replace-* + for highlight overlays. + +2003-03-20 Katsumi Yamaoka + + * gnus-cache.el (gnus-cache-braid-nov): Test if a line looks like + a NOV. + +2003-03-20 Simon Josefsson + + * message.el (message-use-idna): Disable if UTF-8 unavailable. + (message-idna-to-ascii-rhs): Use it. + + * gnus-art.el (gnus-use-idna): Disable if UTF-8 unavailable. + +2003-03-19 Teodor Zlatanov + + * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) + (spam-group-ham-marks, spam-group-spam-marks): new functions + (spam-spam-marks, spam-ham-marks): removed in favor of the + spam-marks and ham-marks parameters + (spam-generic-register-routine, spam-ham-move-routine): use the + new spam-group-{spam,ham}-mark-p functions + + * gnus.el (spam-marks, ham-marks): new group parameters with + default values same as the old spam-spam-marks and spam-ham-marks + +2003-03-19 Simon Josefsson + + * gnus-art.el (gnus-article-decode-hook): Add IDNA. + (gnus-use-idna): New variable. + (article-decode-idna-rhs): New function. + + * message.el (message-use-idna): New variable. + (message-mode-field-menu): Add entry for IDNA. + (message-idna-inside-rhs-p, message-idna-to-ascii-rhs-1) + (message-idna-to-ascii-rhs): New function. + (message-generate-headers): Invoke IDNA code. + +2003-03-19 Paul Jarc + + * nnmaildir.el (nnmaildir--system-name): New function. + (nnmaildir-request-accept-article): Use it. + +2003-03-19 Katsumi Yamaoka + + * gnus-util.el (gnus-byte-compile): Make it work silently as the + gnus-compile function does. + + * gnus-sum.el (gnus-summary-highlight-line-0): Revoke the last + bogus change. + +2003-03-19 Jesper Harder + + * mm-util.el (mm-mule-charset-to-mime-charset): Test if + sort-coding-systems is defined. + +2003-03-18 Paul Jarc + + * nnmaildir.el (nnmaildir-open-server, nnmaildir-request-scan) + (nnmaildir-request-create-group, nnmaildir-request-delete-group): + Replace create-directory with target-prefix. + +2003-03-18 Jesper Harder + + * mm-bodies.el (mm-decode-coding-region-safely): Don't use + find-charset-string which is slooow in XEmacs. + +2003-03-18 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-highlight-line-0): Silence the byte- + compiler under XEmacs. + +2003-03-18 Jesper Harder + + * gnus-art.el (gnus-treat-highlight-signature): Make the default + work for multipart/signed where the message text isn't `last'. + +2003-03-18 Katsumi Yamaoka + + * mm-view.el (mm-setup-w3m): Set w3m-display-inline-images to + the value of mm-inline-text-html-with-images. + (mm-inline-text-html-render-with-w3m): Don't bind + w3m-display-inline-images. + + * gnus-art.el (gnus-article-wash-html-with-w3m): Don't bind + w3m-display-inline-images. + + * lpath.el: Bind w3m-display-inline-images; bind mm-w3m-mode-map + regardless of an Emacs flavor. + +2003-03-18 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + +2003-03-18 00:38:22 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.16 is released. + +2003-03-18 Lars Magne Ingebrigtsen + + * lpath.el (featurep): Bind mm-w3m-mode-map. + +2003-03-17 Paul Jarc + + * nnmail.el (nnmail-cache-primary-mail-backend): Not all + 'respool-able backends define a global nnchoke-get-new-mail + variable. + +2003-03-17 Reiner Steib + + * gnus-art.el (gnus-mime-delete-part): New function. + (gnus-mime-action-alist, gnus-mime-button-commands): Use it. + +2003-03-17 Lars Magne Ingebrigtsen + + * message.el (message-check-news-header-syntax): Don't push + groups twice onto list of unknown groups. + + * nndoc.el (nndoc-type-alist): Move exim-bounce a bit further + back. + + * nnheader.el (nnheader-find-etc-directory): Doc fix. + + * gnus-msg.el (gnus-inews-add-send-actions): Don't restore window + config unless the summary buffer exists. + + * gnus-sum.el (gnus-summary-next-group): Semi-exit group first to + that target group is computed correctly when articles are marked + as read by Xref handling. + + * mail-source.el (mail-source-fetch-imap): Pass buffer-name to + imap-open. + + * message.el (message-send-mail): Add courtesy string to Bcc's, + too. + + * gnus-cite.el (gnus-cited-line-p): New function. + +2003-03-15 Jesper Harder + + * mm-bodies.el (mm-decode-body): Add new optional parameter, + force, to use the supplied charset unconditionally. + + * gnus-art.el (article-decode-charset): Use it. + +2003-03-14 Jesper Harder + + * mm-bodies.el (mm-decode-coding-region-safely): New function. + (mm-decode-body): Use it. + + * rfc2047.el (rfc2047-decode-region): do. + (rfc2047-decode-string): Guess coding system if the default is + invalid. + +2003-03-12 Paul Jarc + + * nnmaildir.el (nnmaildir-request-update-info): Pretend missing + articles are marked 'read, so we get correct article counts. + +2003-03-13 Katsumi Yamaoka + + * gnus-art.el (gnus-insert-mime-button): Exclude a newline from + the button. + (gnus-insert-prev-page-button): Ditto. + (gnus-insert-next-page-button): Ditto. + (gnus-insert-mime-security-button): Ditto. + + * mm-view.el (mm-inline-image-emacs): Open the bottom of an image + one line. Suggested by Greg Klanderman . + (mm-inline-image-xemacs): Ditto. + +2003-03-12 Paul Jarc + + * nnmaildir.el (nnmaildir--parse-filename, nnmaildir--sort-files, + nnmaildir--scan, nnmaildir-request-accept-article): Changes for + the recent filename uniqueness discussion. + +2003-03-12 Katsumi Yamaoka + + * mm-view.el (mm-inline-image-emacs): Make it delete an excessive + newline next time. + (mm-inline-image-xemacs): Ditto. + +2003-03-10 Jesper Harder + + * gnus-agent.el (gnus-agent-synchronize-flags-server): Don't use + kill-line. + +2003-03-09 Jesper Harder + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't use + kill-line. + +2003-03-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just + fixing the code to match the documentation. + (gnus-agent-fetch-selected-article): Replaced + gnus-summary-update-article-line with gnus-summary-update-line as + the former did not correctly recalculate the thread indentation. + (gnus-agent-find-parameter): The agent-predicate, if not found + anywhere else, defaults to the value of gnus-agent-predicate. + (gnus-agent-fetch-session): Fixed typo; now executes + gnus-agent-fetched-hook rather than the undocumented + gnus-agent-fetch-hook. + (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The + default agent predicate is now provided by + gnus-agent-find-parameter. + (gnus-agent-message): New macro. This macro avoids potentially + costly parameter evaluation when the message's level is too high + to display. + (gnus-agent-expire-group-1): Disabled undo tracking in temp + overview buffer. Uses new gnus-agent-message macro to reduce + overhead of optional messages. Reversed message levels to + emphasize percent completion messages. Detailed messages of + little use except when debugging code. + +2003-03-08 Teodor Zlatanov + + * spam.el (spam-ham-move-routine): use + spam-mark-ham-unread-before-move-from-spam-group + (spam-mark-ham-unread-before-move-from-spam-group): new variable + +2003-03-07 Teodor Zlatanov + + * spam.el: load nnimap.el when compiling + (spam-setup-widening): use + nnimap-split-download-body-default instead of + nnimap-split-download-body which is a user-customizable variable + +2003-03-07 Simon Josefsson + + * nnimap.el (nnimap-split-download-body-default): New, holds + default for n-s-d-b. + (nnimap-split-download-body): Add new setting (symbol default), + which uses contents of n-s-d-b-d, and made it the default. + +2003-03-07 Teodor Zlatanov + + * spam.el (spam-use-hashcash): new variable + (spam-list-of-checks): added spam-use-hashcash with associated + spam-check-hashcash + (spam-check-hashcash): new function, installed iff hashcash.el is + loaded + (spam-setup-widening): don't use (return) + +2003-03-06 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-group-1): Added default + predicate of `false' to avoid an error when a group defines no + predicate. Fixed typo that disabled agent scoring (i.e. the + low/high predicates should now work). + +2003-03-06 Teodor Zlatanov + + * spam.el: add spam-maybe-spam-stat-load to + gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook + (spam-bogofilter-register-with-bogofilter): use + spam-bogofilter-spam-switch and spam-bogofilter-ham-switch + (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): new + custom variables to replace "-s" and "-n" + + * gnus-group.el (gnus-group-get-new-news): call the new + gnus-get-top-new-news-hook hook + + * gnus-start.el (gnus-get-top-new-news-hook): new hook, run ONLY + by gnus-get-new-news, NOT by gnus-group-get-new-news-this-group + +2003-03-06 Lars Magne Ingebrigtsen + + * mm-uu.el (mm-uu-pgp-encrypted-test): Fix message. + +2003-03-06 Katsumi Yamaoka + + * gnus-cus.el (gnus-group-customize): Don't use delete-if which is + a cl run-time function. + +2003-03-06 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding + on gnus-agent-short-article. + (gnus-category-read): Replaced CL function mapcar* with new macro: + gnus-mapcar. + * gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to + support functions that accept multiple parameters. A separate + sequence must be provided for each parameter in the function. + Iteration stops when the end of the shortest list is reached. + +2003-03-06 Jesper Harder + + * nnimap.el (nnimap-request-accept-article): Use delete-region. + + * html2text.el (html2text-clean-dtdd, html2text-delete-tags) + (html2text-delete-single-tag, html2text-clean-anchor) + (html2text-remove-tags): Use delete-region. + (html2text-fix-paragraphs): Simplify. + + * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt) + (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign) + (mml1991-pgg-encrypt, mml1991-pgg-encrypt): Use delete-region, not + kill-region. + +2003-03-04 John Paul Wallington + + * gnus-agent.el (gnus-agent-enable-expiration) + (gnus-agent-article-alist, gnus-agent-article-alist) + (gnus-agent-cat-defaccessor): Doc fixes. + +2003-03-04 Kai Gro,A_(Bjohann + + * gnus-agent.el (gnus-function-implies-unread-1): Grok + byte-compiled functions. + +2003-03-04 Kevin Greiner + + * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides + customization between new maneuvering (which permits selecting + undownloaded articles) and old maneuvering (which skipped over + undownloaded articles) behaviors. + (gnus-summary-find-next): Pass through the unread and subject + parameters when calling gnus-summary-find-prev. + (gnus-summary-find-next,gnus-summary-find-prev): Apply + gnus-auto-goto-ignores to filter out unacceptable articles. + +2003-03-04 Jesper Harder + + * mail-source.el (mail-source-read-passwd): Remove. `read-passwd' + exists in all supported Emacs versions, so we don't need this + compatibility function. + (mail-source-fetch-pop, mail-source-check-pop) + (mail-source-fetch-webmail): Use read-passwd. + + * nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo) + (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use + read-passwd. + + * nnwarchive.el (nnwarchive-open-server): Use read-passwd. + + * imap.el (imap-read-passwd): Remove. + (imap-interactive-login): Use read-passwd. + + * canlock.el (canlock-read-passwd): Remove. + (canlock-insert-header, canlock-verify): Use read-passwd. + + * sieve-manage.el (sieve-manage-read-passwd): Remove. + (sieve-manage-interactive-login): Use read-passwd. + + * pop3.el (pop3-read-passwd): Remove. + (pop3-movemail, pop3-get-message-count, pop3-apop): Use + read-passwd. + + * pgg.el (pgg-read-passphrase): Simplify. + +2003-03-04 Kevin Greiner + + * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports + 'plugged' when actually 'unplugged' bug. + (gnus-category-read): Ignore nil values when converting an + old-format category so that the new-format category will default + those attributes to the global variables. + +2003-03-03 Reiner Steib + + * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed + doc-string. + +2003-03-03 Jesper Harder + + * nnrss.el (nnrss-decode-entities-unibyte-string): Use `buffer-string'. + * nndoc.el (nndoc-dissect-mime-parts-sub): do. + * nndb.el (nndb-request-accept-article, nndb-status-message): do. + * mm-url.el (mm-url-decode-entities-string): do. + * mml1991.el (mml1991-mailcrypt-sign, mml1991-gpg-sign): do. + * mm-decode.el (mm-find-raw-part-by-type): do. + * message.el (message-send-mail-partially) + (message-send-mail-with-sendmail): do. + * gnus-uu.el (gnus-uu-save-article, gnus-uu-reginize-string): do. + * gnus-kill.el (gnus-pp-gnus-kill): do. + * gnus-art.el (gnus-article-treat-unfold-headers) + (gnus-article-encrypt-body): do. + +2003-02-24 Reiner Steib + + * mail-source.el (mail-source-delete-incoming): Allow integer value. + (mail-source-delete-old-incoming-confirm): New variable. + (mail-source-delete-old-incoming): Use it. New function. + (mail-source-callback): Call `mail-source-delete-old-incoming' if + `mail-source-delete-incoming' is a nonnegative integer. + +2003-03-03 Reiner Steib + + * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config. + (gnus-user-agent): Fixed typo. + +2003-03-03 Kevin Greiner + + * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation. + (gnus-agent-expire-group-1): Removed invalid (interactive) specifier. + +2003-03-03 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-articles): Fix nil message. + (gnus-agent-fetch-session): Allow debugging to take place. + +2003-03-03 Jesper Harder + + * gnus-sum.el (gnus-highlight-selected-summary) + (gnus-article-get-xrefs, gnus-summary-show-thread): Use + `gnus-point-at-bol' and `gnus-point-at-eol' instead of + `(progn (beginning-of-line) (point))'. It's shorter, faster, + and makes it clear that we don't need the side effect. + * gnus-util.el (gnus-delete-line): do. + * gnus-xmas.el (gnus-group-add-icon): do. + * nnmail.el (nnmail-article-group, nnmail-cache-fetch-group): do. + * nntp.el (nntp-send-authinfo-from-file): do. + * nnml.el (nnml-header-value): do. + * nnheader.el (nnheader-insert-references): do. + * gnus-cite.el (gnus-article-highlight-citation) + (gnus-cite-parse): do. + * gnus-score.el (gnus-score-followup): do. + * gnus-draft.el (gnus-draft-send): do. + * gnus-group.el (gnus-group-highlight-line): do. + * gnus-cache.el (gnus-cache-braid-nov): do. + * nnfolder.el (nnfolder-retrieve-headers) + (nnfolder-request-article): do. + * gnus-art.el (article-hide-boring-headers) + (gnus-article-hide-header): do. + + * nnheader.el (nnheader-find-nov-line): Use gnus-delete-line. + * nnml.el (nnml-request-replace-article): do. + * nnmbox.el (nnmbox-request-move-article, nnmbox-delete-mail): do. + * nnfolder.el (nnfolder-request-move-article): do. + * gnus-cache.el (gnus-cache-possibly-remove-article): do. + * gnus-art.el (gnus-mm-display-part): do. + + * gnus-art.el (gnus-article-goto-part): Use gnus-goto-char. + +2003-03-02 Kevin Greiner + + * nntp.el (nntp-possibly-change-group): Avoid calling + process-buffer on nil (Which happened when you lost your + connection while fetching); instead signal a "Server Closed + Connection" error. + +2003-03-02 Kevin Greiner + + * gnus-agent.el (gnus-agent-enable-expiration): New + variable. Either ENABLE or DISABLE. Sets default behavior for + selecting which groups are expired. + (gnus-agent-cat-set-property, gnus-agent-cat-defaccessor, + gnus-agent-set-cat-groups): Provides abstract interface for + accessing agent category. Category now implemented by an alist. + (gnus-agent-add-group, gnus-agent-remove-group, + gnus-category-insert-line, gnus-category-edit-predicate, + gnus-category-edit-score, gnus-category-edit-groups, + gnus-category-copy, gnus-category-add, gnus-group-category): Use + new agent category abstraction. + (gnus-agent-find-parameter): New function. Search for agent + configuration parameter first in the group's parameters, then its + topics (if any), and then the group's category. If not found + anywhere, use the original defined constants. + (gnus-agent-fetch-headers, gnus-agent-fetch-group-1): Use new + gnus-agent-find-parameter. + (gnus-agent-fetch-headers, gnus-agent-uncached-articles): Clearing + gnus-agent-cache now blocks retrieving headers and articles from + the local cache. Fetched content is still added to the cache + before being returned. + (gnus-agent-fetch-session): Use error-message-string to generate + displayed error message. + (gnus-agent-customize-category): New Command. 'e' in category + buffer opens category customization buffer. + (gnus-category-read): Reads either positional or alist format; + returns alist format. + (gnus-category-write): Writes category file compatible with + current, and previous, versions of gnus-agent. + (gnus-category-make-function, gnus-category-make-function-1): + Corrected documentation; parameter is predicate NOT category. + (gnus-predicate-implies-unread): Now works in more cases per the + todo comment. + (gnus-function-implies-unread-1): New function. Supports + gnus-predicate-implies-unread. + (gnus-agent-expire-group): Command now provides default of group + under point. + (gnus-agent-expire-group-1): Obeys new agent-enable-expiration and + agent-days-until-old parameters. No longer supports + gnus-agent-expire-days being set to an alist. + (gnus-agent-request-article): Now performs its own checks of + gnus-agent, gnus-agent-cache, and gnus-plugged rather than + assuming that the caller will do them correctly. + (): Added one-time hook to gnus-group-prepare-hook. Detects when + gnus-agent-expire-days is set to an alist. Converts said alist + into group parameter so that gnus-agent-expire-days will not be + needed. + * gnus-art.el (gnus-request-article-this-buffer): Conditional + checks surrounding gnus-agent-request-article removed; now + performed by gnus-agent-request-article. + * gnus-cus.el (gnus-agent-parameters): New variable. List of + customizable group/topic parameters that regulate the agent. + (gnus-group-customize): Uses gnus-agent-parameters. Replaced + kill-buffer with gnus-kill-buffer to remove the killed buffer from + the list of gnus buffers. + (gnus-trim-whitespace): Removes leading and trailing whitespace + from multiline strings. + (gnus-agent-cat-prepare-category-field, + gnus-agent-customize-category): Constructs a category + customization buffer. + * gnus-int.el (gnus-retrieve-headers, + gnus-request-expire-articles): No longer checks gnus-agent-cache + as it is handled internally by the agent. + (gnus-request-head, gnus-request-body): Conditional checks + surrounding gnus-agent-request-article removed; now performed by + gnus-agent-request-article. + + * gnus-start.el (): Added defvar statements to resolve compilation + warnings. + (gnus-long-file-names): New function. Isolates platform dependent + msdos-long-file-names. + (gnus-save-startup-file-via-temp-buffer): New variable. Provides + option of writing directly to file. Avoids memory exhausted + errors when .newsrc.eld is huge. + (gnus-save-newsrc-file): Uses new + gnus-save-startup-file-via-temp-buffer. + (gnus-gnus-to-quick-newsrc-format): Rewritten to write to + standard-output. + (gnus-display-time-event-handler): Changed to alias from a defun + to avoid a compile-time warning when display-time-event-handler is + not defined. + * gnus-util.el (gnus-with-output-to-file): New macro. Binds + standard-output such that prin1 and princ will write directly to a + file. + + * gnus.el (gnus-agent-cache): Expanded documentation. + (gnus-summary-high-undownloaded-face): Removed second bold keyword + so that this face is actually bold. + + * nnkiboze.el (nnkiboze-request-article): Only use the cache when + gnus-use-cache has been set. + +2003-03-02 Jesper Harder + + * nnvirtual.el (nnvirtual-update-xref-header): Simplify. + +2003-03-01 Jesper Harder + + * gnus-art.el (gnus-article-refer-article): Be more permissive. + +2003-03-01 ShengHuo ZHU + + * spam.el: Fix typo. + +2003-03-01 Satyaki Das + (Trivial patch.) + + * pgg-gpg.el (pgg-gpg-process-region): Insert process status into + errors-buffer. This produces a nicer error message in case of + problems. + +2003-03-01 Teodor Zlatanov + + * spam.el (spam-maybe-spam-stat-load, spam-maybe-spam-stat-load): + load stats iff spam-use-stat is on + + * spam.el: add spam-maybe-spam-stat-load to gnus-startup hook, + also use spam-maybe-spam-stat-load and spam-maybe-spam-stat-save + instead of spam-stat-load and spam-stat-save in the + gnus-get-new-news-hook and gnus-save-newsrc-hook, respectively + +2003-03-01 ShengHuo ZHU + + * mm-view.el (mm-inline-text): Ignore errors from enriched-decode. + +2003-03-01 Lars Magne Ingebrigtsen + + * message.el (message-make-fqdn): Protect against nil user-mail. + +2003-02-28 Vasily Korytov + + * gnus-art.el (gnus-boring-article-headers): New values: + 'to-list and 'cc-list. + +2003-02-28 Teodor Zlatanov + + * spam.el (spam-setup-widening): new function to set + nnimap-split-download-body, we add it to gnus-get-new-news-hook + (spam-list-of-statistical-checks): list of statistical splitter + checks + (spam-split): added a widen call when a statistical check is + enabled + +2003-02-28 Reiner Steib + + * gnus-msg.el (gnus-user-agent): Changed default to + 'emacs-gnus-type, renamed 'full. + +2003-02-28 ShengHuo ZHU + + * nnfolder.el (nnfolder-request-accept-article): Don't use + mail-header-unfold-field. + +2003-02-27 ShengHuo ZHU + + * imap.el (imap-ssl-open): Don't depend on ssl.el. + * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el. + +2003-02-26 Teodor Zlatanov + + * spam.el: add spam-stat-load to gnus-get-new-news-hook + (spam-split): remove spam-stat-load call + +2003-02-26 Simon Josefsson + + * gnus-sum.el (gnus-summary-toggle-header): Run + gnus-article-decode-hook instead of calling a-decode-encoded-words + directly (the latter is run as part of the former). + +2003-02-26 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-expire-group): Remove debug. + +2003-02-25 Jesper Harder + + * message.el (message-sendmail-envelope-from): New option. + (message-sendmail-envelope-from): New function. + (message-send-mail-with-sendmail): Use it. + +2003-02-25 Reiner Steib + + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added + compensation for TDMA addresses. + +2003-02-24 Reiner Steib + + * gnus-msg.el (gnus-user-agent): New variable. + (gnus-version-expose-system): Removed. Obsoleted by + `gnus-user-agent'. + (gnus-extended-version): Use `gnus-user-agent'. + +2003-02-24 Teodor Zlatanov + + * spam.el (spam-stat-register-spam-routine, + spam-stat-register-ham-routine): remove spam-stat-save + (spam-stat hook): add spam-stat-save to the gnus-save-newsrc-hook + +2003-02-24 Kevin Greiner + + * gnus-group.el (gnus-topic-mode-p): Fixed free variable + reference. + +2003-02-24 Kevin Greiner + + * nnheader.el (nnheader-find-nov-line): Changed midpoint + calculation to avoid integer overflow. + +2003-02-24 Reiner Steib + + * gnus-start.el (gnus-backup-startup-file): Fixed custom type. + +2003-02-24 Ted Zlatanov + * spam.el: disabled spam-get-article-as-filename + + From Michael Shields + + * gnus-group.el (gnus-group-is-exiting-without-update-p): New. + * gnus-sum.el (gnus-summary-exit-no-update): Use it. + * gnus-sum.el (gnus-summary-expire-articles): Use it. + * spam.el (spam-summary-prepare-exit): Use it. + * gnus.el (gnus-install-group-spam-parameters): New. + * spam.el (spam-group-ham-processor-copy-p): New. + * spam.el (spam-summary-prepare-exit): Support for ham copying. + * spam.el (spam-mark-spam-as-expired-and-move-routine): Fix bug + that would cause the current message to be moved if the group had + no spam. + * spam.el (spam-ham-move-routine): New `copy' argument. + +2003-02-24 Kai Gro,A_(Bjohann + From Martin Thornquist + + * gnus-topic.el (gnus-topic-select-group): Select last group if + after last group. + * gnus-group.el (gnus-group-select-group): Ditto. + +2003-02-24 Katsumi Yamaoka + + * gnus-art.el (popup-menu): Compiler macro for Emacs 20. + (gnus-article-refer-article): Use gnus-point-at-(b|e)ol instead of + point-at-(b|e)ol which aren't available in Emacs 20. + + * gnus-registry.el (puthash): Alias to cl-puthash for Emacs 20. + +2003-02-23 Kevin Greiner + + * gnus-start.el (gnus-activate-group): Re-enabled the catch error + clause of the condition-case statement. Errors connecting to a + server no longer terminate gnus. + + * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to + make its use obvious. Added no-nothing case to avoid + opening(closing) servers when already open(closed). + (gnus-agent-while-plugged): Added macro to facilitate internal use + of gnus-agent-toggle-plugged. + (gnus-agent-fetch-group): Use new gnus-agent-while-plugged to + temporarily open servers. + (gnus-agent-get-undownloaded-list): Sort list of article numbers + as sorting gnus-newsgroup-headers is wrong. + (gnus-agent-summary-fetch-group): Use new gnus-agent-while-plugged + to temporarily open servers. Corrected logic to handle setting + gnus-agent-mark-unread-after-downloaded. + (gnus-agent-fetch-articles): Now handles headers with missing + article sizes and/or missing article lengths. Now clears the + message buffer when finished. + (gnus-agent-fetch-group-1): Position point before calling + gnus-summary-set-agent-mark. + (gnus-get-predicate): Corrected description, parameter is + predicate not category. + (gnus-agent-expire-group): Adapted the gnus-agent-expire-* code to + provide a separate single group expiration function. + (gnus-agent-regenerate-group): Now clears the message buffer when + finished. + +2003-02-23 Kai Gro,A_(Bjohann + + * gnus.el (gnus-agent-target-move-group-header): New variable. + * gnus-draft.el (gnus-draft-send): If special header + "X-Gnus-Agent-Target-Move-Group" is present, do like Gcc into + that group, instead of performing the regular sending functions. + +2003-02-23 Katsumi Yamaoka + + * gnus-xmas.el (gnus-xmas-mime-button-menu): Accept a prefix arg. + +2003-02-20 Reiner Steib + + * message.el (message-user-fqdn, message-valid-fqdn-regexp): New + variables. + (message-make-fqdn): Use it. Improved validity check. + +2003-02-23 Lars Magne Ingebrigtsen + + * message.el (message-user-mail-address): Check whether + user-mail-address looks valid. + + * gnus-msg.el (gnus-mailing-list-followup-to): New function. + + * gnus-util.el (gnus-fetch-original-field): New function. + +2003-02-23 Kai Gro,A_(Bjohann + + * message.el (message-mode): \\(...\\) around additional + paragraph-separate alternative. + +2003-02-23 Jesper Harder + + * gnus-art.el (gnus-mime-button-commands): Add ellipsis. + (gnus-mime-button-menu): Define MIME popup menu with easy-menu to + display key bindings. + (gnus-mime-button-menu): Rewrite. + +2003-02-23 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-url-regexp): Removed `. + +2003-02-23 Max Froumentin + + * gnus-art.el (gnus-button-url-regexp): Remove `, enter '. + +2003-02-23 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-action-on-part): Require a match + interactively. + + * gnus-start.el (gnus-save-newsrc-file): Use + gnus-backup-startup-file. + (gnus-backup-startup-file): New variable. + +2003-02-22 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-buffer-name): Moved function here. + + * gnus-draft.el (defun): Remove debug. + +2003-02-22 Jesper Harder + + * gnus-sum.el (gnus-summary-refer-article): Skip method if we + can't open server. + +2003-02-22 Lars Magne Ingebrigtsen + + * gnus-draft.el (defun): Configure posting styles. + + * gnus-start.el (gnus-get-unread-articles-in-group): Make sure + the entry for the group exists before we alter it. + +2003-02-22 Kai Gro,A_(Bjohann + + * message.el (message-mode): MML tags separate paragraphs. Small + change from David S Goldberg . + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort + `gnus-newsgroup-headers'. + + * gnus-art.el (gnus-article-refer-article): Grok more message id + formats. From Karl Pfl,Ad(Bsterer . + +2003-02-22 Jesper Harder + + * mm-decode.el (mm-path-name-rewrite-functions): Doc fix: don't + use "path name". + +2003-02-21 Teodor Zlatanov + + * gnus-sum.el (gnus-summary-move-article) + (gnus-summary-expire-articles): send data header for article, not + just article ID + + * gnus-registry.el (gnus-registry-hashtb, gnus-register-action) + (gnus-register-spool-action): added hashtable of message ID keys + with message motion data + +2003-02-21 Florian Weimer + From Reiner Steib . + + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New + variable, used in `gnus-button-mid-or-mail-heuristic'. + (gnus-button-mid-or-mail-heuristic): New function derived from + Florian Weimer's Perl script. + (gnus-button-handle-mid-or-mail): Allow a function instead of + 'guess. + (gnus-button-guessed-mid-regexp): Removed. + +2003-02-20 Katsumi Yamaoka + + * message.el (message-resend): Bind message-setup-hook to nil; + remove X-Draft-From header. + +2003-02-20 Jesper Harder + + * gnus-sum.el (gnus-simplify-subject-fully, gnus-subject-equal) + (gnus-newsgroup-undownloaded) + (gnus-summary-save-parts-default-mime, gnus-auto-select-next): + Doc fixes. + +2003-02-17 John Paul Wallington + + * gnus.el (gnus-shell-command-separator, gnus-email-address) + (gnus-default-charset, gnus-other-frame-parameters): Doc fixes. + +2003-02-20 Jesper Harder + + * gnus-spec.el (gnus-xmas-format): Use insert instead of + insert-string which is obsolete in Emacs 21.4. + + * message.el (message-cross-post-followup-to-header): do. + + * spam.el (spam-ifile-register-with-ifile) + (spam-stat-register-spam-routine) + (spam-stat-register-ham-routine) + (spam-bogofilter-register-with-bogofilter): do. + + * mailcap.el (mailcap-mime-data): Fix typo. + + * gnus-topic.el (gnus-topic-make-menu-bar): Add ellipsis. + +2003-02-19 Reiner Steib + + * gnus-cite.el (gnus-cite-unsightly-citation-regexp) + (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to + `gnus-cite-unsightly-citation-regexp'. + +2003-02-19 Katsumi Yamaoka + + * gnus-msg.el (gnus-copy-article-buffer): Copy an article header + even if there's just a header. + +2003-02-19 Jesper Harder + + * message.el (message-fix-before-sending): Fix highlighting of + illegible and invisible text. + + * gnus-util.el (gnus-multiple-choice): Separate choices with + ",,A (B". Suggested by Dan Jacobson . + +2003-02-18 Jesper Harder + + * gnus-sum.el (gnus-summary-exit-no-update): Use gnus-kill-buffer. + +2003-02-18 Teodor Zlatanov + + * spam.el (spam-ham-move-routine) + (spam-mark-spam-as-expired-and-move-routine): use + gnus-summary-kill-process-mark and gnus-summary-yank-process-mark + around process-mark manipulation on the group + +2003-02-17 Kai Gro,A_(Bjohann + + * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME/Multipart + submenu. + +2003-02-17 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Reverse the return value of + the continuation question. + +2003-02-16 Lars Magne Ingebrigtsen + + * nndraft.el (nndraft-request-move-article): Bind + nnmh-allow-delete-final to t. + +2003-02-14 ShengHuo ZHU + + * mm-uu.el (mm-uu-uu-filename): Fix use of character constant. + +2003-02-11 Stefan Monnier + + * nntp.el (nntp-accept-process-output): Don't use point-max to get + the buffer's size. + +2003-01-31 Joe Buehler + + * nnheader.el: Added cygwin to system-type comparisons. + +2003-01-27 Juanma Barranquero + + * imap.el (imap-mailbox-status): Fix typo. + +2003-02-14 ShengHuo ZHU + + * gnus-art.el (gnus-article-prepare): Don't set agent mark if + online. + +2003-02-14 Kai Gro,A_(Bjohann + + * gnus-agent.el (gnus-agent-group-make-menu-bar): Include all + commands. + * gnus-sum.el: Small change from Frank Weinberg + : + (gnus-auto-center-group): New variable. + (gnus-summary-read-group-1): Use it. + (gnus-summary-next-group): Fix docstring. + +2003-02-13 Katsumi Yamaoka + + * gnus-util.el (gnus-faces-at): Simplify. + +2003-02-13 Teodor Zlatanov + + * spam.el (spam-ham-move-routine) + (spam-mark-spam-as-expired-and-move-routine): made the article + move conditional, so it's not called even if there's nothing to move + +2003-02-13 Kai Gro,A_(Bjohann + + * message.el (message-unix-mail-delimiter): Accept any whitespace + after the email address and before the date; do not require the + space character. From Kurt B. Kaiser . + +2003-02-13 Katsumi Yamaoka + + * gnus-art.el (gnus-article-only-boring-p): Make sure that the + gnus-article-boring-faces variable is bound; use gnus-faces-at. + + * gnus-util.el (gnus-faces-at): New macro. + +2003-02-13 Michael Shields + + * gnus-cite.el + (gnus-cite-attribution-suffix, gnus-cite-parse): + Better handling for Microsoft citation styles. + (gnus-unsightly-citation-regexp): New. + +2003-02-12 Michael Shields + + * gnus-art.el (article-strip-banner): Strip both per-group and + per-user-address banners. + (article-really-strip-banner): New. + +2003-02-12 Michael Shields + + * gnus-sum.el (gnus-article-goto-next-page, + gnus-article-goto-prev-page): Call gnus-summary-*-page, instead of + relying on the summary bindings of `n' and `p'. + +2003-02-12 Michael Shields + + * gnus-art.el (gnus-article-only-boring-p): New. + (gnus-article-skip-boring): New. + * gnus-cite.el (gnus-article-boring-faces): New. + * gnus-sum.el (gnus-summary-next-page): Use + gnus-article-only-boring-p. + +2003-02-12 Teodor Zlatanov + + * spam.el (spam-mark-spam-as-expired-and-move-routine) + (spam-ham-move-routine): unmark all articles before marking those + of interest and calling gnus-summary-move-article + +2003-02-12 Jesper Harder + + * gnus.el (gnus-kill-buffer): Move to gnus.el because it's + logically the complement of gnus-get-buffer-create and + gnus-add-buffer. + + * gnus-util.el (gnus-kill-buffer): do. + + * nnmail.el: Autoload gnus-kill-buffer. + +2003-02-11 Kevin Greiner + + * gnus-agent.el (gnus-summary-set-agent-mark): Added call to + gnus-summary-goto-subject as gnus-summary-update-mark operates on + the current LINE. + (gnus-agent-summary-fetch-group): Minimized the number of times + that the article is updated in the buffer. + +2003-02-11 Teodor Zlatanov + + * spam.el (spam-ham-move-routine): use the process-mark instead of + gnus-current-article when moving articles + (spam-mark-spam-as-expired-and-move-routine): ditto, use the process-mark + +2003-02-11 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-expire-articles): Recursive. + (gnus-topic-catchup-articles): Ditto. + (gnus-topic-mark-topic): Reverse recursive logic. + +2003-02-11 Jesper Harder + + * gnus-sum.el (gnus-summary-refer-thread): Handle case where + gnus-refer-thread-limit is t. + +2003-02-10 Jesper Harder + + * mm-util.el (mm-mule-charset-to-mime-charset): Use + sort-coding-systems to prefer utf-8 over utf-16. + +2003-02-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-expire-days): + gnus-request-move-article depends on gnus-agent-expire to clean up + the cache after moving the article. Therefore, g-a-e-d can NOT + default to nil or can gnus-agent-expire be disabled by doing so. + If you don't want to run gnus-agent-expire, don't call it. + (gnus-agent-expire): The broken test to disable gnus-agent-expire + when g-a-e-d was NOT nil was removed. + (gnus-agent-article-name): Removed unnecessary input test as + article IDs are always strings. + (gnus-agent-regenerate-group): Added check to protect against + servers that generate absurdly long article IDs. Valid IDs are + less than 10 digits to avoid overflow errors. Fixed logic error + when ensuring that the final article ID is present in the new + alist. + +2003-02-09 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-goto-missing-topic): Just move to the + next line after finding the parent. + +2003-02-08 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bumped. + +2003-02-08 23:23:27 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.15 is released. + +2003-02-08 Michael Welsh Duggan + + * nnmail.el (nnmail-split-it): If a message ends up matching the + same mailbox more than once, it will cause duplicates to appear + in the mailbox. + +2003-02-08 Simon Josefsson + + * gnus-sum.el (gnus-summary-select-article): Remove blink removal + code that only worked under Emacs. + + * pgg-gpg.el (pgg-gpg-process-region): Don't blink. From Satyaki + Das . + +2003-02-08 Jesper Harder + + * gnus-art.el (gnus-article-refer-article): Use + gnus-replace-in-string. + + * gnus-util.el (gnus-map-function): Remove unneeded let-binding. + (gnus-remove-duplicates): do. + +2003-02-07 Teodor Zlatanov + + * gnus-int.el (gnus-internal-registry-spool-current-method): new variable + (gnus-request-scan): set + gnus-internal-registry-spool-current-method to gnus-command-method + before a request-scan operation + + * gnus-registry.el (regtest-nnmail): use + gnus-internal-registry-spool-current-method + +2003-02-07 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Typo fix. + +2003-02-07 Teodor Zlatanov + + * nnmail.el (nnmail-spool-hook): new hook + (nnmail-cache-insert): call nnmail-spool-hook + + * gnus-registry.el: new file with examples of using the hooks + + * gnus.el (gnus-registry): added registry customization group + (gnus-group-prefixed-name): improve function to return full group + name optionally + (gnus-group-guess-prefixed-name): shortcut to + gnus-group-prefixed-name, using just the group name + (gnus-group-full-name): always get a group's full name + (gnus-group-guess-full-name): shortcut, using just the group name + + * gnus-sum.el (gnus-summary-article-move-hook) + (gnus-summary-article-delete-hook) + (gnus-summary-article-expire-hook): new hooks + (gnus-summary-move-article, gnus-summary-expire-articles) + (gnus-summary-delete-article): invoke the new hooks + +2003-02-07 Frank Weinberg + + * gnus-art.el (gnus-article-refer-article): Strip leading "news:" + from message-ID + +2003-02-07 Jesper Harder + + * gnus-util.el (gnus-run-hooks): Use save-current-buffer. + +2003-02-07 John Paul Wallington + + * mm-util.el (mm-delete-duplicates, mm-append-to-file) + (mm-write-region, mm-detect-coding-region): Doc fixes. + +2003-02-07 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Ignore errors. + (mail-source-ignore-errors): New variable. + + * gnus-sum.el (gnus-summary-refer-thread): Don't re-fetch current + articles. + + * gnus-msg.el (gnus-version-expose-system): Change default. + +2003-02-07 Vasily Korytov + + * gnus-msg.el (gnus-version-expose-system): New variable. + +2003-02-07 Simon Josefsson + + * mml-sec.el (mml-unsecure-message): Don't use kill-region. Tiny + patch from deskpot@myrealbox.com (Vasily Korytov). + +2003-02-02 Lars Magne Ingebrigtsen + + * gnus-art.el (article-display-face): Get the Face header from + the current buffer. + +2003-02-06 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-view-part-internally): Bind + buffer-read-only to nil. + +2003-02-05 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-expire-1,2): Pass the dir argument + from g-a-e-1 to g-a-e-2. + +2003-02-05 Teodor Zlatanov + + * spam.el (spam-check-BBDB): no need to regexp-quote the argument + of bbdb-search-simple, use spam-use-BBDB-exclusive + (spam-check-whitelist): use spam-use-whitelist-exclusive + (spam-use-whitelist-exclusive): new variable affecting + spam-use-whitelist + (spam-use-BBDB-exclusive): new variable affecting spam-use-BBDB + +2003-02-05 Simon Josefsson + + * gnus-agent.el (gnus-agent-expire-days): Change default to nil. + (gnus-agent-expire): Don't expire if g-a-e-d is nil. + (gnus-agent-expire): Move most code into gnus-agent-expire-1. + (gnus-agent-expire-1): New. + (gnus-agent-expire-1): Move code into gnus-agent-expire-2. + (gnus-agent-expire-2): New. + +2003-02-05 Jesper Harder + + * gnus-util.el (gnus-delete-if): Rename to gnus-remove-if. + "delete-if" is misleading because it isn't actually destructive. + + * gnus-topic.el (gnus-group-prepare-topics): Use new name. + + * nnmail.el (nnmail-purge-split-history): do. + + * gnus-win.el (gnus-get-buffer-window): do. + + * gnus-sum.el (gnus-simplify-whitespace): Remove unnecessary + let-binding. + (gnus-simplify-all-whitespace): do. + +2003-02-05 Katsumi Yamaoka + + * gnus-delay.el (gnus-delay-article): Fix binding of the + nndraft:delayed group. + +2003-02-04 Teodor Zlatanov + + * gnus.el (spam group parameters): change 'other to 'const in + the group parameter definitions to soothe XEmacs + +2003-02-04 Kai Gro,A_(Bjohann + + * gnus-delay.el (gnus-delay-article): Really create + nndraft:delayed group if it doesn't exist. + +2003-02-04 Jesper Harder + + * gnus-sum.el (gnus-summary-search-article): Speed up by + disabling various visual features while searching. + (gnus-summary-recenter): Test gnus-auto-center-summary first. + +2003-02-03 Jesper Harder + + * spam.el (spam-list-of-checks): Don't quote nil and t in + docstrings. From the elisp manual: + + When a documentation string refers to a Lisp symbol, write + it [..] with single-quotes around it. [..] There are two + exceptions: write t and nil without single-quotes. + + * messcompat.el (message-from-style): do. + + * message.el (message-send-mail): do. + + * gnus-util.el (gnus-use-byte-compile): do. + + * gnus-score.el (gnus-score-lower-thread): do. + + * gnus-int.el (gnus-server-unopen-status): do. + + * gnus.el (gnus-define-group-parameter, gnus-large-newsgroup) + (large-newsgroup-initial, gnus-install-group-spam-parameters): do. + + * gnus-cus.el (gnus-group-customize, gnus-score-parameters) + (gnus-group-parameters): do. + + * gnus-art.el (gnus-article-mime-match-handle-function): do. + + * mm-decode.el (mm-text-html-renderer): do. + +2003-02-02 Katsumi Yamaoka + + * nnheader.el (nnheader-directory-separator-character): Change the + way to compute the dafault value. + +2003-02-02 Jesper Harder + + * gnus-art.el (gnus-button-handle-describe-key): Implement it. + (gnus-button-alist): Fix regexp for describe-key. + (gnus-button-handle-describe-function) + (gnus-button-handle-describe-variable) + (gnus-button-handle-apropos, gnus-button-handle-apropos-command) + (gnus-button-handle-apropos-variable) + (gnus-button-handle-apropos-documentation): Docstring fix. + + * gnus-util.el (gnus-kill-buffer): Use get-buffer. + +2003-02-01 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-group-send-queue): Bind gnus-posting-styles + to nil. + + * nnmail.el: Removed gnus-util autoload. + + * gnus.el: Use gnus-prin1-to-string throughout. + + * gnus-util.el (gnus-prin1-to-string): Bind print-length and + print-level. + + * gnus-art.el (article-display-x-face): Removed grey x-face stuff. + (gnus-treat-display-grey-xface): Removed. + + * gnus-fun.el (gnus-grab-cam-face): New. + (gnus-convert-image-to-gray-x-face): Removed. + (gnus-convert-gray-x-face-to-xpm): removed. + (gnus-convert-gray-x-face-region): Removed. + (gnus-grab-gray-x-face): Removed. + + * nnmail.el (nnmail-expiry-wait-function): Doc indent. + +2003-01-31 Jesper Harder + + * gnus-util.el (gnus-kill-buffer): Functions in gnus-util + shouldn't depend on the rest of Gnus, so test if gnus-buffers is + bound. + + * nnmail.el (nnmail-cache-close): Use gnus-kill-buffer. + +2003-01-30 Jesper Harder + + * gnus-cite.el (gnus-cite-reply-regexp, gnus-cite-always-check): + Remove -- these are bogus options which are never used. + +2003-01-29 Jesper Harder + + * gnus-art.el (gnus-article-mode): Use summary tool bar. + +2003-01-27 Teodor Zlatanov + + * spam.el (spam-check-blackholes) + (spam-blackhole-good-server-regex): new variable to skip some IPs + when checking blackholes; use it + (spam-check-bogofilter-headers) + (spam-bogofilter-bogosity-positive-spam-header): new variable, in + case more X-Bogosity is used than just "Yes/No" + (spam-ham-move-routine): semi-fixed, only first article is + properly moved now + +2003-01-27 Jesper Harder + + * gnus-util.el (gnus-kill-buffer): Remove buffer from gnus-buffers + as well. + + * gnus-sum.el (gnus-select-newsgroup): Use gnus-kill-buffer. + + * gnus-score.el (gnus-score-headers, gnus-score-find-bnews): do. + + * gnus-start.el (gnus-save-newsrc-file, gnus-clear-system): do. + + * gnus-bcklg.el (gnus-backlog-shutdown): do. + + * gnus-srvr.el (gnus-server-exit, gnus-browse-exit): do. + +2003-01-26 Lars Magne Ingebrigtsen + + * gnus-fun.el (gnus-face-encode): New function. + (gnus-convert-png-to-face): Use it. + + * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks. + +2003-01-26 Jesper Harder + + * mm-decode.el (mm-dissection-list): Remove. + (mm-dissect-singlepart): Don't push to mm-dissection-list, it's + only used in mm-remove-all-parts. + (mm-remove-all-parts): Remove it, it's never called. + +2003-01-25 Simon Josefsson + + * gnus-group.el (gnus-group-make-group): Report errors. + + * nnimap.el (nnimap-request-create-group): Ditto. + + * sieve-manage.el (sieve-manage-is-okno): Parse literal strings. + + * sieve.el (sieve-upload): Fix error printing. + + * mm-encode.el (mm-qp-or-base64): Always QP iff + mm-use-ultra-safe-encoding and cleartext PGP. + + * gnus-sum.el (gnus-summary-select-article): Inhibit + redisplay (mainly for secured messages). + + * nnmail.el (nnmail-article-group): Copy body too (but don't + process it). + +2003-01-25 Jesper Harder + + * gnus-art.el (gnus-article-setup-buffer): Reset + gnus-button-marker-list. + +2003-01-25 Lars Magne Ingebrigtsen + + * nntp.el (nntp-read-timeout): Default to using a second delay + under Microsoft Windows. + +2003-01-24 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-directory-separator-character): New + variable. + +2003-01-24 Kai Gro,A_(Bjohann + + * gnus-agent.el (gnus-agent-max-fetch-size) + (gnus-agent-article-alist, gnus-agent-get-undownloaded-list) + (gnus-agent-catchup, gnus-agent-summary-fetch-group) + (gnus-agent-fetch-articles, gnus-agent-backup-overview-buffer) + (gnus-agent-flush-cache, gnus-agent-fetch-headers) + (gnus-agent-braid-nov, gnus-agent-load-alist) + (gnus-agent-article-alist-save-format) + (gnus-agent-read-agentview, gnus-agent-save-alist) + (gnus-agent-fetch-group-1, gnus-agent-expire) + (gnus-agent-uncached-articles, gnus-agent-retrieve-headers) + (gnus-agent-regenerate-group): Reformat to keep under eighty + columns. Reword docstrings so that first line is under eighty + chars and a complete sentence. Still need to work on the rear + end of the file, in particular gnus-agent-expire. + +2003-01-24 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agentize): Indent. + + * gnus.el (gnus-version-number): Bumped. + +2003-01-24 20:32:44 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.14 is released. + +2003-01-24 Kai Gro,A_(Bjohann + + * gnus-sum.el (gnus-summary-prepare-threads): Reset state for %B + before beginning. Tiny patch from Mark Thomas + . + +2003-01-24 Teodor Zlatanov + + * spam.el (spam-check-blackholes, spam-split) + (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): added + gnus-message calls to show to users what spam.el is doing + +2003-01-24 Jesper Harder + + * gnus-msg.el (gnus-message-replysign) + (gnus-message-replyencrypt): Fix typo. + +2003-01-24 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-security-show-details): Toggle showing + details. + +2003-01-23 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-press-button): let* -> let. + (gnus-mime-security-show-details): Cleaned up. + (gnus-mime-security-press-button): Save excursion. + (gnus-insert-mime-security-button): Clean up. + + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Doc fix. + + * gnus-async.el (gnus-async-wait-for-article): Don't use a + timeout. + + * nntp.el (nntp-accept-process-output): Removed timeout. + (nntp-read-timeout): New variable. + (nntp-accept-process-output): Use it. + + * gnus-sum.el (gnus-data-find-list): Remove *. + +2003-01-23 Kevin Greiner + + * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I + introduced on 2002-01-22. + (gnus-summary-first-unseen-or-unread-subject): Ditto. + +2003-01-23 Teodor Zlatanov + + * spam.el (spam-check-regex-headers, spam-list-of-checks) + (spam-regex-headers-spam, spam-regex-headers-ham): added spam/ham + checks of incoming mail based on simple header regexp matching + +2003-01-22 Teodor Zlatanov + + * gnus-sum.el (gnus-spam-mark): set to `$' + +2003-01-22 Kevin Greiner + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Now computes + gnus-newsgroup-unfetched, the list of articles whose headers have + not been fetched from the server. + + * gnus-sum.el (gnus-summary-find-next): Removed undownloaded + parameter as it never worked due to a bug. Added check to prevent + selection of any article in the gnus-newsgroup-unfetched list. + (gnus-summary-find-prev): Added check to prevent selection of any + article in the gnus-newsgroup-unfetched list. + (gnus-summary-first-subject): Documented API. Modified + implementation so that constraints are handled independently. + Added check to prevent selection of any article in the + gnus-newsgroup-unfetched list. + (gnus-summary-first-unseen-subject): Updated parameters in + gnus-summary-first-subject call to match new API. + (gnus-summary-first-unseen-or-unread-subject): Ditto. + (gnus-summary-catchup): Do not mark unfetched articles as read. + +2003-01-22 Jesper Harder + + * gnus-art.el (gnus-treat-strip-pgp, gnus-article-hide-pgp-hook): + make-obsolete-variable allows only two arguments in XEmacs and + Emacs 20. + + * gnus-sum.el (gnus-summary-wash-hide-map): Remove + gnus-article-hide-pgp. + (gnus-summary-make-menu-bar): do. + + * gnus-art.el (gnus-treat-strip-pgp): Make obsolete. + (gnus-treatment-function-alist): Remove gnus-treat-strip-pgp and + gnus-article-hide-pgp. + (article-hide-pgp): Remove. + (gnus-article-hide): Remove gnus-article-hide-pgp. + + * gnus.el: Remove gnus-article-hide-pgp + +2003-01-21 Lars Magne Ingebrigtsen + + * message.el (message-required-headers): Doc fix. + +2003-01-21 Teodor Zlatanov + + * spam.el (spam-group-ham-processor-bogofilter-p): fixed bug + (spam-ifile-register-ham-routine, spam-ifile-ham-category): new + option to make ifile a purely binary classifier + +2003-01-21 Lars Magne Ingebrigtsen + + * mml-sec.el (mml-secure-sign-pgpauto): Renamed. + (mml-secure-encrypt-pgpmime): Removed double. + + * gnus-sum.el (gnus-summary-mark-article-as-replied): Added + debugging statements. + +2003-01-21 Andreas Fuchs + + * mml-sec.el (mml-sign-alist): Added pgpauto. + +2003-01-21 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bumped version number. + +2003-01-21 07:15:41 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.13 is released. + +2003-01-21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-url-regexp): Removed |. + + * message.el (message-send-hook): Doc fix. + + * gnus-win.el (gnus-buffer-configuration): Display article + instead of article-copy when `reply'. + +2003-01-21 Jesper Harder + + * gnus.el (gnus-format): Change customize group to gnus. + (gnus-cache): Add link. + (gnus-group-charter-alist): Fix docstring. + +2003-01-20 Jesper Harder + + * mailcap.el (mailcap-print-command): lpr-command might be + unbound in XEmacs. + +2003-01-18 Kevin Greiner + + * gnus-agent.el (gnus-agent-regenerate-group): Added interactive form. + + * gnus-sum.el (gnus-summary-update-article-line): Fixed + calculation of net characters added for use in the gnus-data + structure. + +2003-01-18 Kai Gro,A_(Bjohann + + * nnmail.el (nnmail-process-unix-mail-format): Improve error + message. Suggested by Jari Aalto. + +2003-01-17 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-followup-with-original): Clean up. + (gnus-article-reply-with-original): Ditto. + + * gnus-sum.el (gnus-summary-catchup): Make sure downloadable, + read articles don't become unread. + +2003-01-17 Simon Josefsson + + * gnus-fun.el (gnus-x-face-from-file): + (gnus-face-from-file): Suggest image format in minibuffer prompt. + + * gnus-fun.el (gnus-convert-image-to-x-face-command) + (gnus-convert-image-to-face-command): Doc fix. + +2003-01-17 Lars Magne Ingebrigtsen + + * gnus-fun.el (gnus-convert-face-to-png): Protect against errors. + +2003-01-17 Jesper Harder + + * gnus-art.el (gnus-mime-print-part): Use mm-save-part-to-file to + avoid encoding problems. + + * mailcap.el (mailcap-ps-command): New variable. + (mailcap-mime-data): Add print entry where applicable. Use + pdftotext on a tty. + +2003-01-16 ShengHuo ZHU + + * gnus-sum.el (gnus-alter-header-function): Add type and group. + +2003-01-16 Simon Josefsson + + * gnus-fun.el (gnus-convert-image-to-x-face-command) + (gnus-convert-image-to-face-command, gnus-x-face-from-file) + (gnus-face-from-file): Doc fix; don't mention image format. + +2003-01-16 Teodor Zlatanov + + * spam.el (spam-get-article-as-filename): new function (unused for now) + (spam-get-article-as-buffer): new function + (spam-get-article-as-string): use spam-get-article-as-buffer + (spam-summary-prepare-exit): fixed bug, noticed by Malcolm Purvis + +2003-01-15 ShengHuo ZHU + + * gnus-agent.el: Don't use `path'. + From the GNU coding standards: + + Please do not use the term ``pathname'' that is used in Unix + documentation; use ``file name'' (two words) instead. We use + the term ``path'' only for search paths, which are lists of + directory names. + + * nnsoup.el (nnsoup-file-name): Ditto. + + * nnmail.el (nnmail-pathname-coding-system): Ditto. + (nnmail-group-pathname): Ditto. + + * nnimap.el (nnimap-group-overview-filename): Ditto. + + * nnheader.el (nnheader-pathname-coding-system): Ditto. + (nnheader-group-pathname): Ditto. + + * nnfolder.el (nnfolder-group-pathname): Ditto. + + * gnus.el (gnus-home-directory): Ditto. + + * gnus-group.el (gnus-group-icon-list): Ditto. + +2003-01-16 Jesper Harder + + * gnus-art.el (gnus-mime-print-part): Use mm-handle-media-type. + + * message.el (message-mode-menu): Use it. + (message-mode-menu): Deactivate "Yank Original" if there's no + reply buffer. + + * messagexmas.el (message-xmas-redefine): Redefine in XEmacs. + + * message.el (message-mark-active-p): New function. + +2003-01-15 Teodor Zlatanov + + * spam.el (spam-use-bogofilter-headers, spam-bogofilter-header) + (spam-bogofilter-database-directory): new variables + (spam-check-bogofilter-headers, spam-check-bogofilter) + (spam-bogofilter-register-with-bogofilter) + (spam-bogofilter-register-spam-routine) + (spam-bogofilter-register-ham-routine) + (spam-group-ham-processor-bogofilter-p): new functions for the new + Bogofilter interface + (spam-summary-prepare-exit): use the new Bogofilter functions + (spam-list-of-checks): added spam-use-bogofilter-headers + (spam-bogofilter-score): rewrote function + (spam-check-bogofilter): optional score parameter, uses + spam-check-bogofilter-headers better + (spam-check-bogofilter-headers): optional score parameter + + * gnus.el (gnus-install-group-spam-parameters): new variable, t by + default, in the gnus-start customization group. Used to disable + the spam-*/ham-* parameters. + (gnus-group-ham-exit-processor-bogofilter): new ham processor + +2003-01-15 Jesper Harder + + * gnus-xmas.el (gnus-xmas-redefine): Use region-exists-p in + XEmacs. + + * gnus-ems.el (gnus-mark-active-p): do. + +2003-01-15 Kevin Ryde + + * gnus.texi (Using MIME): Mention auto-compression-mode with + gnus-mime-copy-part. + +2003-01-15 Lars Magne Ingebrigtsen + + * message.el (message-send): Don't warn about duplicates when + superseding. + +2003-01-15 Simon Josefsson + + * nnimap.el (nnimap-split-download-body): New variable. + (nnimap-split-articles): Use it. + +2003-01-14 Kevin Greiner + + * gnus-agent.el (gnus-agent-check-overview-buffer): This data + integrity checker was incorrectly flagging, and removing, articles + whose article number was negative. + (gnus-agent-fetch-group-1): When executed in the group's summary + buffer, refresh each downloaded line to update the status flag and + font. Preserve the value of gnus-newsgroup-headers so that + gnus-agent-fetch-articles can split the requests by size. + (gnus-agent-expire): Corrected day calculation for when + gnus-agent-expire-days contains a list. + +2003-01-14 Lars Magne Ingebrigtsen + + * gnus-audio.el (gnus-audio-au-player): Use executable-find. + +2003-01-13 Jhair Tocancipa Triana + + * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use + /usr/bin/play as default player. + (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play. + +2003-01-14 Katsumi Yamaoka + + * gnus-msg.el (gnus-inews-add-send-actions): Allow a list of + articles to be marked as well. + +2003-01-14 Kevin Greiner + * gnus-agent.el (gnus-agent-get-undownloaded-list): Include the + fictious headers generated by nnagent (ie. Undownloaded Article + ####) in the list of articles that have not been downloaded. + + * gnus-int.el (): Added require declarations to resolve + compile-time warnings. + (gnus-open-server): If the server status is set to offline, + recursively execute gnus-open-server to open the offline backend + (e.g. nnagent). + +2003-01-14 Jesper Harder + + * gnus-art.el (gnus-article-reply-with-original): Use + gnus-mark-active-p. + (gnus-article-followup-with-original): do. + +2003-01-13 Reiner Steib + + * gnus-sum.el: Removed `(when t ...)' around `gnus-define-keys'. + +2003-01-13 Reiner Steib + + * gnus-score.el (gnus-score-edit-file-at-point): New function. + (gnus-score-find-trace): Bind it to `e' key. Added `q' for quit. + +2003-01-13 Romain FRANCOISE + + * gnus-fun.el (gnus-x-face-from-file): Quote file name. + (gnus-face-from-file): Ditto. + +2003-01-13 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-articles-to-read): Don't just apply + gnus-alter-articles-to-read-function to the unread articles. + +2003-01-13 Reiner Steib + + * deuglify.el (gnus-article-outlook-unwrap-lines) + (gnus-article-outlook-repair-attribution) + (gnus-article-outlook-rearrange-citation): New function names, + renamed from "gnus-outlook-" to "gnus-article-outlook-". Changed + doc-string. + + * gnus-sum.el (gnus-summary-mode-map): Use new function names, + removed `W k' key binding (use `W Y f' instead). + (gnus-summary-make-menu-bar): Use new function names. + +2003-01-13 Simon Josefsson + + * gnus-fun.el (gnus-random-x-face): Doc fix. + (gnus-insert-random-x-face-header): New function. + +2003-01-13 Jesper Harder + + * gnus-sum.el (gnus-summary-make-menu-bar): Deactivate items if + mark is not active. + + * gnus-msg.el (gnus-inews-do-gcc): Comment. + + * gnus-ems.el (gnus-mark-active-p): New function. + + * gnus-group.el (gnus-topic-mode-p): New function. + (gnus-group-make-menu-bar): Show more key bindings in topic mode. + Deactivate items if mark is not active. + +2003-01-12 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bumped version. + (gnus-summary-line-format): Doc fix. + +2003-01-12 22:02:49 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.12 is released. + +2003-01-12 Lars Magne Ingebrigtsen + + * mail-source.el (mail-sources): Removed autoload to make it + compile under XEmacs. + +2003-01-12 Raymond Scholz + + * gnus-msg.el (gnus-confirm-mail-reply-to-news): May be a + regexp or a function too. + (gnus-confirm-treat-mail-like-news): New variable. Ask for + confirmation even if the original article is mail. + +2003-01-12 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-add-send-actions): Get the right + articles to be marked when not yanking. + +2003-01-12 Fran,Ag(Bois-David Collin + + * mm-decode.el (mm-get-part): Use mm-with-unibyte-current-buffer. + +2003-01-12 Lars Magne Ingebrigtsen + + * gnus-fun.el (gnus-face-from-file): Autoload. + + * gnus-cite.el (gnus-cite-delete-overlays): Protect against more + errors. + +2003-01-12 Simon Josefsson + + * sieve.el (sieve-upload-and-bury): New. Suggested by + kai.grossjohann@uni-duisburg.de (Kai Gro,A_(Bjohann). + + * sieve-mode.el (sieve-mode-map): Bind s-u-a-b to C-c C-c. + Suggested by kai.grossjohann@uni-duisburg.de (Kai Gro,A_(Bjohann). + +2003-01-12 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-ignored-headers): Don't include the ^ and : + in every string. + + * gnus.el (gnus-version-number): Bumped version number. + +2003-01-12 13:46:20 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.11 is released. + +2003-01-12 Jesper Harder + + * message.el (message-fetch-reply-field): Narrow to headers. + + * gnus-msg.el (gnus-inews-do-gcc): Don't try to mark GCC's as read + if Gnus isn't alive. + +2003-01-11 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-group-1): Remove downloadable + marks from articles that are already stored in the agent. + (gnus-agent-backup-overview-buffer): New debug tool. Creates a + backup copy of an invalid .overview file for later analysis. + +2003-01-12 Gregorio Gervasio, Jr. + + * gnus-sum.el (gnus-summary-exit): Reverse change to make group + exit work with two frames. + +2003-01-11 Fran,Ag(Bois-David Collin + + * message.el (message-forward-make-body): Use mule4. + +2003-01-11 Lars Magne Ingebrigtsen + + * message.el (message-mode-map): Move wide-reply command. + +2003-01-10 Reiner Steib + + * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp): Added + castellano. + (gnus-outlook-display-hook): New variable. + (gnus-outlook-display-article-buffer): New function. + (gnus-outlook-unwrap-lines, gnus-outlook-repair-attribution) + (gnus-outlook-deuglify-article): Made them interactive and added + optional arg. Use `g-o-d-a-b'. + (gnus-article-outlook-deuglify-article): Use `g-o-d-a-b'. + + * gnus-sum.el: Added autoloads. + (gnus-summary-mode-map): Added gnus-summary-wash-deuglify-map. + (gnus-summary-make-menu-bar): Added "(Outlook) Deuglify" menu. + +2003-01-11 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-display-mime): Use the mime emulation + variable. + + * gnus-sum.el (gnus-article-emulate-mime): New variable. + + * gnus-start.el (gnus-read-newsrc-el-file): Make sure that the + newsrc-alist is initialized properly. + + * mail-source.el (mail-sources): Autoload. + + * gnus-sum.el (gnus-summary-make-false-root-always): Default to + nil. + + * gnus-msg.el (gnus-configure-posting-styles): Make sure we don't + insert two newlines. + + * message.el (message-check-news-header-syntax): Compute the + header length correctly. + +2003-01-10 Kevin Greiner + + * gnus-agent.el (gnus-agent-expire): Do not remove article from + alist when keeping fetched article file. + (gnus-agent-retrieve-headers): When parsing response for article + numbers, use the same algorithm as gnus-agent-braid-nov to protect + against garbage in the server's response. + + * gnus-int.el (gnus-request-expire-articles, + gnus-request-move-article): Only expire when the group's server + has been agentized. + +2003-01-10 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-cite-delete-overlays): Protect against + errors when deleting overlays. + + * gnus-score.el (gnus-score-followup): Allow tracing. + + * gnus-art.el (gnus-treat-display-face): New variable. + (article-display-face): New command. + + * gnus-fun.el (gnus-face-from-file): New function. + (gnus-convert-face-to-png): Ditto. + + * gnus-art.el (gnus-ignored-headers): Added Face. + +2003-01-10 Simon Josefsson + + * nndraft.el (nndraft-request-group): Avoid crash in + directory-files when draft directory doesn't exists. + + * gnus-sum.el (gnus-select-article-hook): Add :option. + +2003-01-10 Teodor Zlatanov + + * spam.el (spam-use-stat): new variable + (spam-group-spam-processor-stat-p) + (spam-group-ham-processor-stat-p): new convenience functions + (spam-summary-prepare-exit): add spam/ham processors to sequence + (spam-list-of-checks): add spam-use-stat to list of checks + (spam-split): conditionally load the spam-stat tables + (spam-stat-register-spam-routine, spam-stat-register-ham-routine, + spam-check-ifile): new functions + + * spam-stat.el (spam-stat): typo fix + (spam-stat-install-hooks): new variable + (spam-stat-split-fancy-spam-group): added documentation clarification + (spam-stat-split-fancy-spam-threshhold): new variable + (spam-stat-install-hooks): make hooks conditional + (spam-stat-split-fancy): use spam-stat-split-fancy-spam-threshhold + + * gnus.el (gnus-group-ham-exit-processor-stat, spam-process): add + spam-stat ham/spam processor symbols + +2003-01-10 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-read-newsrc-el-file): Make sure the .eld + file exists. + +2003-01-10 Simon Josefsson + + * gnus-sum.el (gnus-summary-read-group-1): Don't select first + undownloaded/downloadable only when unplugged. + +2003-01-10 Jesper Harder + + * gnus-srvr.el (gnus-browse-foreign-server): Optimize inner loop. + +2003-01-09 Teodor Zlatanov + + * spam.el (spam-check-ifile): fixed call-process-region to use the + db parameter only if it's set + (spam-ifile-register-with-ifile): ditto + +2003-01-09 Alex Schroeder + + * spam-stat.el (spam-stat-save): Set spam-stat-ngood and + spam-stat-nbad before creating the hash table. + (spam-stat-reset): Set spam-stat-ngood and spam-stat-nbad to 0. + Changed copyright statement to FSF. + +2003-01-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-catchup): Do not mark cached nor + processable articles as read. + (gnus-agent-summary-fetch-series): Remove processable and + downloadable marks on all downloaded articles in the series. + + * nntp.el (nntp-report): Throw error after reporting the problem. + (nntp-accept-process-output): Corrected error check to report an + error when the process is nil. + +2003-01-09 Simon Josefsson + + * message.el (message-tool-bar-map): Add preview. + +2003-01-09 Jesper Harder + + * mml.el (mml-preview): Get rid of MIME handles and buffers after + previewing. + +2003-01-08 Paul Jarc + + * nnmaildir.el (nnmaildir--grp-add-art): Fix wrong-type-argument + bug when the (n+1)th article to be added to a group has a smaller + number than the n articles already added. + +2003-01-08 Jesper Harder + + * message.el (message-mode-field-menu): Use backquote. + +2003-01-08 Teodor Zlatanov + + * spam.el: fixed the BBDB autoloads again, using + bbdb-search-simple now (which is not a macro, thank god) + + * lpath.el (bbdb-search): removed function from maybe-fbind list + + * gnus.el (ham-process-destination): added new parameter for + destination of ham articles found in spam groups at summary exit + + * spam.el (spam-get-ifile-database-parameter): use spam-ifile-database-path + (spam-check-ifile, spam-ifile-register-with-ifile): use spam-get-ifile-database-parameter + (spam-ifile-database-path): added new parameter for ifile's database + (spam-move-spam-nonspam-groups-only): new parameter to determine + if spam should be moved from all groups or only some + (spam-summary-prepare-exit): fixed logic to use + spam-move-spam-nonspam-groups-only when deciding to invoke + spam-mark-spam-as-expired-and-move-routine; always invoke that + routine after the spam has been expired-or-moved in case there's + some spam left over; use spam-ham-move-routine in spam groups + (spam-ham-move-routine): new function to move ham articles to the + ham-process-destinations group parameter + +2003-01-08 Lars Magne Ingebrigtsen + + * gnus-spec.el (gnus-parse-complex-format): %~ => ~*. + + * gnus-agent.el (gnus-agent-fetch-selected-article): Use + gnus-summary-update-article-line. + +2003-01-08 Simon Josefsson + + * nnmail.el (nnmail-expiry-target-group): Request group, create it + not successful. + +2003-01-08 Katsumi Yamaoka + + * lpath.el (bbdb-records): Fbind it for both Emacs and XEmacs. + +2003-01-07 Teodor Zlatanov + + * spam.el (spam-check-ifile): fixed the spam-ifile-all-categories + logic, finally + +2003-01-08 Lars Magne Ingebrigtsen + + * gnus-spec.el (gnus-parse-format): %C is a complex format. + (gnus-parse-format): Change to %~. + + * message.el (message-generate-headers): Don't generate optional + empty headers. + +2003-01-07 Reiner Steib + + * message.el (message-cross-post-default) + (message-cross-post-note-function, message-shoot-gnksa-feet) + (message-strip-subject-trailing-was, message-change-subject) + (message-mark-insert-file, message-cross-post-followup-to) + (message-cross-post-followup-to, message-mode-map) + (message-generate-unsubscribed-mail-followup-to) + (message-make-mail-followup-to): Minor changes to doc-strings and + error messages. Updated copyright line. + + * message.el (message-make-mail-followup-to, + message-generate-unsubscribed-mail-followup-to): New function + names. Renamed functions: "-mft" -> "-mail-followup-to". + (message-make-mft, message-gen-unsubscribed-mft): Removed function + names. + + * mml.el (mml-preview-insert-mail-followup-to): New function name. + (mml-preview-insert-mft): Removed function name. + (mml-preview): Use new function names. + + * gnus-art.el (gnus-article-edit-mode-map): Use new function names. + + * message.el (message-mode-field-menu): Moved header related + commands from "Message" to "Field" menu. + +2003-01-07 Reiner Steib + + * message.el (message-generate-headers-first): Added customization + if variable is a list. + +2003-01-07 Michael Shields + + * gnus-art.el (gnus-article-next-page): Correctly handle the case + where the last line of the article is the last line of the window. + +2003-01-08 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-debug): Use ignore-errors. + + * gnus-agent.el (gnus-agent-fetch-selected-article): Use + `gnus-summary-update-line'. + +2003-01-08 Simon Josefsson + + * gnus-art.el (gnus-unbuttonized-mime-types) + (gnus-buttonized-mime-types): Doc fix. + +2003-01-08 Jesper Harder + + * mm-decode.el (mm-inline-media-tests): .xpm is 'x-xpixmap'. + +2003-01-07 ShengHuo ZHU + + * nnrss.el (nnrss-group-alist): Add and clear up. + +2003-01-07 Teodor Zlatanov + + * spam.el: removed unnecessary condition-case for loading bbdb-com.el + + * lpath.el (bbdb-search): added BBDB functions for a better way to + fix missing functions + + * spam.el (spam-check-ifile): if should be an unless + + * spam.el: define 'ignore alias for spam-BBDB-register-routine, + spam-enter-ham-BBDB, and bbdb-create-internal initially to hush up warnings + (spam-ifile-all-categories): doc string fixed to be less than 80 chars + +2003-01-07 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-make-menu-bar): Added + gnus-summary-refer-thread to thread menu. + +2003-01-07 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-group-1): When fetching within a + summary buffer, articles that cannot be fetched are marked as + canceled. + + * nntp.el (nntp-with-open-group): The quit signal handler must + propagate the quit signal to the next outer handler so that the + caller knows that the request aborted abnormally. + +2003-01-07 Teodor Zlatanov + + * spam.el (spam-check-ifile, spam-ifile-register-with-ifile) + (spam-ifile-register-spam-routine) + (spam-ifile-register-ham-routine): added ifile functionality that + does not use ifile-gnus.el to classify and register articles + (spam-get-article-as-string): convenience function + (spam-summary-prepare-exit): added ifile spam and ham registration + (spam-ifile-all-categories, spam-ifile-spam-category) + (spam-ifile-path, spam-ifile): added customization options + + * gnus.el (gnus-group-ham-exit-processor-ifile): added ifile ham + exit processor + (spam-process): added gnus-group-ham-exit-processor-ifile to the + list of choices + +2003-01-07 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-followup): Also score immediate + followups. + +2003-01-06 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-asynchronous-p): Changed to nil. + +2003-01-07 Simon Josefsson + + * message.el (message-mode-menu): Fix receipt balloon help. + +2003-01-07 Jesper Harder + + * gnus-msg.el (gnus-group-post-news): Don't assume that "" will + always be interpreted as news. + +2003-01-07 Simon Josefsson + + * gnus-sieve.el (gnus-sieve-script): Use the crosspost argument to + gnus-sieve-script, instead of the global variable + gnus-sieve-crosspost. One-line patch from Steinar Bang + . + +2003-01-06 Kevin Greiner + + * gnus.el: Renamed gnus-summary-*-uncached-face as + gnus-summary-*-undownloaded-face to avoid confusing the agent with + the cache. + + * gnus-sum.el: Ditto. + +2003-01-06 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution + in either the group or summary buffer. + New command "JS", in summary buffer, will fetch articles per the + group's category, predicate, and processable flags. + (gnus-agent-summary-fetch-series): Rewritten to call + gnus-agent-session-fetch-group once with all articles in the + series. + (gnus-agent-summary-fetch-group): Fixed bug and modified code to + return list of fetched articles. + (gnus-agent-fetch-articles): Split fetch list into sublists such + that the article buffer is only slightly larger than + gnus-agent-max-fetch-size. Added unwind-protect to ensure that + the group's article alist is saved. + (gnus-agent-fetch-headers): The 'killed' and 'cached' marks no + longer result in the agent trying to fetch an article. + (gnus-agent-fetch-group-1): Can now be called in either the group + or summary buffer. Removed the max-fetch-size code that I added + on 2002-12-13 as that capability is now part of + gnus-agent-fetch-articles. Added code to update summary buffer. + When called in the group buffer, articles that can not be fetched + are AUTOMATICALLY MARKED AS READ. + + * gnus-sum.el (): Modified eval-when-compile to minimize + misleading compilation warnings. + (gnus-update-summary-mark-positions): Changed code to use + gnus-undownloaded-mark rather than gnus-downloaded-mark. + + * nnheader.el (nnheader-insert-nov-file): Do not try to insert an + empty file as the parser assumes that the file isn't empty. + + * nntp.el (nntp-send-string): The process-send-string call can, + because it performs I/O on the process, change the process' state + from open to closed. If this happens, call nntp-report + immediately to report the broken connection. + (nntp-report): Rewritten to avoid needing a global variable to + determine the appropriate course of action. Instead, two function + implementations are provided and the nntp-report function value is + bound to the appropriate implementation. + (nntp-retrieve-data): Moved nntp-report call to end of implementation. + (nntp-with-open-group): Now binds nntp-report's function cell + rather than binding gnus-with-open-group-first-pass. Added a + condition-case to detect a quit during a nntp command. When the + quit occurs, the current connection is closed as a fetch articles + request could have several megabytes queued up for reading. + (nntp-retrieve-headers): Bind articles to itself. If + nntp-with-open-group repeats this command, I must have access to + the original list of articles. + (nntp-retrieve-groups): Ditto for groups. + (nntp-retrieve-articles): Ditto for articles. + (*): Replaced nntp-possibly-change-group calls to + nntp-with-open-group forms in all, but one, occurrance. + (nntp-accept-process-output): Bug fix. Detect when called with + null process. + +2003-01-06 Jesper Harder + + * mm-util.el (mm-find-mime-charset-region): Don't do Latin-9 hack + if we don't need to. + (mm-iso-8859-x-to-15-region): Fix misplaced parenthesis. + +2003-01-06 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-make-web-group): Pass the select + method on to group-create. + (gnus-group-line-format-alist): %U is an integer. + + * gnus-sum.el (gnus-summary-exit-no-update): Don't update + ephemeral groups. + (gnus-summary-read-group-1): Ditto. + (gnus-group-make-articles-read): Ditto. + + * mm-url.el (mm-url-program): Doc fix. + + * message.el (message-mode-map): Rebound + message-insert-wide-reply. + +2003-01-05 Katsumi Yamaoka + + * gnus-xmas.el (gnus-xmas-group-startup-message): Bind the oort + color as `gnus-group-startup-message' does. + +2003-01-05 Teodor Zlatanov + + * spam.el: fixed line lengths to 80 chars or less + + * gnus-sum.el (gnus-read-mark-p): added the spam-mark as a + "not-read" mark + (gnus-summary-mark-forward): added the spam-mark to the list of + marks not to be marked as "read" when viewed + +2003-01-05 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-make-draft): Quote article-reply. + + * gnus-group.el (gnus-number-of-unseen-articles-in-group): + Protect against unactive groups. + + * message.el (message-check-news-header-syntax): Check long + header lines. + (message-check-news-header-syntax): Update `start'. + + * gnus-group.el (gnus-group-expire-articles): Doc fix. + (gnus-group-line-format): %U. + (gnus-group-line-format-alist): ?U. + (gnus-number-of-unseen-articles-in-group): New function. + + * nntp.el (nntp-accept-process-output): Use a 0.1 second timeout. + + * gnus.el (gnus-version-number): Bump version number. + +2003-01-05 01:53:30 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.10 is released. + +2003-01-05 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Fix version number. + +2003-01-05 01:40:09 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.08 is released. + +2003-01-04 Jesper Harder + + * mm-util.el: Add mm-string-make-unibyte. + + * gnus-group.el (gnus-group-jump-to-group): Make it work for + UTF-8 groups. + +2003-01-04 Lars Magne Ingebrigtsen + + * gnus.el (gnus-variable-list): Write gnus-format-specs last. + + * gnus-sum.el (gnus-summary-goto-subjects): Fix typo. + +2003-01-04 Kevin Ryde + + * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New + function. + +2003-01-04 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-exit): Bind gnus-group-is-exiting-p. + (gnus-summary-read-group-1): Update group line. + (gnus-summary-exit-no-update): Update group on exit. + + * gnus-group.el (gnus-group-line-format): Add %*. + (gnus-group-line-format-alist): Ditto. + (gnus-group-insert-group-line): Set it. + (gnus-group-is-exiting-p): New variable. + (gnus-group-insert-group-line): Use it. + +2003-01-03 Teodor Zlatanov + + * spam.el (spam-enter-ham-BBDB, spam-BBDB-register-routine): + enable BBDB ham processing + (spam-blacklist-register-routine): enable blacklist spam processing + (spam-whitelist-register-routine): enable whitelist ham processing + (spam-fetch-field-from-fast): fast fetching of the "from" field + from (gnus-data-list) + (spam-summary-prepare-exit): works completely now + (spam-use-blacklist): oops, should be nil by default + (spam-summary-prepare-exit): spam-use-PROCESSOR is only for + split processing now; before it was for summary exit as + well but that's done with the spam-contents and spam-process + parameters now + +2003-01-03 Jesper Harder + + * mml.el (mml-insert-tag): Don't quote non-ASCII unibyte + characters. + +2003-01-02 Teodor Zlatanov + + * spam.el (spam-group-spam-contents-p, spam-group-ham-contents-p) + (spam-group-processor-p, spam-group-processor-bogofilter-p) + (spam-group-processor-ifile-p, spam-group-processor-blacklist-p) + (spam-group-processor-whitelist-p, spam-group-processor-BBDB-p) + (spam-mark-spam-as-expired-and-move-routine) + (spam-generic-register-routine, spam-BBDB-register-routine) + (spam-ifile-register-routine, spam-blacklist-register-routine) + (spam-whitelist-register-routine): new functions + (spam-summary-prepare-exit): added summary exit processing (expire + or move) of spam-marked articles for spam groups; added slots for + all the spam-*-register-routine functions + +2003-01-03 Lars Magne Ingebrigtsen + + * pop3.el (pop3-retr): Wait 500 msecs. + (pop3-read-response): Ditto. + + * gnus-msg.el (gnus-setup-message): Get the evaliation order + right. + (gnus-inews-make-draft): New function. + (gnus-setup-message): Use it. + + * message.el (message-required-headers): Add From. + +2003-01-02 Katsumi Yamaoka + Trivial patch from Norbert Koch . + + * gnus-msg.el (gnus-gcc-externalize-attachments): Fix typo. + +2003-01-02 Lars Magne Ingebrigtsen + + * message.el (message-generate-headers): Let header formatters do + their work. - * qp.el (quoted-printable-decode-region): Don't backward-char. +2003-01-02 Raymond Scholz -2000-12-25 00:00:00 ShengHuo ZHU + * deuglify.el (gnus-article-outlook-deuglify-article): + Rehighlight, reapply treatments and call + `gnus-article-prepare-hook'. Suggested by Niels Olof Bouvin. + (gnus-outlook-repair-attribution-block): Recognize cited + attributions. Suggested by Niklas Morberg. - * dgnushack.el (dgnushack-compile): elc is in the current directory. +2003-01-02 Pete Kazmier - * qp.el (quoted-printable-encode-region): Don't check multibyte in - XEmacs. + * gnus-art.el (gnus-treat-predicate): Check condition first. -2000-12-25 Simon Josefsson +2003-01-02 Jesper Harder - * starttls.el: Sync with Emacs 21. + * lpath.el: Add url-http-file-exists-p. -2000-12-22 12:00:00 ShengHuo ZHU + * gnus-group.el (gnus-group-fetch-charter): Use + http://TLH.news-admin.org/charters/GROUPNAME as a fallback. - * gnus-vm.el (gnus-summary-save-article-vm): Require gnus-art - before binding gnus-default-article-saver. +2003-01-02 Lars Magne Ingebrigtsen - * gnus-sum.el (gnus-summary-save-article): - (gnus-summary-pipe-output): - (gnus-summary-save-article-mail): - (gnus-summary-save-article-rmail): - (gnus-summary-save-article-file): - (gnus-summary-write-article-file): - (gnus-summary-save-article-body-file): Ditto. + * message.el (message-draft-headers): Also generate From to get a + nicer draft buffer summary. - * gnus-mh.el (gnus-summary-save-article-folder): Ditto. + * gnus-xmas.el (gnus-xmas-read-event-char): Take an optional + parameter. -2000-12-22 09:00:00 ShengHuo ZHU + * gnus-art.el (article-wash-html): Clean up. + (article-wash-html): Typo fix. - * messagexmas.el (message-xmas-redefine): New function. + * gnus-msg.el (gnus-summary-mail-forward): Clean up. + (gnus-summary-mail-forward): To many lists of lists. - * message.el: Use it. + * gnus-art.el (article-wash-html): Clean up. - * gnus-art.el (gnus-article-check-hidden-text): Return t. +2003-01-02 pete-temp - * gnus-util.el (gnus-remove-text-properties-when): Return t. + * gnus-art.el (gnus-treat-wash-html): New variable. -2000-12-22 02:00:00 ShengHuo ZHU +2003-01-02 Lars Magne Ingebrigtsen - * Makefile.in (install-el): New. + * message.el (message-check-news-header-syntax): Allow posting. + (message-check-news-header-syntax): Fix logic for sure, this + time. -2000-12-21 Katsumi Yamaoka +2003-01-02 Matthieu Moy - * gnus-art.el (article-treat-dumbquotes): Quote \. + * message.el (message-check-news-header-syntax): Check syntax of + continuation headers. -2000-12-21 22:00:00 ShengHuo ZHU +2003-01-02 Reiner Steib - * gnus-art.el (gnus-treat-emphasize): Don't treat emphasis if - Emacs 20 runs on a terminal. + * gnus-art.el (gnus-button-url-regexp, + (gnus-button-mid-or-mail-regexp, gnus-button-alist, + (gnus-header-button-alist): Regexps are case insensitive here. -2000-12-21 14:00:00 ShengHuo ZHU +2003-01-02 Simon Josefsson - * mml.el (gnus-add-minor-mode): Autoload. + * dig.el (query-dig): Doc fix. - * message.el (message-forward): Save-restriction. +2003-01-02 Kai Gro,A_(Bjohann -2000-12-21 Kai Gro,A_(Bjohann + * gnus-agent.el (gnus-agent-fetch-selected-article): Update whole + summary buffer line, not just the download mark. - * gnus-art.el (article-treat-dumbquotes): More doc, provided by - Paul Stevenson +2003-01-02 Lars Magne Ingebrigtsen -2000-12-21 10:00:00 ShengHuo ZHU + * gnus-sum.el (gnus-summary-goto-subjects): New function. + (gnus-summary-insert-dormant-articles): New command and + keystroke. - * gnus-ml.el (gnus-mailing-list-mode-map): Use C-c C-n prefix. + * gnus-cache.el (gnus-summary-insert-cached-articles): Use new + function for mass insertion of subjects. - * gnus.el (gnus-decode-rfc1522): Removed. - (gnus-set-text-properties): Define. + * nndraft.el (nndraft-generate-headers): Don't move point. -2000-12-21 09:00:00 ShengHuo ZHU + * gnus.el (nnheader): Require nnheader. - * gnus-art.el (gnus-mime-*): handle may be nil. + * nndraft.el (nndraft-request-associate-buffer): Use + make-local-variable. - * gnus-sum.el (gnus-summary-mode): Turn on gnus-mailing-list-mode. +2003-01-02 Michael Shields - * gnus.el (gnus-group-remove-excess-properties): Not defined - in gnus-xmas. + * nndraft.el (nndraft-request-associate-buffer): Make + write-contents-hooks buffer-local before setting it. -2000-12-20 21:00:00 ShengHuo ZHU +2003-01-02 Lars Magne Ingebrigtsen - * message.el (message-mail-user-agent): Add :version. + * gnus.el (gnus-group-parameter-value): Take an extra param. + (gnus-group-fast-parameter): Let group param results be nil. -2000-12-21 Miles Bader + * gnus-art.el (gnus-article-forward-header): New function. + (article-date-ut): Use it to remove continuation date headers. - * message.el (message-mode): Set `comment-start' to the yank prefix. + * gnus-sum.el (gnus-summary-walk-group-buffer): Supply prompt to + read-event. + (gnus-summary-remove-bookmark): Clean up. + (gnus-summary-set-bookmark): Clean up. -2000-12-20 17:00:00 ShengHuo ZHU + * gnus-util.el (gnus-read-event-char): Take an optional prompt. - * 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.el (gnus-group-startup-message): Bind data-directory to + the Gnus etc directory. -2000-12-20 15:00:00 ShengHuo ZHU +2003-01-01 Teodor Zlatanov - * 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. + * spam.el (spam-summary-prepare-exit): added slots for spam- and + ham-processing of articles; use the new + spam-group-(spam|ham)-contents-p functions + (spam-group-spam-contents-p, spam-group-ham-contents-p): new + convenience functions + (spam-mark-junk-as-spam-routine): use the new + spam-group-spam-contents-p function -2000-12-20 11:00:00 ShengHuo ZHU + * gnus.el (spam-process, spam-contents, spam-process-destination): + added new parameters with corresponding global variables + (gnus-group-spam-exit-processor-ifile, + gnus-group-spam-exit-processor-bogofilter, + gnus-group-spam-exit-processor-blacklist, + gnus-group-spam-exit-processor-whitelist, + gnus-group-spam-exit-processor-BBDB, + gnus-group-spam-classification-spam, + gnus-group-spam-classification-ham): added new symbols for the + spam-process and spam-contents parameters - * uudecode.el (uudecode-decode-region-external): make-temp-file - may not be defined. + * spam.el (spam-ham-marks, spam-spam-marks): changed list + customization and list itself to store mark symbol rather than + mark character. + (spam-bogofilter-register-routine): added logic to generate mark + values list from spam-ham-marks and spam-spam-marks, so (member) + would work. - * binhex.el (defalias): eval-and-compile. +2003-01-02 Katsumi Yamaoka - * message.el (message-tool-bar-map): New function. - (message-mode): Use it. + * message.el (message-cross-post-followup-to): Fix comment. -2000-12-20 09:00:00 ShengHuo ZHU +2003-01-01 Teodor Zlatanov - * nntp.el (nntp-find-connection): Remove the entry. - (nntp-retrieve-groups): (gnus-buffer-live-p buf). + * spam.el (spam-ham-marks, spam-spam-marks): changed list + customization and list itself to store mark symbol rather than + mark character. + (spam-bogofilter-register-routine): added logic to generate mark + values list from spam-ham-marks and spam-spam-marks, so (member) + would work. -2000-12-20 04:00:00 ShengHuo ZHU +2003-01-01 Raymond Scholz - * message.el (message-make-forward-subject): Don't widen. Decode. - (message-forward): Don't decode subject. + * message.el (message-signature-insert-empty-line): New variable. -2000-12-20 Christoph Conrad +2002-12-30 Reiner Steib - * qp.el (quoted-printable-encode-region): Upcase QP. + * message.el: Renamed functions and variables: "xpost" -> + "cross-post", "-fup2" -> "-followup-to". + (message-cross-post-old-target, message-cross-post-default, + message-cross-post-note, message-followup-to-note, + message-cross-post-note-function): New variables names. + (message-xpost-old-target, message-xpost-default, + message-xpost-note, message-fup2-note, + message-xpost-note-function): Removed variable names. + (message-cross-post-followup-to-header, + message-cross-post-insert-note, message-cross-post-followup-to): + New function names. + (message-xpost-fup2-header, message-xpost-insert-note, + message-xpost-fup2): Removed function names. -2000-12-20 02:00:00 ShengHuo ZHU +2002-12-30 Reiner Steib - * gnus-art.el (gnus-insert-mime-button): Simplify. - (gnus-mime-display-alternative): Ditto. - (gnus-insert-mime-security-button): Ditto. + * message.el (message-send-mail): Added message-cleanup-headers to + prevent newlines in headers. -2000-12-20 01:00:00 ShengHuo ZHU +2003-01-01 Lars Magne Ingebrigtsen - * 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. + * dns.el (dns-make-network-process): Comment. -2000-12-19 22:00:00 ShengHuo ZHU + * gnus-sum.el (gnus-summary-display-while-building): Default to + nil. - * gnus-art.el (gnus-insert-mime-button): Emacs20 needs local-map. - (gnus-mime-display-alternative): Ditto. - (gnus-insert-mime-security-button): Ditto. +2003-01-01 Wes Hardaker -2000-12-19 19:00:00 ShengHuo ZHU + * gnus-sum.el (gnus-summary-display-while-building): New + variable. - * nnmbox.el (nnmbox-file-coding-system): Use binary. - (nnmbox-active-file-coding-system): Ditto. +2003-01-01 Raymond Scholz -2000-12-19 18:00:00 ShengHuo ZHU + * deuglify.el (gnus-outlook-rearrange-article): Kill overlays + before rearranging the article. - * gnus.el (gnus-version): - (gnus-version-number): Set to Oort Gnus 0.01. +2003-01-01 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-mime-security-button-map): - (gnus-insert-mime-security-button): Fix for Emacs21. + * nndraft.el (nndraft-generate-headers): New function. + (nndraft-request-associate-buffer): Use it to write headers on + buffer save. -2000-12-19 Raymond Scholz + * message.el (message-generate-headers): Let the function be a + lambda form. + (message-draft-headers): New variable. - * gnus-art.el (gnus-article-dumbquotes-map): Add EUR symbol. + * gnus-msg.el (gnus-inews-make-draft-meta-information): New + function. + (gnus-setup-message): Use it. -2000-12-15 10:00:00 ShengHuo ZHU + * message.el (message-generate-headers-first): Doc fix. + (message-setup-1): Use new function for getting which headers to + generate. + (message-headers-to-generate): New function. - * pop3.el (pop3-movemail): Use binary. - (pop3-movemail-file-coding-system): Removed. +2003-01-01 ShengHuo ZHU -2000-12-14 13:00:00 ShengHuo ZHU + * gnus-agent.el (gnus-agent-save-alist): Make directory. - * mm-util.el (mm-charset-synonym-alist): Add cn-gb. +2002-12-31 Reiner Steib <4uce.02.r.steib@gmx.net> -2000-12-13 13:00:00 ShengHuo ZHU + * gnus-sum.el (gnus-summary-limit-to-age): Make prompt string + mention negatives. - * gnus-msg.el (gnus-post-method): Use backend name when the - address is "". +2002-12-31 Raymond Scholz -2000-12-04 22:00:00 ShengHuo ZHU + * deuglify.el (gnus-outlook-rearrange-article): Use + `transpose-regions' instead of tempering the kill-ring. + (gnus-article-outlook-deuglify-article): Rehighlight article + instead of a complete redisplay. - * gnus-win.el (gnus-configure-frame): Save selected window. +2002-12-31 Teodor Zlatanov -2000-12-04 14:00:00 ShengHuo ZHU + * spam.el: most defvars are defcustoms now - * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if - succeed. + patches from Michael Shields -2000-12-04 13:00:00 ShengHuo ZHU + * spam.el (spam-bogofilter-articles): Select the article + body using gnus-summary-show-article t instead of + gnus-summary-select-article; this presents the raw text + without running any hooks. - * gnus-win.el (gnus-configure-windows): Make sure - nntp-server-buffer is live. - (gnus-remove-some-windows): switch-to-buffer -> set-buffer. + * spam.el (spam-bogofilter-articles): Use message-remove-header + to remove headers; the old way incorrectly removed just the first + line of folded headers. -2000-11-21 Stefan Monnier +2002-12-31 Katsumi Yamaoka - * gnus-win.el (gnus-configure-windows): switch-to-buffer -> set-buffer. + * gnus-start.el (gnus-load): Replace `ding-file' with `file'. -2000-12-04 Andreas Jaeger +2002-12-30 Lars Magne Ingebrigtsen - * gnus-msg.el (gnus-summary-mail-forward): Fix typos in description. + * gnus-start.el (gnus-load): New function. + (gnus-read-newsrc-el-file): Use it. -2000-12-01 Christopher Splinter +2002-12-30 Reiner Steib - * gnus-sum.el (gnus-summary-limit-to-age): Fix typo. + * gnus-art.el (gnus-button-valid-fqdn-regexp): New variable. + (gnus-button-handle-apropos-documentation): New function. + (gnus-button-handle-ctan): New function. + (gnus-button-alist): Use them. Improve some regexps. + (gnus-button-prefer-mid-or-mail): Addition to doc-string. -2000-11-30 19:00:00 ShengHuo ZHU +2002-12-30 Reiner Steib - * gnus-util.el (gnus-add-text-properties-when): New function. - (gnus-remove-text-properties-when): Ditto. + * message.el (message-subscribed-p): New function. + (message-send-mail): Use it. + * mml.el (mml-preview-insert-mft): New function. + (mml-preview): Use it. - * 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. +2002-12-30 Lars Magne Ingebrigtsen -2000-11-30 14:00:00 ShengHuo ZHU + * gnus-sum.el (gnus-thread-latest-date): Protect against errors + when sorting by date. - * mm-util.el (mm-find-charset-region): Remove eight-bit-*. + * gnus-art.el (gnus-article-edit-mode): New variable. + (gnus-article-setup-buffer): Warn user about discarding edits. -2000-11-29 21:00:00 ShengHuo ZHU + * gnus-sum.el (gnus-summary-pipe-output): Clean up. + (gnus-summary-pipe-output): Take a symbolic prefix to save all + headers. - * nndraft.el (nndraft-request-restore-buffer): Remove Date field. + * mm-uu.el (mm-uu-configure-list): Default to (shar . disabled). -2000-11-29 00:00:00 ShengHuo ZHU +2002-12-30 Reiner Steib - * nnmail.el (nnmail-cache-accepted-message-ids): Add doc. + * message.el (message-completion-alist): Added "Mail-Followup-To" + and "Mail-Copies-To". -2000-11-28 17:00:00 ShengHuo ZHU +2002-07-21 Jesper harder - * message.el (message-shoot-gnksa-feet): New variable. - (message-gnksa-enable-p): New function. - (message-send): Use it. - (message-check-news-body-syntax): Ditto. + * gnus-group.el: Add key bindings for + gnus-group-sort-groups-by-real-name and + gnus-group-sort-selected-groups-by-real-name. -2000-11-28 Katsumi Yamaoka +2002-07-21 Jesper harder - * message.el (message-make-message-id): Remove the redundancy. + * gnus.texi (Sorting Groups): Add key bindings for + gnus-group-sort-groups-by-real-name and + gnus-group-sort-selected-groups-by-real-name. -2000-11-22 14:00:00 ShengHuo ZHU +2002-12-30 Teodor Zlatanov - * gnus-ml.el (gnus-mailing-list-insinuate): New function. + * spam.el (spam-use-dig): new variable for blackhole checking + through dig.el + (spam-check-blackholes): added dig.el checking functionality and + more verbose reporting; query-dig is autoloaded from dig.el + (spam-use-blackholes): disabled by default + (spam-blackhole-servers): removed rbl.maps.vix.com from the + blackhole servers list -2000-11-22 13:00:00 ShengHuo ZHU +2002-12-30 Lars Magne Ingebrigtsen - * gnus-ml.el (gnus-mailing-list-archive): Find the real url. + * message.el (message-required-headers): New variable. -2000-11-22 11:00:00 ShengHuo ZHU +2002-12-30 Teodor Zlatanov - * message.el (message-send-mail): Use buffer-substring-no-properties. - (message-send-news): Ditto. + * dig.el (query-dig): new function -2000-11-22 David Edmondson +2002-12-30 Lars Magne Ingebrigtsen - * imap.el (imap-wait-for-tag): Message read info. + * flow-fill.el (fill-flowed): Don't infloop on too long fill + prefixes. -2000-11-20 18:00:00 ShengHuo ZHU + * dns.el (query-dns): Protect against errors. - * gnus-ml.el (gnus-mailing-list-archive): Use browse-url. + * gnus-msg.el (gnus-article-yanked-articles): New variable. + (gnus-inews-add-send-actions): Mark all answered messages as + answered. -2000-11-20 17:00:00 ShengHuo ZHU +2002-08-10 Jari Aalto - * gnus-art.el (gnus-article-make-menu-bar): Use easy-menu-add. + * nnmail.el (nnmail-split-it): Added tracing to + `:' split rule -2000-11-20 16:00:00 ShengHuo ZHU +2002-08-13 Hrvoje Niksic - * gnus-art.el (gnus-article-describe-key): Use prompt. - (gnus-article-describe-key-briefly): Ditto. + * mm-decode.el (mm-mailcap-command): Remove the quotes around '%s' + and "%s" so we don't overquote them. -2000-11-20 15:00:00 ShengHuo ZHU +2002-08-13 Hrvoje Niksic - * gnus-agent.el (gnus-agent-expire): Ignore corrupted history. + * (mm-display-external): Display the actual command that has been + executed in the echo area. -2000-11-20 10:00:00 ShengHuo ZHU +2002-12-29 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-article-describe-key): New function. - (gnus-article-describe-key-briefly): New function. + * gnus-topic.el (gnus-topic-display-missing-topic): Bind entry. + + * message.el (message-with-reply-buffer): New macro. + (message-fetch-reply-field): Use it. + (message-insert-wide-reply): New command and keystroke. + (message-carefully-insert-headers): New function. + (message-insert-to): Use new function. + + * gnus-topic.el (gnus-topic-display-missing-topic): New function. + (gnus-topic-goto-missing-group): Use it. + + * message.el (message-required-news-headers): Removed Lines. + (message-reply): Don't insert References first. + (message-followup): Ditto. + (message-make-references): New function. + (message-followup): Set message-reply-headers before generating + the buffer stuff. + +2002-12-29 Jesper Harder + + * mml.el (mml-generate-mime-1): Reverse the order of + encoding/flowing. + +2002-12-29 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-expiry-target-group): Mark articles as read + after moving them. + + * gnus-sum.el (gnus-summary-dummy-line-format): Update format to + fit with newer standard format. + (gnus-summary-make-false-root-always): New variable. + (gnus-gather-threads-by-subject): Use it. + + * message.el (message-get-reply-headers): Take an address list + optional argument. + +2002-12-28 Lars Magne Ingebrigtsen + + * gnus.el (gnus-keep-backlog): Change default to 20. + + * gnus-agent.el (gnus-agent-check-overview-buffer): Start from + start. + (gnus-agent-check-overview-buffer): Remove negative article + numbers. + + * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): Doc fix. + (nnmail-cache-ignore-groups): Doc fix. + + * nnimap.el (nnimap-debug): Made into a flag and defcustomed. + (nnimap-debug-buffer): New variable. + (nnimap-debug): Use it. + +2002-12-28 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-high-uncached-face): New color scheme. + +2002-12-28 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-check-overview-buffer): Sort lines if + they aren't already sorted. + +2002-12-28 Jesper Harder + + * message.el (message-mode-menu): Add ellipses to menu items + expecting user interaction. + (message-mode-field-menu): do. + +2002-12-26 Jesper Harder + + * gnus-sum.el (gnus-summary-highlight-line): Don't bind `list' -- + it isn't used any more. + +2002-12-22 Jesper Harder + + * binhex.el (binhex-decoder-program): Fix docstring. + +2002-12-21 Kai Gro,A_(Bjohann + + * mm-decode.el (mm-mailcap-command): Do not backslash-quote + special chars if the mailcap file uses single quotes around %s. + From Laurent Martelli . + +2002-12-19 Paul Jarc + + * gnus-int.el (gnus-request-update-info): nnchoke-r-u-i might not + return the info object. + +2002-12-18 Paul Jarc + + * gnus-int.el (gnus-request-update-info): Artificially add + (1 . (1- min)) to the read range, in case the backend doesn't + store marks for nonexistent articles. + +2002-12-17 Katsumi Yamaoka + + * binhex.el (binhex-insert-char): Eval-and-compile. + +2002-12-17 Jesper Harder + + * lpath.el: Add tool-bar-local-item-from-menu. + + * message.el (message-tool-bar-local-item-from-menu): New function. + (message-tool-bar-map): Use it. + +2002-12-14 Jesper Harder + + * gnus-uu.el (gnus-uu-digest-headers): Mention nil value in docstring. + + * gnus-art.el (gnus-article-header-rank): Last header in + gnus-sorted-header-list should have higher rank than non-members. + +2002-12-13 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-close-agent): Don't blank out the list of + covered methods. + +2002-12-12 Kai Gro,A_(Bjohann + + * nntp.el (nntp-with-open-group-first-pass): Do not wrap in + eval-when-compile. Suggested by Kevin Greiner. + +2002-12-13 Kevin Greiner + + * gnus-agent.el (gnus-agent-max-fetch-size): New, defcustom. + (gnus-agent-fetch-headers): Initialize gnus-agent-overview-buffer + even though no headers may have been fetched + (gnus-agent-fetch-group-1, and perhaps others, require this + behavior). + (gnus-agent-fetch-group-1): Fetch articles in chucks so that the + server buffer is constrained by gnus-agent-max-fetch-size. + Multiple chunks in the same group may perform arbitrarily large + updates. + +2002-12-12 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-selected-article): Added call to + gnus-summary-update-download-mark to update the article in the + summary. + +2002-12-11 Kevin Greiner + + * gnus.el (gnus-summary-high-uncached-face, + gnus-summary-normal-uncached-face, gnus-summary-low-uncached-face) + New faces. + + * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. I + added this on 2002-11-23 but it just wasn't working out as + intended. The idea isn't entirely dead, three new faces + gnus-summary-*-uncached-face are being added to gnus.el to provide + the basis for an improved implementation. + (gnus-agent-read-servers): Undo the change made on 2002-11-23. The + proper file to open is lib/servers. + (gnus-summary-set-agent-mark): Expanded documentation. Unmarking + (i.e. removing the article from gnus-newsgroup-downloadable) will + now restore the article's default mark rather than simply setting + no mark. + (gnus-agent-get-undownloaded-list): Corrected documentation. + Added code to set new summary local variable, + gnus-newsgroup-agentized. Reworked impl so that it doesn't create + a temporary list. No longer sets gnus-newsgroup-downloadable. + (gnus-agent-summary-fetch-group): Keep gnus-newsgroup-undownloaded + up to date. Call new gnus-summary-update-download-mark to keep + summary buffer up-to-date. + (gnus-agent-fetch-selected-article): Keep + gnus-newsgroup-undownloaded up to date. + (gnus-agent-fetch-articles): Return list of articles that were + successfully fetched. + (gnus-agent-check-overview-buffer): No more thingatpt. + (gnus-agent-expire): No longer deletes NOV entries of unread + articles. + (gnus-agent-unread-articles): New function. + (gnus-agent-regenerate-group): The article number must be + terminated by a tab character. Added more messages to report + repairs. Inhibit quits while writing changes so it is now safe + have to quit regeneration. Renamed gnus-tmp-downloaded back to + downloaded to 1) resolve the unbound references and 2) avoid + confusing this list with the gnus-tmp-downloaded in gnus-sum.el + + * gnus-art.el (gnus-article-prepare): The agent + downloaded/undownloaded mark is no longer stored as the article's + mark. + + * gnus-salt.el (gnus-tree-highlight-node): Added uncached as + gnus-summary-highlight may use it. Added downloaded as + gnus-summary-highlight was using it. + + * gnus-sum.el (gnus-undownloaded-mark): Changed from ?@ to ?- as + the download mark now follows Kai's +/- convention. + (gnus-downloaded-mark): Added ?+ mark. + (gnus-summary-highlight): Added rules to select + gnus-summary-high-uncached-face, + gnus-summary-normal-uncached-face, and + gnus-summary-low-uncached-face. Removed the + gnus-agent-downloaded-article-face. + (gnus-summary-line-format-alist): Implemented the download flag + format (?O) as named in the manual. This implementation displays + either gnus-undownloaded-mark, gnus-downloaded-mark, or + gnus-no-mark. + (gnus-newsgroup-agentized): New local variable that identifies + which groups are agentized. While the agent is now on by default, + you don't have to agentize every server that you use. + (gnus-update-summary-mark-positions): Completed support for the + download type of mark. + (gnus-summary-insert-line): Added undownloaded to the parameters. + (gnus-summary-prepare-threads): Set gnus-tmp-downloaded for + reference by the gnus-summary-line-format-spec. + + * nntp.el (nntp-with-open-group): This macro handles dropped or + broken connections by opening a new connection and repeating the + failed command. + (nntp-retrieve-headers-with-xover): Some NNTP servers respond to + XOVER commands preceeding the active articles with the nov entry + of the first available article. When gnus connected to such a + server, the unexpected nov entry would result in duplicate lines + in the agent's overview file. This patch fixes the duplicate + lines problem and improves performance by skipping over all + articles IDs that preceed the first nov entry in the server's + reply. + +2002-12-11 Katsumi Yamaoka + + * gnus-sum.el (gnus-tmp-downloaded): New internal variable. + (gnus-summary-highlight): Use it instead of `downloaded'. + (gnus-summary-highlight-line): Ditto. + + * gnus-agent.el (gnus-agent-regenerate-group): Ditto. + +2002-12-11 Lars Magne Ingebrigtsen + + * gnus.el (gnus-variable-list): Add gnus-agent-covered-methods. + + * gnus-agent.el (gnus-agent-check-overview-buffer): Remove debug + calls. + + * gnus-sum.el (gnus-summary-highlight-line): Don't set the + downloaded variable if we're in an uncovered group. + + * gnus-agent.el (gnus-agent-downloaded-article-face): Change the + font to soemthing less noticeable. + (gnus-agent-group-covered-p): New function. + +2002-12-09 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-braid-nov): Remove corrupted lines. + Because of an unknown bug, the group buffer is saved in .overview + file. + +2002-12-09 Kai Gro,A_(Bjohann + + * nntp.el (nntp-send-command): Braino in last commit. Replace + `and' with `or'. + +2002-12-08 Kai Gro,A_(Bjohann + + * nntp.el (nntp-send-command): Assume that echo does not happen + when nntp-open-connection-function is nntp-open-network-stream. + Suggested by Sebastian D.B. Krause . + +2002-12-07 ShengHuo ZHU + + * nnslashdot.el (nnslashdot-retrieve-headers-1): Update the parser. + +2002-12-06 Paul Jarc + + * nnmaildir.el (nnmaildir-request-group): bugfix: don't erase + nntp-server-buffer if we aren't going to write to it. + +2002-12-04 Katsumi Yamaoka + Trivial patch from Itai Zukerman . + + * mm-decode.el (mm-w3m-safe-url-regexp): Fix parenthesis. + +2002-12-04 Katsumi Yamaoka + + * rfc2047.el (rfc2047-decode-region): Remove newlines between + decoded words. + +2002-12-03 Kai Gro,A_(Bjohann + + * gnus.el (fboundp): After loading mm-util, make sure it was the + right one. + +2002-11-29 Kai Gro,A_(Bjohann + + * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Moved here from + gnus-sum. Made into a user option. + + * gnus-sum.el (gnus-simplify-ignored-prefixes) + (gnus-summary-mark-article-as-unread) + +2002-11-29 ShengHuo ZHU + + * time-date.el (date-to-time): Typo. + + * parse-time.el: Typo. + + * nnsoup.el (nnsoup-retrieve-headers): Typo. + + * nnmail.el (nnmail-split, nnmail-process-unix-mail-format): Typos. + + * nnimap.el: + (nnimap-split-rule, nnimap-find-minmax-uid): Typos. + + * mm-encode.el (mm-safer-encoding): Typo. -2000-11-19 23:00:00 ShengHuo ZHU + * messcompat.el: Typo. - * gnus-art.el (gnus-article-read-summary-keys): lookup-key may - return a number. + * message.el (message-face-alist): Typo. -2000-11-17 Per Abrahamsen + * imap.el (imap-interactive-login, imap-open): Typos. - * gnus-msg.el (gnus-group-posting-charset-alist): No longer allow - raw 8-bit in headers in dk.* newsgroups. + * ietf-drums.el (ietf-drums-text-token, ietf-drums-qtext-token): Typos. -2000-11-16 23:31 ShengHuo ZHU + * gnus.el: Typo. - * mml.el (mml-generate-mime-1): Ignore ascii. + * gnus-win.el (gnus-configure-frame): Typo. -2000-11-16 Justin Sheehy + * gnus-util.el (gnus-atomic-progn-assign): Typo. - * gnus-sum.el (gnus-summary-make-menu-bar): Fix menu items. + * gnus-topic.el (gnus-topic-sort-topics): Typo. -2000-11-14 10:32:42 ShengHuo ZHU + * gnus-sum.el (gnus-summary-article-number) + (gnus-summary-read-group-1, gnus-summary-mark-article) + (gnus-summary-fetch-faq, gnus-refer-article-methods): Typos. - * mailcap.el (mailcap-possible-viewers): Match the entire string. + * gnus-mule.el (gnus-mule-add-group): Typo. -2000-11-14 00:48:52 ShengHuo ZHU + * gnus-mlspl.el (gnus-group-split-fancy): Typo. - * gnus-bcklg.el (gnus-backlog-enter-article): Don't enter - nnvirtual articles. - (gnus-backlog-request-article): Don't request nnvirtual articles. + * gnus-group.el (gnus-group-fetch-faq): Typo. -2000-11-13 09:50:29 ShengHuo ZHU + * gnus-art.el (gnus-decode-header-methods): Typo. - * gnus-sum.el (gnus-summary-repair-multipart): Fix Mime-Version - anyway. + * flow-fill.el: Typo. -2000-11-12 21:35:04 ShengHuo ZHU +2002-11-19 Stefan Monnier - * rfc2231.el (rfc2231-encode-string): Insert semi-colon and - leading space. + * binhex.el (binhex-decode-region): Don't hardcode point-min == 1. -2000-11-12 19:48:30 ShengHuo ZHU +2002-11-29 Kai Gro,A_(Bjohann - * gnus-sum.el (gnus-select-newsgroup): Change the error message. + * gnus-sum.el (gnus-simplify-ignored-prefixes) + (gnus-summary-mark-article-as-unread) + (gnus-mark-article-as-unread, gnus-summary-highlight-line): + Reformatting to avoid long lines. + (gnus-inhibit-mime-unbuttonizing): Moved to gnus-art. -2000-11-12 11:53:18 ShengHuo ZHU +2002-11-28 Daiki Ueno - * gnus-art.el (gnus-mime-button-menu): Use select-window. + * gnus-agent.el (gnus-agent-fetch-group-1): Article numbers should + be accessed through `mail-header-number'. -2000-11-12 09:47:54 ShengHuo ZHU +2002-11-27 Kevin Greiner - * gnus-art.el (gnus-mime-display-part): Display multipart/related - as multipart/mixed. + * gnus-sum.el (gnus-summary-insert-old-articles): No longer passes + compressed range to gnus-summary-insert-articles. -2000-11-11 15:55:35 ShengHuo ZHU +2002-11-26 Kevin Ryde - * mm-uu.el (mm-uu-type-alist): Stricter shar regexp. + * gnus-art.el (gnus-mime-copy-part): Look for filename + parameter under content-disposition, not content-type. -2000-11-10 09:01:25 ShengHuo ZHU + * gnus-sum.el (gnus-summary-find-uncancelled): New function. + (gnus-summary-reselect-current-group): Use it. - * gnus-art.el (gnus-mime-display-alternative): Show button if no - preferred part. +2002-11-26 ShengHuo ZHU -2000-11-07 Kai Gro,A_(Bjohann + * gnus-agent.el (gnus-agent-uncached-articles): if + gnus-agent-load-alist fails, return ARTICLES. - * gnus-sum.el (gnus-move-split-methods): Say that - `gnus-split-methods' uses file names, whereas this uses group - names. (Report from Nevin Kapur) + * nnrss.el (nnrss-group-alist): Update the link of Jabber. -2000-11-10 01:23:20 ShengHuo ZHU - - * mm-partial.el (mm-inline-partial): Insert MIME-Version. +2002-11-26 Kai Gro,A_(Bjohann -2000-11-09 17:02:50 ShengHuo ZHU + * gnus-sum.el (gnus-summary-insert-old-articles): Remove + superfluous function call. + (gnus-summary-catchup-all, gnus-summary-catchup-all-and-exit): + Add warning to docstring. - * nnheader.el (nnheader-directory-files-is-safe): New variable. - (nnheader-directory-articles): Use it. - (nnheader-article-to-file-alist): Ditto. +2002-11-26 Katsumi Yamaoka -2000-11-09 16:20:37 ShengHuo ZHU + * gnus-agent.el: Autoload number-at-point instead. + (gnus-agent-check-overview-buffer): No warning for deactivate-mark. - * rfc2047.el (rfc2047-pad-base64): New function. - (rfc2047-decode): Use it. +2002-11-26 Kai Gro,A_(Bjohann -2000-11-08 16:37:02 ShengHuo ZHU + * gnus-agent.el (gnus-agent-check-overview-buffer): Explicitly + require thingatpt (for number-at-point) and protect against + deactivate-mark being unbound (on XEmacs). - * gnus-cache.el (gnus-cache-generate-nov-databases): Reopen cache. +2002-11-25 Kai Gro,A_(Bjohann -2000-11-08 08:38:30 ShengHuo ZHU + * gnus-agent.el (gnus-agent-check-overview-buffer): Make debugger + print message on entry. - * pop3.el (pop3-munge-message-separator): A message may have an - empty body. - -2000-11-07 08:49:36 ShengHuo ZHU + From Kevin Greiner . - * mm-decode.el (mm-display-parts): New function. - * gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first. + * gnus-range.el (gnus-range-difference): New function. + * gnus-sum.el (gnus-summary-insert-old-articles): Use it. -2000-02-02 Alexandre Oliva +2002-11-24 Kai Gro,A_(Bjohann - * gnus-mlspl.el: Documentation tweaks. - -2000-11-06 19:10:14 ShengHuo ZHU + * gnus-sum.el (gnus-summary-insert-old-articles): Use + gnus-remove-from-range instead of gnus-range-difference which + doesn't exist. - * rfc2231.el (rfc2231-encode-string): Use us-ascii if charset is nil. +2002-11-23 Kai Gro,A_(Bjohann + From Kevin Greiner . -2000-11-05 15:06:05 ShengHuo ZHU + * gnus-agent.el (gnus-agent-downloaded-article-face): New face, + used for showing which articles have been downloaded. + (gnus-agent-article-alist): Format change. Add documentation. + (gnus-agent-summary-mode-map): New keybinding `J s' for fetching + process-marked articles. + (gnus-agent-summary-fetch-series): Command for `J s'. Articles + in the series are individually fetched to minimize lose of + content due to an error/quit. + (gnus-agent-synchronize-flags-server, gnus-agent-add-server): Use + gnus-message instead of message. + (gnus-agent-read-servers): Use file lib/methods instead of + lib/servers. TODO: Why? + (gnus-summary-set-agent-mark): Adapt to new agent-alist format. + (gnus-agent-get-undownloaded-list): Remove articles that appear to + come from the agent. This means that they are not downloaded. + (gnus-agent-fetch-selected-article): Don't use history. + (gnus-agent-save-history, gnus-agent-enter-history) + (gnus-agent-article-in-history-p, gnus-agent-history-path): + Removed function; history is not used anymore. + (gnus-agent-fetch-articles): Fix handling of crossposted articles. + (gnus-agent-crosspost): Started rewrite then realized that a typo + in gnus-agent-fetch-articles ensures that this function is never + called. This will need to be fixed later. + (gnus-agent-check-overview-buffer): Some sanity checks on the + agent overview buffer. This is a safety net used during + development. + (gnus-agent-flush-cache): The gnus-agent-article-alist format has + changed, write a number to the file indicating this. + (gnus-agent-fetch-headers): Rewrite to respect + gnus-agent-consider-all-articles without relying on the + `.fetched' files. Make it fast. + (gnus-agent-braid-nov): Change resulting from + gnus-agent-fetch-headers change. + (gnus-agent-load-alist, gnus-agent-save-alist): Don't use + `.fetched' files. + (gnus-agent-read-agentview): New function, used by + gnus-agent-load-alist. + (gnus-agent-load-fetched-headers): Remove. + (gnus-agent-save-alist): Rewrite to accomodate new format. + (gnus-agent-fetch-group-1): Make sure list of articles is in the + same order as in gnus-newsgroup-headers. + (gnus-agent-expire): Document and implement extra args ARTICLES, + GROUP, FORCE. Do not restrict usage. + (gnus-agent-uncached-articles): New function. + (gnus-agent-retrieve-headers): Use it. + (gnus-agent-regenerate-group): No longer needs to be called from + gnus-agent-regenerate. Individual groups may be regenerated. The + regeneration code now fixes duplicate, and mis-ordered, NOV entries. + The article fetch dates are validated in the article alist. The + article alist is pruned of entries that do not reference existing + NOV entries. All changes are computed then applied with + inhibit-quit bound to t. As a result, it is now safe to quit out of + regeneration. The optional clean parameter has been replaced with + an optional reread parameter. Clean is no longer necessary as + regeneration gets the appropriate setting from + gnus-agent-consider-all-articles. The new reread parameter will + result in fetched, or all, articles being marked as unread. + (gnus-agent-regenerate): Removed code to regenerate the history + file as it is no longer used. + + * gnus-start.el (gnus-make-ascending-articles-unread): New + function, for efficient mass-marking. + + * gnus-sum.el (gnus-summary-highlight): Use new face for + downloaded articles. + (gnus-article-mark): Prefer to indicate read/unread status over + downloaded status. + (gnus-summary-highlight-line-0): New function, maybe rehighlights + line. + (gnus-summary-highlight-line): Use new face for downloaded + articles. + (gnus-summary-insert-old-articles): Improved performance by + replacing the initial LIST of older articles with a compressed + RANGE of older articles. Some servers appear to lie about + their active range so the original list could contain millions + of article numbers. The range is not expanded into a list + until the optional ALL parameter has been applied. - * nnvirtual.el (nnvirtual-request-expire-articles): Uncompress range. +2002-11-18 Kai Gro,A_(Bjohann -2000-11-04 20:38:50 ShengHuo ZHU + * gnus-agent.el (gnus-category-mode): Typo in doc string. - * mm-view.el (mm-inline-text): Move point to the end of inserted text. +2002-11-21 Teodor Zlatanov -2000-11-04 10:34:29 ShengHuo ZHU + * spam.el: + added patch from Andreas Fuchs to prevent apply errors - * nnheader.el (nnheader-pathname-coding-system): Default iso-8859-1. - * nnmail.el (nnmail-pathname-coding-system): Ditto. + * spam.el: added `M s t' and `M s x' key mappings -2000-09-29 David Edmondson +2002-11-20 Simon Josefsson - * message.el (message-newline-and-reformat): Typo. + * gnus-sum.el (gnus-summary-morse-message): Narrow to body. -2000-11-04 10:11:05 ShengHuo ZHU +2002-11-19 Simon Josefsson - * rfc2231.el (rfc2231-decode-encoded-string): Test mm-multibyte-p. + * gnus-sum.el (gnus-summary-morse-message): Load + morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs). + (unmorse-region): Autoload it instead. -2000-11-04 09:53:42 ShengHuo ZHU +2002-11-18 Simon Josefsson - * nntp.el (nntp-decode-text): Delete bogus status lines. + * gnus-sum.el (gnus-summary-morse-message): New function. + (gnus-summary-wash-map): Bind to `W m'. + (gnus-summary-make-menu-bar): Add. -2000-11-03 Stefan Monnier + * nnimap.el (nnimap-request-expire-articles): Compress sequence + before storing \Deleted mark on expired articles. - * message.el (message-font-lock-keywords): Match a final newline - to help font-lock's multiline support. - -2000-11-04 Simon Josefsson +2002-11-17 Shenghuo Zhu + Trivial patch from Markus Rost - * nnimap.el (nnimap-split-inbox): Typo. + * gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open + parens in column 0. -2000-11-03 10:46:44 ShengHuo ZHU +2002-11-17 Juanma Barranquero - * gnus-msg.el (gnus-msg-mail): Move it backwards. + * nnweb.el (nnweb-google-create-mapping): Fix typo. -2000-11-03 Simon Josefsson + * nnlistserv.el (nnlistserv-kk-create-mapping): Likewise. - * rfc2231.el (rfc2231-parse-qp-string): New function. - (require): rfc2047. + * gnus-nocem.el (gnus-nocem-liberal-fetch): Likewise. - * mail-parse.el (mail-header-parse-content-type): - (mail-header-parse-content-disposition): Support invalid QP - encoded strings, by using `rfc2231-parse-qp-string'. +2002-11-17 ShengHuo ZHU -2000-11-03 08:58:08 ShengHuo ZHU + * message.el (message-set-auto-save-file-name): Use + make-directory, to avoid the dependence on gnus-util. - * 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. +2002-11-16 Simon Josefsson -2000-11-02 13:27:56 ShengHuo ZHU + * nnimap.el (nnimap-callback-callback-function): + (nnimap-callback-buffer): Removed, these cannot be global but must + be embedded into the callback. + (nnimap-make-callback): New. Embedd article number, callback and + buffer in function. + (nnimap-callback, nnimap-request-article-part): Update. - * 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. +2002-11-15 Katsumi Yamaoka -2000-11-02 Hrvoje Niksic + * mml.el (mml-preview): Bind message-this-is-mail if it is mail. - * rfc2047.el (rfc2047-encoded-word-regexp): Allow empty encoded - word. +2002-11-13 Kai Gro,A_(Bjohann -2000-11-01 08:54:11 ShengHuo ZHU + * gnus.el (gnus-summary-line-format): Document %C. - * mml.el (mml-read-tag): Remove spaces and LF. +2002-11-11 Simon Josefsson -2000-11-01 01:12:29 Lars Magne Ingebrigtsen + * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display + output when called interactively. - * nnultimate.el (nnultimate-create-mapping): Use nreverse. +2002-11-08 Katsumi Yamaoka -2000-10-31 23:45:31 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-edit-exit): Kill local variables. - * nnwfm.el: New file. + * message.el (message-draft-coding-system): Improve comment; use + mm-auto-save-coding-system for the default value. - * nnweb.el (nnweb-replace-in-string): New function. + * nndraft.el (nndraft-request-article): Revert to the state before + 2002-10-29; regexp-quote mail-header-separator. -2000-10-31 11:44:29 ShengHuo ZHU +2002-11-06 Jesper Harder - * gnus-sum.el (gnus-summary-show-article): Fix the summary line. + * gnus-draft.el (gnus-draft-setup): Set gnus-message-group-art to + allow editing of drafts from an nnvirtual group. -2000-10-31 Katsumi Yamaoka +2002-11-06 Katsumi Yamaoka - * gnus-sum.el (gnus-summary-insert-line): Work with quoted - double-quote charcters. - (gnus-summary-prepare-threads): Ditto. + * nndraft.el (nndraft-request-article): Replace emacs-mule with + mm-auto-save-coding-system. -2000-10-31 08:36:03 ShengHuo ZHU + * message.el (message-draft-coding-system): Default to + iso-2022-7bit. - * gnus-art.el (gnus-mime-display-single): Forward line -1. - * mml.el (mml-read-tag): Don't skip the leading space. + * mm-util.el (mm-auto-save-coding-system): Undo last change to + restore the default value to emacs-mule or escape-quoted. -2000-10-16 11:36:52 Lars Magne Ingebrigtsen +2002-11-05 Katsumi Yamaoka - * 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 (gnus-article-encrypt-body): Inhibit encrypting of + a delayed or a queued article as well as a draft. -2000-10-30 Ed L Cashin + * gnus-sum.el (gnus-summary-edit-article): Inhibit editing of a + delayed or a queued article in the raw format; treat a delayed + article as a raw article as well as a draft. + (gnus-summary-setup-default-charset): Clear gnus-newsgroup-charset + for the delayed group. - * gnus-sum.el (gnus-summary-expire-articles): Save point. + * nndraft.el (nndraft-request-article): Ignore auto save files for + a delayed or a queued article; don't bother to decode a queued + article; don't bind nnmail-file-coding-system for a queued article. -2000-10-28 03:38:39 ShengHuo ZHU + * nnmail.el (nnmail-split-fancy-with-parent): Ignore the delayed + and the queue group. - * rfc2047.el (rfc2047-encode-message-header): Make sure no - unencoded stuff in the header. +2002-11-04 Jesper Harder -2000-10-27 Jason Rumney + * gnus-group.el (gnus-group-delete-group): + gnus-cache-active-hashtb might be void. - * gnus-art.el (gnus-signature-face): Use italic on any frame that - supports it. +2002-11-02 Simon Josefsson -2000-10-27 14:19:53 ShengHuo ZHU + * pgg-gpg.el (pgg-gpg-encrypt-region): Makes PGG respect the + setting of the default user ID. From Raymond Scholz + . - * 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. +2002-11-01 Jesper Harder -2000-10-27 Stefan Monnier + * mm-bodies.el (mm-body-encoding): Don't return 8bit for 7bit + charset. - * ietf-drums.el: Require cl when compiling. +2002-10-31 Ted Zlatanov + From Alex Schroeder + * spam-stat.el (spam-stat-process-directory): add dir to message + (spam-stat-reduce-size): No longer remove words + with values close to 0.5, because the default value is 0.2. -2000-10-27 Dave Love +2002-10-31 Kai Gro,A_(Bjohann - * mm-decode.el (mm-valid-and-fit-image-p): Don't test - window-system here. + * gnus-util.el (gnus-user-date-format-alist): Clarify and correct + documentation. - * gnus-art.el (gnus-article-x-face-command): Check - gnus-article-compface-xbm. - (gnus-treat-display-xface): Check for uncompface. +2002-10-28 Kai Gro,A_(Bjohann - * nnheader.el (nnheader-translate-file-chars): Only kludge things - under Doze with XEmacs. + * gnus-agent.el (gnus-agent-fetched-headers) + (gnus-agent-load-fetched-headers) + (gnus-agent-save-fetched-headers): Remove variable and two + functions. Kevin Greiner's version of gnus-agent-fetch-headers + works better. + (gnus-agent-fetch-headers): New implementation from Kevin + Greiner. Uses gnus-agent-article-alist to store information + about fetched messages which aren't on the server anymore. The + trick is to return a list of considered messages to the caller, + but to only fetch those which haven't been fetched yet. -2000-10-26 Simon Josefsson +2002-10-30 Simon Josefsson - * mail-source.el (mail-sources): IMAP predicate is a string. - (mail-sources): Add default values for IMAP mailbox, predicate and - fetchflag. + * pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom. -2000-10-26 Dave Love + * pgg.el (pgg-passphrase-cache-expiry): Removed. - * flow-fill.el: Require cl when compiling. +2002-10-30 TSUCHIYA Masatoshi - * 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. + * mm-view.el (mm-w3m-local-map-property): Make it work with older + versions of emacs-w3m than 1.3.3. -2000-10-25 20:13:02 ShengHuo ZHU + * lpath.el: Bind w3m-minor-mode-map. - * mm-decode.el (mm-viewer-completion-map): New. - (mm-interactively-view-part): Use it. + * mm-view.el (mm-w3m-mode-command-alist) + (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Removed. + (mm-w3m-mode-map): Undefined for Emacs21 and XEmacs. + (mm-setup-w3m): Simplified. + (mm-w3m-local-map-property): New function. + (mm-inline-text-html-render-with-w3m): Use it. -2000-10-25 18:51:12 ShengHuo ZHU + * gnus-art.el (gnus-article-wash-html-with-w3m): Use + mm-w3m-local-map-property. - * rfc2047.el (rfc2047-q-encode-region): Don't break if a QP-word - could be fitted in one line. +2002-10-29 Katsumi Yamaoka -2000-10-25 Dirk Meyer + * mm-util.el (mm-auto-save-coding-system): Default to + iso-2022-7bit. - * gnus-demon.el (gnus-demon-time-to-step): theHour was set to - seconds instead of hour. + * nndraft.el (nndraft-request-article): Decode an article using + the coding-system emacs-mule if it seems to have been saved using + emacs-mule. + (nndraft-request-replace-article): Use message-draft-coding-system + instead of mm-auto-save-coding-system for the draft or delayed + group. -2000-10-25 Per Abrahamsen +2002-10-28 Josh - * mail-source.el (mail-sources): Better `:type'. + * mml.el (mml-mode-map): Fixed keybindings for mml-secure-* + functions. -2000-10-24 18:31:29 ShengHuo ZHU +2002-10-28 Katsumi Yamaoka + From mah@everybody.org (Mark A. Hershberger). - * 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. + * mm-url.el (mm-url-insert-file-contents): Make it return the same + type values ("url" size) regardless of the values of + mm-url-use-external. -2000-10-23 Simon Josefsson +2002-10-26 Kai Gro,A_(Bjohann - * flow-fill.el (fill-flowed): Don't flow "-- " lines. - (fill-flowed): Make "quote-depth wins" rule work when first line - is at level 0. + * nnimap.el (nnimap-request-article-part): Try harder to show + group name in debugging message. -2000-10-21 11:23:21 ShengHuo ZHU +2002-10-25 Kai Gro,A_(Bjohann - * mm-util.el (mm-multibyte-p): Test (featurep 'xemacs). + * gnus-agent.el (gnus-agent-save-fetched-headers): Create + directory if it doesn't exist. + (gnus-agent-fetch-headers): Remove old cruft that tried to + abstain from downloading articles more than once if + gnus-agent-consider-all-articles was true. This is now done + properly via the .fetched files. -2000-10-21 10:54:57 ShengHuo ZHU +2002-10-25 Katsumi Yamaoka - * 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. + * nndraft.el (nndraft-request-article): Treat delayed articles + like drafts. -2000-10-21 09:38:27 ShengHuo ZHU +2002-10-24 Katsumi Yamaoka - * mailcap.el (mailcap-parse-mailcaps): Don't use parse-colon-path, - because they are files, not directories. - (mailcap-parse-mimetypes): Ditto. + * gnus-agent.el (gnus-agent-load-alist): Fix parenthesis. -2000-10-20 19:55:59 ShengHuo ZHU +2002-10-24 Kai Gro,A_(Bjohann - * gnus-art.el (gnus-mime-inline-part): Check validity of charset. + * gnus-agent.el (gnus-agent-save-alist, gnus-agent-load-alist): + Remove unused optional arg DIR and corresponding code. -2000-10-18 Dave Love + * nnimap.el (nnimap-request-article-part): Include group name in + debugging output. - * mail-source.el (mm-util): Require. - (defvar): Use rmail-spool-directory unconditionally. +2002-10-24 Paul Jarc - * 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-agent.el (gnus-agent-fetch-headers): Add some comments. -2000-10-18 Miles Bader +2002-10-23 Kai Gro,A_(Bjohann - * gnus-nocem.el (gnus-nocem-check-article-limit): New variable. - (gnus-nocem-scan-groups): Obey `gnus-nocem-check-article-limit'. + * gnus-agent.el (gnus-agent-fetched-headers): New variable, + contains range of headers that have been fetched by the agent + already. Compare gnus-agent-article-alist. + (gnus-agent-file-header-cache): Like + gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers. + (gnus-agent-fetch-headers): Improve comment. Revert to old + seen/recent logic. + Remember which headers have been fetched before and don't fetch + them again the next time round. + (gnus-agent-load-fetched-headers) + (gnus-agent-save-fetched-headers): New functions, for remembering + which headers have been fetched before. -2000-10-18 Simon Josefsson +2002-10-23 Katsumi Yamaoka - * nnheader.el (nnheader-parse-head): Try both "from:" and "from: ". + * lpath.el: Remove useless bindings. - * gnus-sum.el (gnus-get-newsgroup-headers): Ditto. +2002-10-22 Jesper Harder -2000-10-17 Simon Josefsson + * gnus-sum.el (gnus-summary-execute-command): Disable visual + features while searching. - * gnus-sum.el (gnus-get-newsgroup-headers): Search for "from:" - instead of "from: " for rfc822 compliance. +2002-10-22 TSUCHIYA Masatoshi - * gnus-uu.el (gnus-uu-digest-mail-forward): Ditto. Insert SPC. + * pgg.el (pgg-snarf-keys): Do not refer unbinded local variables. - * nnheader.el (nnheader-parse-head): Ditto. +2002-10-22 Simon Josefsson -2000-10-13 Kai Gro,A_(Bjohann + * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify) + (pgg-snarf-keys): Add. - * 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 - . +2002-10-22 Katsumi Yamaoka -2000-10-13 12:01:15 ShengHuo ZHU + * lpath.el: Fbind bbdb-records. - * message.el (message-send-mail-partially): Replace the header - delimiter with a blank line. + * spam.el: Don't autoload bbdb-records. -2000-10-13 Kai Gro,A_(Bjohann +2002-10-22 Katsumi Yamaoka - * gnus-sum.el (gnus-get-split-value): Use first match only (Ed L - Cashin ). + * spam.el: Set autoload for bbdb-records after loading bbdb-com to + prevent inf-loop. -2000-10-13 10:52:00 ShengHuo ZHU +2002-10-22 Lars Magne Ingebrigtsen - * gnus-ems.el (gnus-article-compface-xbm): Ignore errors. + * nnslashdot.el: Removed some test lines. + More test. -2000-10-11 John Wiegley +2002-10-21 Kai Gro,A_(Bjohann - * 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-agent.el (gnus-agent-fetch-headers): Remove articles that + are known to be downloaded already. - * 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. +2002-10-21 Lars Magne Ingebrigtsen - * 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. + * mm-view.el (mm-text-html-renderer-alist): Add w3m-standalone. + (mm-text-html-washer-alist): Ditto. -2000-10-12 08:26:30 ShengHuo ZHU +2002-10-19 TSUCHIYA Masatoshi - * 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. + * nnheader.el (nnheader-remove-body): Fix an error of detecting + boundary between headers and body. + * nnml.el (nnml-parse-head): Ditto. -2000-10-10 08:44:13 ShengHuo ZHU +2002-10-20 Lars Magne Ingebrigtsen - * rfc2047.el (rfc2047-fold-region): "=?=" is not a break point. + * nnslashdot.el (nnslashdot-generate-active): Ignore any bogus + entries. -2000-10-10 00:00:28 ShengHuo ZHU + * gnus-group.el (gnus-fetch-group): Allow an optional + specification of the articles to select. - * webmail.el (webmail-init): Use mm-disable-multibyte-mule4. + * gnus-srvr.el (gnus-server-prepare): Removed superfluous cdr. -2000-10-09 22:50:05 ShengHuo ZHU +2002-10-20 Kai Gro,A_(Bjohann - * base64.el (base64-decode-region): Just give a message if the end - is not sane. + * gnus-agent.el (gnus-agent-fetch-group-1): After fetching + headers from the group, update variable `articles' to contain + only those numbers where headers exist. (When fetching all + articles in a group, Gnus creates lots of numbers where there is + no articles.) -2000-10-09 20:09:11 ShengHuo ZHU +2002-10-20 Steve Youngs - * 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. + * pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs + doesn't have the 'alist custom type, use cons cells instead. + (pgg-parse-symmetric-key-algorithm-alist): Ditto. + (pgg-parse-hash-algorithm-alist): Ditto. + (pgg-parse-compression-algorithm-alist): Ditto. + (pgg-parse-signature-type-alist): Ditto. -2000-10-09 17:12:00 ShengHuo ZHU + * pgg-gpg.el (pgg-gpg-extra-args): Fix custom mismatch. - * 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. + * pgg-pgp5.el (pgg-pgp5-extra-args): Ditto. -2000-10-09 Dave Love + * pgg-pgp.el (pgg-pgp-extra-args): Ditto. - * 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. +2002-10-19 Simon Josefsson - * 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. + * nnimap.el (nnimap-open-server): Check imap-state in IMAP server + buffer. -2000-10-09 Stefan Monnier +2002-10-18 Kai Gro,A_(Bjohann - * mm-encode.el: Require CL. At least, for `incf'. + * gnus-spec.el (gnus-make-format-preserve-properties) + (gnus-xmas-format, gnus-parse-simple-format): Preserve text + properties also on XEmacs. `gnus-xmas-format' is like format but + preserves text properties on XEmacs (though it only understands + simple format specs). The variable + `gnus-make-format-preserve-properties' controls whether the + function is used, and is checked in `gnus-parse-simple-format'. + Patch by Paul Moore . - * nnfolder.el (nnfolder-ignore-active-file): Typos. + * gnus-agent.el (gnus-agent-fetch-articles): More debugging + output. + (gnus-agent-consider-all-articles): New variable. + (gnus-agent-get-undownloaded-list): Comment that marks todo item. + (gnus-agent-fetch-headers): Depending on + gnus-agent-consider-all-articles, maybe get all articles. + (gnus-category-predicate-alist, gnus-agent-read-p): New predicate + `read'. + (gnus-predicate-imples-unread): New function. + (gnus-agent-fetch-headers): Optimize to call + gnus-list-of-unread-articles if that is sufficient. + Check unseen and recent instead of seen and recent. + (gnus-agent-fetch-headers): Abstain from calling + gnus-list-range-intersection if range (a . b) would have (> a b). - * gnus-mh.el (gnus-summary-save-in-folder): Obey mh-lib-progs. +2002-10-18 Katsumi Yamaoka - * gnus-kill.el (gnus-kill): Typo. + * message.el (message-send-mail): Make it possible to perform + edebug-defun. -2000-10-09 Gerd Moellmann +2002-10-18 Simon Josefsson - * smiley-ems.el (smiley-update-cache): Use `:ascent center'. + * gnus-art.el (gnus-button-man-handler): Change default to + `manual-entry' (defined in both emacsen). + (gnus-button-man-handler): Remove emacsen difference and use + `manual-entry'. -2000-10-09 Simon Josefsson +2002-10-18 Katsumi Yamaoka - * 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. + * spam.el: Wrap autoload settings for bbdb-records, + executable-find and ifile-spam-filter with eval-and-compile. + (spam-display-buffer-contents): Remove. + (spam-bogofilter-score): Merge spam-display-buffer-contents. -2000-10-08 13:05:11 ShengHuo ZHU +2002-10-17 Ted Zlatanov - * dgnushack.el (dgnushack-compile): Delete old elc files first. + * spam.el (spam-display-buffer-contents): New function. + (spam-bogofilter-score): use spam-display-buffer-contents, patch + from Katsumi Yamaoka . -2000-10-08 10:59:13 ShengHuo ZHU +2002-10-17 TSUCHIYA Masatoshi - * 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. + * nnheader.el (nnheader-parse-naked-head): New function. + (nnheader-parse-head): Use the above function, in order to handle + continuation lines properly. + (nnheader-remove-body): New function. + (nnheader-remove-cr-followed-by-lf): New function. + (nnheader-ms-strip-cr): Use the above function. -2000-10-08 08:57:13 ShengHuo ZHU + * gnus-agent.el (gnus-agent-regenerate-group): Call + `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of + `nnheader-parse-head'. + * gnus-cache.el (gnus-cache-possibly-enter-article): Ditto. - * 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. + * gnus-msg.el (gnus-inews-yank-articles): Do not unfold + continuation lines by itself; call `nnheader-parse-naked-head' + instead of `nnheader-parse-head'. + * nndiary.el (nndiary-parse-head): Ditto. + * nnfolder.el (nnfolder-parse-head): Ditto. + * nnimap.el (nnimap-retrieve-headers-progress): Ditto. + * nnmaildir.el (nnmaildir--update-nov): Ditto. + * nnml.el (nnml-parse-head): Ditto. -2000-10-08 08:45:48 ShengHuo ZHU +2002-10-17 Steve Youngs - * gnus-sum.el (gnus-summary-display-article): Enable multibyte. - (gnus-summary-select-article): Don't enable multibyte here. - (gnus-summary-goto-article): Ditto. + * gnus-art.el (gnus-button-man-handler): Add 'manual-entry' for + XEmacs, default to it if featurep 'xemacs. -2000-10-08 Christoph Conrad +2002-10-16 Katsumi Yamaoka - * gnus-draft.el (gnus-draft-send-message): Typo. + * spam-stat.el: Check for the existence of hash functions instead + of the Emacs version to decide whether to load cl. Suggested by + Kai Gro,A_(Bjohann. -2000-10-08 Simon Josefsson +2002-10-15 Kai Gro,A_(Bjohann - * 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. + * gnus-agent.el (gnus-agent-fetch-selected-article): Open history + if it isn't open yet. -2000-10-07 15:49:39 ShengHuo ZHU +2002-10-14 Katsumi Yamaoka - * 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. + * gnus-group.el: Require mm-url only when compiling. + (gnus-group-fetch-charter): Require mm-url. -2000-10-07 15:42:59 ShengHuo ZHU + * spam-stat.el: Require cl for the functions gethash, + hash-table-count, make-hash-table and mapc for Emacs 20. + (puthash): Alias to cl-puthash for Emacs 20. + (with-syntax-table): New macro for Emacs 20. - * gnus-logic.el (gnus-advanced-string): Use "" if nil. +2002-10-12 Jesper Harder -2000-10-07 10:31:05 ShengHuo ZHU + * gnus-spec.el (gnus-pad-form): Use gnus-string-width-function. - * rfc2047.el (rfc2047-q-encode-region): Better calculation of - break point. - (rfc2047-fold-region): Don't break the first non-LWSP characters. +2002-10-11 Ted Zlatanov -2000-10-07 09:18:53 ShengHuo ZHU + * spam.el (spam-check-ifile): added ifile as a spam checking + backend, and spam-use-ifle as the variable to toggle that check. - * 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. +2002-10-12 Simon Josefsson -2000-10-07 08:19:17 ShengHuo ZHU + * message.el (message-beginning-of-line): New variable. + (message-beginning-of-line): Use it. - * 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. +2002-10-11 Ted Zlatanov -2000-10-06 Dave Love + * spam.el: more compilation fixes for BBDB - * 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. + * spam-stat.el added code from Alex Schroeder + (spam-stat-reduce-size): Interactive. + (spam-stat-reset): New function. + (spam-stat-save): Interactive. -2000-10-06 17:38:03 ShengHuo ZHU +2002-10-11 Katsumi Yamaoka - * gnus-art.el (gnus-article-prepare): Configure it again. + * gnus.el: Autoload gnus-delay-initialize. -2000-10-06 15:11:07 ShengHuo ZHU + * message.el: Autoload gnus-delay-article. - * message.el (message-default-charset): Default value for non-Mule - Emacsen. +2002-10-11 Jesper Harder -2000-10-06 14:28:50 ShengHuo ZHU + * gnus-spec.el (gnus-balloon-face-function): Use the help-echo + text property in Emacs. - * message.el (message-alternative-emails): New. - (message-use-alternative-email-as-from): New. - (message-setup): Use them. +2002-10-11 Simon Josefsson -2000-10-06 13:46:47 ShengHuo ZHU + * mml2015.el (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt) + (mml2015-pgg-verify, mml2015-pgg-clear-verify): Remove CR. - * base64.el, dgnushack.el, gnus-spec.el, messagexmas.el - * gnus-xmas.el, nnheaderxm.el, nndraft.el: Use defalias. + * mml1991.el (mml1991-pgg-sign): Remove CR. - * 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. +2002-10-10 Simon Josefsson -2000-10-06 10:01:08 ShengHuo ZHU + * mml2015.el (mml2015-pgg-decrypt): Set gnus details even when + decrypt failed. + (mml2015-trust-boundaries-alist): Removed. + (mml2015-gpg-extract-signature-details): Don't use it. + (mml2015-unabbrev-trust-alist): New. + (mml2015-gpg-extract-signature-details): Use it. - * 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. +2002-10-10 Ted Zlatanov -2000-10-06 09:38:54 ShengHuo ZHU + * spam.el: compilation fixes, spam-check-bbdb function is nil if no + BBDB installed - * qp.el (quoted-printable-encode-region): Use - mm-with-unibyte-current-buffer within narrowed region. + * spam-stat.el: added code from Alex Schroeder to do + statistical analysis of spam in Lisp only -2000-10-06 08:56:33 ShengHuo ZHU +2002-10-10 Simon Josefsson - * webmail.el (webmail-type-definition): Fix my-deja open url. + * nnimap.el (nnimap-open-server): Re-open server if it isn't in + auth, selected or examine state. -2000-10-06 Emerick Rogul + * pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output + buffer and error buffer depending on type of information. - * message.el (message-setup-fill-variables): New variable. - (message-mode): Use it. + * mml2015.el (mml2015-gpg-extract-signature-details): Parse + --status-fd stuff even if gpg.el is not used (revert earlier + change). + (mml2015-pgg-{clear-,}verify): Store both output and errors as + gnus details. + (mml2015-pgg-{clear-,}verify): Extract signature info from errors + buffer. -2000-10-05 Dave Love + * pgg.el (pgg-verify-region): Use it. - * rfc2047.el (rfc2047-fold-region): Use gnus-point-at-bol. - (rfc2047-charset-encoding-alist): Add iso-8859-1[45]. + * pgg-def.el (pgg-query-keyserver): New variable. - * binhex.el: Use defalias, not fset. + * pgg.el (pgg-decrypt-region): Bind pgg-default-user-id to + key-identifier in packet. Is this a good idea? - * rfc1843.el: Require cl when compiling. + * mml.el (mml-mode-map): Add security commands that operates on + MIME parts. + (mml-menu): And menu items for them. -2000-10-05 12:25:08 ShengHuo ZHU + * mml1991.el (mml1991-pgg-encrypt): Remove headers. - * gnus-agent.el (gnus-agent-fetch-group-1): Score-param could be nil. + * mml.el (mml-parse-1): Support sender in #secure tags. -2000-10-05 11:43:25 ShengHuo ZHU + * mml1991.el (mml1991-pgg-sign): Only use message-sender if it is + defined. - * rfc2047.el (rfc2047-encode-region): Merge only if regions are - adjacent. + * mml-sec.el (mml-smime-encrypt-buffer): Warn about combined signing. + (mml-pgp-encrypt-buffer): Support combined signing. -2000-10-05 09:41:33 ShengHuo ZHU + * mml1991.el (mml1991-mailcrypt-encrypt): Support combined signing. + (mml1991-gpg-encrypt): Ditto. + (mml1991-pgg-encrypt): Ditto. + (mml1991-encrypt): Pass sign parameter. - * 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. + * mml-sec.el (mml-signencrypt-style-alist): Defcustom. + (mml-signencrypt-style): Mention the variable. -2000-10-05 09:04:32 ShengHuo ZHU +2002-10-09 Simon Josefsson - * webmail.el (webmail-hotmail-list): Fix. + * mml1991.el (mml1991-pgg-sign): Bind pgg-default-user-id, not + pgg-gpg-user-id. -2000-10-05 Stefan Monnier + * pgg.el (pgg-insert-url-with-w3): Ignore errors. + (pgg-fetch-key-function): Nil if w3 is not installed. - * nnimap.el (require): cl. +2002-10-08 Kai Gro,A_(Bjohann -2000-10-04 15:24:46 ShengHuo ZHU + * gnus-agent.el (gnus-agent-fetch-selected-article): Bind + gnus-agent-current-history. - * gnus-art.el (gnus-article-prepare): Configure windows before - gnus-article-prepare-display is called. Otherwise, BBDB's popup - window might be overrided. +2002-10-06 Simon Josefsson -2000-10-04 Dave Love + * imap.el (imap-parse-status): Don't use read to read token. - * gnus-ems.el (gnus-article-display-xface) - [gnus-article-compface-xbm]: Fix. - (gnus-x-splash): Bind width, height. +2002-10-05 Kai Gro,A_(Bjohann -2000-10-04 11:45:04 ShengHuo ZHU + * gnus-agent.el (gnus-agent-fetch-selected-article): Do nothing + for methods not covered by the agent, and when unplugged. - * gnus-art.el (gnus-mime-inline-part): Use prefix argument only - when it is called interactively. +2002-10-05 Simon Josefsson -2000-10-03 21:20:31 ShengHuo ZHU + * pgg-gpg.el (pgg-gpg-encrypt-region): Query passphrase when + signing. - * gnus-art.el (gnus-mime-action-alist): New variable. - (gnus-mime-action-on-part): Use it. - (gnus-mime-button-commands): Add command ".". + * gnus-agent.el (gnus-agent-read-servers): If getting method from + a named server fails, ignore the server. -2000-10-03 20:37:42 ShengHuo ZHU + * mml1991.el (mml1991-pgg-sign): Do QP. - * gnus-art.el (gnus-mime-inline-part): Support prefix argument. + * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt really + work. -2000-10-03 Katsumi Yamaoka +2002-10-04 Simon Josefsson - * lpath.el: "." is in the load-path because dgnushack.el. + * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work. -2000-10-03 Bjorn Torkelsson + * pgg-pgp.el (pgg-pgp-verify-region): Inline + binary-write-decoded-region from MEL. - * uudecode.el: xemacs cleanup (use featurep ' xemacs) + * pgg.el (pgg-encrypt-region): Support sign. - * nnheader.el: ditto + * pgg-gpg.el (pgg-gpg-encrypt-region): Ditto. - * mm-util.el: ditto + * mml2015.el (mml2015-pgg-encrypt): Ditto. - * message.el: ditto + * pgg.el, pgg-def.el, pgg-parse.el, pgg-gpg.el, pgg-pgp5.el, + pgg-pgp6.el: Moved from ../pgg/. Modifications compared to EMIKO + branch where PGG was taken from in the ChangeLog entries below. - * binhex.el: ditto +2002-10-01 Simon Josefsson - * gnus-audio.el: removed unnecessary xemacs test + * pgg-pgp.el: Don't require mel. Don't use luna. + (pgg-scheme-pgp-instance, pgg-make-scheme-pgp): Remove. + (pgg-pgp-process-region): Use expand-file-name instead of concat. + (pgg-pgp-process-region): Don't use binary-funcall. - * earcon.el: ditto - -2000-10-03 19:55:55 Lars Magne Ingebrigtsen + * pgg-pgp5.el (pgg-pgp5-process-region): Don't use binary-funcall. - * nnweb.el (nnweb-decode-entities): Work for non-character - entities. + * pgg-gpg.el (pgg-gpg-process-region): Use expand-file-name + instead of concat. -2000-09-26 09:20:08 Lars Magne Ingebrigtsen + * pgg-pgp5.el (pgg-pgp5-process-region): Ditto. - * gnus.el: Message the quit parts. +2002-09-29 Simon Josefsson -2000-10-03 08:08:29 ShengHuo ZHU + * pgg-parse.el (pgg-char-int, pgg-string-as-unibyte): Prevent byte + compile warnings. - * mail-source.el (mail-source-fetch-maildir): Don't insert - newlines. + * pgg.el (pgg-decrypt-region): Don't parse packet. -2000-10-02 20:14:27 ShengHuo ZHU + * pgg.el, pgg-gpg.el, pgg-pgp5.el: Don't depend on luna.el. - * dgnushack.el (dgnushack-compile): Don't compile dgnushack.el, - lpath.el. Don't compile base64.el if there is builtin base64. +2002-09-29 Daiki Ueno -2000-10-02 Bj,Av(Brn Torkelsson + * pgg.el: Remove dependency on calist.el. - * base64.el (Repository): Use featurep for XEmacs test. +2002-09-28 Simon Josefsson -2000-10-02 17:38:12 ShengHuo ZHU + * pgg.el (pgg-temporary-file-directory): New variable. + (pgg-verify-region): Don't assume set-buffer-multibyte exists. - * nntp.el (nntp-retrieve-data): Don't ignore quit. + * pgg-pgp5.el (pgg-pgp5-process-region, pgg-scheme-verify-region) + (pgg-scheme-snarf-keys-region): Use pgg-temporary-file-directory. -2000-10-02 14:43:13 ShengHuo ZHU + * pgg-parse.el (pgg-char-int): Defalias. + (pgg-format-key-identifier, pgg-byte-after, pgg-read-byte) + (pgg-read-bytes, pgg-read-body): Use it. + (pgg-decode-packets): Don't use MEL, use base64-*. + (pgg-parse-armor): Don't assume set-buffer-multibyte exists. + (pgg-string-as-unibyte): Defalias. + (pgg-parse-armor-region): Use it. - * gnus-art.el (gnus-article-banner-alist): New variable. - (article-strip-banner): Use it. - * gnus-cus.el (gnus-group-parameters): Allow symbol. + * pgg-gpg.el (pgg-gpg-process-region): Use + pgg-temporary-file-directory. -2000-10-02 Dave Love + * luna.el: Don't def-edebug. - * smiley-ems.el: New file. + * pgg-pgp5.el (pgg-scheme-verify-region): Inline + binary-write-decoded-region from MEL. - * 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. + * pgg-pgp5.el, pgg-gpg.el: Don't require mel. - * mml.el (require): Fix typo. - (mml-parse-1): Modify unknown encoding prompt. + * alist.el, calist.el: Don't require product/APEL. - * mail-source.el (mail-sources): Revert to nil. + * pgg-parse.el (top-level): Remove dependency on static.el, + pccl.el, mel.el. + (pgg-parse-crc24, pgg-parse-crc24-string): Only define if + `define-ccl-program' is boundp, instead of using broken. - * nnmail.el (nnmail-spool-file): Revert previous change. +2002-10-01 Simon Josefsson - * gnus.el: Don't require custom, message. - (gnus-message-archive-method): Wrap initializer in progn and - require message here. + * message.el (message-required-mail-headers): Remove Lines:. -2000-10-02 Gerd Moellmann +2002-10-03 Kai Gro,A_(Bjohann + From Jesper Harder. - * 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. + * gnus-group.el (gnus-group-fetch-charter, + gnus-group-fetch-control): Prompt for group if given a prefix + argument. + * gnus-sum.el (t): Add gnus-group-fetch-charter and + gnus-group-fetch-control to summary key map and menu. -2000-10-02 08:04:48 ShengHuo ZHU +2002-10-03 Paul Jarc - * webmail.el (webmail-hotmail-list): Fix. + * nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article + number when there are no articles. -2000-10-01 20:55:53 ShengHuo ZHU +2002-10-03 Kai Gro,A_(Bjohann - 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-agent.el (gnus-agent-summary-fetch-group): Optional prefix + arg ALL means to fetch all articles, not only downloadable ones. + (gnus-agent-fetch-selected-article): New function for + gnus-select-article-hook or gnus-mark-article-hook. - * 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. +2002-10-02 Katsumi Yamaoka + From Peter von der Ahe . -2000-10-01 17:08:50 ShengHuo ZHU + * gnus-ems.el (gnus-x-splash): Set coding-system-for-read to + raw-text. - * mailcap.el (mailcap-mime-types): Use mailcap-mime-data. - * mml.el (mml-minibuffer-read-type): Use mailcap-mime-types. +2002-09-30 Ted Zlatanov -2000-10-01 13:07:21 ShengHuo ZHU + * spam.el: merged changes from pinard@iro.umontreal.ca (Fran,Ag(Bois + Pinard). + Major revamp of the code, documentation is in comments in the file + for now. - * webmail.el (webmail-netscape-open, webmail-hotmail-article, - webmail-hotmail-list): Update. +2002-09-30 Simon Josefsson -2000-10-01 08:36:09 ShengHuo ZHU + * mml2015.el (mml2015-pgg-clear-verify): Verifying in a unibyte + buffer seem to be needed? - * mail-source.el (mail-source-report-new-mail): Use - nnheader-cancel-timer. +2002-09-29 Simon Josefsson -2000-10-01 08:35:38 ShengHuo ZHU + * mml1991.el (pgg-output-buffer, pgg-errors-buffer): Prevent byte + compile warnings. - * lpath.el (overlay-*): Shut up. - * dgnushack.el: Two implementations of smiley. + * mml1991.el (mml1991-function-alist): Add pgg. + (mml1991-pgg-sign, mml1991-pgg-encrypt): New functions. + (mml1991-pgg-encrypt): Fix recipients querying. -2000-10-01 08:32:42 ShengHuo ZHU +2002-09-28 Simon Josefsson - * 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. + * mml2015.el (autoload): Autoload correct files. Trivial patch + from dme@dme.org. + (mml2015-pgg-decrypt, mml2015-pgg-verify): Make sure either nil or + handle is returned. -2000-09-30 18:52:51 ShengHuo ZHU +2002-09-27 Katsumi Yamaoka - * webmail.el (webmail-my-deja-*): Rewrite. + * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): + Protect against non-existent of `nnimap-mailbox-info'. -2000-09-30 Simon Josefsson +2002-09-27 Simon Josefsson - * nnimap.el (nnimap-request-accept-article): Remove \n's from - From_ lines. + * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): New. + (gnus-setup-news-hook): Use it. + (gnus-after-getting-new-news-hook): Ditto. -2000-08-05 Simon Josefsson + * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Remove. - Make GCC to remote groups work when unplugged - (postpone GCC until message is actually sent). +2002-09-27 Katsumi Yamaoka + From Mats Lidell . - * gnus-draft.el (gnus-draft-send): Call `gnus-agent-restore-gcc'. + * gnus-art.el (gnus-article-mode-syntax-table): Replace "-" to " ". - * gnus-agent.el (gnus-agent-possibly-do-gcc): - (gnus-agent-restore-gcc): - (gnus-agent-possibly-save-gcc): New functions. +2002-09-27 TSUCHIYA Masatoshi - * 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-sum.el (gnus-nov-parse-line): When an error is signaled in + the part to decode encoded words, use raw words instead of decoded + words. - * gnus.el (gnus-agent-gcc-header): New variable. +2002-09-26 ShengHuo ZHU -2000-07-13 Simon Josefsson + * nnimap.el (nnimap-update-unseen): Use gnus-gethash-safe. - Asks the user to synch flags with server when you plug in. + * mm-view.el (mm-w3m-mode-ignored-keys): New variable. + (mm-setup-w3m): Use it. - * 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. +2002-09-27 Simon Josefsson -2000-09-30 Simon Josefsson + * gnus-art.el (gnus-article-mode-syntax-table): Make M-. work in + article buffers. - * starttls.el: New file, by Daiki Ueno. + * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Autoload + it just in case. + (nnimap-update-unseen): New function; update unseen count in + `n-m-info'. + (nnimap-close-group): Call it. + + * gnus-start.el (gnus-setup-news-hook): Add n-f-u-a-g-n-n. + (gnus-after-getting-new-news-hook): Ditto. + + * nnimap.el (nnimap-retrieve-groups): Move the quick mail check + message into verboselevel 9. Change slow mail check message. + (nnimap-retrieve-groups): Use prefixed names in n-mailbox-info. + (nnimap-fixup-unread-after-getting-new-news): New function, to be + used as a hook after getting new mail. + +2002-09-26 Simon Josefsson + + * imap.el (imap-parse-resp-text-code): The UNSEEN value in + SELECT/EXAMINE is first unseen article, not number of unseen + articles. Make them distinct by renaming the former to + `first-unseen' instead of `unseen'. + + * nnimap.el (nnimap-retrieve-groups): Get uidvalidity and unseen + too. + (nnimap-retrieve-groups): Don't used cached data if uidvalidity + changed. + (nnimap-retrieve-groups): Store uidvalidity and unseen data too. + + * gnus-int.el (gnus-server-unopen-status): Defcustom. + + * mml-sec.el (mml-signencrypt-style): Docstring to font-lock + better. + + * mml2015.el (mml2015-pgg-decrypt): Only add security information + if dissecting resulting buffer actually had any information. + +2002-09-26 Katsumi Yamaoka + + * gnus-group.el (gnus-group-sort-by-method): Remove `symbol-name' + because the function `string<' allows symbols. + + * gnus-sum.el (gnus-summary-make-menu-bar): Ditto. + +2002-09-25 ShengHuo ZHU + + * message.el (message-forward-make-body): Revert an early change + because 8-bit utf-8 emails. + +2002-09-25 Bj,Av(Brn Torkelsson + + * gnus-agent.el (gnus-category-line-format): Doc fixes (mostly added + links to Info) + * gnus-art.el (gnus-treat-highlight-signature): + * gnus-art.el (gnus-treat-buttonize): + * gnus-art.el (gnus-treat-buttonize-head): + * gnus-art.el (gnus-treat-emphasize): + * gnus-art.el (gnus-treat-strip-cr): + * gnus-art.el (gnus-treat-unsplit-urls): + * gnus-art.el (gnus-treat-leading-whitespace): + * gnus-art.el (gnus-treat-hide-headers): + * gnus-art.el (gnus-treat-hide-boring-headers): + * gnus-art.el (gnus-treat-hide-signature): + * gnus-art.el (gnus-treat-fill-article): + * gnus-art.el (gnus-treat-hide-citation): + * gnus-art.el (gnus-treat-hide-citation-maybe): + * gnus-art.el (gnus-treat-strip-list-identifiers): + * gnus-art.el (gnus-treat-strip-pgp): + * gnus-art.el (gnus-treat-strip-pem): + * gnus-art.el (gnus-treat-strip-banner): + * gnus-art.el (gnus-treat-highlight-headers): + * gnus-art.el (gnus-treat-highlight-citation): + * gnus-art.el (gnus-treat-date-ut): + * gnus-art.el (gnus-treat-date-local): + * gnus-art.el (gnus-treat-date-english): + * gnus-art.el (gnus-treat-date-lapsed): + * gnus-art.el (gnus-treat-date-original): + * gnus-art.el (gnus-treat-date-iso8601): + * gnus-art.el (gnus-treat-date-user-defined): + * gnus-art.el (gnus-treat-strip-headers-in-body): + * gnus-art.el (gnus-treat-strip-trailing-blank-lines): + * gnus-art.el (gnus-treat-strip-leading-blank-lines): + * gnus-art.el (gnus-treat-strip-multiple-blank-lines): + * gnus-art.el (gnus-treat-unfold-headers): + * gnus-art.el (gnus-treat-fold-headers): + * gnus-art.el (gnus-treat-fold-newsgroups): + * gnus-art.el (gnus-treat-overstrike): + * gnus-art.el (gnus-treat-display-xface): + * gnus-art.el (gnus-treat-display-smileys): + * gnus-art.el (gnus-treat-from-picon): + * gnus-art.el (gnus-treat-mail-picon): + * gnus-art.el (gnus-treat-newsgroups-picon): + * gnus-art.el (gnus-treat-body-boundary): + * gnus-art.el (gnus-treat-capitalize-sentences): + * gnus-art.el (gnus-treat-fill-long-lines): + * gnus-art.el (gnus-treat-play-sounds): + * gnus-art.el (gnus-treat-translate): + * gnus-art.el (gnus-treat-x-pgp-sig): + * gnus-art.el (gnus-mime-button-line-format): + * gnus-art.el (gnus-button-man-level): + * gnus-art.el (gnus-button-emacs-level): + * gnus-cus.el (gnus-group-parameters): + * gnus-gl.el (bbb-build-mid-scores-alist): + * gnus-group.el (gnus-group-line-format): + * gnus-mlspl.el (gnus-group-split-setup): + * gnus-mlspl.el (gnus-group-split): + * gnus-msg.el (gnus-mailing-list-groups): + * gnus-msg.el (gnus-posting-styles): + * gnus-nocem.el (gnus-nocem-issuers): + * gnus-score.el (gnus-score-regexp-bad-p): + * gnus-srvr.el (gnus-server-line-format): + * gnus-topic.el (gnus-topic-line-format): + * gnus.el (gnus-summary-line-format): + * mail-source.el (mail-sources): + * message.el (message-subscribed-address-file): + * nnmail.el (nnmail-split-fancy): + +2002-09-24 Evgeny Roubinchtein + + * mail-source.el(mail-source-run-script): use `functionp' to test + whether the argument `script' is in fact a function. + (mail-sources): adjust the defcustom to allow users to specify a + function or a string as the value of the `:prescript' and + `:postscript' arguments of the `file' and `pop3' mail sources. + +2002-09-25 Paul Jarc + + * nnmaildir.el (nnmaildir--grp-add-art): fix minimum article + number when article 1 does not exist. + +2002-09-25 Kai Gro,b_(Bjohann + + * gnus-art.el (gnus-button-handle-apropos-variable): Fall back to + apropos if apropos-variable does not exist. + (gnus-button-guessed-mid-regexp) + (gnus-button-handle-describe-prefix, gnus-button-alist): Better + regexes. From Reiner Steib. + (gnus-button-handle-describe-function) + (gnus-button-handle-describe-variable): Doc fix. From Reiner Steib. + (gnus-button-handle-describe-key, gnus-button-handle-apropos) + (gnus-button-handle-apropos-command): Doc fix. From Reiner Steib. + +2002-09-25 Mark A. Hershberger + Trivial patch. + + * nnrss.el (nnrss-save-server-data): Save nnrss-group-alist in + the file. + +2002-09-24 ShengHuo ZHU + + * gnus-start.el (gnus-1): Create nndraft:queue, nndraft:drafts. + +2002-09-24 Simon Josefsson + + * mml2015.el (top-level): Require mm-util for mm-make-temp-file. + (mml2015-use): Prefer PGG if installed. + (mml2015-function-alist): Add PGG wrappers. + (mml2015-gpg-extract-signature-details): Check mml2015-use too. + (mml2015-gpg-extract-signature-details): PGG strips "gpg: " + prefix, make regexp optionally skip it. + (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt) + (mml2015-pgg-verify, mml2015-pgg-clear-verify, mml2015-pgg-sign) + (mml2015-pgg-encrypt): New functions. + (defvar, autoload): Prevent byte-compile warnings. + +2002-09-24 Katsumi Yamaoka + From TSUCHIYA Masatoshi . + + * gnus-art.el (article-strip-banner): Check for the existence of + from header. + +2002-09-23 Kai Gro,b_(Bjohann + + * gnus-art.el (gnus-button-guessed-mid-regexp): Improved regexp. + (gnus-button-alist): Improved regexp for + gnus-button-handle-mid-or-mail (false positives), fixed + gnus-button-handle-man entries. + From Reiner Steib. + +2002-09-23 Paul Jarc + From Josh Huber. + + * nnmaildir.el (nnmaildir--update-nov): fix wrong-type error when + nnmail-extra-headers is non-nil. + +2002-09-23 Paul Jarc + + * nnmaildir.el: Store article numbers persistently. General + revision. + (nnmaildir-request-expire-articles): handle 'immediate and 'never + for nnmail-expiry-wait; delete instead of moving if 'force is + given. + +2002-09-23 Simon Josefsson + Trivial fix from beaker@iavmb.pl (Krzysztof J,Bj(Bdruczyk). + + * smime.el (smime-sign-buffer): Get key and extra certs. + (smime-get-key-with-certs-by-email): Utility function. + +2002-09-21 ShengHuo ZHU + Trivial patch from Micha Wiedenmann + + * gnus-soup.el (gnus-soup-add-article): Mark as read only when the + article exists. -2000-08-02 Stanislav Shalunov +2002-09-20 ShengHuo ZHU - * message.el (message-make-in-reply-to): In-Reply-To is message-id - (see DRUMS). - -2000-09-29 Simon Josefsson + * gnus-sum.el (gnus-summary-next-group): Switch to the summary buffer. - * nntp.el (nntp-async-trigger): Fix authinfo in asynchronous - prefetch. +2002-09-20 Kai Gro,b_(Bjohann + From Reiner Steib. -2000-08-09 10:21:20 Katsumi Yamaoka + * gnus-art.el (gnus-button-handle-custom, + gnus-button-handle-mid-or-mail, + gnus-button-handle-describe-{function,variable,key}, + gnus-button-handle-apropos{,command,variable}): New functions. + (gnus-button-prefer-mid-or-mail,gnus-button-guessed-mid-regexp, + gnus-button-{man,emacs,mail}-level): New variables. + (gnus-button-alist): Use the above to buttonize emacs and mail + related links. - * nntp.el (nntp-open-telnet): Wait for the telnet prompt before - sending a command; allow the rtelnet prompt as well. +2002-09-18 Juanma Barranquero -2000-09-29 Simon Josefsson + * gnus-int.el (gnus-status-message): Fix spacing. - * message.el (message-send): Make sure error is signalled if no - send method is specified. + * imap.el (imap-continuation): Fix typos. -2000-09-29 Florian Weimer +2002-09-18 ShengHuo ZHU - * qp.el (quoted-printable-encode-region): Wrap with - `mm-with-unibyte-current-buffer'. + * gnus-msg.el (gnus-configure-posting-styles): Sort results. -2000-09-29 12:12:49 ShengHuo ZHU + * gnus-art.el (gnus-article-reply-with-original): Correct + with-current-buffer scope. - * gnus-agent.el (gnus-agent-fetch-group-1): Reimplement Mike - McEwan's proposal. - -2000-09-29 12:06:40 ShengHuo ZHU + * message.el (message-completion-alist): Add Reply-To, From, etc. - * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to - the GNU assignment issue. +2002-09-18 Simon Josefsson -2000-09-29 09:56:34 ShengHuo ZHU + * nnimap.el (nnimap-request-expire-articles): Make flag setting + conditional. From Nevin Kapur . - * nndoc.el (nndoc-dissect-mime-parts-sub): Correctly mark body-begin. +2002-09-17 Simon Josefsson -2000-09-29 09:14:08 ShengHuo ZHU + * nnimap.el (nnimap-expiry-target): Don't search for which + articles exists here. + (nnimap-request-expire-articles): Do it here instead. Only expire + when articles are found. Suggested by Nevin Kapur + . - * gnus-sum.el (gnus-summary-enter-digest-group): Decode to-address. +2002-09-17 Kai Gro,A_(Bjohann + From Reiner Steib . -2000-09-28 Kai Gro,A_(Bjohann + * message.el (message-strip-subject-trailing-was) + (message-change-subject, message-add-archive-header) + (message-xpost-fup2-header, message-xpost-insert-note) + (message-xpost-fup2, message-reduce-to-to-cc): New functions + adopted from message-utils.el. Add functions to the keymap, mode + describtion and menu. + (message-change-subject,message-xpost-fup2): Signal error if + current header is empty. + (message-xpost-insert-note): Changed insert position. + (message-archive-note): Ensure to insert note in message body (not + in head). + (message-archive-header, message-archive-note) + (message-xpost-default, message-xpost-note, message-fup2-note) + (message-xpost-note-function): New variables adopted from + message-utils.el. Changed some doc-strings. + (message-mark-insert-{begin,end}): Rename from + message-{begin,end}-inserted-text-mark (message-utils.el), changed + values. + (message-subject-trailing-was-query) + (message-subject-trailing-was-ask-regexp) + (message-subject-trailing-was-regexp): New variables. + (message-to-list-only): Added doc-string and menu entry. - * 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. + * message-utils.el: Removed. Functions are now in message.el. -2000-09-26 Richard M. Alderson III +2002-09-16 ShengHuo ZHU - * gnus-art.el (gnus-read-save-file-name): expand-file-name. + * gnus-art.el (gnus-article-reply-with-original, + gnus-article-followup-with-original): Switch to + gnus-summary-buffer before reply/followup. -2000-09-26 Dave Love +2002-09-15 John Paul Wallington - * gnus-draft.el: Don't require gnus-agent. + * gnus-sum.el (gnus-summary-toggle-header): The article window may + not exist. Toggle it anyway. - * mm-view.el: Use featurep for XEmacs test. - (mm-inline-message): Test for `remove-specifier'; don't use - condition-case. +2002-09-13 ShengHuo ZHU -2000-09-24 Simon Josefsson + * gnus-msg.el (gnus-copy-article-buffer): Bind mail-header-separator. - * nnimap.el (nnimap-request-accept-article): Remove From[^:] lines. + * gnus-art.el (article-fill-long-lines): Fill-paragraph properly. + Trivial patch from Urban Engberg . - * gnus-group.el (gnus-group-nnimap-edit-acl): Check if server - support ACL's. + * rfc2047.el (message-posting-charset): Defvar it. + (rfc2047-charset-encoding-alist): Use B for iso-8859-7 and + iso-8859-8. Fix doc. Suggested by Dave Love . - * nnimap.el (nnimap-acl-get): Check capability. + * mail-source.el (mail-source-fetch): Hide password. - * mail-source.el (mail-source-imap-file-coding-system): New variable. - (mail-source-fetch-imap): Use it. + * gnus-sum.el (gnus-summary-next-group): Semi-exit only when needed. - * rfc2104.el (rfc2104-hexstring-to-bitstring): New function. - (rfc2104-hash): Use it. +2002-09-12 Katsumi Yamaoka + From John Paul Wallington . - * 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. + * gnus.el (gnus-visual, gnus-meta): Fix typo. -2000-09-24 Simon Josefsson +2002-09-11 Katsumi Yamaoka - * imap.el (imap-parse-flag-list): Correctly parse empty lists. - (imap-login-p): Support LOGINDISABLED. + * gnus-art.el (gnus-article-address-banner-alist): Doc fix. -2000-09-23 Simon Josefsson +2002-09-11 Simon Josefsson - * rfc2104.el: Add SHA-1 example. + * nnimap.el (nnimap-expiry-target): Only expiry-target existing articles. + (nnimap-split-rule): Doc fix. + (nnimap-request-expire-articles): Cleanup code. -2000-09-22 Simon Josefsson +2002-09-11 Katsumi Yamaoka + From TSUCHIYA Masatoshi . - * imap.el (imap-parse-body): Work around bug in Sun SIMS. + * gnus-art.el (gnus-article-address-banner-alist): New option. + (article-strip-banner): Refer the above option to split banners of + free mail servers, when no group parameter is specified. -2000-09-21 21:54:48 ShengHuo ZHU +2002-09-10 Katsumi Yamaoka - * lpath.el: Bind nnkiboze-score-file. + * nntp.el (nntp-wait-for-string): Check for a process in the + current buffer instead of `nntp-server-buffer'. -2000-09-21 16:15:25 ShengHuo ZHU +2002-09-09 Simon Josefsson - * 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. + * gnus-art.el (gnus-button-man-handler): New variable. + (gnus-button-alist): Use g-b-handle-man. + (gnus-button-handle-man): New, call g-b-man-handler. -2000-07-16 Dmitry Bely +2002-09-08 Simon Josefsson - * nnheader.el (nnheader-translate-file-chars): Path splitting on NT. + * gnus-art.el (gnus-button-alist): Buttonize man page links. -2000-09-20 18:33:00 ShengHuo ZHU +2002-09-07 Lars Magne Ingebrigtsen - * gnus-score.el (gnus-score-find-bnews): Use directory-sep-char. + * gnus-art.el (gnus-article-dumbquotes-map): Add \230. -2000-09-20 17:37:46 ShengHuo ZHU +2002-09-06 Lars Magne Ingebrigtsen - * message.el (message-default-charset): Set default value in - non-MULE XEmacsen as iso-8859-1. + * gnus-srvr.el (gnus-browse-make-menu-bar): Add "d". -2000-09-20 12:02:24 ShengHuo ZHU + * gnus-sum.el (gnus-summary-limit-to-unseen): New command and + keystroke. - * gnus-demon.el: Use (featurep 'xemacs). - * gnus-agent.el: timer vs. itimer. - * mail-source.el: Ditto. + * gnus-srvr.el (gnus-browse-describe-group): New command and + keystroke. -2000-09-19 10:24:57 ShengHuo ZHU +2002-09-06 Katsumi Yamaoka - * 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. + * gnus-art.el (gnus-article-treat-body-boundary): Don't quote a + value for gnus-decoration property. -2000-09-19 Dave Love +2002-09-06 Kai Gro,b_(Bjohann - * nnmail.el (nnmail-cache-accepted-message-ids): Default to nil. - (nnmail-get-new-mail): Test `sources' in top-level conditional. + * nnmail.el (nnmail-cache-fetch-group): Don't return "" (empty + string) as group name in case we have a CRLF in the file. - * mail-source.el (mail-sources): Change default to '((file)). - Add useful custom type. +2002-09-04 Jesper Harder -2000-09-18 Kai Gro,A_(Bjohann + * rfc1843.el (rfc1843-decode-loosely): Move to mime customization + group. + (rfc1843-decode-hzp): do. + (rfc1843-newsgroups-regexp): do. - * gnus-util.el (gnus-time-iso8601): Correct doc string (four digit - year). - (gnus-date-iso8601): Ditto. +2002-09-04 Simon Josefsson -2000-09-18 09:05:46 ShengHuo ZHU + * message.el (message-canlock-generate): Make sure sha1 doesn't + call external programs. - * mail-source.el (mail-source-fetch-imap): Disable multibyte. +2002-09-03 Simon Josefsson -2000-09-17 01:13:46 ShengHuo ZHU + * nntp.el (nntp-wait-for-string): Dont infloop if process died. - * 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. + * gnus-agent.el (gnus-agent-batch): Add doc. -2000-09-16 15:57:42 ShengHuo ZHU +2002-09-03 Josh Huber - * 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. + * gnus-msg.el (gnus-summary-handle-replysign): Change the order we + check for signed and encrypted parts. + * mml.el (mml-parse-1): Correct small typo which preventing + setting recipients in a secure tag. -2000-09-15 21:10:20 ShengHuo ZHU +2002-09-03 Katsumi Yamaoka - * 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 + * mm-util.el (mm-coding-system-priorities): Default to a list of + iso-2022-jp and others for the Japanese environment. - * 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. +2002-09-03 Katsumi Yamaoka -2000-09-15 09:01:40 ShengHuo ZHU + * gnus-util.el (gnus-frame-or-window-display-name): Exclude + invalid display names. - * gnus-art.el (gnus-treat-display-xface): By default, Emacs 21 - display xface. +2002-08-30 Simon Josefsson -2000-08-23 02:54:46 Katsumi Yamaoka + * gnus-group.el (gnus-group-fetch-control): Fix typo in last + commit. From Reiner Steib <4uce.02.r.steib@gmx.net>. - * gnus-group.el (gnus-group-rename-group): Inhibit renaming of - zombie or killed groups. - -2000-09-15 00:09:56 ShengHuo ZHU +2002-08-26 Jesper Harder - * 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. + * gnus.el (gnus-group-charter-alist): New option. + (gnus-group-fetch-control-use-browse-url): New option. -2000-09-14 23:13:50 ShengHuo ZHU + * gnus-group.el (gnus-group-fetch-charter): New function. + (gnus-group-fetch-control): New function. + Add them to the keymap and menu. Require mm-url. - * gnus-art.el (article-de-quoted-unreadable): Guess charset from - original article buffer. - (article-de-base64-unreadable): Ditto. - (article-wash-html): Ditto. +2002-08-30 Katsumi Yamaoka -2000-09-14 18:55:30 ShengHuo ZHU + * gnus-mlspl.el (gnus-group-split-fancy): Doc fix. + From Alex Schroeder . - * gnus-msg.el (gnus-summary-mail-forward): Disable multibyte - unless forward-show-mml. +2002-08-29 Jesper Harder -2000-09-14 14:48:57 ShengHuo ZHU + * gnus-group.el (gnus-group-make-menu-bar): Add ellipses to menu + items expecting user interaction. - * gnus-sum.el (gnus-summary-save-parts-type-history): New. - (gnus-summary-save-parts-last-directory): New. - (gnus-summary-save-parts): Save history. + * gnus-topic.el (gnus-topic-make-menu-bar): do. -2000-09-14 Ben Gertzfield + * gnus-sum.el (gnus-summary-make-menu-bar): do. - * gnus-sum.el (gnus-summary-save-parts-default-mime): New - variable. - (gnus-summary-save-parts): Use it. + * gnus-srvr.el (gnus-server-make-menu-bar): do. -2000-09-14 11:31:28 ShengHuo ZHU + * mml.el (mml-menu): do. - * 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. +2002-08-28 Katsumi Yamaoka -2000-09-14 08:42:48 ShengHuo ZHU + * mail-source.el (mail-source-touch-pop): New function. - * nndoc.el (nndoc-dissect-mime-parts-sub): Remove - Content-Disposition. + * message.el (message-smtpmail-send-it): New function. + (message-send-mail-function): Add it for a candidate. -2000-09-13 23:58:40 ShengHuo ZHU +2002-08-27 Simon Josefsson - * webmail.el: Hotmail updated. Add X-Gnus-Webmail. + * gnus-msg.el (posting-charset-alist): Use + gnus-define-group-parameter instead of defcustom. + (gnus-put-message): Handle SPC in GCC. + (gnus-inews-insert-gcc): Ditto. + (gnus-inews-insert-archive-gcc): Ditto. -2000-09-13 21:41:25 ShengHuo ZHU +2002-08-26 Simon Josefsson - * 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. + * gnus-agent.el (gnus-agent-auto-agentize-methods): New variable. + (gnus-agentize): Auto agentize all nntp and nnimap groups. + (gnus-agent-possibly-save-gcc): Autoload. + Suggested by (KOSEKI Yoshinori) . -2000-09-13 16:59:33 ShengHuo ZHU +2002-08-26 Katsumi Yamaoka - * 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. + * gnus.el (gnus-other-frame-function): New user option. + (gnus-other-frame): Use it; add a doc-string; make it work with + the gnuclient program. -2000-09-13 Dave Love + * gnus-util.el (gnus-frame-or-window-display-name): New function. - * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode. + * lpath.el: Fbind `frame-parameter', `make-frame-on-display', + `device-connection' and `dfw-device'. - * gnus-ems.el (gnus-ems-redefine): Don't alias - gnus-summary-set-display-table. +2002-08-22 Kai Gro,b_(Bjohann - * message.el (message-user-agent): Don't wrap ignore-errors around - it. + * gnus-art.el (gnus-emphasis-alist): Strikethru had a lot of false + positives, make it stricter. From Jochen Hein (trivial change). - * mm-encode.el (mm-insert-multipart-headers): Avoid redundant - `format'. - (mm-content-transfer-encoding): Don't use cadar. +2002-08-21 Katsumi Yamaoka - * uudecode.el (uudecode-decoder-program) - (uudecode-decoder-switches): Customize. + * gnus.el (gnus-other-frame): Trivial fix. - * gnus-score.el (gnus-home-score-file): Improve custom type. +2002-08-21 Katsumi Yamaoka - * gnus-cus.el (gnus-custom-mode): Conditionally set local - variables for Emacs 21. - (gnus-group-customize): Disable undo while laying out the buffer. + * gnus.el (gnus-other-frame-parameters): New user option. + (gnus-other-frame-object): New variable. + (gnus-other-frame): Make it search for existing Gnus frame; don't + read new news; delete frame on exit. -2000-09-13 09:38:26 ShengHuo ZHU + * gnus-util.el (gnus-select-frame-set-input-focus): New function. - * gnus-util.el (gnus-write-active-file): Bind - coding-system-for-write. + * lpath.el: Fbind w32-focus-frame and x-focus-frame. -2000-09-13 09:14:57 ShengHuo ZHU +2002-08-20 Katsumi Yamaoka + From $B>.4X(B $B5HB'(B (KOSEKI Yoshinori) . - * 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. + * message.el (message-set-auto-save-file-name): Add support for + the Cygwin Emacs; the system-type is `cygwin'. + * nnheader.el (nnheader-file-name-translation-alist): Ditto. -2000-09-12 Simon Josefsson +2002-08-20 ShengHuo ZHU - * gnus-sum.el (gnus-update-read-articles): Undo - `gnus-request-set-mark' operation. + * gnus-art.el (gnus-button-url-regexp): Use POSIX regexp if possible. -2000-09-11 Dave Love + * nnmh.el (nnmh-request-list-1): Use %.0f instead of %d to + avoid arithmetic errors. - * Changelog: Use iso-2022 coding. +2002-08-20 Katsumi Yamaoka - * gnus-msg.el (gnus-msg-mail): New function. - (gnus-user-agent): New mail agent. + * gnus-art.el: Don't fbind `gnus-article-replace-with-quoted-text'. -2000-09-10 Dave Love +2002-08-19 Katsumi Yamaoka - * message.el: Require mail-abbrevs for XEmacs for a problem with - keybinding despite the autoloads for it. + * message.el (message-ignored-supersedes-headers): Add X-Hashcash. + (message-ignored-resent-headers): Add envelope From. -2000-09-08 Simon Josefsson +2002-08-18 Kai Gro,b_(Bjohann - * imap.el (imap-kerberos4-open): Erase more (fixes race condition?). + * gnus.el (gnus-summary-line-format): Document %k specifier. - * 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. +2002-08-17 Kai Gro,b_(Bjohann -2000-09-08 David Edmondson + * gnus-sum.el (gnus-summary-line-message-size): New function. + (gnus-summary-line-format-alist): Use it. - * gnus.el (gnus-short-group-name): Guess separator. +2002-08-15 Katsumi Yamaoka -2000-09-07 Tadashi Watanabe + * gnus-art.el (article-make-date-line): Refer to the value for + `gnus-article-time-format' in the summary buffer. - * smiley.el (smiley-buffer, smiley-create-glyph): Work with GTK - XEmacs as well. + * message.el (message-cite-prefix-regexp): Exclude ":" and ",A;(B". -2000-09-06 Francis Litterio +2002-08-14 Simon Josefsson - * gnus-group.el (gnus-group-insert-group-line): Fix. + * gnus-art.el (gnus-button-alist): Use ' not ` for default value + quoting. + (gnus-button-alist): Fix doc. + (gnus-header-button-alist): Use ' not ` for default value quoting. + (gnus-header-button-alist): Don't inline gnus-button-url-regexp, + rationale similar to 2002-05-01 change. + (gnus-article-add-buttons-to-head): Evaluate expression. -2000-09-04 Dave Love + * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME button option. - * mm-decode.el (mime-display) : Add `multimedia' group. - (mm-get-image): Avoid the losing `make-glyph' from W3. +2002-08-14 Katsumi Yamaoka -2000-09-03 Simon Josefsson + * message.el (message-font-lock-keywords): Refer to the value for + `message-cite-prefix-regexp' dynamically. - * gnus-sum.el (gnus-summary-delete-article): Check server. +2002-08-13 Katsumi Yamaoka -2000-09-01 Simon Josefsson + * gnus-art.el (gnus-decode-header-methods): Doc fix. - * imap.el (imap-parse-flag-list): Rewrite. +2002-08-12 Simon Josefsson - * nnimap.el (nnimap-retrieve-headers-from-file): Ignore errors. + * imap.el (imap-shell-open): Allow non-list `imap-shell-program'. + (imap-shell-open): Skip initial junk before IMAP greeting. - * imap.el (imap-parse-flag-list): Hack. +2002-08-11 Simon Josefsson -2000-08-29 Dave Love + * message-utils.el (message-xpost-default, + message-xpost-fup2-header, message-xpost-fup2): Fixed + Typos. Trivial changes from Reiner Steib + <4uce.02.r.steib@gmx.net>. - * gnus-mlspl.el (gnus-group-split-fancy): Eschew mapcon. +2002-08-09 Simon Josefsson - * dgnushack.el (mapcon, union): Remove compiler macros. + * message.el (message-canlock-password): Set + canlock-password-for-verify to newly generated canlock-password. + When Emacs is restarted, Custom makes sure this is set, but during + the same session we must set it manually. - * gnus-agent.el (gnus-agent-union): new function. - (gnus-agent-fetch-headers): Use it. +2002-08-07 Jesper Harder - * gnus.el (gnus-group-startup-message): Specify foreground and - background for xpm image. Centre image vertically. - From Katsumi Yamaoka with mods. + * yenc.el: New file. -2000-08-24 23:49:23 ShengHuo ZHU + * mm-uu.el (mm-uu-yenc-decode-function): New variable. + (mm-uu-type-alist): Add yenc. + (mm-uu-yenc-filename): New function. + (mm-uu-yenc-extract): New function. - * message.el (message-send-mail): Narrow-to-headers. + * mm-bodies.el (mm-decode-content-transfer-encoding): Add yenc. -2000-08-24 Dave Love +2002-08-06 ShengHuo ZHU - * gnus-art.el (gnus-insert-mime-button): Fix help-echo for Emacs - 21. + * dgnushack.el (merge): Don't use coerce. -2000-08-23 Dave Love +2002-05-27 Jesper Harder - * dgnushack.el: Remove `member-if' compiler macro. + * mailcap.el (mailcap-mime-data): Test window-system rather than + mm-device-type. + (mailcap-mime-data): Call xdvi and gv with "-safer". -2000-08-21 Dave Love + * mm-util.el: Don't define mm-device-type. - * nnimap.el (nnimap-request-newgroups): Eschew member-if. +2002-08-05 Simon Josefsson -2000-08-21 10:09:47 ShengHuo ZHU + * mm-util.el (mm-coding-system-priorities): coding-system type not + supported everywhere. - * 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. +2002-08-04 Lars Magne Ingebrigtsen -2000-08-21 Dave Love + * gnus.el (gnus-version-number): Bumped version number. - * gnus-ems.el (gnus-add-minor-mode): Add &rest arg. - (gnus-xemacs): Use featurep. +2002-08-04 01:48:57 Lars Magne Ingebrigtsen - * 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. + * gnus.el: Oort Gnus v0.07 is released. - * mml.el (mml-make-string): Deleted (unused). +2002-08-04 Lars Magne Ingebrigtsen - * gnus.el (gnus-mode-line-buffer-identification): Supply - definition for Emacs 21. + * gnus-sum.el (gnus-thread-sort-functions): Doc fix. + (gnus-article-sort-functions): Doc fix. + (t): New keystroke. + (gnus-article-sort-by-random): New function. + (gnus-thread-sort-by-random): New function. - * gnus-salt.el: Small doc fixes. - (gnus-pick-mode, gnus-binary-mode): Supply a toggle-func arg to - gnus-add-minor-mode. +2002-08-02 Simon Josefsson - * gnus-topic.el (gnus-topic-mode): Supply a toggle-func arg to - gnus-add-minor-mode. + * gnus-logic.el (gnus-advanced-integer): Swap arguments in + funcall. From Scott A Crosby . -2000-08-20 Simon Josefsson +2002-07-31 Danny Siu - * 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-split-articles): do not call nnmail-fetch-field + when splitting malformed messages without message-id - * nnimap.el (nnimap-request-article-part): Less verbose. +2002-07-28 Kai Gro,b_(Bjohann + From Niklas Morberg . -2000-08-19 Andreas Jaeger + * nnweb.el (nnweb-type, nnweb-type-definition) + (nnweb-gmane-create-mapping, nnweb-gmane-wash-article) + (nnweb-gmane-search, nnweb-gmane-identity): Added gmane + functionality. + * nnweb.el: Removed old non-functioning search engines. - * 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 +2002-07-27 Simon Josefsson - * gnus-score.el (gnus-score-find-score-files-function): Fix doc, - custom type. + * message.el (message-forward-make-body): Don't use + `message-forward-ignored-headers' when doing a "raw" followup (it + is important to preserve e.g. CTE). - * gnus-xmas.el (gnus-group-icon-create-glyph): Don't test - gnus-group-running-xemacs. + * flow-fill.el (fill-flowed): Disable filladapt-mode. - * nnheader.el (nnheader-replace-chars-in-string): Use - subst-char-in-string if available. + * gnus-sieve.el (gnus-sieve-guess-rule-for-article): Don't + regexp-quote, Cyrus Sieve is fixed. - * 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. + * sieve-manage.el (sieve-manage-deletescript): New function. -2000-08-17 Dave Love + * sieve.el (sieve-manage-mode-map): Fix down-mouse-2 and down-mouse-3. + (sieve-manage-mode): Fix menubar. + (sieve-activate): Change some messages. + (sieve-deactivate-all): New function. + (sieve-deactivate): New alias. + (sieve-remove): New function. + (sieve-help): Fix help. + All suggested by Ned Ludd. - * gnus-group.el (gnus-group-running-xemacs): Deleted. +2002-07-24 Katsumi Yamaoka - * gnus-demon.el (gnus-demon): Bind use-dialog-box and - last-nonmenu-event. + * mm-decode.el (mm-inline-text-html-with-images): Doc fix. + (mm-w3m-safe-url-regexp): New user option. - * uudecode.el (char-int): Use defalias, not fset. + * mm-view.el (mm-inline-text-html-render-with-w3m): Use + `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'. - * score-mode.el: Don't require easymenu. Require mm-util. - (score-mode-coding-system): Use mm-auto-save-coding-system. +2002-07-23 Karl Kleinpaste - * nneething.el (nneething-create-mapping): Don't use cadar & al. - (nneething-file-name): Use expand-file-name, not concat. + * gnus-sum.el (gnus-summary-delete-article): Force + nnmail-expiry-target to 'delete, so that absolute deletion + happens when absolute deletion is requested. -2000-08-16 13:05:46 ShengHuo ZHU +2002-07-21 Kai Gro,b_(Bjohann + From Nevin Kapur . - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): - Failure proof for email addresses. - (nnslashdot-sane-retrieve-headers): Ditto. + * nnmail.el (nnmail-fancy-expiry-target): Treat nonexisting + headers as empty headers. -2000-08-14 20:08:40 Lars Magne Ingebrigtsen +2002-07-21 Kai Gro,b_(Bjohann + From Jochen Hein . - * message.el (message-send-mail): Only insert courtesy message - when text/plain. + * gnus-art.el (gnus-emphasis-alist): Add strikethrough and + correct typo. + (gnus-emphasis-strikethru): New face. -2000-08-14 19:55:04 Jesper Harder +2002-07-20 Kai Gro,b_(Bjohann + From Jason Merrill . - * message.el (message-cancel-news): Copy the From header from the - original article. + * nnfolder.el (nnfolder-retrieve-headers): Avoid searching the + entire file for each of a sequence of missing articles. -2000-08-14 19:52:01 Lars Magne Ingebrigtsen + * gnus-salt.el (gnus-binary-display-article): Respect an existing + value for gnus-view-pseudos. - * gnus-async.el (gnus-asynchronous): Removed. + * gnus-sum.el (gnus-summary-insert-new-articles): Count down to + avoid nreverse. -2000-08-14 16:12:11 ShengHuo ZHU +2002-07-14 Kai Gro,b_(Bjohann + From Ted Zlatanov . - * mail-source.el (mail-source-fetch-maildir): Use MMDF mail - format. + * gnus-sum.el (gnus-auto-expirable-marks): Remove `spam'. + (gnus-summary-mode-line-format-alist): Add %h for number of + spams. + (gnus-newsgroup-spam-marked): New variable. + (gnus-summary-local-variables): Add gnus-newsgroup-spam-marked. + (gnus-article-read-p, gnus-article-mark) + (gnus-set-global-variables, gnus-set-global-variables) + (gnus-article-marked-p, gnus-summary-mark-article-as-read) + (gnus-summary-mark-article-as-unread) + (gnus-summary-mark-article-as-unread, gnus-summary-mark-article) + (gnus-mark-article-as-read, gnus-mark-article-as-unread) + (gnus-mark-article-as-unread, gnus-summary-catchup): Grok spam. -2000-08-14 19:12:22 Rod Whitby +2002-07-10 Simon Josefsson - * nnmail.el (nnmail-expiry-target-group): Fixed. + * nnimap.el (nnimap-split-to-groups): Allow group string to be a + function. From KANEMATSU Daiji . -2000-08-14 Rod Whitby +2002-07-09 Nevin Kapur - * 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? + * gnus-sum.el (gnus-summary-delete-article): Respect group + parameters while expiring. +2002-07-08 Simon Josefsson -2000-08-14 Rod Whitby + * gnus-art.el (article-make-date-line): Fix string. From Henrik + Enberg. - * 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). +2002-07-08 Kai Gro,b_(Bjohann -2000-08-14 Rod Whitby + * gnus-art.el (article-unsplit-urls): Only display MIME when this + function is called interactively. From Niklas Morberg. - * gnus-sum.el (gnus-summary-expire-articles): Fix the handling of - expiry-target group parameters. +2002-07-06 ShengHuo ZHU -2000-08-13 18:53:08 Lars Magne Ingebrigtsen + * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): Change + cdaar to cdar and car. - * gnus-topic.el (gnus-topic-select-group): Touch the dribble - buffer. - (gnus-topic-hide-topic): Take a PERMANENT parameter. - (gnus-topic-show-topic): Ditto. + * nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type) + (nnsoup-read-active-file, nnsoup-article-to-area): Ditto. - * gnus-dup.el (gnus-dup-suppress-articles): Do auto-expiry. +2002-07-05 Katsumi Yamaoka -2000-08-12 21:48:00 John H. Palmieri + * gnus-sum.el (gnus-summary-toggle-header): Show headers anyway; + don't break a narrowed article. - * mail-source.el (mail-source-incoming-file-prefix): New - variable. + * nntp.el (nntp-via-rlogin-command-switches): Doc fix. + (nntp-open-via-rlogin-and-telnet): Ditto. -2000-08-12 20:29:53 Lars Magne Ingebrigtsen +2002-07-02 Didier Verna - * gnus-start.el (gnus-check-first-time-used): Clean up a bit. + * nnmail.el (nnmail-split-methods): fix custom type. - * mailcap.el (mailcap-maybe-eval): Be even more warning. +2002-07-02 Kai Gro,b_(Bjohann -2000-08-11 Florian Weimer + * gnus-art.el (article-unsplit-urls): Keep URL buttonized after + unsplitting. From Niklas Morberg . - * message.el (message-syntax-checks): New check quotin-style: - Text must be written below quoted text. - (message-check-news-body-syntax): Check it. +2002-07-01 Kai Gro,b_(Bjohann -2000-08-11 Simon Josefsson + * gnus-msg.el (gnus-summary-resend-default-address): New user option. + (gnus-summary-resend-message): Use it. - * imap.el (imap-authenticator-alist): Fix typo. - (imap-gssapi-open): Copy krb4 fixes for modern imtest's, thanks to - Jonas Oberg for debugging. +2002-06-28 Katsumi Yamaoka -2000-08-11 Simon Josefsson + * nntp.el (nntp-via-rlogin-command-switches): New variable. + (nntp-open-via-rlogin-and-telnet): Re-revert; use the var above. - * gnus-async.el (gnus-asynchronous): Disable by default. +2002-06-28 Kai Gro,b_(Bjohann -2000-08-10 20:22:09 Lars Magne Ingebrigtsen + * message.el (message-font-lock-keywords): Don't fontify + headers in the message body, only in the header. + (message-font-lock-make-header-matcher): New function, used by + message-font-lock-keywords. + From Katsumi Yamaoka . - * mm-view.el (mm-inline-text): Bind fill-column. +2002-06-28 Katsumi Yamaoka - * nnvirtual.el (nnvirtual-request-expire-articles): Return the - list of unexpired articles. + * nntp.el (nntp-open-via-rlogin-and-telnet): Revert last change. - * gnus-group.el (gnus-group-expire-articles-1): Return the list of - un-expired articles. +2002-06-28 Katsumi Yamaoka - * gnus-sum.el (gnus-summary-reparent-thread): Narrow to the - headers. + * nntp.el (nntp-open-via-rlogin-and-telnet): Hide commandline args. - * gnus-topic.el (gnus-topic-kill-group): Move up one line so that - we update the right topic.. +2002-06-26 Kai Gro,b_(Bjohann - * mm-decode.el (mm-display-external): Put point at start. + * message.el (message-font-lock-keywords): Revert 2002-06-22 + change. -2000-08-10 Kai Gro,A_(Bjohann +2002-06-24 Kai Gro,b_(Bjohann - * nnmail.el (nnmail-expiry-target): More explicit documentation. + * message.el (message-font-lock-keywords): Put colon in header + name match. - * gnus-cus.el (gnus-group-parameters): Add parameter `expiry-wait'. +2002-06-22 Kai Gro,b_(Bjohann -2000-08-09 Simon Josefsson + * message.el (message-font-lock-keywords): Don't use header faces + in the body. Thanks to Stefan Monnier for the hint on the + implementation. - * 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. +2002-05-09 Miles Bader - * imap.el (imap-range-to-message-set): Move from nnimap.el. + * gnus-cite.el (gnus-cite-blank-line-after-header): New variable. + (gnus-article-hide-citation): Respect it. - * 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. +2002-04-12 Juanma Barranquero -2000-08-08 00:53:41 ShengHuo ZHU + * pop3.el (pop3-open-server): Fix typo. - * message.el (message-dont-reply-to-names): - rmail-dont-reply-to-names may not be defined. +2002-06-18 Josh Huber -2000-08-07 09:37:01 ShengHuo ZHU + * gnus.el (gnus-find-subscribed-addresses): Use add-to-list + instead of push to ignore duplicate to-(list|address) values. + * nnmail.el (nnmail-cache-ignore-groups): New. + * nnmail.el (nnmail-cache-insert): Obey nnmail-cache-ignore-groups - * gnus-group.el (gnus-group-iterate): Uncompiled function should - not use pop. +2002-06-18 Kai Gro,b_(Bjohann -2000-07-19 Dave Love + * gnus-delay.el (gnus-delay-send-queue): Delete the delay header + before sending. Suggested by Jan Rychter. - * 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. +2002-06-18 Katsumi Yamaoka -2000-07-19 Kim-Minh Kaplan + * dgnushack.el (remove): New compiler macro. + (last, coerce, subseq): Remove compiler macros for those built-in + or unused functions. - * imap.el (imap-calculate-literal-size-first): New variable. - (imap-local-variables): Add it. - (imap-kerberos4-open): Set it. - (imap-send-command): Use it. +2002-06-17 Kai Gro,b_(Bjohann -2000-07-17 14:18:16 ShengHuo ZHU + * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): Make + sure to write byte-compiled versions of gnus-*-format-alist to + .newsrc.eld. From Simon Josefsson. - * 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. +2002-06-16 Kai Gro,b_(Bjohann -2000-07-16 18:25:07 ShengHuo ZHU + * gnus-agent.el (gnus-agent-read-servers) + (gnus-agent-write-servers): Put server name (string like + "nnchoke:frumple") in the file instead of a server specification + (Lisp expression like (nnchoke "frumple" ...parameters...)). + From Bj,Ax(Brn Mork . - * nndoc.el (nndoc-type-alist): Add outlook. - (nndoc-outlook-type-p): New function. - (nndoc-outlook-article-begin): Ditto. +2002-06-16 Simon Josefsson -2000-07-16 Daiki Ueno + * gnus-cache.el (gnus-cache-remove-article): n is &optional. From + Reiner Steib <4uce.02.r.steib@gmx.net>. - * gnus-sum.el (gnus-restore-hidden-threads-configuration): Save - excursion. +2002-06-15 ShengHuo ZHU -2000-07-15 Simon Josefsson + * nnheader.el (nnheader-file-name-translation-alist): Set the + default value for MS Windows systems. - * gnus-cus.el (gnus-group-parameters, banner): Type is regexp. + * gnus-ems.el (nnheader-file-name-translation-alist): Removed. - * 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. +2002-06-14 Katsumi Yamaoka -2000-07-14 Simon Josefsson + * message.el (message-beginning-of-line): Keep the region active + in XEmacs. Suggested by TAKAHASHI Kaoru . - * gnus.el (gnus-invalid-group-regexp): New variable. - (gnus-read-group): Use it. +2002-06-13 Josh Huber -2000-07-14 12:40:51 ShengHuo ZHU + * gnus-msg.el (gnus-summary-followup): Use g-s-handle-replysign. + * gnus-msg.el (gnus-summary-reply): Ditto. + * gnus-msg.el (gnus-summary-handle-replysign): New. - * gnus-agent.el (gnus-agent-fetch-group-1): mark-below, - expunge-below and orphan-score are "group variables". +2002-06-12 Katsumi Yamaoka -2000-07-13 Simon Josefsson + * message.el (message-send-mail-with-sendmail): Kill errbuf even + if sending failed. - * gnus-srvr.el (gnus-browse-read-group): Don't pass fully - qualified group names to `gnus-group-read-ephemeral-group'. +2002-06-11 Josh Huber -2000-07-13 07:40:39 Katsumi Yamaoka + * gnus-start.el (gnus-dribble-enter): Don't call set-window-point anymore + * mml2015.el (mml2015-mailcrypt-encrypt): Accept optional argument + to sign while encrypting. - * dgnushack.el (srcdir): Define it before use it. +2002-06-11 Simon Josefsson -2000-07-12 19:37:50 ShengHuo ZHU + * gnus-int.el (gnus-request-move-article): Agent expire article if + successfuly moved. - * gnus-sum.el: `W t' is toggle-header in info. + * nnweb.el (nnweb-google-create-mapping): Honors the value of + nnweb-max-hits. From Niklas Morberg . -2000-07-12 16:50:06 ShengHuo ZHU +2002-06-10 Simon Josefsson - * lpath.el: Fbind subst-char-in-string. + * gnus-int.el (gnus-request-expire-articles): Fix last change? -2000-07-12 15:48:29 ShengHuo ZHU +2002-06-09 Simon Josefsson - * Makefile.in: Use W3DIR and lispdir. - * dgnushack.el: Ditto. + * gnus-sum.el (gnus-summary-delete-article): Don't agent expire here. -2000-07-12 10:12:31 ShengHuo ZHU + * gnus-int.el (gnus-request-expire-articles): Do it here instead. - * gnus-art.el (article-de-base64-unreadable): Typo. +2002-06-08 ShengHuo ZHU -2000-07-12 Simon Josefsson + * flow-fill.el (fill-flowed): Ignore errors. - * gnus-agent.el (require): Require timer. +2002-06-06 Simon Josefsson -2000-07-11 18:29:50 ShengHuo ZHU + * message.el (message-send-mail-with-sendmail): Improve error message. - * message.el (message-bounce): Call mime-to-mml. +2002-06-06 Kai Gro,b_(Bjohann -2000-07-11 18:00:49 Lars Magne Ingebrigtsen + * message.el (message-interactive): Change default from nil to t. + Better to be safe than to be fast. - * nnslashdot.el (nnslashdot-request-close): New function. +2002-06-05 Kai Gro,b_(Bjohann -2000-07-04 23:23:23 Lars Magne Ingebrigtsen + * message.el (message-send-mail-with-sendmail): Check return value + from call-process-region. - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Get the - right line number for the article. +2002-06-04 Simon Josefsson -2000-07-10 22:41:58 ShengHuo ZHU + * gnus-msg.el (gnus-group-mail, gnus-group-news) + (gnus-group-post-news, gnus-summary-mail-other-window) + (gnus-summary-news-other-window, gnus-summary-post-news): Bind + gnus-article-copy to nil, thereby inhibiting the `header' posting + style match to use data from last viewed article. + Suggested by Hrvoje Niksic. - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Save point. - * webmail.el (webmail-fetch): Bind - url-http-silence-on-insecure-redirection. +2002-06-04 Katsumi Yamaoka -2000-07-10 11:43:22 ShengHuo ZHU + * spam.el (spam-point-at-eol): New alias. + (spam-parse-whitelist): Use it. - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Use - unibyte. - (nnslashdot-sane-retrieve-headers): Ditto. - (nnslashdot-request-article): Ditto. +2002-06-03 Simon Josefsson -2000-07-10 11:12:32 William M. Perry + * nnmail.el (nnmail-mail-splitting-decodes): New variable. + (nnmail-article-group): Use it. - * mailcap.el (mailcap-parse-mimetype-file): +2002-05-30 Kai Gro,b_(Bjohann -2000-07-07 23:46:22 ShengHuo ZHU + * gnus-msg.el (gnus-inews-yank-articles): Merge split header lines + so that code reading them won't be surprised. From Jesper Harder + . - * nnweb.el (nnweb-insert): Stricter test. - * webmail.el (webmail-refresh-redirect): Ditto. +2002-05-29 Simon Josefsson -2000-07-06 14:17:48 ShengHuo ZHU + * gnus-sum.el (gnus-summary-delete-article): Agent expire deleted + articles. - * mm-decode.el (mm-dissect-multipart): Match the EOL of boundary. + * gnus.el (gnus-agent-cache): Doc fix. + (gnus-agent): Change default to t. -2000-07-05 21:19:22 ShengHuo ZHU + * gnus-agent.el (gnus-agent-expire): Make it accept optional + ARTICLES, GROUP and FORCE parameters. - * nnheader.el (nnheader-insert-nov): Remove EOLs of all fields. +2002-05-28 Simon Josefsson -2000-07-05 Dave Love + * gnus-group.el (gnus-group-line-format): Doc fix. - * utf7.el: Doc and header fixes. +2002-05-28 Kai Gro,b_(Bjohann - * gnus-sum.el: Doc fixes. + * gnus-msg.el (gnus-inews-yank-articles): Unfold headers of + original article before yanking. From Jesper Harder + . - * gnus-util.el (gnus-point-at-eol, gnus-point-at-bol): Use - defalias, not fset. +2002-05-26 Simon Josefsson - * flow-fill.el (fill-flowed-point-at-eol) - (fill-flowed-point-at-bol): Use defalias, not fset. + * gnus-sum.el (gnus-summary-menu-split): New function. + (gnus-summary-make-menu-bar): Split charset submenu. + (gnus-summary-menu-maxlen): New variable. + (gnus-summary-menu-split): Use it. - * gnus-art.el: Don't alias article-mime-decode-quoted-printable. - (gnus-Plain-save-name): Delete -- apparently bogus. +2002-05-25 Simon Josefsson -2000-07-03 00:12:26 Lars Magne Ingebrigtsen + * mml.el (mml-preview): Generate some headers. - * nnsoup.el: Use expand-file-name throughout. + * gnus.el (gnus-large-newsgroup): Fix :type. -2000-07-03 00:07:51 Kjetil Torgrim Homme + * nnimap.el (nnimap-nov-is-evil): Change default to t (because the + Agent cache NOV's by default now). + (nnimap-nov-is-evil): Make it default to `gnus-agent' instead. - * nnmail.el (nnmail-read-incoming-hook): New example. +2002-05-18 Jesper Harder -2000-07-02 23:17:23 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-dependencies-add-header): Avoid one unecessary + call to gnus-parent-id when we check for References loops. + (gnus-summary-prepare-threads): Avoid simplifying every Subject + twice by saving the simplified subject string in simp-subject. - * mm-view.el (mm-inline-text): Check whether the text has already - been decoded. +2002-05-23 Simon Josefsson -2000-07-04 15:17:05 ShengHuo ZHU + * gnus-msg.el (gnus-confirm-mail-reply-to-news): Typo. Trivial + change from Benjamin Rutt . - * nnslashdot.el (nnslashdot-sid-strip): To strip or not to strip? + * nnweb.el (nnweb-type): Remove dejanewsold. Trivial change from + Niklas Morberg . -2000-07-03 Stainless Steel Rat +2002-05-22 Simon Josefsson - * gnus-sum.el (gnus-recenter): Fix horizontal recenter. + * sieve.el (sieve-change-region): Define it before it is used. -2000-07-03 Simon Josefsson + * gnus-msg.el (gnus-confirm-mail-reply-to-news) + (gnus-summary-reply): Ask for confirmation when replying to news. + Defaults to not ask. From Benjamin Rutt + . - * gnus-sum.el (gnus-update-marks): Don't propagate download and - unsend flags. + * nnimap.el (nnimap-nov-is-evil): Improve doc. -2000-07-03 Simon Josefsson +2002-05-21 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. + * sieve-mode.el (sieve-manage): Fix autoloads. -2000-07-03 Paul Stodghill + * sieve-manage.el (sieve-manage-cram-md5-auth): Just send the SASL + name (makes it work with recent Cyrus timsieved). - * message.el (message-unquote-tokens): Remove all quotes. +2002-05-20 Jason + Trivial patch. -2000-07-03 00:29:08 Julien Gilles + * gnus-art.el (gnus-request-article-this-buffer): Try + reconnecting if you don't get the message. - * gnus-ml.el: New file. +2002-05-20 Lars Magne Ingebrigtsen -2000-07-02 16:11:25 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-enter-digest-group): Only get + Reply-To headers from the headers. - * nnultimate.el (nnultimate-request-close): New function. +2002-05-18 Lars Magne Ingebrigtsen - * gnus-start.el (gnus-clear-system): Clear nnmail-split-history. + * mm-url.el (mm-url-insert): Remove junk message. -2000-06-18 Norbert Koch +2002-05-17 Lars Magne Ingebrigtsen - * Makefile.in: Better support for xemacs builds + * nnslashdot.el (nnslashdot-request-list): Parse new html. + (nnslashdot-use-front-page): New variable. + (nnslashdot-request-list): Use it. -Sun Jul 2 15:11:35 2000 Lars Magne Ingebrigtsen + * mm-url.el (mm-url-timeout): New variable. + (mm-url-retries): Ditto. + (mm-url-insert): Use it. - * gnus.el: Gnus v5.8.7 is released. +2002-05-16 Simon Josefsson -2000-05-19 06:32:52 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-simplify-all-whitespace): New function. + (gnus-simplify-subject-functions): Mention g-s-a-w. - * mm-decode.el (mm-insert-part): Characters doubly decoded. +2002-05-15 Josh Huber -2000-07-01 10:23:08 Shenghuo ZHU + * nnbabyl.el (nnbabyl-request-accept-article): Pass group to + nnmail-cache-insert. + * nndiary.el (nndiary-request-accept-article): Ditto. + * nnfolder.el (nnfolder-request-accept-article): Ditto. + * nnimap.el (nnimap-request-accept-article): Ditto. + * nnmail.el (nnmail-process-unix-mail-format): Ditto. + * nnmail.el (nnmail-check-duplication): Ditto. (from gnus-art) + * nnmbox.el (nnmbox-request-accept-article): Ditto. + * nnmh.el (nnmh-request-accept-article): Ditto. + * nnmail.el (nnmail-cache-insert): Change group to required, + removed code which tried to figure out the group. - * message.el (message-do-fcc): Encode MIME. +2002-05-13 Josh Huber -2000-06-28 13:52:57 Shenghuo ZHU + * mml.el (mml-generate-mime-1): Fix mml generation for signed only + messages. From Hans de Graaff . + * nnml.el (nnml-request-accept-article): Pass in the group name to + nnmail-cache-insert, since it's available. - * lpath.el: Fbind image-size. +2002-05-10 ShengHuo ZHU -2000-06-28 Simon Josefsson + * nndoc.el (nndoc-mime-digest-type-p): Set proper file-end. - * nnimap.el (nnimap-split-rule): Update doc with extended syntax. - (nnimap-assoc-match): New function. - (nnimap-split-find-rule): Support extended syntax. +2002-05-08 Kai Gro,b_(Bjohann + From Florian Weimer . -2000-06-28 Simon Josefsson + * gnus.el (subscribed): New group parameter. + (gnus-find-subscribed-addresses): Use it. - * nnimap.el (nnimap-open-connection): Use port stuff. +2002-05-08 Josh Huber - * gnus-util.el (gnus-netrc-machine): Add defaultport parameter, - document port and defaultport. + * mml-sec.el (mml-signencrypt-style-alist): Rename. Also, changed + the default for pgpmime to support pgp v2. + * mml-sec.el (mml-signencrypt-style): New accessor function to + allow users to get/set the signencrypt style more easily without + frobbing the alist directly. + * mml.el (mml-generate-mime-1): Use accessor function. -2000-06-27 Paul Stodghill +2002-05-08 Kai Gro,b_(Bjohann - * gnus-agent.el (gnus-agent-synchronize): Kill flags buffer. + * gnus-art.el (gnus-article-mode-syntax-table): Specify matching + parenthesis for "<" and ">". Suggested by Andreas Schwab + . -2000-06-26 Dave Love +2002-05-07 Kai Gro,b_(Bjohann - * mm-decode.el (mm-image-fit-p): Use `image-size' in Emacs. + * nnmail.el (nnmail-cache-insert): Prefer group-art over group + when intuiting the group the message is written to. From Josh + Huber . - * 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. +2002-05-06 Simon Josefsson - * gnus-xmas.el (gnus-xmas-define) : - Define if necessary. + * gnus-topic.el (gnus-group-topic-parameters): Work when group + buffer doesn't show group. From Matt Armstrong . - * gnus-art.el (gnus-article-edit-exit): Don't assume `format' - removes text properties. +2002-05-06 Josh Huber - * gnus-srvr.el (gnus-browse-group-name): Likewise. + * mml2015.el (mml2015-gpg-encrypt): Changed name of optional + argument, and fixed compiler warning. (added autoload for + gpg-encrypt). - * gnus-msg.el (gnus-copy-article-buffer): Likewise. +2002-05-04 Simon Josefsson - * gnus-score.el (gnus-summary-score-entry): Likewise. + * mml1991.el (mml1991-function-alist): Doc fix. -2000-06-26 11:18:57 Katsumi Yamaoka + * mml.el (mml-preview): Bind gnus-newsrc-hashtb temporarily if it + doesn't exist (for previewing messages without having Gnus + started). - * nnimap.el (nnimap-request-post): Fix parenthesis. + * mm-util.el (mm-coding-system-priorities): Defcustom. -2000-06-26 Paul Stodghill + * mm-encode.el (mm-content-transfer-encoding-defaults): Defcustom. - * message.el (message-unquote-tokens): New function. +2002-05-01 Josh Huber - * gnus-msg.el (gnus-inews-do-gcc): Unquote gcc tokens. + * gnus-msg.el (gnus-message-replysignencrypted): enabled by + default. + * mml-sec.el: + * mml-sec.el (mml-signencrypt-style): New. + * mml-sec.el (mml-pgpmime-encrypt-buffer): Accept optional + argument `sign'. + * mml-sec.el (mml-secure-message-encrypt-pgp): Changed default to + signencrypt. + * mml-sec.el (mml-secure-message-encrypt-pgpmime): Ditto. + * mml.el (mml-generate-mime-1): Changed logic so a part which is + both signed & encryped is processed in one operation. (rather than + two separate ops: sign, then encrypt) + * mml2015.el (mml2015-gpg-extract-signature-details): Give some + indication if a message is signed by an expired key. + * mml2015.el (mml2015-gpg-encrypt): Accept optional argument which + enables combined sign & encrypt operation. (this was always on + before). + * mml2015.el (mml2015-encrypt): Accept optional argument `sign'. - * nnimap.el (nnimap-request-post): Ditto. +2002-05-01 Simon Josefsson -2000-06-21 Simon Josefsson + * nnimap.el (nnimap-retrieve-groups): Use separate data for each + server. + (nnimap-mailbox-info): defvar instead of defvoo. - * gnus.el (gnus-asynchronous): Removed (defined in gnus-async.el). +2002-05-01 20:09:21 Lars Magne Ingebrigtsen - * nnimap.el (nnimap-callback): Update for IMAP4rev1 servers (see - patch commited 2000-04-02). + * gnus.el: Oort Gnus v0.06 is released. -2000-06-20 Simon Josefsson +2002-05-01 Lars Magne Ingebrigtsen - * 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. + * lpath.el: Bind url-package-version. -2000-06-19 Dave Love +2002-05-01 Simon Josefsson - * mm-uu.el Don't require message. Require cl when compiling. + * nnfolder.el (nnfolder-request-delete-group): Figure out nov/mrk + filename before deleting the group itself, because the presence of + a group filename decides if long filenames are used or not. -2000-06-17 18:58:46 Shenghuo ZHU + * gnus-art.el (gnus-button-alist): Don't inline + gnus-button-url-regexp. This makes it possible to change g-b-u-r + without also modifying g-button-alist. + (gnus-button-alist): Fix type to allow variable as well as regexp. + (gnus-article-add-buttons): Evaluate regexp. Strings evaluate to + themselves, variables to its contents. + (gnus-button-entry): Ditto. - * gnus-sum.el (gnus-summary-local-variables): gnus-orphan-score is - a local variable. - * gnus-sum.el (gnus-orphan-score): Move here. +2002-05-01 Simon Josefsson -2000-06-10 09:33:36 Shenghuo ZHU + * imap.el (imap-parse-resp-text-code, imap-parse-status): Treat + UIDNEXT as a string. - * message.el (message-forward): Remove show-mml condition. - (message-forward-ignored-headers): Remove X-Gnus headers. + * nnimap.el (nnimap-string-lessp-numerical): New function. + (nnimap-retrieve-groups): Compare UIDNEXT as strings instead of + integers. -2000-06-08 Simon Josefsson +2002-04-29 Simon Josefsson - * gnus-cus.el (gnus-extra-group-parameters): Add uidvalidity. + * nnmail.el (nnmail-cache-insert): Accept optional group + parameter. -2000-06-08 12:34:26 Urban Engberg + * nnimap.el (nnimap-retrieve-groups): Don't send STATUS when + n-r-g-a is disabled. - * gnus-demon.el (gnus-demon-scan-mail): Bind nnmail-fetched-sources. +2002-04-29 Simon Josefsson -2000-06-08 12:27:55 Shenghuo ZHU + * nnimap.el (nnimap-split-fancy): Fix doc. + (nnimap-split-fancy): Fix doc. - * message.el (message-syntax-checks): Add type. + * nnimap.el (nnimap-retrieve-groups-asynchronous): New variable. + (nnimap-mailbox-info): New internal variable. + (nnimap-retrieve-groups): Implement faster new mail check. -2000-06-07 Dave Love + * nnimap.el (nnimap-split-articles): Support + nnmail-cache-accepted-message-ids. + (nnimap-request-accept-article): Ditto. - * mm-view.el (mm-inline-image-emacs): Don't specify string for - put-image. - (mm-inline-image): Defalias, not fset. + * imap.el (imap-mailbox-status-asynch): New command. - * gnus.el (gnus-group-startup-message): Don't specify string for - insert-image. +2002-04-29 Nevin Kapur - * 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. + * gnus.el (gnus-find-subscribed-addresses): Return nil when there + are no subscribed mail groups. + - Strip quoted names when comparing addresses -2000-06-06 13:28:53 Shenghuo ZHU +2002-04-28 Jesper Harder - * 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. + * mm-decode.el (mm-text-html-renderer): Change customize type to + const. -2000-06-05 22:25:12 Shenghuo ZHU + * gnus-msg.el (gnus-discouraged-post-methods): Fix typo. + (gnus-debug-exclude-variables): do. - * 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. +2002-04-27 ShengHuo ZHU -2000-06-04 15:05:16 Shenghuo ZHU + * gnus-msg.el (gnus-article-mail): Use gnus-msg-mail instead. + Trivial change from Karl Pfl,Ad(Bsterer . - * message.el (message-read-from-minibuffer): Typo. +2002-04-27 Katsumi Yamaoka -2000-06-03 13:36:46 Shenghuo ZHU + * dns.el (dns-make-network-process): New macro. + (query-dns): Use it. - * gnus-art.el (article-decode-charset): Override non-MIME forward - charset. +2002-04-27 ShengHuo ZHU -2000-06-02 12:04:26 Shenghuo ZHU + * gnus-msg.el (gnus-summary-reply): Remove unbound variable + article-buffer. - * mml.el (mml-quote-region): Correct the regexp. - * gnus-msg.el (gnus-summary-reply): mml-quote it. + * mm-url.el (mm-url-package-name): New variable. + (mm-url-package-version): New variable. + (mm-url-insert-file-contents): Bind url-package-name and + url-package-version here. + * nnrss.el (nnrss-insert-w3): Move the bindings. -2000-06-02 11:57:15 Shenghuo ZHU + * nnrss.el (nnrss-insert-w3): Bind url-package-name and + url-package-version. Trivial change from Andrew J Cosgriff + - * 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. + * mm-decode.el (mm-save-part): Fill in file name when GUI saving + attachments. Trivial change from Peter 'Luna' Runestig + . -2000-06-01 Florian Weimer +2002-04-19 Jesper Harder - * mm-bodies.el (mm-body-encoding): Always encoded if - `mm-use-ultra-safe-encoding' is set. + * nnkiboze.el (nnkiboze-request-scan): Call + nnkiboze-possibly-change-group. + (nnkiboze-generate-group): Use mm-with-unibyte to avoid encoding + problems. + (nnkiboze-generate-group): Set newsrc to the *highest* article + number kibozed, not the lowest. -2000-05-31 14:50:52 Shenghuo ZHU +2002-04-15 Jesper Harder - * mml.el (ange-ftp-name-format): Typo. + * gnus-art.el (article-unsplit-urls): Allow trailing SPC. -2000-05-30 Simon Josefsson +2002-04-24 Kai Gro,b_(Bjohann + From Dan Christensen . - * 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 + * nndoc.el (nndoc-type-alist, nndoc-lanl-gov-announce-type-p) + (nndoc-transform-lanl-gov-announce, nndoc-generate-lanl-gov-head): + Recognize math postings. Extract Date (now ignores "(15kb)"). + Extract email address using gnus-extract-address-components + instead of just taking the first word. Create Date and From + headers for message which are missing these headers. Get rid + of spurious \\ lines (purely cosmetic). Extend body-end and + file-end regexps, to exclude more garbage from the message. + Make URL rephrasing regexp more flexible, to match current + format. - * gnus-group.el (gnus-group-nnimap-edit-acl): Help text updated - from latest draft. +2002-04-23 Simon Josefsson -2000-05-08 Simon Josefsson + * netrc.el: New file, functions copied from gnus-util.el by Ted + Zlatanov . - * gnus-group.el (gnus-group-expire-articles-1): Make sure server - is open. + * gnus-util.el: Require netrc. + (gnus-netrc-get, gnus-netrc-machine, gnus-parse-netrc): Aliased to + new code in netrc.el. + +2002-04-23 Kai Gro,b_(Bjohann + + * gnus-msg.el (gnus-summary-resend-message-edit): Remove + message-ignored-resent-headers, too. From Matthieu Moy + . + +2002-04-22 Bj,Av(Brn Torkelsson -2000-05-24 Dave Love + * gnus-srvr.el (gnus-server-browse-in-group-buffer): it is a + boolean not a string + * gnus-group.el (gnus-group-line-format): add description of %C + * gnus-group.el (gnus-group-line-format-alist): add gnus-tmp-comment + as %C + * gnus-group.el (gnus-group-insert-group-line): add gnus-tmp-comment - * mml.el (mml-parse-file-name): Fix ange-ftp part. +2002-04-22 Paul Jarc -2000-05-22 Didier Verna + * nnmaildir.el (nnmaildir-request-scan): typo: set + nnmaildir-get-new-mail, not nnmaildir-new-mail. Don't call + nnmail-get-new-mail for 'find-new-groups. - * 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. +2002-04-21 Paul Jarc -2000-05-19 Dave Love + * nnmaildir.el (nnmaildir-request-update-info, + nnmaildir-request-group, nnmaildir-retrieve-groups): remove + unnecessary calls to nnmaildir-request-scan. - * gnus-art.el (gnus-article-next-page): Revert last change. +2002-04-20 Josh Huber -2000-05-19 09:56:07 Shenghuo ZHU + * gnus-msg.el: + * gnus-msg.el (gnus-message-replysign): New. + * gnus-msg.el (gnus-message-replyencrypt): New. + * gnus-msg.el (gnus-message-replysignencrypted): New. + * gnus-msg.el (gnus-summary-reply): Use the three new variables + (above) to automatically encrypt/sign to encrypted/signed + messages. + * message.el: + * message.el (message-mode-map): Add keybinding for + `message-to-list-only' + * message.el (message-mode): Add description for + `message-to-list-only' + * message.el (message-to-list-only): New. + * message.el (message-make-mft): Changed to use the cl loop macro, + and added optional flag to return only the matched list. (for use + in new message-to-list-only function) - * gnus-agent.el (gnus-agent-open-history): Open history in binary mode. +2002-04-20 Josh Huber -2000-05-19 Dave Love + * gnus-msg.el: + * gnus-msg.el (gnus-message-replysign): + * gnus-msg.el (gnus-replysign): New. + * gnus-msg.el (gnus-replyencrypt): New. + * gnus-msg.el (gnus-replysignencrypted): New. + * gnus-msg.el (gnus-summary-reply): + * message.el: + * message.el (message-mode-map): + * message.el (message-mode): + * message.el (message-to-list-only): New. + * message.el (message-make-mft): - * gnus-art.el (gnus-mime-externalize-part): Bind mm-inlined-types, - not mm-inline-large-images. +2002-04-19 ShengHuo ZHU -2000-05-19 01:45:40 Shenghuo ZHU + * gnus-win.el (gnus-configure-windows-hook): Fix typo. - * mml.el (mml-parse-1): Don't test multiple-charsets within mml tag. +2002-04-18 Josh Huber -2000-05-18 Dave Love + * message.el (message-gen-unsubscribed-mft): accept a prefix + argument so CC can be included with C-u C-c C-f C-a - * 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. +2002-04-17 Kai Gro,b_(Bjohann + From Ted Zlatanov . -2000-05-17 21:16:54 Shenghuo ZHU + * spam.el (spam-whitelist, spam-blacklist, spam-enter-whitelist): + Improve docstring. + (spam-enter-blacklist): New command. - * gnus-group.el (gnus-group-mode-map): Add M-SPACE. - * mml.el (mml-mode-map): Comment out mml-narrow-to-part. + * gnus-sum.el (gnus-spam-mark): New mark. + (gnus-auto-expirable-marks): Add gnus-spam-mark. + (gnus-summary-make-tool-bar): Correct conditional. + (gnus-summary-limit-to-unread): Add gnus-spam-mark. + (gnus-summary-mark-as-spam): New command. -2000-05-17 21:13:38 Jim Davidson +2002-04-13 Josh Huber - * gnus-sum.el (gnus-summary-save-article-rmail): Use - gnus-summary-save-in-rmail. - * message.el (message-output): Ditto. + * mml-sec.el (mml-secure-message): changed to support arbritrary + modes. + * mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)): + changed to support "signencrypt" mode. + * mml.el (mml-parse-1): changed to support different secure modes + more easily. (for signencrypt) -2000-05-17 22:37:25 Katsumi Yamaoka +2002-04-11 Stefan Monnier - * gnus-art.el (gnus-emphasize-whitespace-regexp): Doc fix. + * gnus-sum.el (gnus-update-summary-mark-positions) + (gnus-summary-toggle-header): + * gnus-uu.el (gnus-uu-binhex-article, gnus-uu-reginize-string) + (gnus-uu-expand-numbers, gnus-uu-post-make-mime) + (gnus-uu-post-encoded): + * nnfolder.el (nnfolder-possibly-change-group): + * nnimap.el (nnimap-retrieve-headers): + * nnmbox.el (nnmbox-create-mbox): Don't assume point-min == 1. -2000-05-17 14:03:49 Shenghuo ZHU +2002-04-08 Stefan Monnier - * 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. + * nnml.el (nnml-save-nov, nnml-generate-nov-file): + * pop3.el (pop3-md5): Don't hardcode point-min == 1. -2000-05-17 10:16:32 Karl Kleinpaste +2002-04-12 Katsumi Yamaoka - * gnus-art.el (gnus-emphasize-whitespace-regexp): New variable. - * gnus-util.el (gnus-put-text-property-excluding-newlines): Use it. + * gnus-srvr.el (gnus-server-set-info): Clear + `gnus-server-method-cache' when `gnus-server-alist' is changed. + From Daiki Ueno . -2000-05-17 02:25:11 Shenghuo ZHU +2002-04-11 Simon Josefsson - * 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. + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Force + viewing of security buttons. Thanks to Nicolas Kowalski + . -2000-05-17 00:49:09 Shenghuo ZHU + * smime.el (smime-CA-directory): Fix doc. Thanks to Arne + J,Ax(Brgensen . + (smime-sign-buffer): Work in XEmacs. Thanks to Nicolas Kowalski + . + (smime-decrypt-buffer): Ditto. - * gnus-group.el (gnus-group-list-dormant): New function. +2002-04-11 Lars Magne Ingebrigtsen -2000-05-16 23:20:42 Shenghuo ZHU + * gnus-art.el (gnus-article-prepare): Place point on the emtpy + header line. - * 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. +2002-04-11 Per Abrahamsen - * 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.el (gnus-refer-article-method): Change `dejanews' to `google'. - * gnus-agent.el (gnus-agent-save-group-info): Disable multibyte. +2002-04-08 ShengHuo ZHU -2000-05-16 21:13:24 Shenghuo ZHU + * gnus-sum.el (gnus-summary-delete-marked-with): Fix typo. - * mml.el (mml-generate-mime-preprocess-function): New variable. - (mml-generate-mime-postprocess-function): New variable. - (mml-generate-mime-1): Use them. +2002-04-07 ShengHuo ZHU -2000-05-16 18:15:24 Shenghuo ZHU + * mm-view.el (mm-inline-text-html-render-with-w3): Don't ignore + errors when debug. - * 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. +2002-04-07 Josh Huber -2000-05-16 17:55:57 Karl Kleinpaste + * message.el (message-make-mft): Changed MFT code from using + message-recipients (which included Bcc) to use only the To and CC + headers. - * gnus-util.el (gnus-put-text-property-excluding-newlines): Improve. +2002-04-05 Per Abrahamsen -2000-05-16 16:22:17 Shenghuo ZHU + * gnus-art.el (gnus-treat-from-picon): Add to gnus-picon group and + add link. + (gnus-treat-mail-picon): Ditto. + (gnus-treat-newsgroups-picon): Ditto. + (gnus-picon-databases): Fix custom type. + (gnus-picon-databases): Add link. + (gnus-article-x-face-command): Add to gnus-picon group. - * 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. +2002-04-01 Jesper Harder -2000-05-16 Simon Josefsson + * message.el (message-buffer-naming-style): Remove. - * nnimap.el (nnimap-request-accept-article): Don't unselect - mailbox if no mailbox is selected. +2002-04-02 ShengHuo ZHU -2000-05-15 Per Abrahamsen + * gnus-group.el (gnus-group-make-tool-bar): Load tool-bar first. - * gnus-art.el (gnus-button-url-regexp): Revert earlier change. - Recognize domain names starting with `www.' as starting an URL. + * message.el (message-tool-bar-map): Ditto. -2000-05-15 09:46:47 Shenghuo ZHU + * gnus-sum.el (gnus-summary-make-tool-bar): Ditto. - * mail-source.el (mail-source-fetch-maildir): Insert "From ". - (mail-source-keyword-map): Add "subdirs" for maildir. +2002-04-01 ShengHuo ZHU -2000-05-14 16:19:28 Shenghuo ZHU + * nnwarchive.el (nnwarchive-mail-archive-article): Fix typo. - * nnmail.el (nnmail-scan-directory-mail-source-once): New variable. - (nnmail-get-new-mail): Use it. - * gnus-start.el (gnus-get-unread-articles): Ditto. +2002-04-01 Paul Jarc -2000-05-14 14:02:12 Shenghuo ZHU + * nnmaildir.el: fixed some buggy invocations of nnmaildir--pgname. - * 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. +2002-03-31 Andrew Cohen + Trivial patch. -2000-05-14 Dave Love + * dns.el: open-network-stream under XEmacs does udp. - * nnheader.el: Replace uses of `fset' with `defalias'. - (jka-compr-compression-info-list): Only defvar when compiling. +2002-03-31 Lars Magne Ingebrigtsen -2000-05-14 12:30:28 Shenghuo ZHU + * spam.el (spam-enter-whitelist): New function. + (spam-parse-whitelist): Ditto. + (spam-refresh-list-cache): Ditto. + (spam-address-whitelisted-p): New function. - * webmail.el (webmail-netaddress-article): Refresh redirect. + * dns.el (query-dns): Use TCP when make-network-process isn't + available. + (dns-servers): New variable. + (dns-parse-resolv-conf): New function. + (query-dns): Use it. -2000-05-13 20:41:10 Shenghuo ZHU + * spam.el: New file. - * mm-view.el (mm-inline-text): w3 might not recognize utf-8. + * dns.el (query-dns): Test. -2000-05-13 16:49:41 Shenghuo ZHU +2002-03-31 Lars Magne Ingebrigtsen - * webmail.el: Translate   to SP. + * lpath.el (featurep): Bind make-network-process. -2000-05-13 13:00:17 Robin S. Socha +2002-03-31 Paul Jarc - * message.el (message-bounce): Doc typo. + * nnmaildir.el: Use defstruct. Use a single copy of + nnmail-extra-headers to save memory. Store server's group name + prefix instead of each group's prefixed name. + * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Erase + nntp-server-buffer. -2000-05-13 12:25:21 Shenghuo ZHU +2002-03-31 Lars Magne Ingebrigtsen - * 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 + * dns.el: New file. -2000-05-13 12:03:29 Shenghuo ZHU +2002-03-28 Simon Josefsson - * message.el (message-mode): Two parameters for local-variable-p. + * gnus-sum.el (gnus-summary-dummy-line-format): + * gnus.el (gnus-summary-line-format): Fixing links to Info. + Trivial change from Bj,Av(Brn Torkelsson . -2000-05-13 00:54:46 Shenghuo ZHU +2002-03-29 Kai Gro,b_(Bjohann - * 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. + * gnus-sum.el (gnus-summary-move-article) + (gnus-summary-copy-article): Mention `gnus-move-split-methods' in + the doc string. -2000-05-12 22:28:54 Shenghuo ZHU +2002-03-28 Simon Josefsson - * gnus-uu.el (gnus-uu-digest-mail-forward): Bind - mail-parset-charset and use non-numeric argument. + * mml-sec.el (mml-secure-message): Search after + mail-header-separator from top of message. -2000-05-12 20:54:11 Shenghuo ZHU +2002-03-28 Paul Jarc - * 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. + * nnmaildir.el: Cosmetic changes. + (nnmaildir--with-nntp-buffer, nnmaildir--with-work-buffer, + nnmaildir--with-nov-buffer, nnmaildir--with-move-buffer, + nnmaildir--group-ls): New macros/functions. Use them. + (nnmaildir--unlink): Evalutate argument only once. -2000-05-12 15:15:55 Shenghuo ZHU +2002-03-27 Jesper Harder - * 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. + * gnus-sum.el (gnus-summary-highlight): Use `eq' when comparing + symbols. + (gnus-summary-highlight-line): Use `gnus-point-at-bol' and + `gnus-point-at-eol'. -2000-05-11 11:08:03 Shenghuo ZHU +2002-03-27 Paul Jarc - * 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. + * nnmaildir.el (nnmaildir--subdir, nnmaildir--nov-dir, + nnmaildir--marks-dir): New macros. Use them. + Use inhibit-quit for atomicity instead of in-memory journaling. + (nnmaildir--edit-prep): New function. + (Local Variables): Use it. -2000-05-10 12:17:58 Shenghuo ZHU +2002-03-26 Pavel@Janik.cz (Pavel Jan,Am(Bk) - * qp.el (quoted-printable-encode-region): Bind tab-width to 1. Set - limit to 76. + * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo. -2000-05-10 09:11:48 Lars Magne Ingebrigtsen +2002-03-25 Simon Josefsson - * 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. + * message.el (message-mode): Fix doc. -2000-05-09 13:23:50 Shenghuo ZHU +2002-03-25 Simon Josefsson - * gnus-sum.el (gnus-with-article): Define it before use it. + * message.el (message-subject-re-regexp): Skip Re[42]: junk. From + Matthieu Moy . -2000-05-08 22:34:19 Shenghuo ZHU +2002-03-24 Jesper Harder - * message.el (message-supersede): Use mime-to-mml. - * mm-decode.el (mm-insert-part): Test the buffer if no encoding. + * mml-sec.el (mml-unsecure-message): Add docstring. -2000-05-08 22:34:24 Katsumi Yamaoka +2002-03-23 ShengHuo ZHU - * gnus-group.el (gnus-group-list-cached): Don't use - `subst-char-in-string'. + * nnmail.el (nnmail-large-newsgroup): Fix doc, allow non-numeric + value. + Trivial change from andre@slamdunknetworks.com -2000-05-08 Dave Love +2002-03-22 Josh Huber - * pop3.el (pop3-open-server): Fix creating name of trace buffer. + * mml.el (mml-mode-map): Added a keybinding for + `mml-unsecure-message'. Also, added a menu entry for said + function in the Attachments menu. -2000-05-08 01:07:47 Shenghuo ZHU +2002-03-22 Katsumi Yamaoka - * mm-decode.el (mm-interactively-view-part): Append %s if the - method is a single word. - * nnwarchive.el (nnwarchive-type-definition): Typo. + * canlock.el (canlock-version): Remove. + (canlock-sha1-with-openssl): Don't use `canlock-string-as-unibyte' + here; simplify \x insertions. + (canlock-sha1): New function, always return a unibyte string. + (canlock-make-cancel-key): Use `canlock-sha1'; simplify truncation + of a password. + (canlock-insert-header): Use `canlock-sha1'. + (canlock-verify): Ditto. -2000-05-07 17:24:01 Shenghuo ZHU +2002-03-21 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. + * message.el (message-fix-before-sending): Add an option that + ignores illegible text. + Trivial change from Mark Milhollan -2000-05-07 10:50:02 Shenghuo ZHU + * message.el (message-font-lock-keywords): Support multi-line MML + tags. - * gnus-art.el (article-decode-charset): Don't decode message with - format. + * gnus-sum.el (gnus-print-buffer): Remove gnus-decoration. + Trivial change from lorentey@elte.hu (L,Bu(Brentey K,Aa(Broly) -2000-05-07 Florian Weimer +2002-03-20 Katsumi Yamaoka - * mailcap.el (mailcap-maybe-eval): Honor user request not to - evaluate the Lisp code. + * gnus-sum.el (gnus-summary-make-menu-bar): Use intern'ed function + symbols for "View as different encoding" submenu. -2000-05-06 17:40:20 Shenghuo ZHU +2002-03-19 Simon Josefsson - * 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. + * gnus-sum.el (gnus-summary-make-menu-bar): Add "View as different + encoding" submenu. -2000-05-06 Florian Weimer +2002-03-19 ShengHuo ZHU - * gnus-uu.el (gnus-uu-unshar-warning): New variable. - (gnus-uu-unshar-article): Use it. + * gnus-group.el (gnus-group-process-prefix): Make sure there is a mark. - * mailcap.el (mailcap-maybe-eval-warning): New variable. - (mailcap-maybe-eval): Use it. +2002-03-19 Kai Gro,b_(Bjohann - * gnus-msg.el (gnus-group-posting-charset-alist): Speling mistake - in docstring. + * gnus-sum.el (gnus-sum-thread-tree-root) + (gnus-sum-thread-tree-single-indent) + (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent) + (gnus-sum-thread-tree-leaf-with-other) + (gnus-sum-thread-tree-single-leaf): Make customizable. - * mml.el (mml-generate-mime-1): Small comment. +2002-03-16 Simon Josefsson -2000-05-05 12:27:53 Shenghuo ZHU + * gnus-util.el (gnus-extract-address-components): Don't break on + names such as James "Kibo" Parry. From Francis Litterio + . - * 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. +2002-03-13 Simon Josefsson -2000-05-05 10:32:27 Shenghuo ZHU + * pop3.el (pop3-open-server): Revert multibyte change. From + Pavel@Janik.cz (Pavel Jan,Am(Bk). - * gnus-sum.el (gnus-summary-show-article): Remove en/disable multibyte. - (gnus-summary-select-article): Add en/disable multibyte. + * message.el (message-send-mail-with-qmail): Make it work. From + Pavel@Janik.cz (Pavel Jan,Am(Bk). -2000-05-05 02:47:23 Shenghuo ZHU +2002-03-13 Josh Huber - * gnus-sum.el (gnus-summary-edit-article): Enable multibyte. - (gnus-summary-edit-article): New feature: editing raw articles. + * message.el (message-make-mft): Set case-fold-search while + generating the MFT. Also, a little cleanup in the MFT code. -2000-05-05 00:30:12 Shenghuo ZHU +2002-03-12 Simon Josefsson - * 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. + * message.el (message-qmail-inject-args): May be function. + (message-send-mail-with-qmail): Call function if m-q-i-a is + function. From fn@hungry.org (Faried Nawaz). -2000-05-04 17:49:04 Shenghuo ZHU +2002-03-12 ShengHuo ZHU - * nndoc.el (nndoc-type-alist): Extend forward regexp. - (nndoc-forward-type-p): Ditto. + * message.el (message-abbrevs-loaded): Remove. + (mailabbrev): Require it. -2000-05-04 17:13:04 Shenghuo ZHU + * nnslashdot.el (nnslashdot-request-article): Remove IFRAME. - * mm-util.el (mm-with-unibyte-current-buffer): Set the default - value of enable-multibyte-characters. +2002-03-12 Katsumi Yamaoka -2000-05-04 10:31:24 Shenghuo ZHU + * pop3.el (pop3-open-server): Set process buffer unibyte. - * gnus-sum.el (gnus-summary-show-article): En/disable multibyte. +2002-03-10 Lars Magne Ingebrigtsen -2000-05-03 Dave Love + * gnus-fun.el (gnus-subscribe-to-mailing-list): New function. - * 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. +2002-03-10 ShengHuo ZHU -2000-05-03 14:23:38 Shenghuo ZHU + * nnslashdot.el (nnslashdot-request-article): Remove javascript + too. - * 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. +2002-03-09 ShengHuo ZHU -2000-05-03 14:11:23 Shenghuo ZHU + * gnus-sum.el (gnus-summary-save-parts-default-mime): Remove + duplication. + (gnus-summary-save-parts-type-history): Ditto. + (gnus-summary-save-parts-last-directory): Ditto. + Trivial change from andre@slamdunknetworks.com - * rfc2047.el (rfc2047-encode): Test the validity of coding-system. +2002-03-09 Paul Jarc -2000-05-03 11:35:15 Shenghuo ZHU + * gnus-start.el (gnus-auto-subscribed-groups): Include nnmaildir. - * 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. +2002-03-06 ShengHuo ZHU -2000-05-03 08:09:14 Shenghuo ZHU + * nnslashdot.el (nnslashdot-request-article): Use "" as the end of the first article. - * 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. + * gnus-msg.el (gnus-summary-resend-message-edit): New function. + From Matthieu Moy -2000-05-03 Dave Love + * message.el (message-add-action): Use add-to-list. + (message-delete-action): New function. - * gnus.el (gnus-group-startup-message): Add newline before image. + * nndoc.el (nndoc-mail-in-mail-type-p): Break a long regexp into + pieces. -2000-05-02 21:34:10 Shenghuo ZHU +2002-03-05 Paul Jarc - * rfc2047.el (rfc2047-encode-message-header): Check the coding-system. - * message.el (message-send-mail): Use unibyte-buffer. - (message-send-mail): Ditto. + * nnnil.el: New file. + * gnus.el (gnus-valid-select-methods): Include nnnil. -Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen +2002-03-05 ShengHuo ZHU - * gnus.el: Gnus v5.8.6 is released. + * message.el (message-syntax-checks): Because canlock is + supported, we disable sender syntax check. + (message-shoot-gnksa-feet): Add cancel-messages option doc. -2000-05-01 07:45:43 Shenghuo ZHU + * gnus-draft.el (gnus-draft-send): If interactive, use its default + value of message-syntax-checks. - * mml.el (mml-parse-1): Set no-markup-p and warn to nil. + * qp.el (quoted-printable-decode-region): Doc addition. + From: Eli Zaretskii -2000-04-28 21:14:21 Shenghuo ZHU + * mail-source.el (make-source-make-complex-temp-name): Use + make-temp-file. - * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB. + * mm-util.el (mm-make-temp-file): New function. + * nneething.el (nneething-file-name): Use it. + * mml-smime.el (mml-smime-encrypt): Ditto. + * mm-view.el (mm-inline-wash-with-file): Ditto. + * mm-decode.el (mm-display-external, mm-create-image-xemacs): Ditto. + * gnus-uu.el (gnus-uu-decode-binhex, gnus-uu-decode-binhex-view) + (gnus-uu-digest-mail-forward, gnus-uu-initialize): Ditto. + * gnus-start.el (gnus-slave-save-newsrc): Ditto. + * gnus-fun.el (gnus-convert-image-to-gray-x-face): Ditto. + * gnus-art.el (gnus-mime-print-part): Ditto. -2000-04-28 16:37:09 Shenghuo ZHU +2002-03-04 Paul Jarc - * message.el (message-send-mail-partially): Use forward-line. + * message.el (nnmaildir-article-number-to-base-name): New + function. + (nnmaildir-base-name-to-article-number): New function. -2000-04-28 16:01:09 Shenghuo ZHU +2002-03-04 Katsumi Yamaoka - * gnus-art.el (gnus-mime-button-menu): Use call-interactively. + * smime.el (smime-make-temp-file): Don't quote + `temporary-file-directory'. -2000-04-28 15:30:17 Shenghuo ZHU +2002-03-04 Simon Josefsson - * mml.el (mml-generate-mime-1): Ignore 0x1b. - (mml-insert-mime): No markup only for text/plain. - (mime-to-mml): Remove MIME headers. + * smime.el (smime-sign-region): Rename argument keyfiles to + keyfile. You only sign something with one key. + (smime-sign-buffer): Better completing-read prompt. + (smime-decrypt-buffer): Ditto. -2000-04-28 14:23:14 Shenghuo ZHU + * smime.el (smime-make-temp-file): Make it work under XEmacs. - * 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. + * mm-view.el (mm-view-pkcs7-decrypt): Better prompt for + completing-read. + (mm-view-pkcs7-decrypt): CRLF->LF. -2000-04-28 Dave Love +2002-03-04 Paul Jarc - * gnus.el (gnus-group-startup-message): Maybe use image in Emacs - 21. + * message.el (message-hierarchical-addresses): New variable. + (message-get-reply-headers): Use it. + From Ted Zlatanov - * 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. +2002-03-03 ShengHuo ZHU - * gnus-start.el (gnus-unload): Iterate over `features', not - `load-history'. + * message.el (message-mode): If buffer-file-name, don't set auto + save file name. + Trivial change from Geoff Greene -2000-04-28 09:52:21 Shenghuo ZHU +2002-03-02 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. + * gnus-util.el (gnus-multiple-choice): Use message. XEmacs only + takes one argument in read-char. -2000-04-28 01:16:10 Shenghuo ZHU + * message.el (message-fix-before-sending): Forward a char. + Check mmu-multibyte-p, add control-1. - * message.el (message-send-mail-partially): Remove CTE. +2002-03-01 ShengHuo ZHU -2000-04-28 00:31:53 Shenghuo ZHU + * gnus-start.el (gnus-read-init-file): Ditto. - * lpath.el: Fbind put-image for XEmacs. - * mm-view.el (mm-inline-image): Fset it. + * gnus-agent.el (gnus-agent-fetch-session): Ditto. -2000-04-27 23:23:37 Shenghuo ZHU + * dgnushack.el (dgnushack-make-load): Ditto. - * nndoc.el (nndoc-type-alist): Change forward regexp. + * mail-source.el (mail-source-fetch): Extract the right error + code. -2000-04-27 21:57:10 Shenghuo ZHU + * message.el (message-fix-before-sending): Check illegible text. - * message.el (message-send-mail-partially-limit): Change the - default value. + * gnus-util.el (gnus-multiple-choice): New function. -2000-04-27 21:53:32 Erik Toubro Nielsen + * gnus-kill.el (gnus-score-insert-help): Removed, because it is + also defined in gnus-score.el. - * gnus-util.el (gnus-extract-address-components): Name might be - "". +2002-03-01 Paul Jarc -2000-04-27 20:32:06 Shenghuo ZHU + * message.el (message-get-reply-headers): downcase email addresses + for comaparisons for duplicate removal. - * 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. +2002-03-01 ShengHuo ZHU -2000-04-27 Dave Love + * mm-view.el (mm-view-pkcs7-verify): New function. A bogus + implementation of PKCS#7, which just allows users read the + message. + (mm-view-pkcs7): Use it. - * gnus-art.el: Don't bother to require custom, browse-url. - (gnus-article-x-face-command): Include gnus-article-display-xface. +2002-02-27 ShengHuo ZHU - * gnus-ems.el: Assume only (X)Emacs 20+. Simplify XEmacs checks. - Use defalias, not fset. - (gnus-article-display-xface): New function. + * gnus.el (large-newsgroup-initial): New parameter. - * mm-view.el (mm-inline-image-emacs): Use put-image, remove-images. + * gnus-sum.el (gnus-articles-to-read): Use large-newsgroup-initial. + (gnus-summary-insert-old-articles): Ditto. - * 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. +2002-02-26 ShengHuo ZHU -2000-04-27 15:27:54 Shenghuo ZHU + * gnus-sum.el (gnus-articles-to-read): `gnus-large-newsgroup' is + used as the default answer of the question, "How many articles?". + From TSUCHIYA Masatoshi - * 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. + * nnagent.el (nnagent-retrieve-headers): Remove articles with + small numbers. -2000-04-27 10:03:36 Shenghuo ZHU +2002-02-24 ShengHuo ZHU - * mml.el (mml-insert-tag): Match more special characters. + * deuglify.el: Fix comments. -2000-04-27 09:06:29 Shenghuo ZHU +2002-02-23 ShengHuo ZHU - * gnus-msg.el (gnus-bug): Avoid attaching the external buffer. + * html2text.el (html2text-clean-anchor): If there is no HREF, + insert nothing. -2000-04-27 00:58:43 Shenghuo ZHU + * mml.el (mml-generate-mime-1): Add cdr. + From: andre@slamdunknetworks.com - * mm-decode.el (mm-inline-media-tests): Add message/partial. - (mm-inlined-types): Ditto. - * mm-partial.el: New file. + * mm-view.el (mm-text-html-renderer-alist): Add html2text. + (mm-text-html-washer-alist): Ditto. -2000-04-27 Dave Love + * mm-decode.el (mm-text-html-renderer): Add html2text. - * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might - matter in Emacs 21. + * html2text.el: Face lift. -2000-04-26 Florian Weimer + * html2text.el: New file from Joakim Hove . - * mm-bodies.el (mm-encode-body): Remove reference to - mm-default-charset in comment. +2002-02-22 ShengHuo ZHU -2000-04-24 00:56:00 Bj,Av(Brn Torkelsson + * gnus-sum.el: Add gnus-article-outlook-deuglify-article. - * rfc2047.el (rfc2047-encode-message-header): Fixing typo. + * deuglify.el: Change copy right. Add autoload. Add coding-system. -2000-04-26 12:27:41 Shenghuo ZHU + * deuglify.el: New file. The original file name is + gnus-outlook-deuglify.el from Raymond Scholz . - * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of - let. + * mm-decode.el (mm-display-external): Use + mm-file-name-rewrite-functions. From -2000-04-26 12:26:10 Pavel Janik ml. +2002-02-22 Paul Jarc - * gnus-draft.el (gnus-draft-setup): Fix comments. + * nnmaildir.el (nnmaildir-request-list): Report the highest + article number, not the total number of articles. -2000-04-26 10:06:12 Shenghuo ZHU +2002-02-21 ShengHuo ZHU - * nnmbox.el (nnmbox-create-mbox): Use nnmbox-file-coding-system, - if nnmbox-file-coding-system-for-write is nil. + * gnus-sum.el: Move uu key map here. + (gnus-summary-make-menu-bar): Add gnus-summary-save-parts. -2000-04-26 02:17:44 Shenghuo ZHU +2002-02-21 Paul Jarc - * gnus-msg.el (gnus-configure-posting-styles): Just remove the - header if nil. + * nnmaildir.el (nnmaildir-request-expire-articles): Use + nnmail-expiry-wait* if expire-age parameter is not set. -2000-04-26 00:23:46 Shenghuo ZHU +2002-02-21 ShengHuo ZHU - * mm-view.el (mm-inline-text): Insert directly if decoded. - * mml.el (autoload): Typo. + * gnus-group.el (gnus-group-sort-groups-by-real-name): New + function. + (gnus-group-sort-selected-groups-by-real-name): New function. + (gnus-group-make-menu-bar): Add sort by real name. -2000-04-25 22:46:36 Shenghuo ZHU + * gnus-sum.el (gnus-dependencies-add-header): If replaced, don't + rebuild. + (gnus-summary-edit-article-done): Gnus-get-newsgroup-headers takes + nil as dependencies as well. - * mml.el (mml-preview): Set up posting-charset. - * gnus-msg.el (gnus-group-posting-charset-alist): Add koi8-r. +2002-02-20 ShengHuo ZHU -2000-04-25 21:23:54 Shenghuo ZHU + * nndoc.el (nndoc-dissect-mime-parts-sub): Fix MIME-Version header + for mime-parts. - * webmail.el: Fix yahoo mail. + * gnus-art.el (gnus-article-edit-done): Widen the buffer. -2000-04-25 20:12:17 Shenghuo ZHU + * gnus-group.el (gnus-group-name-decode): Don't test + multibyte-string, because it breaks XEmacs. + From: TSUCHIYA Masatoshi - * rfc2047.el (rfc2047-dissect-region): Don't include LWS ahead of - word if not necessary. - (rfc2047-encode-region): Put space between encoded words. + * message.el (message-send-mail): Be talkative. -2000-04-24 21:11:48 Shenghuo ZHU + * mm-decode.el (mm-inlined-types): Add application/x-emacs-lisp. + (mm-automatic-display): Ditto. - * gnus-util.el (gnus-netrc-machine): Another default to nntp. + * mailcap.el (mailcap-mime-data): Ditto. + From: Reiner Steib <4uce.02.r.steib@gmx.net> -2000-04-24 18:14:12 Shenghuo ZHU +2002-02-20 Katsumi Yamaoka - * gnus-draft.el (gnus-draft-setup): Restore mml only when - required. - (gnus-draft-edit-message): Require restoration. + * many files: Remove trailing whitespaces, replace spc+tab with + tab, replace leading whitespaces with tabs. -2000-04-24 16:51:04 Shenghuo ZHU +2002-02-19 Paul Jarc - * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored - back. + * gnus-sum.el (gnus-summary-toggle-header): Fix handling of + articles with no body and no blank line after the header. -2000-04-24 16:01:15 Shenghuo ZHU +2002-02-19 ShengHuo ZHU - * gnus-art.el (gnus-treat-article): Make sure that the summary - buffer is live. + * mm-decode.el (mm-dissect-multipart): Consider the case of empty + parts. -2000-04-24 15:42:53 Shenghuo ZHU + * ietf-drums.el (ietf-drums-syntax-table): Modify syntax of + non-ascii chars. - * 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. + * rfc2231.el (rfc2231-parse-string): Support non-ascii chars. -Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-wash-html-with-w3): Remove + w3-delay-image-loads. + * mm-view.el (mm-inline-text-html-render-with-w3): Ditto. + (mm-w3-prepare-buffer): Ditto. - * gnus.el: Gnus v5.8.5 is released. + * mail-source.el (mail-source-fetch-directory): Run scripts. -2000-04-24 16:29:07 Lars Magne Ingebrigtsen +2002-02-19 Lars Magne Ingebrigtsen - * rfc2047.el (rfc2047-header-encoding-alist): Doc fix. + * gnus-fun.el (gnus-respond-to-confirmation): Do the right thing + for Majordomo confirmations. - * gnus-util.el (gnus-netrc-machine): Default to nntp. +2002-02-18 Lars Magne Ingebrigtsen - * mml.el (mml-generate-mime-1): Force 8bit on message/rfc822. + * gnus-fun.el (gnus-respond-to-confirmation): New command. -2000-04-23 23:27:25 Shenghuo ZHU +2002-02-11 Lars Magne Ingebrigtsen - * mm-view.el (mm-inline-message): Disable prepare-hook. + * nnultimate.el (nnultimate-retrieve-headers): Clean up. -2000-04-23 00:32:32 Lars Magne Ingebrigtsen +2002-02-18 Paul Jarc - * gnus.el: Fix copyright statements. + * gnus-util.el (gnus-parent-id): Ignore trailing whitespace in the + References header field. From Mark Thomas . - * gnus-sum.el (gnus-alter-articles-to-read-function): New - variable. - (gnus-articles-to-read): Use it. +2002-02-18 ShengHuo ZHU - * message.el (message-get-reply-headers): Bind free variable. + * mm-view.el (mm-inline-render-with-file): With unibyte buffer. + (mm-inline-render-with-stdin): Ditto. + (mm-inline-render-with-function): Ditto. + (mm-inline-wash-with-file): Bind coding-system-for-write. + (mm-inline-wash-with-stdin): Ditto. -2000-04-23 01:14:28 Shenghuo ZHU +2002-02-18 ShengHuo ZHU - * message.el (message-get-reply-headers): Fix to-address. + Suggested by Felix Natter -2000-04-22 22:51:46 Shenghuo ZHU + * gnus-art.el (gnus-mime-view-part-externally): Rename from + gnus-mime-externalize-view. + (gnus-mime-view-part-internally): Rename from + gnus-mime-internalize-view. + (gnus-article-view-part-externally): Rename from + gnus-article-externalize-part. + (gnus-mime-action-alist): Change correspondingly. + (gnus-mime-button-commands): Ditto. + (gnus-mime-action-alist): Remove duplication. - * webmail.el: Hotmail fix. Add a debug function. + * gnus-sum.el (gnus-summary-mime-map): Change correspondingly. -2000-04-23 00:32:32 Lars Magne Ingebrigtsen +2002-02-18 ShengHuo ZHU - * gnus-sum.el (t): M-down and M-up. + * mm-decode.el (mm-dissect-buffer): Add loose-mime parameter. -2000-04-22 20:22:03 Kai Gro,A_(Bjohann + * gnus-art.el (gnus-display-mime): Use it. - * gnus-sum.el: Doc fix. + * mm-partial.el (mm-partial-find-parts): Use it. -2000-04-22 10:25:56 Shenghuo ZHU + * gnus-sum.el (gnus-article-loose-mime): Rename from + gnus-article-no-strict-mime. + (gnus-summary-save-parts): Use it. - * nnwarchive.el (nnwarchive-egroups-article): Remove < and >. +2002-02-18 Katsumi Yamaoka -2000-04-22 14:25:05 Lars Magne Ingebrigtsen + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Remove unused + local variable. - * 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. + * gnus-art.el (article-display-x-face): Don't sort multiple + X-Faces. - * message.el (message-get-reply-headers): Return a value. +2002-02-18 Katsumi Yamaoka -2000-04-22 14:12:41 David Aspinwall + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed + up. Suggested by Yuuichi Teranishi . - * gnus-art.el (gnus-button-url-regexp): New value to match naked - urls. + * gnus-art.el (article-display-x-face): Sort gray X-Faces. -2000-04-22 01:23:59 Lars Magne Ingebrigtsen +2002-02-17 ShengHuo ZHU - * gnus-cache.el (gnus-summary-insert-cached-articles): Reverse the - order messages are inserted. + Some ideas is inspired by code from Hrvoje Niksic + - * mml.el (mml-generate-mime-1): rfc2047-encode the heads of - message/rfc822 parts. + * gnus-art.el (gnus-article-wash-function): Set the default to + nil, so that we use mm-text-html-renderer instead. + (article-wash-html): Use mm-text-html-renderer. - * gnus-art.el (gnus-article-read-summary-keys): Check for - numerical values. + * mm-decode.el (mm-inline-media-tests): Use mm-inline-text-*. + (mm-text-html-renderer): New variable. + (mm-inline-text-html-renderer): Set the default to nil, so that we + use mm-text-html-renderer instead. - * message.el (message-get-headers): Made into own function. - (message-reply): Use it. - (message-get-reply-headers): Renamed. - (message-widen-reply): New command. + * mm-view.el (mm-inline-text-html): New function. + (mm-text-html-renderer-alist): New variable. + (mm-inline-text-vcard): New function. + (mm-inline-text): Split. + (mm-links-remove-leading-blank): New function. + (mm-inline-render-with-file): New function. + (mm-inline-render-with-stdin): New function. + (mm-inline-render-with-function): New function. + (mm-text-html-washer-alist): New variable. + (mm-inline-wash-with-file): New function. + (mm-inline-wash-with-stdin): New function. -2000-04-21 20:52:09 Shenghuo ZHU +2002-02-17 ShengHuo ZHU - * nntp.el (nntp-retrieve-data): Report the error and return nil. + * message-utils.el: Fix installation doc. + From: Reiner Steib <4uce.02.r.steib@gmx.net> -2000-04-21 19:38:43 Shenghuo ZHU +2002-02-16 ShengHuo ZHU - * mm-bodies.el (mm-decode-content-transfer-encoding): Don't remove - non-base64 text at the end if not found. + * gnus-msg.el (gnus-discouraged-post-methods): New variable. + (gnus-post-method): Use it. + (gnus-summary-cancel-article): Find the correct post-method. -2000-03-01 Simon Josefsson + * gnus-soup.el (gnus-soup-send-packet): Via ... using ... + * message.el (message-send-news): Ditto. + Suggested by Lloyd Zusman and IPmonger + - * 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. + * gnus.el (gnus-select-method): Fix doc. + (gnus-server-string): Use 'using nntp'. -2000-04-21 22:27:15 Lars Magne Ingebrigtsen + * gnus-agent.el (gnus-slave-unplugged): New command. + From: Felix Natter - * gnus-msg.el (gnus-configure-posting-styles): Allow nil values to - override. +2002-02-15 ShengHuo ZHU -2000-04-21 21:58:20 Kai Gro,A_(Bjohann + * gnus-art.el (gnus-article-edit-done): Kill-all-local-variables. + Call edit-done-function first, then change the window + configuration. + (gnus-article-edit-mode-map): Add message key bindings. Add menu. + (gnus-article-edit-mode): mml-mode. - * 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. + * gnus-util.el (gnus-byte-compile): Work around a bug in XEmacs + 21.4. Suggested by Russ Allbery . -1999-12-06 Hrvoje Niksic + * message-utils.el: Adopt the file. - * message.el (message-caesar-region): Use translate-region. + * message-utils.el: New file. + From Holger Schauer -2000-04-21 21:20:32 Mike Fabian +2002-02-14 ShengHuo ZHU - * gnus-group.el (gnus-group-catchup-current): Doc fix. + * gnus-sum.el (gnus-summary-move-article): Select-article only + when gnus-move-split-methods is non-nil. And we don't render or + mark the article. -2000-04-21 20:36:21 Lars Magne Ingebrigtsen + * gnus-fun.el (gnus-shell-command-to-string): New function. + (gnus-shell-command-on-region): New function. + (gnus-random-x-face): Use them. + (gnus-x-face-from-file): Ditto. + (gnus-convert-image-to-gray-x-face): Ditto. + (gnus-convert-gray-x-face-to-xpm): Ditto. + (gnus-convert-image-to-x-face-command): Don't use 2>/dev/null. - * gnus-art.el (gnus-article-setup-buffer): Don't kill local - variables, because that makes Emacs flash. +2002-02-14 Katsumi Yamaoka - * gnus-group.el (gnus-group-insert-group-line): Don't call - gnus-group-add-icon unconditionally. + * gnus-art.el (gnus-treat-display-xface): Don't use + `shell-command-to-string' when compiling. + (gnus-treat-display-grey-xface): Ditto. - * gnus-xmas.el (gnus-group-add-icon): Moved here. +2002-02-13 Paul Jarc - * gnus-group.el (gnus-group-glyph-directory): Don't depend on - xmas. - (gnus-group-glyph-directory): Removed. + * nnmaildir.el (nnmaildir--article-count): If the group is + completely empty, report minimum article number as 1 instead of 0. -2000-04-21 20:26:23 Jaap-Henk Hoepman +2002-02-13 ShengHuo ZHU - * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't do stuff if - gnus-newsgroup-name is "". + * gnus-agent.el (gnus-get-predicate): Use nconc. -2000-04-21 Florian Weimer + * gnus-sum.el (gnus-summary-display-make-predicate): Use + gnus-summary-display-cache as cache. - * mm-util.el (mm-mime-mule-charset-alist): Add support for UTF-8 - in conjunction with MULE-UCS. + * nndoc.el (nndoc-type-alist): Add mail-in-mail type. + (nndoc-mail-in-mail-type-p): New function. + (nndoc-mail-in-mail-article-begin): New function. -1999-12-13 Per Abrahamsen +2002-02-12 ShengHuo ZHU - * rfc2047.el (rfc2047-fold-region): Don't use the same break twice. + * mailcap.el (mailcap-mime-data): Use enriched-decode. -1999-12-14 04:14:44 Katsumi Yamaoka + * gnus-cite.el (gnus-article-fill-cited-article): Bind + use-hard-newlines to nil. - * dgnushack.el (last, mapcon, member-if, union): New compiler - macros for emulating cl functions. + * gnus-xmas.el (gnus-xmas-image-type-available-p): Assume that + image is not available if window-system is not available. -1999-12-21 Jan Vroonhof + * gnus-sum.el (gnus-summary-display-make-predicate): Add unread. - * message.el (message-shorten-references): Only cater to broken - INN for news. This caters for broken smtpd. +2002-02-11 ShengHuo ZHU -2000-04-21 18:20:10 Lars Magne Ingebrigtsen + * gnus.el (gnus-article-unpropagated-mark-lists): Don't propagate + bookmark, because update-mark doesn't handle it correctly. - * mailcap.el (mailcap-mime-info): Use the first match; not the - last. +2002-02-09 ShengHuo ZHU - * gnus-agent.el (gnus-category-kill): Save the category list. + * gnus-soup.el (gnus-soup-send-packet): Send news and mail + directly instead of calling message-send-mail. -2000-04-21 16:41:50 Chris Brierley + * gnus-start.el (gnus-read-descriptions-file): Use + gnus-default-charset. - * gnus-sum.el (gnus-summary-move-article): Do something or other. + * mm-util.el (mm-guess-mime-charset): New function. -2000-04-21 16:07:07 Lars Magne Ingebrigtsen + * gnus.el (gnus-default-charset): Use it. + (gnus-group-charset-alist): Remove .*, Let gnus-default-charset be + the default. - * gnus-group.el (gnus-group-add-icon): Fixed indentation. +2002-02-08 ShengHuo ZHU -2000-04-21 16:07:07 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-treat-display-grey-xface): New variable. + (article-display-x-face): Use it. Disable grey xface, if + uncompface is not found. - * gnus-group.el (gnus-group-add-icon): Fixed indentation. + * message.el (message-mode): Don't enable multibyte on an indirect + buffer. -2000-04-21 10:43:16 Shenghuo ZHU + * nnrss.el (nnrss-content-function): New variable. + (nnrss-request-article): Use it. - * gnus-group.el (gnus-group-prepare-flat-predicate): New function. - (gnus-group-list-cached): Use it. +2002-02-08 ShengHuo ZHU -2000-04-21 16:07:07 Lars Magne Ingebrigtsen + * gnus.el: Add article-unsplit-urls. + * gnus-sum.el: Ditto. + * gnus-art.el (gnus-treat-strip-cr): New variable. + (gnus-treatment-function-alist): Use it. + (article-unsplit-urls): New function. + (gnus-article-make-menu-bar): Use it. + From: Michael Cook - * gnus.el: Update all the copyright notices. +2002-02-08 ShengHuo ZHU -2000-04-21 15:38:06 Vladimir Volovich + * gnus-agent.el (gnus-agent-braid-nov): Find the first article to + copy. - * mm-bodies.el (mm-decode-content-transfer-encoding): Remove - non-base64 text at the end. +2002-02-07 Paul Jarc -2000-04-21 15:21:30 Katsumi Yamaoka + * gnus-util.el (gnus-split-references): Allow (broken) Message-IDs + with internal whitespace. + (gnus-parent-id): Ditto. - * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized. +2002-02-07 ShengHuo ZHU -2000-04-21 15:15:41 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-treat-body-boundary): Add + gnus-decoration property. + * gnus-msg.el (gnus-copy-article-buffer): Remove gnus-decoration. - * nnheader.el: Don't autoload cancel-function-timers. + * message.el (message-mode): Set local-abbrev-table. + From Matt Armstrong . - * message.el (message-fetch-field): Fold case. + * gnus-art.el (gnus-article-treat-unfold-headers): Don't remove + too many spaces. -2000-04-21 15:11:09 + * rfc2047.el (rfc2047-unfold-region): Ditto. + (rfc2047-decode-region): Don't unfold. Let + gnus-article-treat-unfold-headers do it. - * message.el (message-forward-before-signature): New variable. + * gnus-sum.el (gnus-dependencies-add-header): Fix typo. + From: Jesper Harder -2000-04-21 15:10:31 Alexandre Oliva +2002-02-06 Lars Magne Ingebrigtsen - * gnus-mlspl.el: Fix stuff. + * gnus-msg.el (gnus-posting-styles): Add x-face-file. + (gnus-configure-posting-styles): Use it. + (gnus-configure-posting-styles): Remove trailing newspaces. -2000-04-21 14:41:09 Lars Magne Ingebrigtsen +2002-02-06 ShengHuo ZHU - * gnus-sum.el (gnus-summary-update-article-line): Don't hide - subjects when unthreaded. + * gnus-sum.el (gnus-articles-to-read): Fetch all if the predicate + is non-nil. -2000-04-21 14:11:39 David S. Goldberg + * mm-util.el (mm-use-find-coding-systems-region): Add doc. - * gnus-art.el (gnus-boring-article-headers): Work on long CCs as - well. + * gnus.el (gnus-server-to-method): Switch position with + gnus-server-get-method. + (gnus-agent): Add doc. -2000-04-21 14:06:43 Rui Zhu + * gnus-sum.el (gnus-article-no-strict-mime): New variable. + (gnus-summary-save-parts): Use it. - * gnus-art.el (gnus-article-mode): Fix variable name. + * gnus-art.el (gnus-display-mime): Use it. + * mm-partial.el (mm-partial-find-parts): Use it. -2000-04-21 13:54:51 Lars Magne Ingebrigtsen + * nnweb.el (nnweb-google-parse-1): Use a correct format of date. - * mm-view.el: Fix autoload. + * gnus-agent.el (gnus-agent-summary-make-menu-bar): Fix typo. + From Stefan Reich,Av(Br . - * flow-fill.el (flow-fill): Fix provide. + * nnagent.el (nnagent-request-expire-articles): Don't delete + files. - * gnus-draft.el (gnus-draft-send): Bind message-setup-hook to - nil. +2002-02-05 ShengHuo ZHU -2000-04-20 22:24:04 Shenghuo ZHU + * message.el (message-gen-unsubscribed-mft): New function. + From Sriram Karra . - * gnus-win.el (gnus-configure-windows): Revert to switch-to-buffer. + * gnus.el (gnus-article-unpropagated-mark-lists): Backslash the + open parenthesis. -2000-04-21 05:22:18 Katsumi Yamaoka + * mm-view.el (mm-w3-prepare-buffer): Bind url-gateway-unplugged. + (mm-inline-text-html-render-with-w3): Ditto. + * gnus-art.el (gnus-article-wash-html-with-w3): Ditto. + Suggested by Dave Love . - * gnus-util.el (gnus-netrc-machine): Didn't work. + * mm-url.el (mm-url-load-url): Require w3-vars for old versions. -2000-04-20 21:22:10 Shenghuo ZHU + * nntp.el (nntp-send-command-and-decode): Check PROCESS. + * nntp.el (nntp-send-command): Ditto. + * nntp.el (nntp-send-command-nodelete): Ditto. - * gnus-draft.el (gnus-draft-setup): Restore to mml. +2002-02-04 ShengHuo ZHU -2000-04-21 01:24:41 Lars Magne Ingebrigtsen + * mm-url.el (mm-url-load-url): New function. + (mm-url-insert-file-contents): Use it. - * flow-fill.el: Renamed from fill-flowed. + * gnus-msg.el (gnus-summary-mail-forward): Use gnus-article-charset. - * message.el (message-forward-ignored-headers): Default to - removing CTE. + * message.el (message-forward-make-body): Correctly copy + forward-buffer. -2000-04-21 00:48:48 + * rfc2047.el (rfc2047-decode-region): Don't decode us-ascii characters. - * message.el (message-mode): Don't fill headers. +2002-02-04 Simon Josefsson -2000-04-20 23:12:43 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-followup-with-original): Mark with + force, prevent errors when following up from article buffer. + (gnus-article-reply-with-original): Ditto. - * message.el (message-pipe-buffer-body): Use shell + * binhex.el (binhex-decoder-switches): Fix doc. From + Pavel@Janik.cz (Pavel Jan,Am(Bk). -2000-02-21 Yoshiki Hayashi +2002-02-04 ShengHuo ZHU - * nnvirtual.el (nnvirtual-request-article): - Bind gnus-override-method to nil. - (nnvirtual-request-update-mark): Don't update mark when - article is not there. + * gnus-art.el (gnus-treatment-function-alist): Move hide-citation, + highlight-citation after emphasize. -2000-04-20 16:35:41 Shenghuo ZHU +2002-02-04 Simon Josefsson - * mm-uu.el (mm-uu-dissect): Check forwarded message. + * nnfolder.el (nnfolder-open-marks): -2000-04-20 21:17:48 Lars Magne Ingebrigtsen + * nnml.el (nnml-open-marks): Message when done. From David + Edmondson . - * gnus-util.el (gnus-parse-netrc): Allow "port". - (gnus-netrc-machine): Take a port param. - (gnus-netrc-machine): +2002-02-03 ShengHuo ZHU - * gnus-art.el (gnus-request-article-this-buffer): Allow - re-selecting referenced articles. + * imap.el (imap-anonymous-auth): Fix typo. + From: Steinar Bang - * message.el (message-cancel-news): Allow editing. - (message-cancel-message): Add newline. + * gnus-cache.el (gnus-cache-braid-nov): Use set-buffer instead of + save-excursion. + (gnus-cache-braid-heads): Ditto. -2000-04-20 21:03:54 William M. Perry + * gnus-agent.el (gnus-agent-copy-nov-line): Move to the correct + line, because there are extra articles in the overview buffer. - * mm-view.el (mm-inline-image-emacs): New function. + * nntp.el (nntp-retrieve-groups): Check whether BUF is live. -2000-04-20 20:44:55 Lars Magne Ingebrigtsen + * message.el (message-forward-rmail-make-body): Directly use + rmail-msg-restore-non-pruned-header to avoid calling + vertical-motion. - * mail-source.el (mail-source-delete-incoming): Change default in - cvs. +2002-02-02 ShengHuo ZHU -2000-04-20 20:43:34 Kim-Minh Kaplan + * gnus-cache.el (gnus-summary-insert-cached-articles): + (gnus-summary-limit-include-cached): gnus-newsgroup-cached is sorted. - * gnus-art.el (gnus-mime-view-part-as-type-internal): New - function. + * gnus-group.el (gnus-group-mark-article-read): Nreverse + gnus-newsgroups-unselected. -2000-04-20 14:45:20 Lars Magne Ingebrigtsen + * gnus-agent.el (gnus-summary-set-agent-mark): Use + gnus-add-to-sorted-list. - * nnml.el (nnml-request-expire-articles): Use it. + * gnus-sum.el (gnus-summary-update-info): gnus-newsgroup-unreads + gnus-newsgroup-unselected are sorted. Use gnus-sorted-union. + (gnus-build-all-threads): Use gnus-add-to-sorted-list. + (gnus-update-read-articles): UNREAD is sorted. + (gnus-newsgroup-unreads, gnus-newsgroup-unselected) + (gnus-newsgroup-marked, gnus-newsgroup-cached) + (gnus-newsgroup-expirable, gnus-newsgroup-downloadable) + (gnus-newsgroup-dormant): Require sorted. - * nnmail.el (nnmail-expiry-target): New variable. - (nnmail-expiry-target-group): New function. + * gnus-dired.el (gnus-dired-find-file-mailcap): Correctly handle + directories. + (gnus-dired-print): New function. -2000-04-20 02:36:31 Emerick Rogul + * gnus-art.el (gnus-mime-print-part): Add argument filename. Call + ps-despool. - * message.el (message-forward): Add non-MIME separators. +2002-02-02 Simon Josefsson -2000-04-20 02:25:39 Lars Magne Ingebrigtsen + * gnus-dired.el (turn-on-gnus-dired-mode): Autoload. Make defun. - * message.el (message-generate-headers): Respect the syntax check - spec. +2002-02-02 ShengHuo ZHU - * gnus-sum.el (gnus-remove-thread-1): Show thread. - (gnus-remove-thread): Don't show all threads. + * gnus-start.el (gnus-1): Call gnus-agentize if gnus-agent is + t. This makes gnus-agent customizable without putting + gnus-agentize into .gnus. -Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen + * gnus.el (gnus-agent): Make it customizable. - * gnus.el: Pterodactyl Gnus v5.8.4 is released. + * gnus-dired.el: New file. + From Benjamin Rutt -2000-04-19 Dave Love + * gnus-cache.el (gnus-cache-articles-in-group): Remove from active + if no article. + (gnus-cache-possibly-remove-article): Ditto. + (gnus-cache-possibly-enter-article): Use gnus-add-to-sorted-list. - * mailcap.el (mailcap-parse-mimetypes): Add ...mime.types. +2002-02-01 Simon Josefsson -2000-04-18 12:28:24 Shenghuo ZHU + * gnus-int.el (gnus-request-accept-article): Use gnus-get-function. - * nnwarchive.el (nnwarchive-type-definition): New egroups html. - (nnwarchive-egroups-*): Ditto. - (nnwarchive-url): Unibyte buffer and single line cookie. +2002-02-01 Katsumi Yamaoka -2000-04-14 18:50:04 Shenghuo ZHU + * mm-view.el (mm-w3m-mode-dont-bind-keys): New variable. + (mm-setup-w3m): Don't bind keys listed in the above. - * mm-util.el (mm-char-or-char-int-p): New alias. - * nnweb.el (nnweb-decode-entities): Check the validity of numeric - entities. +2002-02-01 Katsumi Yamaoka -2000-04-10 Daiki Ueno + * mm-view.el (mm-inline-text-html-render-with-w3m): Bind + `w3m-safe-url-regexp' with nil if `mm-inline-text-html-with-images' + is non-nil; bind `w3m-force-redisplay' with nil. - * lisp/imap.el (imap-body-lines): Check Content-Type: of the - article case insensitively. + * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto. -2000-04-10 20:35:46 Shenghuo ZHU + * mm-decode.el (mm-inline-text-html-with-images): Supplement docs. - * mail-source.el (mail-source-fetch-webmail): Use the default - password provided in mail-sources; use webmail:subtype:user as - the key. +2002-01-31 ShengHuo ZHU -2000-04-10 20:35:46 John Wiegley + * nnfolder.el (nnfolder-request-replace-article): Unfold. Don't + use mail-header-unfold-field. - * mail-source.el (mail-source-fetch-webmail): Use - mail-source-password-cache. + * gnus-cache.el (gnus-summary-insert-cached-articles): Use + gnus-summary-limit. -2000-04-09 18:13:47 Shenghuo ZHU + * gnus-range.el (gnus-add-to-sorted-list): New function. + * gnus-sum.el (gnus-mark-article-as-read): Use it. + (gnus-mark-article-as-unread): Ditto. + (gnus-summary-mark-article-as-unread): Ditto. + (gnus-build-get-header): Ditto. + (gnus-summary-prepare-threads): Ditto. + (gnus-summary-insert-pseudos): Ditto. + (gnus-articles-to-read): Use gnus-sorted-union and gnus-sorted-nunion. + (gnus-summary-insert-new-articles): Use gnus-sorted-nunion. + (gnus-summary-insert-old-articles): Ditto. - * webmail.el: Add netscape mail and fix HotMail mail. + * gnus-msg.el (gnus-posting-styles): Add new format of header. + (gnus-configure-posting-styles): Support the new format. -2000-04-08 Simon Josefsson + * mail-source.el (mail-source-bind, mail-source-bind-common): Set + edebug-form-spec to (sexp body). + Suggested by Joe Wells . - * imap.el (imap-kerberos4-open): Work with recent `imtest's. + * message.el (message-reply-headers): Add doc. -2000-04-02 Simon Josefsson +2002-01-30 ShengHuo ZHU - * 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. + * gnus-group.el (gnus-group-delete-group): Nix the entry in + gnus-cache-active-hashtb. -2000-03-11 Simon Josefsson + * gnus-agent.el (gnus-agent-mark-unread-afer-downloaded): New variable. + (gnus-agent-summary-fetch-group): Use it. - * fill-flowed.el: New file. + * gnus-msg.el (gnus-debug-files): New variable. + (gnus-debug-exclude-variables): New variable. + (gnus-debug): Use them. - * mm-decode.el (mm-dissect-singlepart): Create a MIME handle for - text/plain parts with `format' parameters. + * gnus-range.el (gnus-range-length): Don't use gnus-uncompress-range. - * mm-view.el (autoload): Autoload fill-flowed. - (mm-inline-text): For "plain" parts with a format=flowed - parameter, call `fill-flowed'. +2002-01-30 ShengHuo ZHU -2000-03-21 10:32:44 Lars Magne Ingebrigtsen + * message.el (message-cite-prefix-regexp): Use text-mode-syntax-table. + (message-mode-syntax-table): Move back the previous position. - * nnslashdot.el (nnslashdot-request-list): Fudge new-style - slashdot ids. + * nnagent.el (nnagent-retrieve-headers): Use gnus-sorted-difference. -2000-03-20 00:12:42 Lars Magne Ingebrigtsen + * gnus-agent.el (gnus-agent-retrieve-headers): Use + gnus-sorted-difference. - * nnslashdot.el (nnslashdot-request-list): Use the new slashdot - format. + * nnsoup.el (nnsoup-request-expire-articles): Use + gnus-sorted-difference. -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. + * nnheader.el: Autoload gnus-sorted-difference. - * nnimap.el (nnimap-retrieve-headers-progress): Fold continuation - lines and turn TAB into SPC before parsing. + * nnfolder.el (nnfolder-request-expire-articles): Use + gnus-sorted-difference. -2000-03-15 Simon Josefsson + * gnus-cache.el (gnus-cache-retrieve-headers): Use + gnus-sorted-difference. - * nnheader.el (nnheader-group-pathname): Make sure to return a - directory. - * nnmail.el (nnmail-group-pathname): Ditto. + * gnus-range.el: Autoload cookies. + (gnus-sorted-difference): New function. + (gnus-sorted-ndifference): New function. + (gnus-sorted-nintersection): Rename from + gnus-set-sorted-intersection. + (gnus-sorted-nunion): Rename from gnus-set-sorted-union. + (gnus-list-range-difference): Rename from + gnus-inverse-list-range-intersection. + (gnus-inverse-list-range-intersection): Use defalias. -2000-02-08 Per Abrahamsen + * gnus-sum.el (gnus-select-newsgroup): Use gnus-sorted-difference, + gnus-sorted-ndifference, and gnus-sorted-nintersection. + (gnus-articles-to-read): Use gnus-sorted-difference. + (gnus-summary-limit-mark-excluded-as-read): Use + gnus-sorted-intersection and gnus-sorted-ndifference. + (gnus-list-of-read-articles): Use gnus-list-range-difference. + (gnus-summary-insert-articles): Use gnus-sorted-difference. - * nnmail.el (nnmail-fix-eudora-headers): Fix `In-Reply-To' too, it - might split in the middle of a message-id. + * gnus-sum.el (gnus-summary-update-info): Use gnus-sorted-union. -2000-03-13 13:51:38 Lars Magne Ingebrigtsen +2002-01-30 Katsumi Yamaoka - * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the - groups from the server. + * gnus-art.el (gnus-article-wash-html-with-w3m): Add keymap + property to the buffer for using emacs-w3m command keys. - * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec. - (gnus-summary-toggle-header): Update the wash status. + * mm-decode.el (mm-inline-text-html-with-w3m-keymap): New user + option. - * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)): - Moved here. + * mm-view.el (mm-w3m-mode-map): New variable. + (mm-w3m-mode-command-alist): New variable. + (mm-w3m-minor-mode): Removed. + (mm-setup-w3m): Setup `mm-w3m-mode-map'; don't add minor mode. + (mm-inline-text-html-render-with-w3m): Add keymap property to the + buffer for using emacs-w3m command keys. - * gnus-agent.el (gnus-agent-save-group-info): Respect old - setting. +2002-01-29 ShengHuo ZHU - * nnmail.el (nnmail-get-active): Use it. - (nnmail-parse-active): New function. + * message.el (message-mode-syntax-table): Move forward. + (message-cite-prefix-regexp): Auto detect non word constituents. + (message-cite-prefix-regexp): Don't use with-syntax-table. - * mm-view.el (mm-inline-text): Support the new version of - vcard.el. + * gnus-sum.el (gnus-summary-update-info): Use + gnus-list-range-intersection. - * gnus-sum.el (gnus-summary-move-article): Only delete article - when moving junk. - (gnus-deaden-summary): Bury the buffer. + * gnus-agent.el (gnus-agent-fetch-headers): Use + gnus-list-range-intersection. - * nnmail.el (nnmail-group-pathname): Ditto. + * gnus-range.el (gnus-range-normalize): Use correct predicate. + (gnus-list-range-intersection): Use it. + (gnus-inverse-list-range-intersection): Ditto. + (gnus-sorted-intersection): Add doc. + (gnus-set-sorted-intersection): Add doc. + (gnus-sorted-union): New function. + (gnus-set-sorted-union): New function. - * nnheader.el (nnheader-group-pathname): Use expand-file-name. + * gnus-range.el (gnus-list-range-intersection): Correct the logic. + (gnus-inverse-list-range-intersection): Ditto. -2000-03-13 20:23:06 Christoph Rohland +2002-01-29 Karl Kleinpaste - * rfc2047.el (rfc2047-encode-message-header): Encode no matter - whether Mule. + * mm-uu.el (mm-uu-type-alist): Add optional leading `0'. -2000-03-10 14:57:58 Lars Magne Ingebrigtsen + * gnus-uu.el (gnus-uu-shar-name-marker): Add optional leading `0' + and permit `:' and `\' in order to handle full Windows pathnames. + (gnus-uu-begin-string): Add optional leading `0'. Leading `0' is + technically not correct per standard, but seems to have common use. - * message.el (message-send-mail): Protect against unloaded Gnus. +2002-01-29 ShengHuo ZHU - * 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. + * gnus-uu.el (gnus-uu-expand-numbers): Ignore errors when + replacing numbers. -2000-03-01 09:55:26 Lars Magne Ingebrigtsen +2002-01-28 ShengHuo ZHU - * nnultimate.el (nnultimate-retrieve-headers): Ignore errors. + * gnus-art.el (gnus-article-followup-with-original): Use (mark). -2000-02-13 13:53:08 Lars Magne Ingebrigtsen + * gnus-score.el (gnus-score-insert-help): Move to (point-min). + Don't split when the window is small, e.g. when a small *BBDB* + window is the lowest one. - * mm-decode.el (mm-dissect-buffer): Ditto. + * gnus-agent.el (gnus-agent-retrieve-headers): Use + nnheader-find-nov-line to speed up. Use nreverse, because it is + sorted. Use nnheader-insert-nov-file. - * gnus-art.el (article-decode-charset): Strip CTE. +2002-01-28 Katsumi Yamaoka - * ietf-drums.el (ietf-drums-strip): New function. + * mm-decode.el (mm-inline-text-html-with-images): New user option. - * gnus-sum.el (gnus-summary-move-article): Don't use the prefix - when prompting in read-only groups. + * mm-view.el (mm-inline-text-html-render-with-w3m): Bind the value + of `w3m-display-inline-images' with the value of + `mm-inline-text-html-with-images'. + From: TSUCHIYA Masatoshi . -2000-02-23 Simon Josefsson + * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto. - * 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. +2002-01-27 Richard M. Stallman -2000-02-19 Simon Josefsson + * time-date.el: Add autoload cookies. Many doc fixes. + (time-add): New function. + (time-subtract): Renamed from subtract-time. + (subtract-time): New alias for time-subtract. - * mail-source.el (mail-source-fetch-imap): Copy `imap-password' - into `mail-source-password-cache'. +2002-01-28 Katsumi Yamaoka -2000-02-17 Florian Weimer + * gnus-art.el (gnus-article-wash-html-with-w3m): Replace w3m to + emacs-w3m in doc-string. - * 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). + * lpath.el: Bind `w3m-cid-retrieve-function-alist' and + `w3m-current-buffer'. -2000-01-28 Dave Love +2002-01-27 TSUCHIYA Masatoshi - * 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. + * gnus-art.el (gnus-article-wash-html-with-w3m): Handle cid: URLs. - * nnmail.el (nnmail-split-history): Use fundamental-mode in the - right buffer. + * mm-view.el (mm-setup-w3m): Add `mm-w3m-cid-retrieve' to + `w3m-cid-retrieve-function-alist' for `gnus-article-mode'. + (mm-w3m-cid-retrieve): New function. + (mm-inline-text-html-render-with-w3m): Handle cid: URLs. -2000-01-26 12:01:18 Shenghuo ZHU +2002-01-27 ShengHuo ZHU - * qp.el (quoted-printable-decode-region): Add charset parameter. - (quoted-printable-decode-string): Ditto. + * gnus-agent.el (gnus-agent-fetch-articles): Don't save empty articles. - * gnus-art.el (article-de-quoted-unreadable): Use it. +2002-01-27 Lars Magne Ingebrigtsen -2000-01-21 Simon Josefsson + * gnus-util.el (gnus-cache-file-contents): Don't use equalp. - * nnimap.el (nnimap-split-predicate): New variable. - (nnimap-split-articles): Use it. +2002-01-26 Lars Magne Ingebrigtsen -2000-01-20 Simon Josefsson + * nnheader.el (nnheader-insert-nov-file): Increased cutoff to + 32K. - * utf7.el: Change email address. + * gnus-sum.el (gnus-summary-expire-articles): Clean up. -2000-01-18 22:03:51 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-article-group): Decode headers before running + split rules over them. + (nnmail-mail-splitting-charset): New variable. - * gnus-group.el (gnus-group-catchup): Purge split history. + * smiley.el: Replaced with smiley-ems.el. -2000-01-14 02:43:55 Shenghuo ZHU +2002-01-26 ShengHuo ZHU - * nnmail.el (nnmail-generate-active): Support extended group name. - (nnmail-get-active): Ditto. + * mm-url.el (mm-url-predefined-programs): Add w3m. + (mm-url-program): Ditto. -2000-01-13 15:16:10 Shenghuo ZHU +2002-01-26 Lars Magne Ingebrigtsen - * gnus-agent.el (gnus-agent-write-active): Since no prefix in - group names, don't remove anything. + * nnml.el (nnml-use-compressed-files): New variable. + (nnml-filenames-are-evil): Removed. + (nnml-current-group-article-to-file-alist): Don't use. + (nnml-update-file-alist): Inhibit. + (nnml-article-to-file): Use new var. -2000-01-13 15:10:53 Shenghuo ZHU +2002-01-26 ShengHuo ZHU - * webmail.el (webmail-my-deja-open): My-deja changes. + * gnus-util.el (gnus-parse-without-error): Add edebug-form-spec. -2000-01-13 Simon Josefsson + * nnagent.el (nnagent-retrieve-headers): loop until eobp. - * nnimap.el (nnimap-retrieve-headers-progress): Create xref field. +2002-01-26 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-load-alist): Use new caching + function. -2000-01-10 23:35:33 Shenghuo ZHU + * gnus-util.el (gnus-cache-file-contents): New function. - * gnus-agent.el (gnus-agent-fetch-headers): Translate full path. + * gnus-agent.el (gnus-agent-file-loading-cache): New variable. + (gnus-agent-load-alist): Use it. -2000-01-09 22:52:35 Shenghuo ZHU + * nnagent.el (nnagent-retrieve-headers): Use optimized function. - * gnus.el (gnus-other-frame): Fix typo. + * nnheader.el (nnheader-insert-nov-file): New function. -1999-06-25 Andreas Jaeger + * gnus-util.el (gnus-parse-without-error): Correct the loop. - * gnus-cus.el (gnus-group-customize): Fix typo. + * gnus-sum.el (gnus-dependencies-add-header): Use in-reply-to if + there are no references. + (gnus-extract-message-id-from-in-reply-to): New function. + (gnus-nov-parse-line): Use in-reply-to if there are no + references. -2000-01-08 08:36:13 Lars Magne Ingebrigtsen +2002-01-25 Lars Magne Ingebrigtsen - * nnweb.el (nnweb-insert): Simplified. + * nnagent.el (nnagent-retrieve-headers): Use new macro. -2000-01-06 18:32:53 Lars Magne Ingebrigtsen + * gnus-util.el (gnus-parse-without-error): New macro. - * gnus-art.el (gnus-article-mode-map): "e" is - gnus-summary-edit-article. +2002-01-25 ShengHuo ZHU -2000-01-06 18:25:37 Jari Aalto + * gnus-art.el (gnus-article-wash-html-with-w3m): Call w3m-region. + (gnus-article-wash-function): use locate-library to decide which + to use. - * mailcap.el (mailcap-mime-extensions): Add .diff. +2002-01-25 Simon Josefsson -2000-01-06 00:06:40 Kim-Minh Kaplan + * pop3.el (pop3-munge-message-separator): Work if no date. + Trivial patch from Marius Vollmer . - * mm-decode.el (mm-mailcap-command): handle "%%" and the case where - there is no "%s" in the method. +2002-01-25 Lars Magne Ingebrigtsen -2000-01-08 21:01:04 Kim-Minh Kaplan + * gnus-agent.el (gnus-agent-save-alist): Fix. - * gnus-sum.el (gnus-summary-select-article): Return 'old. + * nnagent.el (nnagent-retrieve-headers): Must have cut too much by + mistake. Reinstated lost code. -2000-01-06 13:41:11 Lars Magne Ingebrigtsen +2002-01-25 Josh Huber - * nnfolder.el (nnfolder-read-folder): Use nnfolder-save-buffer. + * mml2015.el (mml2015-mailcrypt-decrypt): Display a signature if + one exists in the case of an encrypted message with an internal + signature. - * gnus.el: Really always pop up a new frame. +2002-01-25 Lars Magne Ingebrigtsen - * parse-time.el (parse-time-rules): Allow 100-110 to be - 2000-2010. + * gnus-agent.el (gnus-agent-save-alist): Optimized. - * time-date.el (date-to-time): Don't use timezone. +2002-01-25 Katsumi Yamaoka -2000-01-06 Dave Love + * dgnushack.el: Commented out the experimental code. - * 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. +2002-01-25 Lars Magne Ingebrigtsen - * base64.el: Require cl when compiling. + * gnus-range.el (gnus-inverse-list-range-intersection): Off-by-one + error. -2000-01-05 BrYan P. Johnson + * gnus.el (gnus-server-to-method): Made into subst. + (gnus-server-method-cache): New variable. + (gnus-server-to-method): Use it. + (gnus-group-method-cache): New variable. + (gnus-find-method-for-group-1): Renamed. + (gnus-find-method-for-group): New function. + (gnus-group-method-cache): Removed. - * 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. + * gnus-sum.el (gnus-compute-unseen-list): Use new optimized + function. -2000-01-05 17:31:52 Lars Magne Ingebrigtsen + * gnus-range.el (gnus-members-of-range): New function. + (gnus-list-range-intersection): Renamed. + (gnus-inverse-list-range-intersection): New function. - * gnus-sum.el (gnus-summary-select-article): Return whether we - selected something new. - (gnus-summary-search-article): Start searching at the window - point. + * gnus-sum.el (gnus-compute-unseen-list): Made into own function. - * gnus-group.el (gnus-fetch-group): Complete over - gnus-active-hashtb. + * nnagent.el (nnagent-retrieve-headers): New implementation. -Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen + * gnus-agent.el (gnus-agent-get-undownloaded-list): New, faster + implementation. - * gnus.el: Pterodactyl Gnus v5.8.3 is released. +2002-01-25 Katsumi Yamaoka -2000-01-05 15:56:02 Lars Magne Ingebrigtsen + * lpath.el: Fbind `w3m-charset-to-coding-system'; bind + `w3m-meta-content-type-charset-regexp'. - * gnus-sum.el (gnus-preserve-marks): New variable. - (gnus-summary-move-article): Use it. - (gnus-group-charset-alist): Added more entries. + * mm-view.el (mm-inline-text-html-render-with-w3m): Decode + charset-encoded html contents. -2000-01-03 01:18:36 Lars Magne Ingebrigtsen +2002-01-24 ShengHuo ZHU - * mm-decode.el (mm-inline-override-types): Removed duplicate. + * gnus-agent.el (gnus-agent-request-article): Make sure it is not + an empty file. - * gnus-uu.el (gnus-uu-mark-over): Use gnus-summary-default-score - as the default score. + * nnweb.el (url): Ignore errors when request url. - * gnus-score.el (gnus-score-delta-default): Changed name. + * nnrss.el: Clean up the comments. -2000-01-04 Simon Josefsson +2002-01-24 Katsumi Yamaoka - * imap.el (imap-parse-literal): - (imap-parse-flag-list): Don't care about props. - (imap-parse-string): Handle quoted characters. + * lpath.el: Fbind `w3m-region'; bind `w3m-mode-map'. -2000-01-02 08:37:03 Lars Magne Ingebrigtsen + * mm-decode.el (mm-inline-text-html-renderer): New user option. + (mm-inline-media-tests): Test whether the value of + `mm-inline-text-html-renderer' is a function for text/html. - * 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. + * mm-view.el (mm-inline-text-html-render-with-w3): New function + separated from `mm-inline-text'. + (mm-w3m-minor-mode): New variable. + (mm-w3m-setup): New variable. + (mm-setup-w3m): New function. + (mm-inline-text-html-render-with-w3m): New function. + (mm-inline-text): Funcall `mm-inline-text-html-renderer' for + text/html. - * gnus-art.el (gnus-article-mode-map): Use gnus-article-edit for - "e". - (gnus-article-mode-map): No, don't. +2002-01-23 Paul Jarc - * gnus-sum.el (gnus-summary-next-subject): Don't show the thread - of the final article. + * lpath.el: fbind make-symbolic-link and unix-sync for nnmaildir. - * mm-decode.el (mm-interactively-view-part): Error on no method. +2002-01-23 Katsumi Yamaoka -2000-01-02 06:10:32 Stefan Monnier + * gnus-xmas.el (gnus-xmas-redefine): Quote `gnus-completing-read' + and `gnus-xmas-completing-read'. - * gnus-score.el (gnus-score-insert-help): Something. +2002-01-19 TSUCHIYA Masatoshi - * gnus-art.el (gnus-button-alist): Exclude < from - * gnus-mh.el (gnus-summary-save-in-folder): Use - with-current-buffer. + * gnus-art.el (gnus-emphasis-alist): Include !? as sentence-ending + characters. -2000-01-02 05:00:13 Lars Magne Ingebrigtsen +2002-01-22 Lars Magne Ingebrigtsen - * nnwarchive.el: Changed file perms. + * gnus-xmas.el (gnus-xmas-completing-read): New function. + (gnus-xmas-redefine): Redefine conditionally. -1999-12-19 21:42:15 Lars Magne Ingebrigtsen +2002-01-22 Josh Huber - * gnus-group.el (gnus-group-delete-groups): New command. - (gnus-group-delete-group): Extra no-prompt parameters. + * mml.el (mml-parse-1): Fixed usage of recipients in the secure + tag. -1999-12-14 10:18:30 Lars Magne Ingebrigtsen +2002-01-22 Josh Huber - * nnslashdot.el (nnslashdot-request-article): Translate
into -

. + * message.el (message-font-lock-keywords): Added the secure tag. + * mml-sec.el: Added functions to generate/modify/remove the secure + tag while in message mode. + * mml-sec.el (mml-secure-message): New. + * mml-sec.el (mml-unsecure-message): New. + * mml-sec.el (mml-secure-message-sign-smime): New. + * mml-sec.el (mml-secure-message-sign-pgp): New. + * mml-sec.el (mml-secure-message-sign-pgpmime): New. + * mml-sec.el (mml-secure-message-encrypt-smime): New. + * mml-sec.el (mml-secure-message-encrypt-pgp): New. + * mml-sec.el (mml-secure-message-encrypt-pgpmime): New. + * mml.el (mml-parse-1): Added code to recognise the secure tag and + convert it to either a part or multipart depending on if there are + other parts in the message. + * mml.el (mml-mode-map): Changed default sign/encrypt keybindings + to use the secure tag, rather than the part tag. + * mml.el (mml-preview): Added a save-excursion to keep cursor + position after doing an MML preview. -1999-12-28 12:20:18 Shenghuo ZHU +2002-01-22 Lars Magne Ingebrigtsen - * webmail.el (webmail-hotmail-article): Don't insert message id. + * nnheader.el (nnheader-parse-overview-file): New function. + (nnheader-write-overview-file): New function. -1999-12-28 Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,A_(Bjohann) +2002-01-21 Lars Magne Ingebrigtsen - * nnimap.el (nnimap-split-fancy): New variable. - (nnimap-split-fancy): New function. + * gnus.el (gnus-group-fast-parameter): Check better if expansion + in wanted. -1999-12-28 Simon Josefsson + * nnweb.el (nnweb-type-definition): Clean up. - (nnimap-split-rule): Document symbol value. +2002-01-21 Alastair Burt + Trivial patch. -1999-12-28 Simon Josefsson + * gnus-art.el (gnus-mm-display-part): Make sure that the summary + buffer exists before jumping to it. - * 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'. +2002-01-21 Lars Magne Ingebrigtsen -1999-12-23 Florian Weimer + * gnus-art.el (gnus-article-wash-html-with-w3): Made into own + function. + (article-wash-html): Use it. + (gnus-article-wash-function): New variable. + (gnus-article-wash-html-with-w3m): New function. - * gnus-msg.el (gnus-group-posting-charset-alist): Correct default - value (crosspostings are handled), improve documentation. +2002-01-20 Bj,Av(Brn Torkelsson - * smiley.el: Declare file coding system as iso-8859-1. + * dgnushack.el (dgnushack-compile): Compile smiley-ems for + XEmacs. - * nnultimate.el: Dito. +2002-01-20 John H. Palmieri - * message.el: Dito. + * gnus-fun.el (gnus-convert-image-to-gray-x-face): More standard + command line. - * gnus-cite.el: Dito. +2002-01-21 Simon Josefsson - * gnus-spec.el: Dito. + * canlock.el (base64-encode-string): Autoload it from base64. + (canlock-make-cancel-key): Base64 encode unibyte string. -1999-12-21 Florian Weimer +2002-01-20 Lars Magne Ingebrigtsen - * 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'. + * nnfolder.el (nnfolder-request-accept-article): Unfold + x-from-line. + (nnfolder-request-replace-article): Ditto. - * 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'. +2002-01-20 Nevin Kapur - * mm-bodies.el (mm-body-encoding): Consider - `message-posting-charset' when deciding whether to use 8bit. + * gnus-group.el (gnus-group-best-unread-group): Use the right + positioning function. - * rfc2047.el (rfc2047-encode-message-header): Back out change. - (rfc2047-encodable-p): Now solely for headers; use - `message-posting-charset'. +2002-01-20 Lars Magne Ingebrigtsen -1999-12-20 14:10:39 Shenghuo ZHU + * smiley-ems.el (smiley-region): Use new function. + (smiley-update-cache): Use general image functions. + (smiley-region): Use general functions. - * nnwarchive.el (nnwarchive-type-definition): Set default value. + * gnus-util.el (gnus-graphic-display-p): New function. -1999-12-19 22:49:13 Shenghuo ZHU + * nnmail.el (nnmail-article-group): Allow outputting traces of + non-strings. - * nnagent.el (nnagent-server-opened): Optional. - (nnagent-status-message): Optional. + * nndoc.el (nndoc-type-alist): Rules for exim bounces. + (nndoc-exim-bounce-type-p): New function. -1999-12-19 Simon Josefsson + * message.el (message-dont-send): Doc fix. - * gnus-cite.el (gnus-article-toggle-cited-text): Restore beg and - end (referenced by instructions in - `gnus-cited-opened-text-button-line-format-alist'). + * gnus-util.el (gnus-completing-read): Remove + inherit-input-method. -1999-12-18 Simon Josefsson + * gnus-art.el (gnus-treat-smiley): Doc fix. - * imap.el (imap-starttls-open): Typo. + * gnus-agent.el (gnus-agent-fetch-headers): Ignore seen and recent + articles. -1999-12-18 16:43:37 Shenghuo ZHU +2002-01-19 Simon Josefsson - * 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. + * imap.el (imap-gssapi-open): Don't wait for logout to complete. + (imap-kerberos4-open): Ditto. + (imap-open): Set port correctly, don't set auth. -1999-12-18 Florian Weimer +2002-01-20 Lars Magne Ingebrigtsen - * mml.el (mml-generate-multipart-alist): Correct default value. + * gnus.el (gnus-version-number): Bump version number. - * mm-encode.el (mm-use-ultra-safe-encoding): New variable. - (mm-safer-encoding): New function. - (mm-content-transfer-encoding): Use both. +2002-01-20 05:33:30 Lars Magne Ingebrigtsen - * mm-bodies.el (mm-body-encoding): Use mm-use-ultra-safe-encoding. - * qp.el (quoted-printable-encode-region): Dito. + * gnus.el: Oort Gnus v0.05 is released. -1999-12-18 14:08:48 Shenghuo ZHU +2002-01-20 Lars Magne Ingebrigtsen - * webmail.el (webmail-hotmail-article): Snarf the raw file. + * nnkiboze.el (nnkiboze-generate-group): Make sure the directory + exists. -1999-12-18 14:08:12 Victor S. Miller + * gnus-spec.el (gnus-string-width-function): New function. + (gnus-tilde-cut-form): Use it. + (gnus-tilde-max-form): Ditto. + (gnus-use-correct-string-widths): Default to (featurep 'xemacs). + (gnus-substring-function): Use it. + (gnus-tilde-cut-form): Ditto. + (gnus-substring-function): New function. - * webmail.el (webmail-hotmail-list): raw=0. + * message.el (message-check-news-header-syntax): New message. -1999-12-18 11:14:51 Shenghuo ZHU + * gnus.el (gnus-slave-no-server): Doc fix. - * gnus-agent.el (gnus-agent-enter-history): Back-compatible in - group name. + * gnus-spec.el (gnus-use-correct-string-widths): Default to t. -1999-12-18 11:02:00 Shenghuo ZHU +2002-01-15 Katsumi Yamaoka - * gnus-agent.el (gnus-agent-expire): Convert to symbol if stringp. + * gnus-sum.el (gnus-adjust-marked-articles): Fix the record for + `seen' if it looks like (seen NUM1 . NUM2). It should be + (seen (NUM1 . NUM2)). -1999-12-18 Simon Josefsson +2002-01-20 Lars Magne Ingebrigtsen - * 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. + * gnus-topic.el (gnus-topic-catchup-articles): Update article + number in closed topics. -1999-12-17 Daiki Ueno +2002-01-19 Daniel Pittman - * base64.el (base64-encode-string): Accept 2nd argument - `no-line-break'. + * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): New + functions. - * 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. +2002-01-19 Lars Magne Ingebrigtsen -1999-12-18 01:08:10 Shenghuo ZHU + * gnus.el (gnus-group-find-parameter): Clean up. - * gnus-agent.el (gnus-agent-enter-history): Bad group name. + * gnus-sum.el (gnus-summary-goto-subject): Error on non-numerical + articles. -1999-12-17 19:36:47 Shenghuo ZHU + * gnus-util.el (gnus-completing-read-with-default): Renamed. - * rfc2047.el (rfc2047-dissect-region): Use mapcar instead of - string-to-x function. + * nnmail.el (nnmail-article-group): Clean up. -1999-12-17 13:08:54 Shenghuo ZHU +2002-01-19 Paul Stodghill - * rfc2047.el (rfc2047-fold-region): Fold a line more than once. + * gnus-agent.el (gnus-category-name): Intern the category name. -1999-12-17 11:54:41 Shenghuo ZHU +2002-01-19 Lars Magne Ingebrigtsen - * webmail.el: Enhance hotmail-snarf. + * gnus-topic.el (gnus-topic-move-group): Use gnus-topic-history. -1999-12-17 10:38:10 Shenghuo ZHU + * gnus-util.el (gnus-completing-read): New function. - * rfc2047.el (rfc2047-dissect-region): Rewrite. +2002-01-19 ShengHuo ZHU -1999-12-16 22:59:22 Shenghuo ZHU + * gnus-art.el (gnus-add-wash-type): Use add-to-list. - * webmail.el (webmail-hotmail-list): Search no-error. + * smiley-ems.el (smiley-region): Register smiley. + (smiley-toggle-buffer): Rewrite the function. + (smiley-active): Removed. -1999-12-15 22:07:15 Shenghuo ZHU +2002-01-19 Simon Josefsson - * 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. + * gnus-util.el (gnus-parent-id): Optimize null n case. From + Jesper Harder . -1999-12-15 08:55:19 Shenghuo ZHU +2002-01-18 TSUCHIYA Masatoshi - * nnagent.el (nnagent-server-opened): Redefine. - (nnagent-status-message): Ditto. + * gnus-art.el (gnus-request-article-this-buffer): Call + `nneething-get-file-name' to extract the file name from the + message id. -1999-12-14 23:37:44 Shenghuo ZHU + * nneething.el (nneething-encode-file-name): New function. + (nneething-decode-file-name): Ditto. + (nneething-get-file-name): Ditto. + (nneething-make-head): Encode the file name and encapsulate it + into the field of the message id. - * rfc1843.el (rfc1843-decode-region): Use - buffer-substring-no-properties. - * gnus-art.el (article-decode-HZ): New function. +2002-01-18 Simon Josefsson -1999-12-14 22:07:26 Shenghuo ZHU + * nnml.el (nnml-request-update-info): Don't erase flags that isn't + stored in .marks. - * nnheader.el (nnheader-translate-file-chars): Only in full path. + * nnfolder.el (nnfolder-request-update-info): Ditto. -1999-12-14 16:21:45 Shenghuo ZHU +2002-01-18 ShengHuo ZHU - * mm-util.el (mm-find-charset-region): mail-parse-charset is a - MIME charset not a MULE charset. + * gnus-art.el (gnus-url-parse-query-string): Allow new line in value. -1999-12-14 15:08:03 Shenghuo ZHU +2002-01-18 Simon Josefsson - * gnus-ems.el: Translate more ugly characters. - * nnheader.el (nnheader-translate-file-chars): Don't translate - the second ':'. + * imap.el (imap-starttls-p): Don't check for binary. + (imap-gssapi-auth-p): Ditto. + (imap-kerberos4-auth-p): Ditto. + (imap-open): Change logic. Iterate through all possible streams, + instead of bailing out after first failure. Move authenticator + decision to `imap-authenticate'. + (imap-authenticate): Change logic, now finds the authenticator to + use, was previously in `imap-open'. + (imap-open): Return nil on failure. + (imap-open): Setup temp buffer correctly. + (imap-open): Return buffer only on success. + (imap-interactive-login, imap-interactive-login): Tell the user + which stream/authenticator is used for the queried + username/password. + (imap-open, imap-authenticate): Set variables. + (imap-gssapi-auth-p, imap-kerberos4-auth-p): Fix typo. + (imap-open): Don't assume how `with-temp-buffer' is implemented. -1999-12-14 10:40:33 Shenghuo ZHU +2002-01-17 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-request-article-this-buffer): Use all refer - method if cannot find the article. + * gnus-fun.el (gnus-grab-cam-x-face): New function. -1999-12-14 01:13:50 Shenghuo ZHU +2002-01-16 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-request-article-this-buffer): Don't use refer - method if overrided. + * gnus-art.el (gnus-emphasis-alist): Allow matching "*this*.)". -1999-12-13 23:38:53 Shenghuo ZHU +2002-01-17 ShengHuo ZHU - * mail-source.el (mail-source-fetch-webmail): Parameter - dontexpunge. + * gnus-agent.el (gnus-agent-toggle-group-plugged): New function. + (gnus-agent-group-mode-map): Bind it to "Jo". + (gnus-agent-group-make-menu-bar): Add it into menu bar. -1999-12-13 23:31:17 Shenghuo ZHU +2002-01-17 Karl Kleinpaste - * webmail.el: Support my-deja. Better error report. + * gnus-xmas.el (gnus-group-toolbar): Add .newsrc save button. + (gnus-summary-mail-toolbar): Add mail article deletion button. -1999-12-13 18:59:33 Shenghuo ZHU + * smiley.el (smiley-deformed-regexp-alist): Eliminate noseless + false positives for lines of "^^^^". - * 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. + * gnus-picon.el (gnus-picon-find-face): faces database is all + lowercase. -1999-12-13 18:22:08 Shenghuo ZHU +2002-01-17 ShengHuo ZHU - * nnslashdot.el (nnslashdot-request-article): A space. + * gnus-agent.el (gnus-agent-retrieve-headers): Use correct buffer. + (gnus-agent-braid-nov): Switch back to nntp-server-buffer. Remove + duplications. + (gnus-agent-batch): Bind gnus-agent-confirmation-function. -1999-12-13 17:20:25 Shenghuo ZHU +2002-01-16 Lars Magne Ingebrigtsen - * nnagent.el: Support different backend with same name. + * gnus-sum.el (gnus-summary-initial-limit): Inline + gnus-summary-limit-children. + (gnus-summary-initial-limit): Don't limit if + gnus-newsgroup-display is nil. + (gnus-summary-initial-limit): No, don't. -1999-12-13 13:14:42 Shenghuo ZHU + * gnus-util.el + (gnus-put-text-property-excluding-characters-with-faces): Inline + gnus-put-text-property. - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Support - archived group. - (nnslashdot-sane-retrieve-headers): Ditto. - (nnslashdot-request-article): Ditto. + * gnus-spec.el (gnus-default-format-specs): New variable. -1999-12-13 11:41:32 Shenghuo ZHU + * gnus-start.el (gnus-read-newsrc-file): Don't clear + gnus-format-specs. + (gnus-read-newsrc-el-file): Default to gnus-default-format-specs. - * nnweb.el (nnweb-insert): Narrow to point. + * gnus-spec.el (gnus-update-format-specifications): Really check + the Gnus version of the .newsrc.eld file. + (gnus-format-specs): Save the new default summary format. -1999-12-13 10:59:42 Shenghuo ZHU + * gnus-util.el (gnus-parent-id): Check whether references is empty + before splitting. - * nnweb.el (nnweb-insert): Follow refresh url. - * nnslashdot.el: Use it. + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Inline some + functions. + (gnus-gather-threads-by-references): Inline + `gnus-split-references'. -1999-12-13 10:39:53 Shenghuo ZHU + * gnus-spec.el (gnus-summary-line-format-spec): New, optimized + default value of gnus-summary-line-format-spec. - * nnweb.el (nnweb-decode-entities): Decode numerical entities. - (nnweb-decode-entities-string): New function. +2002-01-15 ShengHuo ZHU - * 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 (nnslashdot-retrieve-headers-1): A better error + message. + (nnslashdot-request-list): Ditto. + (nnslashdot-sid-strip): Removed. - * nnslashdot.el: Use nnweb-decode-entities-string. - (nnslashdot-decode-entities): Remove. +2002-01-15 Simon Josefsson -1999-12-13 10:40:56 Eric Marsden + * nnimap.el (nnimap-close-asynchronous): Enable. + (nnimap-close-group): Expunge. - * nnslashdot.el: Decode entities. +2002-01-15 ShengHuo ZHU -1999-12-12 Dave Love + * gnus-util.el (gnus-user-date-format-alist): Typo. + From: Frank Schmitt - * gnus-agent.el (gnus-category-edit-groups) - (gnus-category-edit-score, gnus-category-edit-predicate): Replace - expansion of setf, fixed. +2002-01-15 TSUCHIYA Masatoshi -1999-12-12 12:50:30 Shenghuo ZHU + * nneething.el (nneething-request-article): Set + `nnmail-file-coding-system' to `binary' locally, in order to read + files without any conversion. - * gnus-agent.el: Revoke last Dave Love's patch, because of - incompatibility of XEmacs. +2002-01-15 ShengHuo ZHU -1999-12-12 12:27:03 Shenghuo ZHU + * gnus-agent.el (gnus-agent-retrieve-headers): Use + nnheader-file-coding-system and nnmail-active-file-coding-system. + (gnus-agent-regenerate-group): Ditto. + (gnus-agent-regenerate): Ditto. + (gnus-agent-write-active): Ditto. + Suggested by Katsumi Yamaoka - * mm-uu.el: Change headers. - * rfc1843.el: Ditto. - * uudecode.el: Ditto. +2002-01-14 ShengHuo ZHU -1999-12-07 Dave Love + * gnus-art.el (gnus-button-alist): Don't highlight - * gnus-agent.el (gnus-category-edit-predicate) - (gnus-category-edit-score, gnus-category-edit-score): Expand setf - inside backquote to avoid it at runtime. +2002-01-14 ShengHuo ZHU -1999-12-07 Dave Love + * gnus.el: We don't need gnus-article-show-all-headers. - * binhex.el: Require cl when compiling. + * gnus-art.el (article-show-all, gnus-article-show-all-header): + Ditto. -1999-12-04 Dave Love + * gnus-sum.el (gnus-summary-select-article): Don't call + show-all-headers, because hidden headers are not hidden text any + more. - * gnus-cus.el (gnus-group-parameters): Allow nil for banner. +2002-01-13 Simon Josefsson -1999-12-04 Dave Love + * message.el (message-newline-and-reformat): Use `newline' instead + of inserting \n, so that the newline is marked as hard. - * mm-util.el (mm-delete-duplicates): New function. - (mm-write-region): Use it. + * gnus-spec.el (gnus-pad-form): Don't evaluate EL multiple times. + From Jesper Harder . - * mml.el (mml-minibuffer-read-type): Use mm-delete-duplicates. +2002-01-12 ShengHuo ZHU - * mailcap.el (mailcap-mime-types): Require mm-util. Use - mm-delete-duplicates. + * imap.el (imap-close): Keep going if quit. - * imap.el (imap-open, imap-debug): Avoid mapc. + * gnus-agent.el (gnus-agent-retrieve-headers): Erase + nntp-server-buffer. - * nnvirtual.el (nnvirtual-create-mapping): Likewise. +2002-01-12 Lars Magne Ingebrigtsen - * gnus-sum.el (gnus-summary-exit-no-update): Avoid copy-list. - (gnus-multi-decode-encoded-word-string): Avoid mapc. + * mm-view.el (mm-display-inline-fontify): Require font-lock to + avoid unbinding shadowed variables. - * gnus-start.el (gnus-site-init-file): Avoid ignore-errors at - runtime. + * gnus-art.el (gnus-picon-databases): Moved here. + (gnus-picons-installed-p): Moved here. + (gnus-article-reply-with-original): Use `mark'. - * gnus.el (gnus-select-method): Likewise. + * gnus.el (gnus-picon): Moved here and renamed. - * nnheader.el (nnheader-nov-read-integer): Likewise. + * gnus-art.el (gnus-treat-from-picon): Only be on if picons are + installed. + (gnus-treat-mail-picon): Ditto. + (gnus-treat-newsgroups-picon): Ditto. - * mm-view.el (mm-inline-message): Require cl when compiling. - Avoid ignore-errors at runtime. - (mm-inline-text): Avoid mapc. + * gnus-picon.el (gnus-picons-installed-p): New function. -1999-12-12 10:36:51 Shenghuo ZHU +2002-01-12 ShengHuo ZHU - * gnus-art.el (article-decode-charset): Widen is bad. + * gnus-agent.el (gnus-agent-go-online): Fix doc. -1999-12-12 10:17:42 Shenghuo ZHU +2002-01-12 Simon Josefsson - * mm-util.el (mm-charset-after): `charset-after' may not be defined. + * nnimap.el (nnimap-need-unselect-to-notice-new-mail) + (nnimap-before-find-minmax-bugworkaround): Use it. + (nnimap-find-minmax-uid): Don't reselect current mailbox. + (nnimap-dont-close): New variable. + (nnimap-close-group): Use it. -1999-12-12 Florian Weimer +2002-01-12 Lars Magne Ingebrigtsen - * 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. + * gnus-art.el (gnus-article-reply-with-original): Use + `mark-active'. -1999-12-12 03:08:15 Shenghuo ZHU + * gnus-msg.el (gnus-summary-reply): Don't bug out on regions. - * ietf-drums.el (ietf-drums-narrow-to-header): Make it work with - CRLF. + * gnus-logic.el (gnus-advanced-score-rule): Thinko fix. + (gnus-score-advanced): Clean up. + (gnus-score-advanced): Accept a multiple of the score. -1999-12-11 14:42:26 Shenghuo ZHU +2002-01-12 Simon Josefsson - * webmail.el: Require url-cookie. + * flow-fill.el (fill-flowed-display-column) + (fill-flowed-encode-columnq): New variables. Suggested by + Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann). + (fill-flowed-encode, fill-flowed): Use them. -1999-12-11 14:21:23 Shenghuo ZHU + * message.el (message-send-news, message-send-mail): Use + m-b-s-n-p-e-h-n. - * 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. + * mml.el (autoload): Autoload fill-flowed-encode. + (mml-buffer-substring-no-properties-except-hard-newlines): New + function. + (mml-read-part): Use it. + (mml-generate-mime-1): Encode format=flowed if appropriate. + (mml-insert-mime-headers): Insert format=flowed. -1999-12-11 12:30:20 Shenghuo ZHU + * flow-fill.el (fill-flowed-encode): New function. + (fill-flowed): Bind fill-column to window width. - * webmail.el (webmail-url): Use mm-with-unibyte-current-buffer. +2002-01-12 Lars Magne Ingebrigtsen -1999-12-10 16:22:24 Shenghuo ZHU + * gnus-sum.el (gnus-summary-buffer-name): Return the dead name if + it exists. + (gnus-summary-setup-buffer): Wake up dead summary buffers. + (gnus-summary-buffer-name): Don't return the dead name after all. + (gnus-summary-setup-buffer): Kill the dead buffer. - * nnweb.el (nnweb-request-article): Return cons. + * gnus-art.el (gnus-article-followup-with-original): Store the + value of the mark before deactivating it. -1999-12-10 16:06:04 Shenghuo ZHU +2002-01-11 ShengHuo ZHU - * gnus-sum.el (gnus-summary-setup-default-charset): Typo. + * gnus-fun.el (gnus-display-x-face-in-from): Fake it. + From: Karl Kleinpaste -1999-12-10 12:14:04 Shenghuo ZHU + * gnus-art.el (article-display-x-face): Ditto. + (gnus-article-reply-with-original): Use gnus-region-active-p. + (gnus-article-followup-with-original): Ditto. - * mm-util.el (mm-with-unibyte): New macro. - * nnweb.el (nnweb-init): Use it. + * gnus-sum.el (gnus-summary-read-group-1): Don't select + downloadable article either. -1999-12-09 20:39:49 Shenghuo ZHU +2002-01-11 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. + * gnus-art.el (article-display-x-face): Insert From:. - * mm-bodies.el (mm-encode-body): Use mm-charset-after. + * gnus-sum.el (gnus-summary-move-article): Don't draw the + article. Bind gnus-display-mime-function and + gnus-article-prepare-hook. - * mml.el (mml-parse-singlepart-with-multiple-charsets): Ditto. + * gnus-agent.el (gnus-agent-retrieve-headers): Load agentview. + (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move + gnus-agent-possibly-synchronize-flags to the last. + (gnus-agent-go-online): New function. New variable. -1999-12-09 17:47:56 Shenghuo ZHU +2002-01-11 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. + * gnus-agent.el (gnus-agent-regenerate-group): Add clean option. + (gnus-agent-regenerate): Ditto. -1999-12-09 Simon Josefsson +2002-01-11 ShengHuo ZHU - * 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). + * message.el (message-ignored-news-headers) + (message-ignored-mail-headers): Add X-Gnus-Agent-Meta-Information:. + Suggested by ARISAWA Akihiro -1999-12-09 12:05:28 Shenghuo ZHU + * gnus.el (gnus-gethash-safe): New macro. - * nnml.el (nnml-request-move-article): Save nnml-current-directory - and nnml-article-file-alist. + * gnus-agent.el (gnus-agent-regenerate-history): New function. + (gnus-agent-regenerate): Show messages. -1999-12-09 10:20:07 Shenghuo ZHU +2002-01-11 ShengHuo ZHU - * gnus-group.el (gnus-group-get-new-news-this-group): Binding - nnmail-fetched-sources. + * gnus-agent.el (gnus-agent-regenerate-group): New function. + (gnus-agent-regenerate): New function. + (gnus-agent-save-alist): Sort. + (gnus-agent-copy-nov-line): Test eobp. + (gnus-agent-retrieve-headers): Erase buffer. -1999-12-09 10:19:01 Shenghuo ZHU +2002-01-10 ShengHuo ZHU - * mm-util.el (mm-find-charset-region): Use the last charset. + * mm-util.el (mm-charset-to-coding-system): Change charset to cs. + From: Torsten Hilbrich -1999-12-08 Per Abrahamsen + * gnus.el (gnus-agent-covered-methods): Move here. + (gnus-online): New function. + (gnus-agent-method-p): Move here. - * gnus.el (gnus-select-method): Made the option list prettier. + * nnagent.el (nnagent-retrieve-headers): Check whether arts is + nil. Remove articles-alist. -1999-12-08 Florian Weimer + * gnus-start.el (gnus-get-unread-articles): Check online. + (gnus-groups-to-gnus-format): Ditto. + (gnus-active-to-gnus-format): Ditto. - * gnus-msg.el (gnus-group-posting-charset-alist): Use iso-8859-1 - for the `de' newsgroups hierarchy, as it is common practice there. + * gnus-agent.el (gnus-agent-get-function): Use it. + (gnus-agent-get-undownloaded-list): Ditto. + (gnus-agent-fetch-session): Only fetch online methods. + * gnus-srvr.el (gnus-server-make-menu-bar): Add offline. + (gnus-server-mode-map): Ditto. + (gnus-server-offline-face): New face. + (gnus-server-offline-face): New variable. + (gnus-server-font-lock-keywords): Add offline. + (gnus-server-insert-server-line): Ditto. + (gnus-server-offline-server): New function. -1999-12-07 16:17:12 Shenghuo ZHU + * gnus-int.el (gnus-open-server): Turn to offline. + (gnus-server-unopen-status): New variable. - * nnwarchive.el (nnwarchive-mail-archive-article): Fix - buffer-string arguments. Fix references. +2002-01-10 ShengHuo ZHU -1999-12-07 15:04:18 Shenghuo ZHU + * nnkiboze.el (nnkiboze-request-article): Use + gnus-agent-request-article. - * gnus-agent.el (gnus-agent-confirmation-function): New variable. - (gnus-agent-batch-fetch): Use it. - (gnus-agent-fetch-session): Use it. + * nnagent.el (nnagent-retrieve-headers): Don't use nnml + function. Insert undownloaded NOV. -1999-12-07 12:32:43 Shenghuo ZHU + * gnus-agent.el (gnus-agent-retrieve-headers): New function. + (gnus-agent-request-article): New function. - * mm-util.el (mm-find-mime-charset-region): Delete nil. + * gnus.el (gnus-agent-cache): New variable. -1999-12-07 11:45:10 Shenghuo ZHU + * gnus-int.el (gnus-retrieve-headers): Use + gnus-agent-retrieve-headers. + (gnus-request-head): Use gnus-agent-request-article. + (gnus-request-body): Ditto. - * mm-util.el (mm-find-charset-region): Don't capitalize. Delete - nil. + * gnus-art.el (gnus-request-article-this-buffer): Use + gnus-agent-request-article. -1999-12-07 Per Abrahamsen + * gnus-sum.el (gnus-summary-read-group-1): Don't show the first + article if it is undownloaded. - * nnslashdot.el (nnslashdot-request-list): There were two - top-level body-forms. Put a `progn' around them. +2002-01-10 Katsumi Yamaoka - * gnus.el (gnus-select-method): Use `condition-case' - instead of `ignore-errors', since cl may not be loaded when the - form is evaluated. + * gnus-spec.el (gnus-spec-tab): Deal with wide characters. -1999-12-06 23:57:47 Shenghuo ZHU +2002-01-09 Katsumi Yamaoka - * nnwarchive.el: Support www.mail-archive.com. + * canlock.el (canlock-string-as-unibyte): New macro. + (canlock-sha1-with-openssl): Return a unibyte string. + (canlock-make-cancel-key): Treat Message-ID as a unibyte string. -1999-12-06 23:55:55 Shenghuo ZHU +2002-01-09 ShengHuo ZHU - * nnmail.el (nnmail-get-new-mail): Remove fetched sources before - do anything. + * gnus.el (gnus-expand-group-parameters): Match \N or \& only. -1999-12-06 Simon Josefsson +2002-01-08 ShengHuo ZHU - * utf7.el: New file, written by Jon K Hellan. + * mm-encode.el (mm-content-transfer-encoding-defaults): Add + application/x-emacs-lisp. - * imap.el (imap-use-utf7): Renamed from `imap-utf7-p', change - default to t. + * gnus-msg.el (gnus-bug): Use application/emacs-lisp. -1999-12-06 04:40:24 Lars Magne Ingebrigtsen + * nntp.el (nntp-request-article): Add group parameter. + (nntp-request-head): Ditto. + (nntp-find-group-and-number): Add parameter group. Figure out + number if the status line doesn't give (e.g. quimby.gnus.org). - * nnslashdot.el (nnslashdot-request-delete-group): New function. +2002-01-08 Simon Josefsson - * gnus-sum.el (gnus-summary-refer-article): Work for lists with - current. - (gnus-refer-article-methods): New function. - (gnus-summary-refer-article): Use it. + * mml.el (mml-generate-mime-1): Set recipient correctly. -1999-11-13 Simon Josefsson +2002-01-08 ShengHuo ZHU - * nnimap.el (nnimap-retrieve-groups): Return active format. + * message.el (message-read-from-minibuffer): Add parameter + initial-contents. + * gnus-msg.el (gnus-summary-resend-message): Use it. - * nnimap.el (nnimap-replace-in-string): Removed. - (nnimap-request-list): - (nnimap-retrieve-groups): - (nnimap-request-newgroups): Quote group instead of escaping SPC. + * gnus-group.el (gnus-group-read-ephemeral-group): Restore the old + behavior of quit-config. -1999-12-05 Simon Josefsson + * message.el (message-make-from): Don't quote fullname. + From: Bj,Ax(Brn Mork - * imap.el: Use format-spec for ssl program. - * imap.el (imap-ssl-arguments): Removed. - (imap-ssl-open-{1,2}): Removed. + * gnus-group.el (gnus-group-suspend): Don't kill message buffers. + From: -1999-12-04 Per Abrahamsen +2002-01-07 ShengHuo ZHU - * 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. + * gnus-group.el (gnus-group-mark-article-read): Typo. Increase n. -1999-12-04 11:34:22 Shenghuo ZHU + * gnus-art.el (gnus-header-button-alist): Handle mailto. - * mm-bodies.el (mm-8bit-char-regexps): Removed. - (mm-7bit-chars): New variable. - (mm-body-7-or-8): Use it in both cases. + * mml.el (mml-preview): Bind gnus-original-article-buffer because + article-decode-group-name uses it. Bind gnus-article-prepare-hook + because bbdb may use it. -1999-12-04 Michael Welsh Duggan +2002-01-07 TSUCHIYA Masatoshi - * gnus-start.el (gnus-site-init-file): Don't use cl macros in - defcustom definitions. + * nneething.el (nneething-request-article): When a non-text file + is converted to an article, its data is encoded in base64. Call + `nneething-make-head' with options to specify MIME types. + (nneething-make-head): Add optional arguments to specify MIME + types. -1999-12-04 Simon Josefsson +2002-01-06 ShengHuo ZHU - * mm-decode.el (mm-display-part): Let mm-display-external return - inline or external. - (mm-display-external): For copiousoutput methods, insert output in - buffer. + * gnus-fun.el (gnus-display-x-face-in-from): Fake a "From: " + header if there is not. -1999-12-04 03:29:13 Shenghuo ZHU + * gnus-xmas.el (gnus-xmas-put-image): Insert " " if bobp. - * nntp.el (nntp-retrieve-headers-with-xover): Goto the end of - buffer. + * gnus-msg.el (gnus-gcc-mark-as-read): New variable. + (gnus-inews-mark-gcc-as-read): Obsolete variable. + (gnus-inews-do-gcc): Use them. -1999-12-04 08:31:10 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-mark-article-read): Put holes into + gnus-newsgroup-unselected. - * gnus-audio.el: An M too far. +2002-01-06 Simon Josefsson - * gnus-msg.el (gnus-setup-message): One backtick too many. + * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): Use + condition-case, not ignore-errors. - * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is - a function, not a variable. +2002-01-06 ShengHuo ZHU -1999-12-04 08:14:08 Max Froumentin + * gnus-sum.el (gnus-summary-insert-old-articles): Bind + gnus-fetch-old-headers. - * gnus-score.el (gnus-score-body): Widen before requesting. + * gnus-art.el (article-display-x-face): Use the current buffer + unless `W f'. Otherwise, X-Face may be shown in the header of a + forwarded part. + (gnus-treatment-function-alist): Treat xface before hiding + headers. -1999-12-04 08:06:13 Lars Magne Ingebrigtsen +2002-01-06 Lars Magne Ingebrigtsen - * gnus-group.el (gnus-group-prepare-flat): Comment fix. + * gnus-group.el (gnus-group-read-ephemeral-group): Fix + parameters. -1999-12-04 03:01:55 Shenghuo ZHU +2002-01-06 ShengHuo ZHU - * mail-source.el (mail-source-fetch-webmail): Bind - mail-source-string. + * mm-util.el (mm-multibyte-p): Define conditionally when load. + (mm-guess-charset): New function. + (mm-charset-after): Use it. + (mm-detect-coding-region): New function. + (mm-detect-mime-charset-region): New function. -1999-12-04 07:18:23 Matt Swift + * gnus-sum.el (gnus-summary-show-article): Use + mm-detect-coding-region. - * gnus-uu.el (gnus-uu-mark-by-regexp): Doc fix. - (gnus-uu-unmark-by-regexp): Ditto. +2002-01-06 Lars Magne Ingebrigtsen - * gnus-group.el (gnus-group-catchup-current): Would bug out on - dead groups. + * message.el (message-make-fqdn): Be less violent. -1999-12-04 01:34:31 Lars Magne Ingebrigtsen + * gnus.el (gnus-logo-color-style): Compute custom form + automatically. - * gnus-msg.el (gnus-setup-message): Allow the charset setting to - do their real thing. + * gnus-sum.el (gnus-summary-enter-digest-group): Feed the adaptive + score file of the parent to the document group. - * nnmh.el (nnmh-be-safe): Doc fix. + * gnus-group.el (gnus-group-read-ephemeral-group): Add an optional + parameters parameter. - * gnus-sum.el (gnus-summary-exit): Write cache active file. + * gnus-score.el (gnus-score-load-file): Clean up. - * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire - status line has arrived before we count it. +2002-01-06 ShengHuo ZHU - * mailcap.el (mailcap-mime-data): Removed save-file from audio/*. + * gnus-sum.el (gnus-thread-sort-by-most-recent-number): Fix typo. + From: Damien Wyart - * gnus-sum.el (gnus-thread-header): Fixed after indent. - Whitespace problems. + * gnus-util.el (gnus-local-map-property): In Emacs 21, use keymap. - * gnus-win.el (gnus-configure-windows): Error fix. +2002-01-05 ShengHuo ZHU - * gnus-demon.el (gnus-demon-add-nntp-close-connection): Add the - right function. + * gnus-sum.el (gnus-select-group-hook): Typo. - * 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. + * rfc2047.el (rfc2047-decode-string): Return immediately if there + is no quoted-printable-encoded STRING. + From: Jesper Harder -1999-12-04 01:14:55 YAMAMOTO Kouji + (rfc2047-decode-string): Decode it. - * 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. +2002-01-05 Lars Magne Ingebrigtsen -1999-10-10 Robert Bihlmeyer + * gnus.el (gnus-logo-color-alist): Added more colors from Luis. - * mml.el (mml-insert-part): New function. +2002-01-05 Keiichi Suzuki + Trivial patch. -1999-09-29 04:48:14 Katsumi Yamaoka + * nntp.el (nntp-possibly-change-group): Erase contents of nntp + buffer to get rid of junk line. - * lpath.el: Add `sc-cite-regexp'. +2002-01-05 Simon Josefsson -1999-12-02 Dave Love + * message.el (message-mode-map): Bind message-goto-from to C-c C-f + C-o. + (message-mode-map): Bind message-insert-or-toggle-importance to + C-c C-u. + (message-mode-map): Bind message-disposition-notification-to to + C-c M-n. + (message-mode-menu): Add m-d-n-t. + (message-mode-field-menu): Add m-goto-from. + (message-mode): Doc fix. + (message-goto-from): New function. + (message-insert-disposition-notification-to): New function. + (message-tool-bar-map): Add receipt button. - * mm-decode.el: Customize. +2002-01-05 Lars Magne Ingebrigtsen -1999-12-03 Dave Love + * gnus-sum.el (gnus-thread-latest-date): New function. + (gnus-thread-sort-by-most-recent-number): Renamed. + (gnus-thread-sort-functions): Doc fix. + (gnus-select-group-hook): Don't use setq on a hook. + (gnus-thread-latest-date): Use date, not number - * nnslashdot.el, nnultimate.el: Don't lose at compile time when - the W3 stuff isn't available. + * gnus-agent.el (gnus-agent-expire-days): Doc fix. + (gnus-agent-expire): Allow regexp of expire-days. -1999-12-03 Dave Love + * gnus-art.el (gnus-article-reply-with-original): Deactivate + region. + (gnus-article-followup-with-original): Ditto. - * imap.el, mailcap.el, nnvirtual.el, rfc2104.el: Don't require cl - at runtime. + * gnus-sum.el (gnus-thread-highest-number): Doc fix. -1999-12-04 00:47:35 Dan Christensen + * gnus-art.el (gnus-mime-display-alternative): Use + gnus-local-map-property. + (gnus-mime-display-alternative): Ditto. + (gnus-insert-mime-security-button): Ditto. + (gnus-insert-next-page-button): Ditto. + (gnus-button-prev-page): Take optional args. + (gnus-insert-prev-page-button): widget-convert. - * gnus-score.el (gnus-score-headers): Fix orphan scoring. + * gnus-util.el (gnus-local-map-property): New function. -1999-12-01 Andrew Innes + * gnus-art.el (gnus-prev-page-map): Use parent map. + (gnus-next-page-map): Ditto. - * nnmbox.el (nnmbox-read-mbox): Count messages correctly, and - don't be fooled by "From nobody" lines added by respooling. + * gnus-spec.el (gnus-parse-format): Clean up. + (gnus-parse-format): Do complex formatting for %=. - * pop3.el (pop3-movemail): Write crashbox in binary. - (pop3-get-message-count): New function. + * gnus-fun.el (gnus-display-x-face-in-from): Add the string + "X-Face: " to the data in the built-in scenario. - * 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. + * gnus-spec.el (gnus-parse-simple-format): Use gnus-pad-form. + (gnus-correct-pad-form): Renamed. + (gnus-tilde-max-form): Clean up. + (gnus-pad-form): Use gnus-use-correct-string-widths. -1999-12-04 00:39:34 Andreas Schwab + * gnus-fun.el (gnus-display-x-face-in-from): Use native xface + support if that is available. - * gnus-cus.el (gnus-group-customize): Customize fix. + * gnus-sum.el (gnus-thread-highest-number): New function. + (gnus-thread-sort-by-most-recent-thread): New function. + (gnus-thread-sort-functions): Doc fix. -1999-12-04 00:38:24 Andrea Arcangeli +2002-01-04 ShengHuo ZHU - * message.el (message-send-mail-with-sendmail): Use - message-make-address. + * gnus-sum.el (gnus-summary-select-article): Disable multibyte in + all cases. + (gnus-summary-mode): Enable it in all cases. + (gnus-summary-display-article): Ditto. + (gnus-summary-edit-article): Ditto. -Fri Dec 3 20:34:11 1999 Lars Magne Ingebrigtsen + * gnus-ems.el (gnus-put-image): Really return glyph. - * gnus.el: Pterodactyl Gnus v5.8.2 is released. + * gnus-art.el (gnus-article-x-face-command): Fix :type. + (gnus-treat-smiley): Don't take "P" in the interactive form. -Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen +2002-01-04 Lars Magne Ingebrigtsen - * gnus.el: Pterodactyl Gnus v5.8.1 is released. + * compface.el (uncompface): XEmacs and Emacs have differing + capabilities. -1999-11-11 Hrvoje Niksic + * gnus-fun.el (gnus-display-x-face-in-from): Use face. - * 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. + * gnus-ems.el (gnus-article-xface-ring-internal): Removed. + (gnus-article-xface-ring-size): Removed. + (gnus-article-display-xface): Removed. + (gnus-remove-image): Cleaned up. -1999-12-03 08:49:53 Shenghuo ZHU + * gnus-xmas.el (gnus-xmas-create-image): Convert pbm to xbm. + (gnus-xmas-create-image): Take pbm files. + (gnus-x-face): Removed. + (gnus-xmas-article-display-xface): Removed. - * nnfolder.el (nnfolder-request-article): Return -1 if not find - the article number. + * gnus-fun.el (gnus-display-x-face-in-from): Bind + default-enable-multibyte-characters. -1999-12-03 01:12:41 Shenghuo ZHU + * compface.el (uncompface): Doc fix. - * gnus.el (gnus-find-method-for-group): The method of a new group - is not the native one. + * gnus-art.el (gnus-article-x-face-command): Use + gnus-display-x-face-in-from. -1999-12-03 01:26:55 Lars Magne Ingebrigtsen + * gnus-xmas.el (gnus-xmas-put-image): Return the image. - * gnus-art.el (gnus-button-embedded-url): Always call browse-url. + * gnus-ems.el (gnus-put-image): Return the image. -1999-12-02 18:00:15 Lars Magne Ingebrigtsen + * gnus-fun.el (gnus-display-x-face-in-from): New function. + (gnus-x-face): Moved here. - * nnultimate.el (nnultimate-retrieve-headers): Use - mm-with-unibyte-current-buffer. - (nnultimate-request-article): Ditto. +2002-01-04 ShengHuo ZHU -1999-12-02 14:57:46 Shenghuo ZHU + * gnus-xmas.el (gnus-xmas-put-image): Don't insert SPC or make + invisible if string is nil. + (gnus-xmas-article-display-xface): Use it. - * nntp.el (nntp-retrieve-groups): Set to process buffer. + * gnus-ems.el (gnus-put-image): Explicitly use SPC, and add text + property when string is nil. + (gnus-article-display-xface): Use it. -1999-12-02 11:14:50 Shenghuo ZHU +2002-01-04 Lars Magne Ingebrigtsen - * mm-util.el (mm-with-unibyte-current-buffer): New macro. - * nnweb.el (nnweb-retrieve-headers): Use it. - (nnweb-request-article): Use it. + * gnus-art.el (article-display-x-face): Check whether valid grey + face was returned. + (article-display-x-face): Place image in the right spot. - * nnweb.el (nnweb-dejanews-create-mapping): Set a default date in - case matching failed. + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Get rid of + stderr. + (gnus-convert-gray-x-face-to-xpm): Check whether output is valid. -1999-12-02 John Wiegley +2002-01-03 Lars Magne Ingebrigtsen - * mail-source.el (mail-source-keyword-map): Add backslash to - Delete-flag. + * gnus-xmas.el (gnus-xmas-create-image): Take optional + parameters. + (gnus-xmas-put-image): Allow non-strings to be passed. -1999-12-02 07:24:35 Lars Magne Ingebrigtsen + * gnus-art.el (article-display-x-face): Use optional parameters. - * gnus-sum.el (gnus-group-charset-alist): Default nnweb groups to - Latin-1. - (gnus-group-charset-alist): No, don't. + * gnus-ems.el (gnus-create-image): Take optional parameters. - * nnweb.el (nnweb-init): Make the buffer unibyte. + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface. -1999-12-01 23:02:48 Shenghuo ZHU + * compface.el (compface-xbm-p): Removed. - * mail-source.el (mail-source-set-common-1): Fix to get the - default value. + * gnus-ems.el (gnus-article-compface-xbm): Removed. + (gnus-article-display-xface): Use compface. -1999-12-02 00:27:46 Lars Magne Ingebrigtsen + * compface.el: New file. - * nnslashdot.el (nnslashdot-read-groups): Unibyte. + * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Remove quotes. + (gnus-convert-image-to-x-face-command): Ditto. + (gnus-random-x-face): Quote argument. + (gnus-x-face-from-file): Ditto. - * nnultimate.el (nnultimate-request-list): Use unibyte. +2002-01-03 Paul Jarc - * gnus-uu.el (gnus-uu-grab-articles): Bind - gnus-display-mime-function to nil. + * nnmaildir.el (nnmaildir-request-expire-articles): evaluate + the expire-group parameter once per article rather than once + per group; bind `nnmaildir-article-file-name' and `article' + for convenience. Leave article alone when expire-group + specifies the current group. + (nnmaildir--update-nov): be more concurrency-friendly with + temp file names. - * message.el (message-send-mail-with-sendmail): Use the - user-mail-address variable. +2002-01-03 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-ignored-headers): More headers. + * gnus-start.el (gnus-read-init-file): Cleaned up. - * message.el (message-shorten-1): Use list. +2002-01-03 Dave Love -1999-12-01 21:59:36 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-startup-file-coding-system): Removed. + (gnus-read-init-file): Don't use it. - * gnus-msg.el (gnus-configure-posting-styles): Ignore nil - signatures. +2002-01-03 Lars Magne Ingebrigtsen - * nnweb.el (nnweb-dejanews-create-mapping): Get the data. - (nnweb-dejanews-create-mapping): Do the properish date. + * gnus-agent.el (gnus-agent-fetch-session): Run hook. -1999-12-01 17:41:21 Shenghuo ZHU +2002-01-03 Kai Gro,b_(Bjohann - * 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. + * gnus-start.el (gnus-read-init-file): Don't force coding system + for ~/.gnus. From Dave Love . -1999-12-01 21:59:36 Lars Magne Ingebrigtsen +2002-01-03 ShengHuo ZHU - * mm-view.el (mm-inline-message): Check whether charset is a - string. + * nntp.el (nntp-send-buffer): Use mm-with-unibyte-current-buffer. + * nnspool.el (nnspool-request-post): Ditto. - * nnslashdot.el (nnslashdot-request-post): Insert

's. + * mm-util.el (mm-use-find-coding-systems-region): New variable. + (mm-find-mime-charset-region): Use it. - * message.el (message-mode-map): Changed keystroke for - message-yank-buffer. +2002-01-03 Per Abrahamsen -1999-11-26 Hrvoje Niksic + * gnus.el (gnus-summary-line-format): Added :link. + * gnus-topic.el (gnus-topic-line-format): Ditto. + * gnus-sum.el (gnus-summary-dummy-line-format): Ditto. + * gnus-srvr.el (gnus-server-line-format): Ditto. + * gnus-group.el (gnus-group-line-format): Ditto. - * 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. + * gnus-sum.el (gnus-summary-make-menu-bar): Use correct syntax for + :keys, it works on both Emacsen. -1999-12-01 21:47:10 Eric Marsden +2002-01-03 ShengHuo ZHU - * nnslashdot.el (nnslashdot-lose): New function. + * mm-util.el (mm-charset-to-coding-system): Don't setq charset. -1999-12-01 21:08:48 Lars Magne Ingebrigtsen +2002-01-03 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. + * gnus-msg.el (gnus-summary-send-map): Fix binding for very-wide. -1999-11-24 Carsten Leonhardt +2002-01-03 Reiner Steib - * mail-source.el (mail-source-fetch-maildir): work around the - ommitted "file-regular-p" in efs/ange-ftp + * gnus-sum.el (gnus-summary-make-menu-bar): Menu bar entries for + very wide reply. -1999-12-01 19:59:25 Lars Magne Ingebrigtsen +2002-01-03 Lars Magne Ingebrigtsen - * mml.el (mml-generate-mime-1): Don't insert extra empty line. - (mml-generate-mime-1): Use the encoding param. + * gnus-picon.el (gnus-picon-transform-address): Cache stuff. + (gnus-picon-cache): New variable. + (gnus-picon-transform-newsgroups): Cache stuff. - * gnus-sum.el (gnus-summary-show-article): Don't bind gnus-visual. + * gnus-art.el (gnus-article-reply-with-original): New command. + (gnus-article-followup-with-original): New command. - * gnus-cache.el (gnus-cache-possibly-enter-article): Require - gnus-art before binding its variables. + * gnus-msg.el (gnus-copy-article-buffer): Take optional BEG and + END parameters. + (gnus-summary-followup): Take a list of list of articles. + (gnus-inews-yank-articles): Allow lists of article/regions. - * gnus-art.el (gnus-article-prepare-display): Run the prepare - after the MIME. + * gnus-art.el (gnus-article-read-summary-keys): `R' and `F' are no + longer the usual commands. -1999-12-01 19:48:14 Rupa Schomaker + * gnus-fun.el (gnus-convert-image-to-gray-x-face): Use pnmnoraw. + (gnus-convert-gray-x-face-to-xpm): Don't use six parameters to + shell-command-on-region. - * message.el (message-clone-locals): Use it. +2002-01-02 ShengHuo ZHU - * gnus-msg.el (gnus-configure-posting-styles): Make - user-mail-address local. + * gnus-picon.el (gnus-picon-transform-newsgroups): Fix for the case + "Newsgroups: rec.music.beatles.moderated, rec.music.beatles". -1999-11-20 Simon Josefsson +2002-01-03 Steve Youngs - * gnus-start.el (gnus-get-unread-articles): Scan each method only - once. + * gnus-sum.el (gnus-summary-make-menu-bar): XEmacs doesn't + understand ':keys', wrap it in an featurep 'xemacs. -1999-12-01 17:37:18 Lars Magne Ingebrigtsen +2002-01-02 ShengHuo ZHU - * message.el (message-generate-new-buffer-clone-locals): Use varstr. - (message-clone-locals): Ditto. + * gnus-ems.el (gnus-article-display-xface): Show xface in the + order of headers (Actually, it is called in a reversed order). Add + 'gnus-image-text-deletable property. + (gnus-remove-image): Remove text with such a property. - * gnus-sum.el (gnus-summary-enter-digest-group): Have the digest - group inherit reply-to or from. + * gnus-xmas.el (gnus-xmas-article-display-xface): Don't use + gnus-put-image. -1999-12-01 13:04:09 Shenghuo ZHU + * gnus-art.el (gnus-article-treat-fold-newsgroups): Replace ", *" + with ", " - * gnus-sum.el (gnus-summary-show-article): Support numbered ARG - for charset. - (gnus-summary-show-article-charset-alist): New variable. +2002-01-02 Lars Magne Ingebrigtsen - * mm-bodies.el (mm-decode-string): Support gnus-all and - gnus-unknown. - (mm-decode-body): Ditto. - * rfc2047.el (rfc2047-decode): Ditto. + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed. -1999-12-01 17:37:18 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-ignored-headers): Hide all X-Faces. + (article-display-x-face): Display grey X-Faces. - * mail-source.el (mail-source-delete-incoming): Change default to - t. + * gnus-fun.el (gnus-convert-gray-x-face-region): New function. + (gnus-convert-gray-x-face-to-ppm): Ditto. + (gnus-convert-image-to-gray-x-face): Ditto. -Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-make-menu-bar): Add a :keys to + gnus-summary-show-raw-article. - * gnus.el: Pterodactyl Gnus v0.99 is released. +2002-01-02 ShengHuo ZHU -1999-12-01 14:28:49 Lars Magne Ingebrigtsen + Display picons in XEmacs without showing text. - * dgnushack.el (dgnushack-compile): No webmail under Emacs. + * gnus-xmas.el (gnus-xmas-create-image): Don't use + mm-create-image-xemacs to create xbm glyph, because it deletes + temporary files. + (gnus-xmas-put-image): Use end-glyph. Make text invisible. + (gnus-xmas-remove-image): Make text visible, remove glyph. - * gnus-sum.el (gnus-summary-refer-article): Wrong interactive - spec. + * gnus-picon.el (gnus-picon-transform-newsgroups) + (gnus-picon-transform-address): Insert spec backward, due to the + incompatibility of gnus-xmas-put-image. - * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'. - (gnus-configure-posting-styles): No, don't. - (gnus-configure-posting-styles): Allow overriding files. +2002-01-02 Pavel Jan,Am(Bk - * gnus-art.el (gnus-header-button-alist): Use browse-url - directly. + * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Doc fix. - * mm-decode.el (mm-inline-media-tests): Check feature vcard. +2002-01-02 Lars Magne Ingebrigtsen - * gnus-msg.el (gnus-summary-yank-message): New command and - keystroke. + * gnus.el: Doc fix. - * message.el (message-yank-buffer): New command. - (message-buffers): New function. + * gnus-art.el: Doc fix. - * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Select - next group in a more normal fasion. + * gnus-agent.el: Doc fix. - * mml.el (mml-boundary-function): New variable. - (mml-compute-boundary): Use it. +2002-01-01 ShengHuo ZHU - * nnmh.el (nnmh-active-number): Skip past files that have buffers - that exist for them. + * gnus-diary.el, gnus-delay.el: Fix copyright lines. - * gnus-async.el (gnus-async-prefetch-next): Cancel timers. - (gnus-async-timer): New variable. +2002-01-01 Paul Jarc -1999-11-30 02:07:18 Lars Magne Ingebrigtsen + * nnmaildir.el (nnmaildir--update-nov): automatically parse + NOV data out of the message again if nnmail-extra-headers has + changed. - * nnultimate.el (nnultimate-request-list): Be more lenient with - root addresses. +2002-01-02 Lars Magne Ingebrigtsen -1999-11-28 20:22:37 Lars Magne Ingebrigtsen + * gnus-fun.el: New file. + (gnus-convert-image-to-x-face-command): New variable. + (gnus-insert-x-face): New function. + (gnus-random-x-face): Renamed. + (gnus-x-face-from-file): Renamed. - * gnus-art.el (gnus-treatment-function-alist): Do - gnus-treat-capitalize-sentences. + * gnus-art.el (gnus-body-boundary-delimiter): Changed default to + "_". + (gnus-body-boundary-delimiter): Typo fix. -1999-11-30 09:07:53 Shenghuo ZHU +2002-01-02 Simon Josefsson - * webmail.el (webmail-hotmail-article): Hotmail changes the - format. + * gnus-art.el (gnus-article-treat-body-boundary): Handle nil. + (gnus-body-boundary-delimiter): Fix type. -1999-11-29 Simon Josefsson +2002-01-01 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". + * gnus-art.el (gnus-treat-buttonize, gnus-treat-buttonize-head) + (gnus-treat-emphasize, gnus-treat-strip-cr) + (gnus-treat-leading-whitespace, gnus-treat-hide-headers) + (gnus-treat-hide-boring-headers, gnus-treat-hide-signature) + (gnus-treat-fill-article, gnus-treat-hide-citation) + (gnus-treat-hide-citation-maybe) + (gnus-treat-strip-list-identifiers, gnus-treat-strip-pgp) + (gnus-treat-strip-pem, gnus-treat-strip-banner) + (gnus-treat-highlight-headers, gnus-treat-highlight-citation) + (gnus-treat-date-ut, gnus-treat-date-local) + (gnus-treat-date-english, gnus-treat-date-lapsed) + (gnus-treat-date-original, gnus-treat-date-iso8601) + (gnus-treat-date-user-defined, gnus-treat-strip-headers-in-body) + (gnus-treat-strip-trailing-blank-lines) + (gnus-treat-strip-leading-blank-lines) + (gnus-treat-strip-multiple-blank-lines) + (gnus-treat-unfold-headers, gnus-treat-fold-headers) + (gnus-treat-fold-newsgroups, gnus-treat-overstrike) + (gnus-treat-display-xface, gnus-treat-display-smileys) + (gnus-treat-from-picon, gnus-treat-mail-picon) + (gnus-treat-newsgroups-picon, gnus-treat-body-boundary) + (gnus-treat-capitalize-sentences, gnus-treat-fill-long-lines) + (gnus-treat-play-sounds, gnus-treat-translate) + (gnus-treat-x-pgp-sig): Doc fix, add link to manual. -1999-11-27 15:21:25 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-body-boundary-delimiter): New variable. + (gnus-article-treat-body-boundary): Use it. - * nnultimate.el (nnultimate-possibly-change-server): Don't always - read groups file. + * message.el (message-mode): Fix doc. + (message-mode-menu): Fix names. - * nnslashdot.el (nnslashdot-request-article): Convert

to -

. +2002-01-01 Lars Magne Ingebrigtsen -1999-11-24 20:18:24 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-first-subject): Really go to unseen + articles. - * message.el (message-mode): Doc fix. + * gnus-picon.el (gnus-picon-find-face): Search MISC for all types. + (gnus-picon-transform-address): Search for unknown faces as well. + (gnus-picon-find-face): Don't search "news" for MISC. + (gnus-picon-user-directories): Changed default back to exclude + "unknown". -1999-11-24 09:25:00 Shenghuo ZHU + * gnus-sum.el (gnus-summary-hide-all-threads): Reversed logic. - * gnus-art.el (article-emphasize): Check group variable. - * rfc1843.el (rfc1843-decode-article-body): Ditto. + * gnus-picon.el (gnus-picon-find-face): Search through all + databases. + (gnus-picon-find-face): New implementation. -1999-11-24 00:11:27 Shenghuo ZHU + * gnus-topic.el (gnus-topic-goto-previous-topic): New command and + keystroke. + (gnus-topic-goto-next-topic): Ditto. - * mm-decode.el (mm-save-part-to-file): Inhibit jka-compr for any - type. + * gnus.el (gnus-summary-line-format): Changed default. -1999-11-23 17:21:05 Shenghuo ZHU + * nnmail.el (nnmail-extra-headers): Change default. - * webmail.el: Support www.netaddress.com, i.e. usa.net. + * gnus-sum.el (gnus-extra-headers): Change default. -1999-11-23 Hrvoje Niksic + * message.el (message-news-other-window): Changed "news" to + "posting". + (message-news-other-frame): Ditto. + (message-do-send-housekeeping): Ditto. - * mml.el (mml-quote-region): Insert ! after the hash. + * gnus-sum.el (gnus-summary-maybe-hide-threads): Use predicate + function. + (gnus-article-unread-p): New function. + (gnus-article-unseen-p): New function. + (gnus-dead-summary-mode-map): Typo. -1999-11-23 05:08:23 Shenghuo ZHU + * gnus-util.el (gnus-make-predicate): New function. + (gnus-make-predicate-1): New function. - * gnus-group.el (gnus-group-warchive-address-history): Change to - nil. + * gnus-sum.el: New function. + (gnus-map-articles): New function. -1999-11-23 02:33:13 Shenghuo ZHU + * gnus-art.el (gnus-treat-fold-headers): New variable. + (gnus-article-treat-fold-headers): New command and keystroke. - * webmail.el: Support mail.yahoo.com. + * gnus-sum.el (gnus-dead-summary-mode-map): Clean up. + (gnus-dead-summary-mode-map): Bind q to bury-buffer. - * mail-source.el (mail-source-fetch-webmail): Add password check. - (mail-source-keyword-map): Use `subtype'. +2002-01-01 ShengHuo ZHU -1999-11-22 04:35:43 Shenghuo ZHU + * message.el (message-fcc-externalize-attachments): New variable. + (message-do-fcc): Use it. - * mail-source.el (mail-source-keyword-map): Add webmail. - (mail-source-fetcher-alist): Ditto. - (mail-source-fetch-webmail): New function. - * webmail.el: New file. + * gnus-msg.el (gnus-gcc-externalize-attachments): New variable. + (gnus-inews-do-gcc): Use it. -1999-11-21 12:20:02 Shenghuo ZHU + * mml.el (mml-tweak-sexp-alist): New variable. + (mml-externalize-attachments): New variable. + (mml-tweak-part): Use mml-tweak-sexp-alist. + (mml-tweak-externalize-attachments): New function. - * nnwarchive.el (nnwarchive-request-group): Print 0 if it is nil. +2002-01-01 Steve Youngs -1999-11-21 12:19:11 Shenghuo ZHU + * gnus-xmas.el (gnus-xmas-article-display-xface): Uncomment + 'set-glyph-face' so x-face back/foreground can be set. - * mailcap.el (mailcap-parse-mailcap): Don't skip double semicolon. +2001-12-31 ShengHuo ZHU -1999-11-20 12:54:25 Lars Magne Ingebrigtsen + * message.el (message-fix-before-sending): Fix a typo. - * 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. +2002-01-01 Lars Magne Ingebrigtsen -1999-11-19 12:17:25 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-treat-smiley): Renamed command. + (gnus-article-remove-images): New command and keystroke. - * nnslashdot.el (nnslashdot-sane-retrieve-headers): Fix to match - threaded subjects. + * gnus-sum.el (gnus-summary-toggle-smiley): Removed. -1999-11-20 02:22:52 Shenghuo ZHU + * smiley-ems.el (gnus-smiley-display): Removed. - * nnwarchive.el: Lots of changes make agent happy. + * gnus.el (gnus-version-number): Update version. -1999-11-19 21:37:41 Shenghuo ZHU + * message.el (message-text-with-property): Renamed and moved + here. + (message-fix-before-sending): Highlight invisible text and place + point there. - * gnus-start.el (gnus-get-unread-articles): Assert group is in - hashtb. +2002-01-01 02:32:53 Lars Magne Ingebrigtsen -1999-11-19 19:53:08 Shenghuo ZHU + * gnus.el: Oort Gnus v0.04 is released. - * mm-decode.el (mm-display-external): Write region with binary - mode. +2002-01-01 Lars Magne Ingebrigtsen -1999-11-18 14:52:05 Shenghuo ZHU + * gnus-delay.el (gnus-delay-send-queue): Renamed. - * nnweb.el (nnweb-dejanews-create-mapping): Bind `text'. + * gnus-art.el (gnus-ignored-headers): More headers, -1999-11-18 14:35:01 Shenghuo ZHU + * ietf-drums.el (ietf-drums-parse-addresses): Use `error' instead + of `scan-error', since XEmacs doesn't seem to support that. - * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'. - (mm-uu-test): Now it is in restricted region. +2001-12-31 Lars Magne Ingebrigtsen - * gnus-art.el (article-decode-charset): Don't mm-uu-test. + * gnus-sum.el (gnus-summary-best-unread-article): Take a prefix + arg. + (gnus-summary-best-unread-subject): Ditto. + (gnus-summary-best-unread-subject): No, don't. + (gnus-summary-better-unread-subject): New command. - * mm-view.el (mm-view-message): Fix buffer leak. - (mm-inline-message): Support 'gnus-decoded. + * gnus-xmas.el (gnus-xmas-put-image): Insert the string itself. - * mm-bodies.el (mm-decode-body): Ditto. + * lpath.el ((featurep 'xemacs)): fbind url function. - * rfc2047.el (rfc2047-decode-region): Ditto. + * gnus-xmas.el (gnus-xmas-article-display-xface): Use data, not + buffer. + (gnus-xmas-remove-image): Implementation that does something. + (gnus-xmas-article-display-xface): Mark images properly. -1999-11-18 Matthias Andree + * gnus-art.el (gnus-mime-print-part): Use mm-temp-directory. - * imap.el (require): Added autoload for base64-encode-string. +2001-12-31 Florian Weimer -1999-11-17 Per Abrahamsen + * gnus.el (gnus): Warn if trying to run Gnus un-byte-compiled. - * gnus.el (gnus-refer-article-method): Made list value - customizable. +2001-12-31 Lars Magne Ingebrigtsen -1999-11-17 13:09:37 Shenghuo ZHU + * gnus-group.el (gnus-group-line-format): Added %O to the default + value. - * gnus-sum.el (gnus-summary-recenter): set-window-start with - NOFORCE in Emacs case. + * gnus-util.el (gnus-text-with-property): The smallest point is + point-min. -1999-11-17 13:04:01 Shenghuo ZHU + * smiley-ems.el (smiley-region): Return images. + (gnus-smiley-display): Allow toggling. + (smiley-region): Use text properties, not overlays. - * gnus-art.el (gnus-request-article-this-buffer): Set - gnus-newsgroup-name. + * gnus-xmas.el (gnus-xmas-remove-image): New function, not + implemented yet. -1999-11-16 23:53:22 Shenghuo ZHU + * smiley-ems.el (smiley-update-cache): Check for valid types. - * gnus-xmas.el (gnus-xmas-summary-recenter): set-window-start with - NOFORCE. + * gnus-art.el (gnus-with-article-buffer): New macro. -1999-11-17 Simon Josefsson + * gnus-picon.el (gnus-picon-transform-newsgroups): Keep the + strings as well as the glyphs. + (gnus-picon-transform-address): Ditto. + (gnus-picon-insert-glyph): Ditto. + (gnus-picon-transform-newsgroups): Toggle. + (gnus-picon-transform-address): Toggle. - * gnus-start.el (gnus-get-unread-articles): Check server before - scanning. + * gnus-ems.el (gnus-remove-image): New function. + (gnus-put-image): Take an optional string. -1999-11-16 10:01:03 Lars Magne Ingebrigtsen + * gnus-util.el (gnus-text-with-property): New function. - * gnus.el (gnus-valid-select-methods): nnslashdot is news. + * gnus-art.el (gnus-delete-images): New function. - * nnslashdot.el (nnslashdot-login-name): New variable. - (nnslashdot-password): Ditto. - (nnslashdot-request-post): New function. + * gnus-ems.el (gnus-article-display-xface): Mark and store image. - * gnus-art.el (gnus-treat-buttonize): More testing. + * gnus-art.el (gnus-article-wash-status-entry): Renamed. + (gnus-article-wash-status): Use it. + (gnus-signature-toggle): Clean up. + (gnus-add-wash-status): New function. + (gnus-delete-wash-status): New function. + (gnus-article-hide-text-type): Use them throughout. + (gnus-add-image): New function. - * mm-encode.el: Another CVS test. + * gnus-ems.el (gnus-article-display-xface): Use new interface. - * gnus-art.el (gnus-treat-emphasize): Change default. - (gnus-treat-buttonize): Ditto. - (gnus-treat-buttonize): This is a test. + * gnus-xmas.el (gnus-xmas-article-display-xface): Use new + interface. - * gnus-sum.el (gnus-build-old-threads): Bind mail-parse-charset. - (gnus-build-sparse-threads): Ditto. - (gnus-build-all-threads): Ditto. + * gnus-art.el (article-display-x-face): Cleaned up. - * nnheader.el (make-full-mail-header): Make into a subst. + * rfc2047.el (rfc2047-field-value): New function. - * dgnushack.el (dgnushack-compile): Skip all w3-dependent files - unless w3 is supplied. + * mail-parse.el (mail-header-field-value): New alias. - * gnus.el (gnus-refer-article-method): Doc fix. + * gnus-art.el (gnus-mime-print-part): Fix typos. - * gnus-sum.el: Do not accept a prefix. - (gnus-summary-refer-article): Accept a list of select methods. + * smiley-ems.el (gnus-smiley-file-types): New variable. + (smiley-update-cache): Use it. + (smiley-regexp-alist): Suffix-less smiley names. + (smiley-regexp-alist): Added more smileys. -1999-11-15 21:28:40 Shenghuo ZHU + * gnus-sum.el (gnus-print-buffer): Made into own function. + (gnus-summary-print-article): Use it. - * Makefile.in: Change `^ *' to `\t'. + * mailcap.el (mailcap-mime-info): Actually return the bit that we + looked for when REQUEST is a string. -1999-11-11 Matt Pharr + * gnus-art.el (gnus-mime-button-commands): Add printing + keystroke. + (gnus-mime-copy-part): Doc fix. + (gnus-mime-print-part): New command. - * 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. +2001-12-31 Simon Josefsson -1999-11-15 20:44:50 William M. Perry + * imap.el (imap-parse-fetch): Notice empty flags responses. From + Nic Ferrier . - * dgnushack.el (dgnushack-compile): Vpath file. +2001-12-30 ShengHuo ZHU - * Makefile.in (SHELL): VPATH support. + * gnus-picon.el (gnus-treat-from-picon): Autoload. + (picon): Fix doc. -1999-11-15 20:37:17 Lars Magne Ingebrigtsen + * gnus-win.el (gnus-window-to-buffer): gnus-picon-buffer-name no + longer exists. Remove those codes. + * gnus.el (gnus-use-picons): Ditto. - * gnus-ems.el: Check for cygwin32. +2001-12-30 Lars Magne Ingebrigtsen -1999-11-14 18:15:28 Shenghuo ZHU + * gnus-art.el (gnus-article-treat-fold-newsgroups): Don't + infloop. - * mm-decode.el (mm-display-external): Use 'non-viewer. + * gnus-sum.el (t): New `W D' map. -1999-11-14 15:21:06 Shenghuo ZHU + * gnus-art.el (gnus-treat-fold-newsgroups): New variable. + (gnus-article-treat-body-boundary): Clean up. + (gnus-body-boundary-face): Removed. + (gnus-article-goto-header): Moved here. + (gnus-article-goto-header): Allow better regexps. + (gnus-article-treat-fold-newsgroups): New command. - * base64.el (base64-encode-string): An alias for base64-encode for - compatibility. + * gnus-sum.el (gnus-summary-move-article): We have to select an + article to give `gnus-read-move-group-name' an opportunity to + suggest an appropriate default. -1999-11-14 01:58:18 Shenghuo ZHU + * rfc2047.el (rfc2047-fold-line): New function. + (rfc2047-unfold-line): Ditto. + (rfc2047-fold-region): Don't fold just after the header name. - * nntp.el (nntp-retrieve-groups): Erase nntp-sever-buffer before - nntp-inhibit-erase. + * mail-parse.el (mail-header-fold-line): New alias. + (mail-header-unfold-line): Ditto. -1999-11-13 Simon Josefsson + * gnus-art.el (gnus-body-boundary-face): Renamed. + (gnus-article-treat-body-boundary): Use it. + (gnus-article-treat-body-boundary): Use an invisible header and a + line of underline characters. - * 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. +2001-12-30 ShengHuo ZHU -1999-11-13 17:59:18 Lars Magne Ingebrigtsen + * ietf-drums.el (ietf-drums-parse-addresses): Recover from errors. - * mm-util.el (mm-find-mime-charset-region): Make sure - find-coding-systems-for-charsets is fbound. + * gnus-picon.el (gnus-picon-transform-address): Skip bad addresses. + (gnus-picon-split-address): New function. + (gnus-picon-find-face): Use it. + (gnus-picon-transform-address): Use it. Set first to t for each + address. - * gnus-ems.el: Typo fix. + * gnus-art.el (gnus-with-article-headers): Move to here. Define + the macro then use it. + (gnus-treatment-function-alist): Treat picons earlier. -1999-11-13 Florian Weimer +2001-12-30 Lars Magne Ingebrigtsen - * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if - it's available and makes sense. + * gnus-art.el (gnus-body-separator-face): New variable. + (gnus-article-treat-body-boundary): Use a blank, colored line. -1999-11-12 19:56:23 Fabrice POPINEAU + * gnus-picon.el (gnus-picon-find-face): Look into misc/MISC as + well. - * gnus-score.el (gnus-score-save): Translate score file. + * gnus-art.el (gnus-treat-body-boundary): New variable. + (gnus-article-treat-unfold-headers): Use helper macro. + (gnus-article-treat-body-boundary): New command. -1999-11-13 Simon Josefsson + * gnus.el (gnus-logo-color-style): Change the default color. + (gnus-splash-face): Gray, gray. - * mail-source.el (mail-source-keyword-map): For IMAP mail source, - added fetchflag and dontexpunge keywords. - (mail-source-fetch-imap): Use them. + * gnus-xmas.el (gnus-xmas-group-startup-message): Use general + colors. -1999-11-12 Per Abrahamsen + * gnus.el (gnus-logo-color-alist): Moved here and renamed. + (gnus-logo-color-style): Ditto. + (gnus-logo-colors): Ditto. - * gnus-start.el (gnus-level-subscribed, gnus-level-unsubscribed, - gnus-level-zombie, gnus-level-killed): Changed from `defcustom' to - `defconst'. + * gnus-picon.el (gnus-picon-create-glyph): Cache glyphs. - * 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-art.el (gnus-treat-newsgroups-picon): New variable. - * gnus.el (gnus-select-method): Added default value and tag. - (gnus-refer-article-method): Added `DejaNews' customization option. + * gnus-picon.el (gnus-treat-newsgroups-picon): New function. + (gnus-picon-transform-newsgroups): New function. -1999-11-12 05:04:43 Lars Magne Ingebrigtsen + * ietf-drums.el (ietf-drums-parse-addresses): Accept a nil + string. - * gnus-int.el (gnus-server-opened): Ignore denied servers. + * gnus-picon.el (gnus-treat-mail-picon): Renamed. - * gnus-ems.el (gnus-mule-max-width-function): New backquote - syntax. + * gnus-art.el (gnus-treat-cc-picon): New variable. + (gnus-treat-mail-picon): Renamed. - * nndoc.el (nndoc-mime-digest-type-p): Reinstated. + * gnus-picon.el: New implementation. + (gnus-picon-find-face): Renamed. + (gnus-treat-from-picon): Use it. + (gnus-picon-transform-address): Renamed. + (gnus-treat-from-picon): Use it. + (gnus-picon-create-glyph): Renamed. + (gnus-picon-transform-address): Use it. + (gnus-treat-cc-picon): New command. - * nnslashdot.el (nnslashdot-group-number): Changed default. + * mm-decode.el (mm-create-image-xemacs): Separated out into + function. + (mm-get-image): Use it. - * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja. - (nnweb-dejanews-wash-article): Removed. - (nnweb-type-definition): Fetch by id. + * gnus-art.el (gnus-treat-display-picons): Simplify. + (gnus-treat-from-picon): Renamed. - * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless - we mean it. + * gnus-ems.el (gnus-create-image): New function. + (gnus-put-image): New function. - * 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-article-treat-unfold-headers): Doc fix. + (gnus-with-article-headers): New macro. + (gnus-article-goto-header): New function. -1999-11-11 17:40:54 Lars Magne Ingebrigtsen + * gnus-xmas.el (gnus-image-type-available-p): New function. - * gnus-art.el (gnus-mime-internalize-part): Doc fix. + * gnus-ems.el (gnus-image-type-available-p): New function. -1999-11-11 14:32:48 Steinar Bang +2001-12-30 ShengHuo ZHU - * nnweb.el (nnweb-type-definition): /=dnc + * nnrss.el (nnrss-check-group): Find the correct tag, because + xml.el is changed. -1999-11-11 10:58:38 Lars Magne Ingebrigtsen +2001-12-30 Lars Magne Ingebrigtsen - * nnultimate.el (nnultimate-retrieve-headers): Work with american - dates. - (nnultimate-retrieve-headers): Wrong ordering. + * gnus-art.el (gnus-article-treat-unfold-headers): Only fold when + lines are shorter than the window width. + (gnus-ignored-headers): More headers. -1999-11-11 07:31:51 Matt Pharr +2001-12-29 Lars Magne Ingebrigtsen - * message.el (message-forward-as-mime): New variable. + * gnus-art.el (gnus-treat-unfold-lines): New variable. + (gnus-treat-unfold-headers): Renamed. + (gnus-article-treat-unfold-headers): New command and keystroke. -1999-11-11 05:24:13 Lars Magne Ingebrigtsen + * rfc2047.el (rfc2047-encode-message-header): Clean up. - * gnus-util.el (gnus-dd-mmm): Beware buggy dates. + * gnus-int.el (gnus-open-server): Mark quit-ed server as denied. -1999-11-10 16:50:01 Shenghuo ZHU +2001-12-29 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. + * sha1-el.el (sha1-use-external): New variable. + (sha1-region): Use it. + (sha1-string): Ditto. -1999-11-10 13:48:10 Shenghuo ZHU + * dgnushack.el (dgnushack-compile): Compile gnus-picon for Emacs. + * gnus-picon.el: Less warnings when compile. - * nnwarchive.el: New file. - * gnus-group.el (gnus-group-make-warchive-group): New function. - * gnus.el (gnus-valid-select-methods): Add `nnwarchive'. +2001-12-29 Lars Magne Ingebrigtsen -1999-11-10 12:13:30 Lars Magne Ingebrigtsen + * gnus-picon.el (gnus-picons-news-directories): Removed obsolete + alias. + (gnus-picons-database): Default to list. + (gnus-picons-lookup-internal): Use it. - * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page - subjects. + * nnmail.el (nnmail-article-group): Default nnmail-split-methods + to "bogus". -1999-11-10 11:33:23 Rajappa Iyer + * gnus-win.el (gnus-configure-windows-hook): New hook. - * gnus-salt.el (gnus-pick-article-or-thread): Don't move point. +2001-12-29 Sascha L,A|(Bdecke -1999-11-10 05:22:56 Lars Magne Ingebrigtsen + * gnus-win.el (gnus-configure-windows): Minimize tree buffer. - * nnultimate.el (nnultimate-open-server): Do address. - (nnultimate-forum-table-p): New function. +2001-12-29 Lars Magne Ingebrigtsen - * nnweb.el (nnweb-insert-html): Renamed. - (nnweb-insert): New function. + * gnus-sum.el (gnus-update-marks): Don't uncompress the seen + lists. + (gnus-select-newsgroup): Don't append; push. + (gnus-adjust-marked-articles): Remove obsolete ranges from + `seen'. + (gnus-update-marks): Clean up. + (gnus-select-newsgroup): Don't stomp gnus-newsgroup-seen. - * nnultimate.el (nnultimate-insert-html): New function. +2001-12-29 Frank Schmitt - * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything - if nov is evil. - (nnslashdot-retrieve-headers): use the sane version instead. + * gnus-sum.el (gnus-summary-limit-to-age): Allow negative days. -1999-11-09 00:13:25 Lars Magne Ingebrigtsen +2001-12-29 Lars Magne Ingebrigtsen - * nnslashdot.el (nnslashdot-request-article): Fold case. + * gnus-sum.el (gnus-auto-select-subject): New variable. + (gnus-summary-best-unread-subject): New function. + (gnus-summary-best-unread-article): Use it. + (gnus-summary-first-unseen-subject): New function and command. - * nnultimate.el: New file. + * gnus-art.el (gnus-treatment-function-alist): Emphasize after + other treatments. - * nnslashdot.el (nnslashdot-retrieve-headers): Skip the article - unless wanted. + * gnus-util.el (gnus-put-overlay-excluding-newlines): New + function. - * 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. + * gnus-art.el (gnus-article-show-hidden-text): Remove the type + from the list of hidden types. - * nnslashdot.el (nnslashdot-request-article): Search better on - first article. - (nnslashdot-request-list): Fold case. - (nnslashdot-retrieve-headers): Ditto. + * mm-view.el (mm-inline-text): Ditto. + (mm-inline-text): Ditto. + (mm-w3-prepare-buffer): Ditto. -1999-11-08 05:33:15 Lars Magne Ingebrigtsen + * gnus-art.el (article-wash-html): Inhibit more remote fetching. - * gnus.el: Autoload gnus-subscribe-topics. +2001-12-29 Lars Magne Ingebrigtsen -1999-11-07 22:56:46 Shenghuo ZHU + * gnus-art.el (gnus-ignored-headers): Added more headers. - * gnus-agent.el (gnus-agent-save-group-info): Remove backslash - before dot. - * gnus-util.el (gnus-write-active-file): Ditto. +2001-12-29 Jesper Harder -1999-11-07 22:31:10 Shenghuo ZHU + * gnus-srvr.el (gnus-browse-foreign-server): Compute the prefix + once. - * 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. +2001-12-29 Lars Magne Ingebrigtsen -1999-11-07 21:07:55 Shenghuo ZHU + * gnus-srvr.el (gnus-server-browse-in-group-buffer): Doc fix. - * 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. +2001-12-28 Simon Josefsson -1999-11-07 20:03:16 Shenghuo ZHU + * gnus-srvr.el (gnus-browse-foreign-server): Fix typo. From + Jesper Harder . - * gnus-srvr.el (gnus-browse-foreign-server): Keep using `read' to - support nnslashdot. +2001-12-27 Simon Josefsson -1999-11-08 00:06:02 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-select-newsgroup): Make + `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen' + contain all articles (instead of none) when no seen marks have + been set for the group. + (gnus-update-marks): Use `gnus-range-add' on a uncompressed list + instead, it seems to result in shorter ranges. - * nnslashdot.el (nnslashdot-retrieve-headers): Don't fetch too - many articles. - (nnslashdot-generate-active): New function. - (nnslashdot-request-newgroups): Use it. +2001-12-26 11:00:00 ShengHuo ZHU - * gnus-start.el (gnus-active-to-gnus-format): Intern strings group - names. + * mm-util.el (mm-iso-8859-x-to-15-region): Use + insert-before-markers. + From Jesper Harder - * nnslashdot.el (nnslashdot-request-newgroups): New function. - (nnslashdot-request-list): Not moderated. +2001-12-26 Paul Jarc -1999-11-07 Simon Josefsson + * nnmaildir.el (nnmaildir-save-mail): create the destination + groups if they do not exist. - * nnimap.el (nnimap-open-server): Remove error signal if - nnimap-server-buffer is nil (the check should've been `boundp'). +2001-12-26 Katsumi Yamaoka - * imap.el (imap-log): - * nnimap.el (nnimap-debug): Disable debugging by default. + * canlock.el (canlock-sha1-with-openssl): Remove unused variable. -1999-11-07 01:17:53 Lars Magne Ingebrigtsen +2001-12-22 22:00:00 ShengHuo ZHU - * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix. + * gnus-group.el (gnus-group-read-ephemeral-group): Call + gnus-group-real-name. - * gnus-topic.el (gnus-subscribe-topic): New function. + * gnus-sum.el (gnus-decode-encoded-word-methods): Backslash paren. + (gnus-newsgroup-variables): Ditto. - * nnslashdot.el (nnslashdot-request-list): Give out extended group - names. + * gnus.el (gnus-group-prefixed-name): If group name is prefixed, + return it. - * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars - if starting with a quote. +2001-12-21 Paul Jarc -1999-11-07 13:06:11 Shenghuo ZHU + * gnus.el (gnus-valid-select-methods): Include nnmaildir. + * nnmaildir.el (top-level): Add commentary. + (nnmaildir-version): Indicate that nnmaildir is now a standard + part of Gnus, not separately released. - * gnus-srvr.el (gnus-browse-foreign-server): Support backslash in - group name. +2001-12-21 08:00:00 ShengHuo ZHU -1999-11-07 01:17:53 Lars Magne Ingebrigtsen + * gnus-art.el, gnus-picon.el, gnus-sieve.el, gnus-sum.el: + * gnus-xmas.el, imap.el, mailcap.el, mm-util.el, nnfolder.el: + * nnheader.el, nnmail.el: Nil/NIL vs. nil. + From Pavel Jan,Am(Bk - * nnslashdot.el: New file. +2001-12-20 15:00:00 ShengHuo ZHU - * nnheader.el (nnheader-insert-header): New function. + * nnmaildir.el: Copyright changes. Require cl only at compile time. - * gnus-art.el (gnus-mime-internalize-part): Bind - mm-inlined-types. +2001-12-20 Simon Josefsson - * nndraft.el (nndraft-request-expire-articles): Do all the backup - files. + * nnimap.el (top-level): Don't require cl. Suggested by ShengHuo + ZHU . + (nnimap-close-group): Don't quote KEYLIST items. Suggested by + Brian P Templeton . -1999-10-29 David S. Goldberg +2001-12-19 17:00:00 ShengHuo ZHU - * emacs-mime.texi (Customization): Document mm-inline-override-types + * nnmaildir.el: New file. + From Paul Jarc . -1999-10-29 David S. Goldberg +2001-12-19 16:00:00 ShengHuo ZHU - * emacs-mime.texi (Customization): Document mm-inline-override-types + * nndoc.el (nndoc-type-alist): Move forward to the end. -1999-10-29 David S. Goldberg +2001-12-19 Katsumi Yamaoka - * emacs-mime.texi (Customization): Document mm-inline-override-types + * gnus.el (gnus-find-subscribed-addresses): Replace `mapc' with + `dolist'. -1999-10-26 Katsumi Yamaoka +2001-12-19 01:00:00 ShengHuo ZHU - * 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. + * gnus-win.el (gnus-frames-on-display-list): New function. + (gnus-get-buffer-window): Use it. -1999-11-07 01:00:32 Lars Magne Ingebrigtsen +2001-12-19 00:00:00 ShengHuo ZHU - * gnus-topic.el (gnus-topic-goto-missing-topic): Work even in - empty buffers. + * nnwarchive.el (nnwarchive-mail-archive-xover): Fix the regexp. -1999-11-06 23:16:24 Lars Magne Ingebrigtsen +2001-12-18 11:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-mode-map): Use the summary article - edit. + * gnus-win.el (gnus-get-buffer-window): Use gnus-delete-if. -1999-11-06 22:56:49 Jens-Ulrik Petersen +2001-12-18 11:00:00 ShengHuo ZHU + From Harald Meland - * gnus-group.el (gnus-group-read-ephemeral-group): Doc fix. + * gnus-win.el (gnus-get-buffer-window): New function. + (gnus-all-windows-visible-p): Use it. -1999-11-06 21:40:30 Lars Magne Ingebrigtsen + * gnus-util.el (gnus-horizontal-recenter) + (gnus-horizontal-recenter, gnus-horizontal-recenter) + (gnus-horizontal-recenter, gnus-set-window-start): Use it. - * gnus-uu.el (gnus-uu-mark-thread): Don't move point around. + * gnus-score.el (gnus-score-insert-help): Use it. -1999-10-07 Katsumi Yamaoka + * gnus-salt.el (gnus-tree-recenter, gnus-generate-tree) + (gnus-generate-tree, gnus-highlight-selected-tree) + (gnus-highlight-selected-tree, gnus-tree-highlight-article): Use + it. - * gnus-art.el (gnus-treat-predicate): Examine whether the argument - is list or not before condition. + * gnus-art.el (gnus-article-set-window-start) + (gnus-mm-display-part, gnus-request-article-this-buffer) + (gnus-button-next-page, gnus-button-prev-page) + (gnus-article-button-next-page, gnus-article-button-prev-page): + Use it. -1999-10-07 Yoshiki Hayashi +2001-12-18 Josh Huber - * gnus-art.el (gnus-treat-predicate): Work for (typep "something"). + * ChangeLog, ChangeLog.1, nnwfm.el, smiley.el: + * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el: + * mml1991.el, nnultimate.el: Removed buffer-file-coding-system tag. -1999-11-06 19:18:14 Kevin the Bandicoot +2001-12-18 01:00:00 ShengHuo ZHU - * gnus-art.el (gnus-emphasis-alist): New value. + * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el: + * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el: + * mml1991.el, nnultimate.el: Add `coding'. -1999-11-06 13:57:13 Shenghuo ZHU +2001-12-17 Josh Huber - * gnus-srvr.el (gnus-browse-foreign-server): Use both `read' and - `buffer-substring'. + * ChangeLog: changed coding to buffer-file-coding-system + * ChangeLog.1: same + * nnwfm.el: same + * gnus-smiley.el: same + * gnus-cite.el: moved -*- magic cookie -*- to Local Variables + * gnus-delay.el: same + * gnus-spec.el: same + * message.el: same + * mml1991.el: same + * nnultimate.el: same -1999-11-06 04:24:30 Lars Magne Ingebrigtsen +2001-12-16 Simon Josefsson + Inspired by code by Dirk Meyer . - * gnus-art.el (article-date-ut): Keep the updated timer. - (gnus-emphasis-underline-italic): Doc fix. + * gnus-sum.el (gnus-summary-muttprint-program): New variable. + (gnus-summary-save-map): Add muttprint. + (gnus-summary-make-menu-bar): Ditto. + (gnus-summary-muttprint): New function. - * gnus-msg.el (gnus-post-method): Doc fix. - (gnus-post-method): Change default. + * gnus-art.el (gnus-summary-pipe-to-muttprint): New function. -1999-11-06 04:12:13 Francisco Solsona +2001-12-14 11:00:00 ShengHuo ZHU - * message.el (message-newline-and-reformat): Improvements. + * uudecode.el (uudecode-decode-region-internal): Speedup by using + temporary list instead of buffer. -1999-11-06 03:51:24 Lars Magne Ingebrigtsen + * mm-url.el (executable-find): autoload. - * message.el (message-newline-and-reformat): Don't insert too many - newlines. - (message-newline-and-reformat): Work even if not sc. +2001-12-12 Pavel Jan,Am(Bk - * mm-view.el (mm-inline-message): Insert a delimiter at the end. + * gnus-mlspl.el (gnus-group-split-fancy): Doc fix (add reference + to variable, follow doc-string conventions). - * mm-decode.el (mm-inline-media-tests): Only if diff mode. +2001-12-13 Josh Huber -1999-11-06 03:48:02 Toby Speight + * gnus-cus.el (gnus-extra-topic-parameters): added topic parameter + subscribe-level + * gnus-topic.el (gnus-subscribe-topics): use it. - * mm-view.el (mm-display-patch-inline): New function. +2001-12-13 22:00:00 ShengHuo ZHU -1999-11-06 03:47:54 Robert Bihlmeyer + * gnus-msg.el (gnus-summary-mail-forward): Forward all marked + messages. (A small patch with indentation) + From Sean Neakums . - * mm-view.el (mm-display-patch-inline): New function. + * gnus-uu.el (gnus-uu-grab-articles): Set gnus-current-article to + nil after shooting down the gnus-original-article-buffer. -1999-11-06 02:17:54 Lars Magne Ingebrigtsen +2001-12-13 20:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-read-move-group-name): Subscribe to the - group. + * uudecode.el (uudecode-use-external): New variable. + (uudecode-decode-region): Automatically detect external program. - * message.el (message-forward): Narrow to the right header. + * binhex.el (binhex-use-external): New variable. + (binhex-decode-region-internal): New function. + (binhex-decode-region): Automatically detect external program. - * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus - dates. + * mm-uu.el (mm-uu-decode-function,mm-uu-binhex-decode-function): + Use them. - * gnus-msg.el (gnus-configure-posting-styles): Use the - user-full-name function. +2001-12-12 Simon Josefsson - * mm-bodies.el (mm-body-encoding): Use the choosing function. - (mm-body-charset-encoding-alist): Default to nil. + * nnvirtual.el (nnvirtual-always-rescan) + (nnvirtual-component-regexp): Fix doc. - * message.el (message-elide-ellipsis): Fix typo. - (message-elide-region): Ditto. - (message-elide-region): Don't insert a newline first. + * nnoo.el (defvoo): Add doc to defvoo variables. -1999-11-05 20:28:27 Lars Magne Ingebrigtsen + * nnml.el (nnml-directory, nnml-active-file) + (nnml-newsgroups-file, nnml-get-new-mail, nnml-nov-is-evil) + (nnml-marks-is-evil, nnml-filenames-are-evil) + (nnml-prepare-save-mail-hook, nnml-inhibit-expiry): Fix doc. - * 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. + * nnmh.el (nnmh-directory, nnmh-get-new-mail) + (nnmh-prepare-save-mail-hook, nnmh-be-safe): Fix doc. + (nnmh-possibly-change-directory): Use `nnheader-report' instead of + `error'. - * gnus-msg.el (gnus-configure-posting-styles): Allow `header' - matches. + * nnmbox.el (nnmbox-mbox-file, nnmbox-active-file) + (nnmbox-get-new-mail, nnmbox-prepare-save-mail-hook): -1999-11-06 Simon Josefsson + * nnfolder.el (nnfolder-directory, nnfolder-active-file) + (nnfolder-newsgroups-file, nnfolder-get-new-mail) + (nnfolder-save-buffer-hook, nnfolder-inhibit-expiry) + (nnfolder-nov-is-evil, nnfolder-marks-is-evil): Fix doc. - * gnus-art.el (article-decode-encoded-words): - (gnus-mime-display-single): Don't assume gnus-summary-buffer is - live. + * nnbabyl.el (nnbabyl-mbox-file, nnbabyl-active-file) + (nnbabyl-get-new-mail, nnbabyl-prepare-save-mail-hook): Fix doc. - * gnus.el (gnus-read-method): Add methods from - `gnus-opened-servers' to completion. Map entered method/address - into existing methods if possible. + * imap.el, nnimap.el: Fix indentation. - * gnus-group.el (gnus-group-make-group): Simplify method. + * gnus-sieve.el (gnus-sieve-article-add-rule): Autoload it. - * gnus-srvr.el (gnus-browse-unsubscribe-group): Simplify method. +2001-12-12 Didier Verna - * mml.el (mml-preview): Remove mail-header-separator before - encoding. + * gnus-msg.el (gnus-group-news): New function. + * gnus-group.el (gnus-group-mode-map): bind it to `i'. + * gnus-group.el (gnus-group-make-menu-bar): add a menu item for it. + * gnus-salt.el (gnus-carpal-group-buffer-buttons): add a button + for it. + * gnus-msg.el (gnus-summary-news-other-window): New function. + * gnus-msg.el ((gnus-summary-send-map "S" gnus-summary-mode-map)): + bind it to `i'. + * gnus-sum.el (gnus-summary-mode-map): bind it to `i'. + * gnus-sum.el (gnus-summary-make-menu-bar): add a menu item for it. + * gnus-salt.el (gnus-carpal-summary-buffer-buttons): add a button + for it (called with a prefix). + * gnus-msg.el (gnus-configure-posting-styles): add an optional + group-name argument. + * gnus-msg.el (gnus-setup-message): use it. -1999-11-05 20:28:27 Lars Magne Ingebrigtsen +2001-12-12 00:00:00 ShengHuo ZHU - * message.el (message-read-from-minibuffer): New function. + * gnus-sum.el (gnus-summary-show-article): Fix doc. -Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen +2001-12-10 17:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.98 is released. + * mml.el (mime-to-mml): Remove Content-Disposition too. -1999-11-05 01:27:49 Shenghuo ZHU +2001-12-09 08:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-expire): Remove bad line in NOV. + * gnus-sum.el (gnus-summary-buffer-name): Decode group name. + * gnus-group.el (gnus-group-name-decode): Decode unibyte + strings only. + From TSUCHIYA Masatoshi -1999-11-04 22:20:35 Shenghuo ZHU +2001-12-08 Nevin Kapur - * mml.el (mml-generate-mime-1): Read attached binary file in - binary mode. + * nnmail.el (nnmail-fancy-expiry-targets): New variable. + (nnmail-fancy-expiry-target): Use it. + Suggestions from Simon Josefsson . -1999-11-03 16:08:56 Shenghuo ZHU +2001-12-07 14:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-toggle-header): Fix arg bug. + * gnus-sum.el (gnus-summary-show-article): Recount lines if not exist. -1999-11-03 15:27:38 Shenghuo ZHU +2001-12-07 10:00:00 ShengHuo ZHU - * mailcap.el (mailcap-viewer-lessp): Fix bug. + * nnwfm.el (nnwfm-create-mapping): Use gnus-url-unhex-string. -1999-11-02 17:28:33 Shenghuo ZHU + * gnus-util.el (gnus-url-unhex-string): Move here. - * gnus-sum.el (gnus-summary-search-article): Fix loop search bug. +2001-12-07 09:00:00 ShengHuo ZHU -1999-10-31 21:24:59 Shenghuo ZHU + * nnrss.el (nnrss-decode-entities-unibyte-string): Use + mm-url-decode-entities-nbsp. - * 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. + * nnlistserv.el, nnultimate.el, nnwarchive.el, nnweb.el: + * webmail.el, nnwfm.el: Use mm-url. -1999-10-29 14:30:07 Shenghuo ZHU + * mm-url.el (mm-url-fetch-form): Move from nnweb. + (mm-url-remove-markup): Move from nnweb. + (mm-url-fetch-simple): Move from webmail. - * gnus-sum.el (gnus-article-get-xrefs): Test eobp. + * nnslashdot.el (nnslashdot-request-post): Use mm-url-fetch-form. -1999-09-27 Hrvoje Niksic +2001-12-07 01:00:00 ShengHuo ZHU - * mm-decode.el (mm-attachment-override-types): Exclude text/plain. + * gnus-sum.el (gnus-summary-print-truncate-and-quote): New function. + (gnus-summary-print-article): Use it. -1999-10-26 23:27:44 Shenghuo ZHU + * gnus-util.el (gnus-replace-in-string): Typo. - * mm-decode.el (mm-dissect-buffer): CTE may come without CTL. +2001-12-06 10:00:00 ShengHuo ZHU -1999-10-26 21:44:05 Shenghuo ZHU + * nnweb.el (nnweb-replace-in-string): Removed. - * gnus-srvr.el (gnus-browse-foreign-server): Use - `buffer-substring' instead of `read'. + * gnus-util.el (gnus-replace-in-string): New function. + (gnus-mode-string-quote): Use it. -1999-10-23 Simon Josefsson + * nnrss.el (nnrss-format-string): Use gnus-replace-in-string. + * nnwfm.el (nnwfm-create-mapping): Ditto. - * nnimap.el, imap.el, rfc2104.el: New files. +2001-12-06 01:00:00 ShengHuo ZHU - * gnus.el (gnus-valid-select-methods): Add nnimap. + * dgnushack.el (dgnushack-compile): nnrss.el and + nnslashdot.el don't depend on nnweb, url, w3. - * 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. + * nnrss.el: Use mm-url. - * 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. +2001-12-06 00:00:00 ShengHuo ZHU - * nnagent.el (nnagent-request-set-mark): Save marks. + * mm-url.el (mm-url-insert-file-contents): Support file:. - * 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. +2001-12-05 14:00:00 ShengHuo ZHU - * gnus-art.el (article-hide-pgp): Hide all headers, not just - Hash:. + * mm-view.el: Lower case for the description line. Sync from the + Emacs CVS. -1999-10-22 11:03:00 Shenghuo ZHU +2001-12-05 12: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. + * gnus-group.el (gnus-group-find-new-groups): Fix doc. + From: Stefan Monnier -1999-10-13 21:31:50 Shenghuo ZHU +2001-12-05 Katsumi Yamaoka - * gnus-art.el (gnus-article-setup-buffer): Fix buffer leak. + * mm-view.wl (mm-inline-text): Decode a charset-encoded rich text. -1999-10-13 12:52:18 Shenghuo ZHU +2001-12-04 08:00:00 ShengHuo ZHU - * mm-view.el (mm-inline-message): Fix leaving group bug. + * mm-url.el: Require executable. + Suggested by Katsumi Yamaoka . -1999-10-07 17:59:49 Shenghuo ZHU +2001-12-03 11:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-post-method): Use normal method if current is - not available. + * pop3.el (pop3-munge-message-separator): Only use valid date. + Trivial patch from Michael Welsh Duggan . -1999-10-07 17:09:34 Shenghuo ZHU + * Makefile.in: gnus-load.elc may not be generated. - * nnmail.el (nnmail-insert-xref): Dealing with empty articles. - (nnmail-insert-lines): Ditto. +2001-12-03 09:00:00 ShengHuo ZHU -1999-10-07 Shenghuo ZHU + * mm-url.el: New file. + * nnslashdot.el: Use it. + * mm-extern.el (mm-extern-url): Use it. - * nnfolder.el (nnfolder-insert-newsgroup-line): Insert a blank - line. +2001-12-01 15:00:00 ShengHuo ZHU - * message.el (message-unsent-separator): One more separator. + * gnus-sum.el (gnus-summary-save-article): Nix + gnus-display-mime-function and gnus-article-prepare-hook. -1999-10-06 Shenghuo ZHU + * gnus-spec.el (gnus-parse-complex-format): Properly handle %C at + the beginning of lines. + (gnus-complex-form-to-spec): Ditto. - * 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. +2001-12-01 08:00:00 ShengHuo ZHU -1999-10-05 Shenghuo ZHU + * message.el (message-make-mft): Fix the m-s-a-file regexp. + From Paul Jarc . - * qp.el (quoted-printable-encode-region): Check eobp. +2001-11-30 21:00:00 ShengHuo ZHU -1999-10-03 Shenghuo ZHU + * message.el: New variable message-subscribed-address-file; + use it in message-make-mft. From Paul Jarc . - * nntp.el (nntp-retrieve-headers-with-xover): Fix hanging problem. +2001-11-30 12:00:00 ShengHuo ZHU -1999-10-02 Shenghuo ZHU + * message.el (message-tab-body-function): Set to nil. + (message-tab): Use text-mode-map or global-map. + Suggested by Kai Gro,b_(Bjohann . - * nntp.el (nntp-send-xover-command): Wait for nothing if not - wait-for-reply. +2001-11-30 Simon Josefsson -1999-09-29 Shenghuo ZHU + * gnus-agent.el (gnus-agent-fetch-headers): Use gnus-range-add + instead of gnus-union, for speed. Suggested by Christoph Conrad + . + (gnus-agent-fetch-group-1): Add verbose message. - * mm-uu.el (mm-uu-forward-begin-line): Change the regexp. - (mm-uu-forward-end-line): Ditto. +2001-11-29 12:00:00 ShengHuo ZHU -1999-09-29 Didier Verna + * gnus-agent.el (gnus-agent-write-active): Make sure sym is a cons + of integers. - * binhex.el (binhex-decode-region): don't consider the value of - `enable-multibyte-characters' in XEmacs. +2001-11-29 Kai Gro,b_(Bjohann - * gnus-start.el (gnus-read-descriptions-file): ditto. + * message.el (message-newgroups-header-regexp) + (message-completion-alist, message-tab-body-function): Use + defcustom rather than defvar. + (message-tab): Mention `message-tab-body-function' in doc. + Suggested by Karl Eichwalder. - * mm-util.el (mm-multibyte-p): ditto. - (mm-with-unibyte-buffer): ditto. - (mm-find-charset-region): use `mm-multibyte-p'. +2001-11-28 16:00:00 ShengHuo ZHU - * mm-bodies.el (mm-decode-body): ditto. - (mm-decode-string): ditto. + * gnus-uu.el (gnus-uu-save-article): Use #part instead of #mml. - * lpath.el ((string-match "XEmacs" emacs-version)): Don't define - `enable-multibyte-characters' in XEmacs. +2001-11-28 12:00:00 ShengHuo ZHU -1999-09-29 Shenghuo ZHU + * nnheader.el (nnheader-find-nov-line): Don't use macro + gnus-delete-line. - * mm-util.el (mm-binary-coding-system): Try binary first. + * gnus-group.el (gnus-group-name-decode): Defun instead of defsubst. + (gnus-group-name-charset): Ditto. -1999-09-14 Shenghuo ZHU + * gnus-util.el (gnus-buffer-live-p): Ditto. - * rfc1843.el (rfc1843-decode-article-body): Don't decode twice. +2001-11-28 11:00:00 ShengHuo ZHU -1999-09-10 Shenghuo ZHU + * sieve-manage.el (sieve-manage-stream-alist): Backslash before + open parenthesis in doc. + (sieve-manage-authenticator-alist): Typo in doc. + * imap.el (imap-authenticator-alist): Typo in doc. + (imap-stream-alist): Backslash. - * gnus-art.el (article-make-date-line): Add time-zone in iso8601 - format. - (article-date-ut): Find correct insert position. + * gnus-sum.el (gnus-summary-limit-to-author): Missing arguments. + Thanks to david.goldberg6@verizon.net (David S. Goldberg) -1999-09-03 Shenghuo ZHU +2001-11-27 14:00:00 ShengHuo ZHU - * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable - forwarded message. + * gnus-topic.el (gnus-topic-mode): Add LOCAL for add-hook. -1999-09-27 20:33:41 Lars Magne Ingebrigtsen + * message.el (message-mode): make-local-hook is harmless in Emacs 21. - * gnus-topic.el (gnus-topic-find-groups): Work for unactivated - groups. + * gnus-msg.el (gnus-configure-posting-styles): use + make-local-hook. Add LOCAL for add-hook. - * message.el (message-resend): Use message mode when prompting. +2001-11-27 Per Abrahamsen - * gnus-art.el (article-hide-headers): Mark wash. - (article-emphasize): Ditto. + * message.el (message-mode): Use `make-local-hook' unless + obsolete. + Patch by Katsumi Yamaoka . -1999-09-27 19:52:14 Vladimir Volovich +2001-11-26 Katsumi Yamaoka - * message.el (message-newline-and-reformat): Work for SC. + * canlock.el: Remove sha1.el and base64.el stuff. -1999-09-27 19:38:33 Lars Magne Ingebrigtsen +2001-11-26 Didier Verna - * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*. + * nnmbox.el (nnmbox-create-mbox): create the mbox file directory + if needed. - * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown. +2001-11-21 Katsumi Yamaoka -1999-10-20 David S. Goldberg + * message.el (message-tamago-not-in-use-p): New function. + (message-strip-forbidden-properties): Use it. - * mm-decode.el mm-inline-override-types: New variable +2001-11-26 Didier Verna - * mm-decode.el (mm-inline-override-p): New function + * gnus-start.el (gnus-check-first-time-used): only check for + existence of .el[d] files. - * mm-decode.el (mm-inlined-p): Use it +2001-11-25 15:00:00 ShengHuo ZHU -1999-10-20 David S. Goldberg + * mm-util.el (mm-coding-system-priorities): Add backslash in the doc. - * mm-decode.el mm-inline-override-types: New variable + * message.el (message-setup-1): Clean up mc-*. - * mm-decode.el (mm-inline-override-p): New function +2001-11-25 09:00:00 ShengHuo ZHU - * mm-decode.el (mm-inlined-p): Use it + * gnus-util.el (gnus-directory-sep-char-regexp): New variable. + * gnus-score.el (gnus-score-find-bnews): Use it. -Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version. + (gnus-summary-limit-to-author): Ditto. + (gnus-summary-limit-to-extra): Ditto. + (gnus-summary-find-matching): Support not-matching argument. - * gnus.el: Pterodactyl Gnus v0.97 is released. +2001-11-25 Kai Gro,b_(Bjohann -1999-09-01 Brendan Kehoe + * message.el (message-wash-subject): Use `insert' rather than + `insert-string', which is deprecated. - * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Use - gnus-summary-next-group, not gnus-summary-next-article. Only give - 3 args. +2001-11-24 Simon Josefsson -1999-09-25 08:07:57 Lars Magne Ingebrigtsen + * mm-encode.el (mm-encode-content-transfer-encoding): Fix error + message. (Gnus does not "default" to using 8bit for the message, + it default to use 8bit encoding and the user-supplied CTE + value. Calling this behaviour "treating it as 8bit" is perhaps + better.) - * gnus-agent.el (gnus-agent-fetch-group-1): Look in the group - buffer for params. + * mm-bodies.el (mm-body-encoding): Intern encoding if needed + (compare mm-charset-to-coding-system). - * gnus-xmas.el (gnus-xmas-summary-recenter): Display one more - line. +2001-11-23 02:00:00 ShengHuo ZHU - * message.el (message-forward-ignored-headers): New variable. + * canlock.el (canlock-sha1-with-openssl): Use unibyte + buffer. Correctly decode hex. - * gnus-art.el (gnus-article-prepare-display): Nix out - gnus-article-wash-types. +2001-11-21 01:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-create-buffer): New function. - (gnus-agent-fetch-group-1): Use it. - (gnus-agent-start-fetch): Ditto. + * gnus-agent.el (gnus-category-insert-line): Convert category + names to strings. - * gnus-sum.el (gnus-summary-exit): Don't use - `gnus-use-adaptive-scoring'. +2001-11-20 21:00:00 ShengHuo ZHU - * mail-source.el (mail-source-fetch-pop): Only store password when - successful. + * message.el (sha1): eval-and-compile. - * gnus-nocem.el (gnus-nocem-scan-groups): Message better. +2001-11-20 Simon Josefsson -1999-09-24 18:43:23 Lars Magne Ingebrigtsen + * message.el (message-allow-no-recipients): New variable. + (message-send): Use it, customize the prompting when posting to + Gcc/Fcc alone. From prj@po.cwru.edu (Paul Jarc). - * message.el (message-reply): Use it. - (message-dont-reply-to-names): New variable. +2001-11-20 09:00:00 ShengHuo ZHU - * nntp.el (nntp-open-telnet): Don't erase-buffer. + * mm-util.el (mm-coding-system-priorities): New variable. + (mm-sort-coding-systems-predicate): New function. + (mm-find-mime-charset-region): Resort coding systems if needed. + Suggested by Katsumi Yamaoka . - * mm-util.el (mm-preferred-coding-system): Typo fix. +2001-11-20 Didier Verna - * message.el (message-bounce): Work for non-MIME. + * gnus-group.el (gnus-group-make-help-group): new optional + argument to control the error behavior. + * gnus-start.el (gnus-check-first-time-used): use it to avoid + erroring. - * gnus.el (gnus-short-group-name): Short the right parts of the - name. +2001-11-19 Simon Josefsson -1999-09-24 18:17:48 Johan Kullstam + * message.el (message-mode-map): Use C-c C-f C-i for Importance: + instead of C-c C-u. Suggested by Per Abrahamsen + . - * mm-encode.el (mm-qp-or-base64): New version. +2001-11-18 08:00:00 ShengHuo ZHU -1999-09-10 Shenghuo ZHU + * nnfolder.el (nnfolder-read-folder): Use group instead of + nnfolder-current-group. + Suggested by Lorentey Karoly . - * gnus-art.el (article-make-date-line): Fix time-zone bug. +2001-11-17 Simon Josefsson -1999-09-09 Shenghuo ZHU + * message.el (message-send): Ask user if Fcc/Gcc should be + performed when no other sender was specified. + Suggested by prj@po.cwru.edu (Paul Jarc). - * gnus-art.el (gnus-article-add-buttons): Don't delete markers out - of restricted region. - (gnus-mime-display-single): Set beg at correct point. +2001-11-17 Simon Josefsson -1999-09-09 Shenghuo ZHU + * message.el (message-mode, message-mode-map): Use C-c C-u for + Importance: instead of C-c C-p (used by SC). - * nnmail.el (nnmail-process-maildir-mail-format): Typo. +2001-11-16 Simon Josefsson -1999-09-09 Jens-Ulrik Petersen + * message.el (message-insert-importance-high) + (message-insert-importance-low): Save point. - * 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. + * mail-source.el (mail-source-fetch-imap): Fix BODY.PEEK return + value. -1999-09-24 18:10:56 Robert Bihlmeyer +2001-11-16 Per Abrahamsen - * gnus-score.el (gnus-summary-increase-score): Allow editing of - Message-ID. + * message.el (message-strip-special-text-properties): New option. + (message-strip-forbidden-properties): Obey it. -1999-09-08 Shenghuo ZHU +2001-11-14 Sam Steingold - * mm-encode.el (mm-encode-content-transfer-encoding): Fold - quoted-printable-encode-region. + * gnus-score.el: Fixed some doc strings to properly quote symbols. - * qp.el (quoted-printable-encode-region): Assume charset - encoded. Fold every line in the region. +2001-11-15 Simon Josefsson -1999-09-02 Shenghuo ZHU + Support "Importance:" header in Message. - * gnus-srvr.el (gnus-browse-foreign-server): Read the first line - of active file. + * message.el (message-mode-map): Bind C-c C-p to + `message-insert-or-toggle-importance' + (message-mode-menu): Add message-insert-importance-{high,low}. + (message-insert-importance-high, message-insert-importance-low) + (message-insert-or-toggle-importance): New functions. + (message-tool-bar-map): Add {un,}important. + (message-mode): Doc fix. -1999-09-01 Didier Verna +2001-11-15 Simon Josefsson - * message.el (message-mode): allows whitespaces between multiple - instances of the fill character ">". + * message.el (message-tool-bar-map): Fix attach toolbar tooltip. -1999-09-24 18:02:50 Kim-Minh Kaplan + * mml.el (mml-menu): Fix toolbar tooltip. - * mm-encode.el (mm-qp-or-base64): Fix. +2001-11-15 14:00:00 ShengHuo ZHU -1999-09-01 12:18:01 Katsumi Yamaoka + * nnfolder.el (nnfolder-save-marks): gnus-prin1 takes one argument. + * nnml.el (nnml-save-marks): Ditto. - * message.el (message-send): Too much and. + * gnus-sum.el (gnus-newsgroup-variables): Fix doc. -1999-09-24 17:58:07 Andreas Schwab +2001-11-15 Simon Josefsson - * gnus-art.el (gnus-mime-view-part-as-type): Renamed. + * nnml.el (nnml-save-marks): + * nnfolder.el (nnfolder-save-marks): Use `gnus-prin1'. + Suggested by Istvan Marko . -1999-08-28 12:44:20 Lars Magne Ingebrigtsen +2001-11-15 Per Abrahamsen - * gnus-score.el (gnus-score-headers): Work for nil scores. + * gnus-art.el (gnus-article-wash-status-strings): Use + `copy-sequence', not `copy-seq'. -1999-08-27 20:46:11 Lars Magne Ingebrigtsen +2001-11-15 Per Abrahamsen - * gnus-cache.el (gnus-cache-write-active): Write full names. + * gnus-art.el (gnus-article-wash-status-strings): New constant. + (gnus-gnus-article-wash-status-entry): New function. + (gnus-article-wash-status): Use it. - * gnus-util.el (gnus-write-active-file): Accept full name. +2001-11-13 10:00:00 ShengHuo ZHU - * mm-decode.el (mm-inlinable-p): Use string-match on the types. - (mm-assoc-string-match): New function. - (mm-display-inline): Use it. + * mml1991.el: Add coding header. - * gnus-group.el (gnus-group-set-info): Work for nil group params. +2001-11-12 Simon Josefsson - * gnus-msg.el (gnus-configure-posting-styles): Allow eval. + * mml1991.el (mml1991-use, mml1991-function-alist): New variables. + (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from + `mml1991-sign' and `mml1991-encrypt'. + (mml1991-encrypt, mml1991-sign): New glue functions. + (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions. -1999-08-27 19:08:10 Florian Weimer + * mml.el (mml-mode-map): `C-c RET o' map for PGP. + (mml-menu): Add PGP to menu. - * mml.el (mml-generate-multipart-alist): New variable. + * mml-sec.el (top-level): Require mml1991. Don't require smime. + (mml-sign-alist, mml-encrypt-alist): Add "pgp". + (mml-pgp-sign-buffer, mml-pgp-encrypt-buffer) + (mml-secure-sign-pgp, mml-secure-encrypt-pgp): New glue functions. -1999-08-27 15:30:02 Lars Magne Ingebrigtsen + * mml2015.el: Mention RFC 3156. - * gnus-art.el (gnus-treat-predicate): Work for (not 5). + * mml1991.el: New file. From Sascha L,A|(Bdecke . -1999-08-27 Peter von der Ahe +2001-11-12 13:00:00 ShengHuo ZHU - * message.el (message-send): More helpful error message if sending - fails + * gnus-start.el (gnus-auto-subscribed-groups): Use ^nnml. -1999-09-06 Robert Bihlmeyer + * gnus-sum.el (gnus-summary-move-article): Use number-to-string. + From - * gnus-score.el (gnus-summary-increase-score): "Lars" was broken - in newer emacsen, where ?r isn't equal 114. +2001-11-11 Simon Josefsson -Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen + * message.el (top-level): Autoload sha1. + (message-canlock-generate): Use sha1 instead of md5 (sha1 used by + canlock, no need to require two different hash algs). Suggested + by Ferenc Wagner . - * gnus.el: Pterodactyl Gnus v0.96 is released. +2001-11-09 Simon Josefsson -1999-08-17 Simon Josefsson + * gnus.el (gnus-local-domain): Fix doc. From Pavel Jan,Am(Bk + . - * 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. +2001-11-09 Kai Gro,b_(Bjohann -1999-08-17 Simon Josefsson + * message.el (message-point-in-header-p): New function. + (message-do-auto-fill): Use it. + (message-beginning-of-line): New function. Goes to beginning of + header value (i.e., end of header name), or to beginning of line + if already at beginning of value. Behaves like + `beginning-of-line' when in message body. + (message-mode-map): Bind it. - * gnus-sum.el (gnus-summary-move-article): Report backend errors. +2001-11-08 Simon Josefsson -1999-08-09 Dave Love + * gnus-msg.el (gnus-posting-styles): Add doc. - * mm-util.el: Use `defalias', not `fset' for dummy functions. +2001-11-07 Simon Josefsson -1999-08-09 Simon Josefsson + * gnus-sieve.el (gnus-sieve-generate): Don't invoke sieve-mode. - * gnus-art.el (gnus-ignored-headers): Remove "X-Pgp-*" - (already matched by "^X-Pgp"), removed duplicate - X-Mailing-List, added several new junk headers. + * sieve-mode.el (sieve-control-commands-face) + (sieve-control-commands-face, sieve-action-commands-face) + (sieve-test-commands-face, sieve-tagged-arguments-face): New + faces. + (sieve-font-lock-keywords): Use them. + (sieve-mode): Only set font-lock-defaults in emacs. -1999-08-01 Simon Josefsson + * gnus-art.el (gnus-default-article-saver): Add + gnus-summary-save-body-in-file. + (gnus-summary-write-to-file): Fix doc. - * gnus-art.el (article-decode-charset): Don't assume - gnus-summary-buffer is live. +2001-11-07 Simon Josefsson -1999-08-27 15:07:43 Paul Flinders + * gnus-art.el (gnus-treat-highlight-signature): Add cross + reference to the correct chapter in the manual. - * smiley.el (smiley-deformed-regexp-alist): Fix % smileys. + * mml.el (mml-mode): Add cross reference to Emacs MIME manual. + Suggested by "Golubev I. N." . -1999-08-27 15:02:58 Florian Weimer +2001-11-07 06:00:00 ShengHuo ZHU - * gnus-score.el (gnus-home-score-file): Work with absolute path - names. + * mml.el (mml-preview): Bind mail-header-separator. -1999-07-17 Shenghuo ZHU +2001-11-07 Katsumi Yamaoka - * gnus-sum.el (gnus-articles-to-read): Return cached articles if - nothing else in the group. + * message.el: Always require canlock. + (message-ignored-supersedes-headers): Include Cancel-Lock and + Cancel-Key. + (message-insert-canlock): Don't require canlock. + (message-cancel-news): Don't check whether canlock is available. + (message-supersede): Support cancel-locks. -1999-07-16 Shenghuo ZHU + * gnus-art.el: Don't autoload canlock. - * gnus-bcklg.el (gnus-backlog-enter-article): Check the size of - the article. +2001-11-06 18:00:00 ShengHuo ZHU -1999-07-15 Shenghuo ZHU + * mail-source.el (mail-source-fetch-imap): ASYNC param. + From: - * mm-uu.el (mm-uu-dissect): Fix for base64 message. +2001-11-06 10:00:00 ShengHuo ZHU -1999-07-15 Shenghuo ZHU + * many files: Fix copyright lines. - * mm-uu.el (mm-uu-forward-end-line): Support forwarded message - from mutt. +2001-11-05 07:00:00 ShengHuo ZHU -1999-07-14 Shenghuo ZHU + * mml.el (mml-generate-mime-1): Use mm-with-unibyte-current-buffer. + Suggested by Dave Love . - * mm-bodies.el (mm-decode-content-transfer-encoding): Delete - whitespace. +2001-11-04 10:00:00 ShengHuo ZHU -1999-07-14 Shenghuo ZHU + * message.el (message-kill-buffer): Remove auto-save file after + confirm. - * mm-util.el (mm-text-coding-system-for-write): New variable. - (mm-append-to-file): New function. - (mm-write-region): New function. + * message.el (message-send-mail): Call message-generate-headers + once. Suggested by Matt Armstrong . - * 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. + * gnus-topic.el (gnus-topic-rename): Initial-input. + Suggested by Katsuhiro Hermit Endo . -1999-07-14 Shenghuo ZHU +2001-11-03 Per Abrahamsen - * nnmail.el (nnmail-find-file): Use mm-auto-mode-alist. + * message.el (message-forbidden-properties): New constant. + (message-strip-forbidden-properties): New function. + (message-mode): Activate it. - * 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. +2001-11-02 17:00:00 ShengHuo ZHU - * mm-util.el (mm-inhibit-file-name-handlers): New variable. - (mm-insert-file-contents): Add a new parameter for inserting - compressed file literally. + * mm-util.el (mm-iso-8859-15-compatible): Fix doc. + (mm-hack-charsets): Fix doc. - * mml.el (mml-generate-mime-1): Insert non-text literally. +2001-11-02 Simon Josefsson - * gnus.el: Change most mm-insert-file-contents back to nnheader. + * gnus-int.el (gnus-check-server): Message "...done" when done. -1999-07-13 Hrvoje Niksic + * imap.el (imap-close): Don't message (imap-send-command-wait + returns if the connection is dropped). + (imap-wait-for-tag): Nix out message only when necessary. - * gnus-art.el (gnus-unbuttonized-mime-types): Fix docstring. + * gnus-sieve.el (gnus-sieve-script): Use "stop" instead of "elsif" + for non-crossposting. + (gnus-sieve-crosspost): Default to t to be consistent with other + parts of Gnus. -1999-08-27 14:53:42 Oleg S. Tihonov +2001-11-01 18:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-group-charset-alist): Default fido7 to - koi8-r. + * mm-util.el (mm-iso-8859-15-compatible): Add inconvertible chars. + (mm-iso-8859-x-to-15-table): Ditto. + (mm-iso-8859-x-to-15-region): Ditto. + (mm-find-mime-charset-region): Ditto. -1999-07-11 Shenghuo ZHU +2001-11-01 Simon Josefsson - * mml.el (mml-insert-mime): Decode text. - (mml-to-mime): Narrow to headers-or-head. + * nnimap.el (nnimap-close-asynchronous): New variable. + (nnimap-close-group): Use it. + (nnimap-expunge): Don't use it. -1999-07-11 Shenghuo ZHU + * imap.el (imap-callbacks): New variable. + (imap-remassoc): Copied from `gnus-remassoc'. + (imap-add-callback): New function. + (imap-mailbox-expunge, imap-mailbox-close): Support asynchronous + behaviour. + (imap-parse-response): Call the callback. - * mm-view.el (mm-inline-text): Check - w3-meta-content-type-charset-regexp. + * message.el (message-insert-canlock): New variable. + (message-canlock-generate, message-canlock-password) + (message-insert-canlock): New functions. + (message-send-news): Call `message-insert-canlock'. + (top-level): Require canlock when compiling. + (message-insert-canlock): Require canlock before we need it. -1999-07-10 Simon Josefsson +2001-11-01 13:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-fetch-group-1): Search topics for - predicate. + * gnus-msg.el (gnus-copy-article-buffer): Copy sequence. -1999-07-10 Alexandre Oliva +2001-11-01 12:00:00 ShengHuo ZHU - * gnus-mlspl.el: Documentation fixes. + * dgnushack.el (dgnushack-make-load): A workaround for + custom-add-loads bug in some versions of XEmacs. -1999-08-27 14:42:14 Rui Zhu +2001-11-01 10:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-limit-to-age): Prompt better. + * mm-util.el (mm-charset-synonym-alist): Revert (some). -1999-08-27 14:40:52 Michael Cook +2001-11-01 09:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-setup-buffer): Kill all local - variables. + * mm-util.el (mm-iso-8859-x-to-15-region): New function. + (mm-hack-charsets): New variable. + (mm-iso-8859-15-compatible): New variable. + (mm-iso-8859-x-to-15-table): New variable. + (mm-find-mime-charset-region): Add parameter hack-charsets. -1999-08-27 14:39:34 Hrvoje Niksic + * mm-bodies.el (mm-encode-body): Use it. + * mml.el (mml-parse-1): Ditto. - * nnmail.el (nnmail-get-new-mail): "Done". +2001-11-01 Simon Josefsson -1999-08-27 14:38:14 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-make-menu-bar): Add Sieve. - * gnus-group.el (gnus-group-kill-all-zombies): Only prompt when - interactive. +2001-11-01 08:00:00 ShengHuo ZHU -1999-07-12 Shenghuo ZHU + * mm-util.el (mm-charset-to-coding-system): Return nil, if charset + is nil. - * gnus-art.el (article-decode-charset): Fix broken CT. +2001-11-01 07:00:00 ShengHuo ZHU -1999-07-12 Shenghuo ZHU + * smiley-ems.el (smiley-update-cache): Auto detect file type. - * gnus-agent.el (gnus-agent-fetch-group-1): Recreate agent - overview buffer if it is killed. + * message.el (message-forward-rmail-make-body): Use + save-window-excursion. + (message-encode-message-body): Search with noerror. + (message-setup-1): Convert compose-mail send-actions to + message-send-actions. -1999-08-27 14:26:03 Eric Marsden +2001-11-01 Simon Josefsson - * gnus-art.el (article-babel): New version. + * sieve.el: Don't require easy-mmode. Suggested by Katsumi Yamaoka + . -1999-08-27 14:22:39 Jon Kv +2001-10-31 20:00:00 ShengHuo ZHU - * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry. + * sieve-manage.el (sieve-string-bytes): No complain. -1999-07-10 Mike McEwan +2001-11-01 Simon Josefsson - * gnus.texi (More Threading): Document new variable - `gnus-sort-gathered-threads-function'. + * gnus-group.el (gnus-group-mode-map): Bind "D u" to + `gnus-sieve-update' and "D g" to `gnus-sieve-generate'. (Functions + has autoload cookies, so no `require' should be necessary.) -1999-07-10 Mike McEwan + * sieve.el, sieve-mode.el, sieve-manage.el, gnus-sieve.el: New + files. - * gnus.texi (More Threading): Document new variable - `gnus-sort-gathered-threads-function'. +2001-10-31 Simon Josefsson -1999-07-11 Andreas Jaeger + * gnus-cus.el (gnus-group-parameters): Support integer `display' + parameter. - * gnus-uu.el (gnus-uu-digest-mail-forward): Delete file after - usage. + * gnus-sum.el (gnus-select-newsgroup): If group parameter + `display' is a number (and C-u wasn't used to enter group), only + fetch that number of articles. -1999-07-10 Shenghuo ZHU +2001-10-31 Matt Armstrong - * 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. + * gnus.el (gnus-find-subscribed-addresses): Doc fix: + not-subscribed -> subscribed. -1999-07-11 11:02:03 Lars Magne Ingebrigtsen +2001-10-31 08:00:00 ShengHuo ZHU + From: Josh Huber - * mm-encode.el (mm-qp-or-base64): Also consider control chars. - (mm-qp-or-base64): Reversed logic. + * message.el (message-subscribed-address-functions): New variable. + (message-subscribed-addresses): New variable. + (message-subscribed-regexps): New variable. + (message-goto-mail-followup-to): New function. + (message-send-mail): Add Mail-Followup-To. + (message-make-mft): New function. - * mm-decode.el (mm-save-part-to-file): Let coding system be - binary. + * gnus.el (gnus-find-subscribed-addresses): New function. -1999-07-15 Mike McEwan +2001-10-31 07:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to - be set in topic parameters. + * mail-source.el (mail-source-fetch): If debug, don't regain signals. + (mail-source-fetch-pop): Ditto. + (mail-source-check-pop): Ditto. -1999-07-10 Mike McEwan + * gnus-start.el (gnus-read-init-file): Ditto. + (gnus-activate-group): Ditto. + (gnus-read-newsrc-el-file): Ditto. - * 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. +2001-10-30 23:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't - mark cached articles as `undownloaded'. + * message.el (message-get-reply-headers): Make sure there is ", ". -Tue Jul 20 02:39:56 1999 Peter von der Ahe + * mm-util.el (mm-mime-mule-charset-alist): Move down and call + mm-coding-system-p. Don't correct it only in XEmacs. + (mm-charset-to-coding-system): Use mm-coding-system-p and + mm-get-coding-system-list. + (mm-emacs-mule, mm-mule4-p): New variables. + (mm-enable-multibyte, mm-disable-multibyte, + mm-enable-multibyte-mule4, mm-disable-multibyte-mule4, + mm-with-unibyte-current-buffer, + mm-with-unibyte-current-buffer-mule4): Use them. + (mm-find-mime-charset-region): Treat iso-2022-jp. - * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring - to have buffer local values. + From Dave Love : -1999-07-25 Matt Pharr + * mm-util.el (mm-mime-mule-charset-alist): Make it correct by + construction. + (mm-charset-synonym-alist): Remove windows-125[02]. Make other + entries conditional on not having a coding system defined for + them. + (mm-mule-charset-to-mime-charset): Use + find-coding-systems-for-charsets if defined. + (mm-charset-to-coding-system): Don't use + mm-get-coding-system-list. Look in mm-charset-synonym-alist + later. Add last resort search of coding systems. + (mm-enable-multibyte-mule4, mm-disable-multibyte-mule4) + (mm-with-unibyte-current-buffer-mule4): Just treat Mule 5 like + Mule 4. + (mm-find-mime-charset-region): Re-write. + (mm-with-unibyte-current-buffer): Restore buffer as well as + multibyteness. - * gnus-group.el (gnus-group-make-doc-group): Notice when user - types 'g' for 'guess group type. +2001-10-30 21:00:00 ShengHuo ZHU -1999-07-30 Simon Josefsson + * canlock.el, sha1-el.el, hex-util.el: Move from contrib + directory. Thanks to Katsumi Yamaoka and Shuhei + KOBAYASHI . - * nnmail.el (nnmail-remove-list-identifiers): Remove whitespace - after each regexp in nnmail-list-identifiers, not just after last - one. +2001-10-30 20:00:00 ShengHuo ZHU - * 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 (article-display-x-face): Nix buffer-read-only + again. - * 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. + * mml2015.el (mml2015-gpg-verify): Convert to . -Fri Jul 9 22:21:16 1999 Lars Magne Ingebrigtsen +2001-10-30 13:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.95 is released. + * gnus-spec.el (gnus-parse-simple-format): Use + buffer-substring-no-properties. -1999-07-09 21:46:05 Lars Magne Ingebrigtsen +2001-10-30 Katsumi Yamaoka - * mm-decode.el (mm-mailcap-command): New function. - (mm-display-external): Use it. + * gnus-art.el (article-verify-cancel-lock): New function. - * gnus-art.el (article-make-date-line): Work for India. + * nnheader.el (nntp-process-response): New variable. + (nnheader-init-server-buffer): Make `nntp-process-response' + buffer-local in `nntp-server-buffer'. - * mm-encode.el (mm-qp-or-base64): Typo. + * nntp.el (nntp-prepare-post-hook): New hook. + (nntp-wait-for): Save a server's ID in `nntp-process-response'. + (nntp-async-trigger): Ditto. + (nntp-request-post): Insert a server's ID if there's no Message-ID + header; run `nntp-prepare-post-hook'. - * gnus-topic.el (gnus-topic-goto-topic): Made into command. +2001-10-30 04:00:00 ShengHuo ZHU -Fri Jul 9 19:28:29 1999 Lars Magne Ingebrigtsen + * gnus-art.el (article-decode-group-name): Use nnmail-fetch-field + instead. - * gnus.el: Pterodactyl Gnus v0.94 is released. + * message.el (message-forward-subject-author-subject): Don't use + message-news-p, which widens the buffer. + (message-forward-make-body): New function. + (message-forward): Use it. + (message-insinuate-rmail): New function. + (message-forward-rmail-make-body): New function. -1999-07-09 21:19:23 Stainless Steel Rat +2001-10-30 02:00:00 ShengHuo ZHU - * pop3.el: New version. + * mm-extern.el (mm-extern): Provide it. -1999-07-09 20:01:44 Lars Magne Ingebrigtsen + * mm-partial.el (mm-partial): Provide it. - * mm-encode.el (mm-qp-or-base64): New function. - (mm-content-transfer-encoding): Use it. +2001-10-28 16:00:00 ShengHuo ZHU - * gnus-util.el (gnus-parse-netrc): Allow quoted names. + * gnus-msg.el (gnus-setup-message): Call post-command-hook. -1999-07-08 Shenghuo ZHU +2001-10-29 Simon Josefsson - * mm-decode.el (mm-display-external): Fix typo and use 'non-viewer. + * mml.el (mml-preview): Bind message-this-is-news if it is + news. From Jesper Harder . - * mailcap.el (mailcap-mailcap-entry-passes-test): Add needsterminal. +2001-10-28 Simon Josefsson -1999-07-09 18:52:22 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-group-make-articles-read): Inline group. - * gnus-art.el (gnus-mime-view-part-as-media): New command and - keystroke. +2001-10-29 Per Abrahamsen - * mailcap.el (mailcap-mime-types): New function. + * smiley-ems.el (smiley-regexp-alist): Add support for sad and + ironic smilies. - * nnmh.el (nnmh-request-group): Update nnmh-group-alist. +2001-10-27 Simon Josefsson - * message.el (message-goto-eoh): Really go to the end. + * message.el (message-indent-citation): Don't add trailing + whitespace when citing text. -1999-07-09 18:40:23 Puneet Goel + * gnus.el (gnus-group-faq-directory): Fix. From Jesper Harder + . - * message.el (message-make-date): Do the right thing in with - sub-hour time zones. +2001-10-26 14:00:00 ShengHuo ZHU -1999-07-09 18:36:21 Lars Magne Ingebrigtsen + * nnweb.el (nnweb-possibly-change-server): Create nnweb-hashtb if + not available. + (nnweb-request-scan): Nix nnweb-hashtb if ephemeral. + (nnweb-type-definition): Add google as alias of dejanews. + (nnweb-google-parse-1): Forward 1 line. - * gnus-group.el (gnus-group-make-menu-bar): Removed double bug - report. +2001-10-26 Kai Gro,b_(Bjohann -1999-07-08 Shenghuo ZHU + * gnus-msg.el (gnus-summary-mail-forward): Doc fix: add pointer to + variable `message-forward-ignored-headers'. - * nnfolder.el (nnfolder-request-rename-group): Create directory. +2001-10-24 Per Abrahamsen -1999-07-08 Shenghuo ZHU + * gnus.el (gnus-expand-group-parameter): New function. + (gnus-expand-group-parameters): Call it. + (gnus-group-fast-parameter): New function. + (gnus-group-find-parameter): Call it. - * mailcap.el (mailcap-parse-mailcap): Skip \;. - (mailcap-parse-mailcap-extras): Fix "nonterminal;" and empty name, - and use t as default value. +2001-10-23 Per Abrahamsen -Wed Jul 7 18:40:30 1999 Shenghuo ZHU + * gnus.el (gnus-news-group-p): Rewrote. Now accepts a header + vector (it didn't before because of a bug). + * gnus-msg.el (gnus-post-news): Use header vector directly, if + available. Before it converted it to an article number. - * gnus-sum.el (gnus-get-newsgroup-headers): Don't assume - gnus-summary-buffer is live. + This makes followup to news articles with negative numbers in + nnvirtual groups use news instead of mail. -1999-07-09 17:44:03 Robert Pluim +2001-10-23 Per Abrahamsen - * mm-util.el (mm-enable-multibyte): Check whether var bound. + * gnus.el (post-method): Use `native' instead of `nil'. -1999-07-09 17:31:39 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-post-method): Ditto. - * message.el (message-bounce): Do MIME bounces MIMEy. +2001-10-23 Per Abrahamsen - * gnus-sum.el (gnus-summary-read-group-1): Update mark positions. + * gnus.el (gnus-define-group-parameter): Grammar fix. -1999-07-08 08:41:10 Lars Magne Ingebrigtsen +2001-10-22 Simon Josefsson - * mailcap.el (mailcap-mime-extensions): Changed patch to - text/x-patch. + * gnus-msg.el (gnus-extended-version): Include + system-configuration. + Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann). - * mm-decode.el (mm-display-external): Wrong placement of paren. +2001-10-22 Per Abrahamsen -Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen + * gnus.el (post-method): Customization fix: `native' is not a + valid value. + * gnus-msg.el (gnus-post-method): Doc and customization fix: + `native' is not a valid value. - * gnus.el: Pterodactyl Gnus v0.93 is released. +2001-10-21 Simon Josefsson -1999-07-08 Alexandre Oliva + * nnimap.el (nnimap): Defgroup + (nnimap-strict-function, nnimap-strict-function-match): New + widget, from Per Abrahamsen . + (nnimap-split-crosspost, nnimap-split-inbox) + (nnimap-split-rule, nnimap-split-predicate) + (nnimap-split-predicate): Defcustom. + (nnimap-split-inbox, nnimap-expunge-search-string) + (nnimap-importantize-dormant): Remove "*" from doc. - * gnus-cus.el (gnus-group-parameters): New entries for - gnus-group-split. +2001-10-20 Kai Gro,b_(Bjohann - * gnus-mlspl.el: Renamed functions and variables so as to - start with gnus-group-split. - * gnus.el: Adjust autoload entries. + * gnus-sum.el (gnus-summary-limit-to-score): Prompt for score if + not supplied via prefix arg. From Lisp, make arg mandatory. + Suggested by Frank Schmitt. -1999-07-07 ??:??:?? Alexandre Oliva +2001-10-20 Per Abrahamsen - * 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. + * message.el (message-do-auto-fill): Avoid calling + 'rfc822-goto-eoh'. -1999-07-06 05:37:46 Alexandre Oliva +2001-10-20 Kai Gro,b_(Bjohann + From Paul Jarc . - * 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. + * message.el (message-get-reply-headers): Restructure the logic + and add comments. From Paul Jarc . - * nnmail.el (nnmail-split-fancy): Document RESTRICT clauses. - (nnmail-split-it): Implement them. +2001-10-20 Simon Josefsson - * nnmail.el (nnmail-split-fancy): Document ! splits. + * message.el (message-cancel-news): Support cancel-locks. + Suggested by Per Abrahamsson. -1999-07-07 10:41:11 Stainless Steel Rat + * nnml.el (nnml-marks-changed-p): Use `equal' when comparing + conses. From David Z Maze . - * pop3.el: New version. + * nnfolder.el (nnfolder-marks-changed-p): Ditto. -1999-07-05 Simon Josefsson +2001-10-19 Per Abrahamsen - * gnus-srvr.el (gnus-browse-foreign-server): Use read. + * mm-decode.el (mm-default-directory): Fix customize type. -1999-07-07 10:37:26 Lars Magne Ingebrigtsen + * message.el (message-setup-fill-variables): Kludge to use + normal-auto-fill-function even if auto fill is already activated. - * gnus-art.el (gnus-mime-display-alternative): Do treatment. +2001-10-19 Per Abrahamsen -1999-07-06 Shenghuo ZHU + * message.el (message-do-auto-fill): New version that does not + rely on text properties, by Simon Josefsson . + (message-setup-1): Removed the `message-field' property. - * gnus-util.el (gnus-write-active-file): Use real name. + * gnus-draft.el (gnus-draft-edit-message): Removed the + `message-field' property. - * gnus-agent.el (gnus-agent-expire): Update active file - method by method. +2001-10-19 Per Abrahamsen -1999-07-06 Shenghuo ZHU + * gnus-draft.el (gnus-draft-edit-message): Change `field' to + `message-field'. The `field' property has a special significance in + Emacs 21. - * nndraft.el (nndraft-request-article): Use difference - coding-systems for queue and drafts. + * message.el (message-send, message-setup-1): Ditto. - * gnus-sum.el (gnus-summary-setup-default-charset): Special-case - nndraft:drafts. +2001-10-18 Simon Josefsson - * mm-util.el (mm-auto-save-coding-system): New coding system. + * gnus-sum.el (gnus-group-make-articles-read): Call g-r-set-mark + when undoing. - * message.el (message-draft-coding-system): Use it. +2001-10-18 Simon Josefsson + From Frank Schmitt -1999-07-06 Shenghuo ZHU + * gnus-sum.el (gnus-summary-limit-to-display-predicate): Fix typo. + (gnus-summary-make-menu-bar): Ditto. - * mm-uu.el: More customizable and less aggressive. +2001-10-17 Simon Josefsson -1999-07-07 07:53:23 Lars Magne Ingebrigtsen + * nnimap.el (nnimap-expiry-target): Make sure it is back to the + server. Suggested by ShengHuo ZHU . - * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active - when plugged. +2001-10-17 17:00:00 ShengHuo ZHU - * mml.el (mml-generate-mime-1): Don't insert nofile files. - (mml-insert-mml-markup): Accept a nofile. - (mml-insert-mime): Insert nofile. + * gnus-sum.el (gnus-summary-line-format-alist): user-date entry. + * gnus-util.el (gnus-user-date): New function. + From Frank Schmitt . - * gnus-art.el (gnus-treat-strip-blank-lines): Removed. +2001-10-17 Per Abrahamsen - * 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. "/")) + * message.el (message-check-news-header-syntax): Special case + nnvirtual groups. -1999-05-18 03:03:50 Katsumi Yamaoka + * gnus-sum.el (gnus-summary-respool-default-method): Changed + customize type to `symbol'. - * gnus-art.el (gnus-treat-predicate): Typo. +2001-10-17 12:00:00 ShengHuo ZHU -1999-07-07 06:21:36 Lars Magne Ingebrigtsen + * gnus-spec.el (gnus-parse-simple-format): Support extended spec + %&foo;. + (gnus-parse-simple-format): Support user extended spec too. + %u&foo; invokes gnus-user-format-function-foo. - * gnus-score.el (gnus-summary-score-entry): Made un-interactive. +2001-10-17 11:00:00 ShengHuo ZHU -1999-07-06 17:57:16 Lars Magne Ingebrigtsen + * nnml.el (nnml-request-expire-articles): Make sure it is back to + the server. + * nnmbox.el (nnmbox-request-expire-articles): Ditto. + * nnfolder.el (nnfolder-request-expire-articles): Ditto. + * nnbabyl.el (nnbabyl-request-expire-articles): Ditto. + * nndiary.el (nndiary-request-expire-articles): Ditto. + (nndiary-schedule): Defsubst it before use it. + (nndiary-error): eval-and-compile. - * gnus-art.el (article-date-ut): UT! Default it! +2001-10-17 Per Abrahamsen -Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-post-method): Changed two instances of + `active' to `current' and one `null' to `not'. - * gnus.el: Pterodactyl Gnus v0.92 is released. +2001-10-16 Kai Gro,b_(Bjohann + From Katsumi Yamaoka . -1999-07-06 12:30:59 Johannes Weinert + * message.el (message-setup-fill-variables): Use + `normal-auto-fill-function' instead of `auto-fill-function'. - * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. +2001-10-16 Simon Josefsson -1999-07-06 07:41:07 Lars Magne Ingebrigtsen + * mml2015.el (mml2015-fix-micalg): Fix for Mutt-bug. + (mml2015-gpg-decrypt-1): Decanonicalize decrypted MIME + body. (Mailcrypt seem to do this, but gpg.el doesn't.) - * nntp.el (nntp-retrieve-groups): Don't do anything when not - connected. +2001-10-16 Kai Gro,b_(Bjohann + Patch by Oliver Scholz . - * gnus-start.el (gnus-active-to-gnus-format): Only save active - when plugged. + * gnus-draft.el (gnus-draft-edit-message): Add text property + `field' with value `header' to message headers. + * message.el (message-setup-1): Really add text property to all of + the header, not just part of it. - * mm-view.el (mm-inline-message): Ignore remove-spec. +2001-09-04 Lars Magne Ingebrigtsen - * gnus-agent.el (gnus-agent-write-active): Check whether orig sym - is bound. + * gnus-group.el (gnus-group-sort-by-server): Use it. - * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines. + * gnus.el (gnus-method-to-full-server-name): New, bogus function. - * nndoc.el (nndoc-guess-type): Remove blank lines at the start. + * gnus-topic.el (gnus-topic-sort-groups-by-server): New command + and keystroke. - * nnfolder.el (nnfolder-read-folder): Remove blank lines at the - start. +2001-10-14 Simon Josefsson - * message.el (message-fill-yanked-message): Remove `t' arg. + * dig.el: Doc fix. - * gnus-group.el (gnus-group-kill-group): Message killing of - groups. + * smime.el: Doc fix. - * mm-util.el (mm-preferred-coding-system): New function. - (mm-mime-charset): Use it. + * gnus-msg.el (gnus-inews-do-gcc): Port header encoded-word + charset magic from message.el. - * mml.el (mml-generate-mime-1): Charset-encode message parts. +2001-10-12 Simon Josefsson + Suggested by david.goldberg6@verizon.net (David S. Goldberg) -1999-07-06 07:03:31 Alexandre Oliva + * gnus-cite.el (gnus-article-toggle-cited-text): Don't remove + 'cite from g-a-wash-types. + (gnus-cite-toggle): Ditto. Add 'cite. Set modeline. + (gnus-article-hide-citation): Fix. - * gnus-mlsplt.el: New file. + * gnus-cite.el (gnus-article-hide-citation): Add `c' mode line + character. + (gnus-article-toggle-cited-text): Toggle `c' mode line character. -1999-07-06 05:47:57 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-treat-hide-citation-maybe): Remove duplicate + definition. + (gnus-signature-toggle): Toggle `s' mode line character. - * 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. + * gnus-art.el (article-emphasize): Set `g-a-wash-types' after + doing stuff that clears it. - * nndraft.el (nndraft-request-expire-articles): Delete backup - files. +2001-10-12 Simon Josefsson - * mailcap.el (mailcap-parse-mailcap): Regexp-quote stuff. + * gnus-cache.el (gnus-summary-limit-include-cached): Rewrite. + From Eric Marsden . - * gnus-sum.el (gnus-summary-limit-to-extra): Typo. +2001-10-12 10:00:00 ShengHuo ZHU -1999-07-06 05:37:46 Alexandre Oliva + * message.el (message-do-auto-fill): Use gnus-point-at-bol. + (autoload): Add some autoloads. - * nnmail.el (nnmail-split-it): Allow .*. +2001-10-12 Kai Gro,b_(Bjohann + Suggested by Oliver Scholz . -1999-07-05 05:04:57 Lars Magne Ingebrigtsen + * message.el (message-do-auto-fill): New function. Like + `do-auto-fill' but don't fill when in the message header. + (message-setup-1): Put a text property on the message header. + (message-setup-fill-variables): Use `message-do-auto-fill'. - * mm-decode.el (mm-inline-large-images-p): Renamed. +2001-10-10 12:00:00 ShengHuo ZHU - * gnus-art.el (article-date-ut): Always look in the current buffer - for the Date header. + * message.el (message-send-mail-partially): Insert an empty line + first, because of the change of message-make-lines. - * mml.el (mml-validate): New command. +2001-10-10 Florian Weimer - * mailcap.el (mailcap-possible-viewers): Revert to string-match - since we are dealing with regexps. + * mm-util.el (mm-charset-synonym-alist): If Emacs doesn't support + iso-8859-15, make it an alias for iso-8859-1. -Sun Jul 4 06:31:01 1999 Lars Magne Ingebrigtsen +2001-10-10 Katsumi Yamaoka - * gnus.el: Pterodactyl Gnus v0.91 is released. + * message.el (message-send-news): Don't modify the value of + `message-syntax-checks' if it is not a list (possibly it is + `dont-check-for-anything-just-trust-me'). -1999-07-04 04:35:28 Lars Magne Ingebrigtsen +2001-10-10 Katsumi Yamaoka - * gnus-agent.el (gnus-agent-save-active-1): New function. - (gnus-agent-save-active): use it. - (gnus-agent-save-groups): Ditto. + * gnus-group.el (gnus-group-name-charset-group-alist): Use + `find-coding-system' for XEmacs to check whether the coding-system + `utf-8' is available. - * gnus-cache.el (gnus-cache-write-active): Use it. +2001-10-09 13:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-write-active): Use it. + * dgnushack.el (dgnushack-compile): Detect mh-e and xml. - * gnus-util.el (gnus-write-active-file): New function. +2001-10-09 Per Abrahamsen - * 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. + * message.el (message-send-news): Oops, missed case with no + "Followup-To" header... - * 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. +2001-10-09 Per Abrahamsen - * message.el (message-reply): Bind message-this-is-mail. + * message.el (message-send-news): Allow + `gnus-group-name-charset-group-alist' to affect encoding of the + "Newsgroups" and "Followup-To" headers. -1999-07-03 13:16:31 Michael Klingbeil +2001-10-07 15:00:00 ShengHuo ZHU - * smiley.el (smiley-buffer): Fix for NT. + * Makefile.in (install-el): Depend on gnus-load.el. -1999-07-03 11:26:47 Lars Magne Ingebrigtsen +2001-10-07 13:00:00 ShengHuo ZHU - * mm-encode.el (mm-encode-buffer): Check whether we have 7bit. + * Makefile.in (install-el): Use -f. + From: Amos Gouaux - * message.el (message-check-news-header-syntax): Protect against - nil froms. +2001-10-07 Per Abrahamsen - * mm-util.el (mm-auto-mode-alist): New. + * message.el (message-send-news): Don't encode Followups-To when + `gnus-group-name-charset-group-alist is' ".*". [Yuck] - * mml.el (mml-generate-mime-1): Ditto. + * gnus-util.el (gnus-decode-newsgroups): No space in newsgroup + header. - * gnus.el: Use mm-insert-file-contents throughout instead of - nnheader. + * gnus-art.el (article-decode-group-name): Also decode + "Followup-To". - * mm-util.el (mm-insert-file-contents): New function. + * rfc2047.el (rfc2047-encode-message-header): Encode without + asking for null methods. -Sat Jul 3 07:35:35 1999 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-name-charset-group-alist): Make utf-8 + default charset for newsgroup names in accordance with USEFOR. - * gnus.el: Pterodactyl Gnus v0.90 is released. + * gnus-group.el (gnus-group-name-charset-method-alist, + gnus-group-name-charset-group-alist): Removed "*" from doc + strings, "*" should not be used for complex variables. -1999-07-03 09:31:10 Sven Fischer +2001-10-06 Simon Josefsson - * mailcap.el (mailcap-possible-viewers): Use string=. + Support UTF-8 group names better. -1999-07-01 Shenghuo ZHU + * message.el (message-check-news-header-syntax): Encode group + names before comparison. - * 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. + * gnus-msg.el (gnus-copy-article-buffer): Run all + `gnus-article-decode-hook's except `article-decode-charset' + instead of hardcoding call to one of them. -1999-06-29 Shenghuo ZHU + * gnus-art.el (gnus-article-decode-hook): Add + `article-decode-group-name'. + (article-decode-group-name): New function, use `g-d-n'. - * lpath.el: Two free variables. + * gnus-group.el (gnus-group-insert-group-line): Decode + gnus-tmp-group using `g-d-n'. -1999-07-02 Shenghuo ZHU + * gnus-util.el (gnus-decode-newsgroups): New function. - * 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. +2001-10-06 Per Abrahamsen - * 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-srvr.el (gnus-browse-foreign-server): Fixed bug non-nil + `gnus-group-name-charset-group-alist'. - * 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. +2001-10-06 08:00:00 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. + * Makefile.in: Install el in install. Add uninstall. - * mm-util.el (mm-text-coding-system): raw-text or -dos. - (mm-running-ntemacs): Removed. +2001-10-05 Simon Josefsson - * nnml.el (nnml-file-coding-system): Use nnmail-file-coding-system. + * nnheader.el (gnus-verbose-backends, gnus-nov-is-evil): Custom. -1999-07-02 Shenghuo ZHU + * gnus-sum.el (gnus-summary-move-article): Also activate new groups. - * nnfolder.el (nnfolder-read-folder): Use nnheader-file-coding-system. + * nnfolder.el (nnfolder-normalize-buffer): Don't insert \n\n in + empty folders. -1999-07-01 Shenghuo ZHU + * gnus-sum.el (gnus-select-newsgroup): Don't enable `display' + limiting if read-all (C-u RET) was used. - * qp.el (quoted-printable-encoding-characters): Support lower case. +2001-10-04 Simon Josefsson -1999-07-01 Shenghuo ZHU + * mail-source.el (mail-source-movemail-program): New variable. + (mail-source-movemail): Use it. Suggested by Taylor Hutt + . - * rfc2047.el (rfc2047-encode): Fold before B-encoding. - (rfc2047-b-encode-region): Encode line by line. +2001-10-03 Simon Josefsson -1999-07-03 09:20:16 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): New param. + (gnus-summary-line-format-alist): Fix param. - * mm-util.el (mm-find-mime-charset-region): Fix. +2001-10-02 Simon Josefsson -1999-06-30 KOSEKI Yoshinori + * nnimap.el (nnimap-request-move-article): Use imap.el directly, + don't go through `nnimap-request-expire-articles' to delete the + article. Thanks to prj@po.cwru.edu (Paul Jarc). - * mm-util.el (mm-mime-mule-charset-alist): Fix iso-2022-jp(-2) bug. - (mm-find-mime-charset-region): Ditto. +2001-10-02 10:00:00 ShengHuo ZHU -1999-07-03 09:15:35 Simon Josefsson + * gnus-agent.el (gnus-agent-write-active): The min in the + agent/active may be larger than that in the server/active. - * gnus-sum.el (gnus-summary-move-article): Fix something or - other. +2001-10-01 Simon Josefsson -1999-06-29 Shenghuo ZHU + * mail-source.el (mail-source-fetch-imap): Use BODY.PEEK if server + is IMAP4rev1. - * 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. + * nnml.el (gnus-article-unpropagatable-p): Autoload gnus-sum. -1999-06-15 Shenghuo ZHU + * nnfolder.el: Ditto. - * base64.el (base64-run-command-on-region): Use unibyte buffer. +2001-09-30 Dan Christensen -1999-06-15 Shenghuo ZHU + * gnus-sum.el (gnus-summary-extract-address-component): New function. + (gnus-summary-from-or-to-or-newsgroups): Optimize. - * gnus-msg.el (gnus-configure-posting-styles): Fix bug when - gnus-newsgroup-name is nil. +2001-09-29 Kai Gro,b_(Bjohann -1999-06-15 Shenghuo ZHU + * message.el (message-mode-map): Keybinding for `gnus-delay-article'. + (message-mode-menu): Menu item for same. - * rfc2047.el (rfc2047-encode): Chop the tail newline. + * gnus-group.el (gnus-group-make-menu-bar): Menu item for sending + delayed articles. -1999-06-15 Shenghuo ZHU + * gnus-delay.el (gnus-delay-send-drafts): Do nothing if + nndraft:delayed does not exist. + (gnus-delay-initialize): Don't set up keymap, that's done from + message.el now. + (gnus-delay, gnus-delay-group, gnus-delay-header) + (gnus-delay-default-delay, gnus-delay-default-hour): Customize. - * gnus-art.el (article-emphasize): Use correct - gnus-article-emphasis-alist. +2001-09-29 Simon Josefsson -1999-06-15 Shenghuo ZHU + * mm-util.el (mm-mime-mule-charset-alist): Encode mule-utf-8 as + utf-8, not eight-bit-control. - * mm-view.el (mm-inline-text): Fix text/html bug. + * imap.el (imap-shell-host, imap-default-user, imap-use-utf7) + (imap-log, imap-debug): Custom. + (imap-log-buffer, imap-debug-buffer): New constants. + (imap-kerberos4-open, imap-gssapi-open, imap-ssl-open) + (imap-network-open, imap-shell-open, imap-starttls-open) + (imap-send-command-1, imap-send-command, imap-arrival-filter) + (imap-debug): Use imap-*-buffer. -Mon Jun 28 17:54:01 1999 Lars Magne Ingebrigtsen + * nndoc.el (nndoc-article-type): Add mailman. + (nndoc-type-alist): Ditto. + (nndoc-mailman-type-p): New function. - * gnus.el: Pterodactyl Gnus v0.89 is released. +2001-09-28 07:00:00 ShengHuo ZHU -1999-06-24 Shenghuo ZHU + * gnus-xmas.el (gnus-article-x-face-command): Merge it into + gnus-art.el. - * 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. +2001-09-27 Simon Josefsson -1999-06-23 Shenghuo ZHU + * gnus-topic.el (gnus-topic-mode-map): Add catchup. + (gnus-topic-catchup-articles): New function. Suggested by Robin + S. Socha . - * gnus-xmas.el (gnus-xmas-summary-recenter): A blank line may - cause problem. +2001-09-27 11:00:00 ShengHuo ZHU + From Gerd M,Av(Bllmann . -1999-06-23 Shenghuo ZHU + * gnus-ems.el (gnus-article-display-xface): Insert xface after + previous ones. - * mm-view.el (mm-inline-text): Ignore error in w3-region. +2001-09-27 07:00:00 ShengHuo ZHU + From Daiki Ueno -1999-06-23 Shenghuo ZHU + * gnus-sum.el (gnus-summary-show-article): The arglist of + detect-coding-region is incompatible. - * mml.el: require mm-decode. +2001-09-26 18:00:00 ShengHuo ZHU + From Katsuhiro Hermit Endo -1999-06-23 Shenghuo ZHU + * gnus-group.el (gnus-group-delete-group): Typo. - * gnus-art.el (gnus-display-mime): Treat as head only if necessary. +2001-09-26 Simon Josefsson -1999-06-23 Shenghuo ZHU + * nnmail.el (nnmail-expiry-target-group): Add doc warning. - * mm-view.el (mm-inline-image): Fix image undisplayer. + * nnimap.el (nnimap-expiry-target): Use temp buffer. -1999-06-22 Shenghuo ZHU +2001-09-26 07:00:00 ShengHuo ZHU - * mml.el (mml-insert-multipart): Error in compeling-read. - (mml-insert-tag): Match tags. + * gnus-cus.el (gnus-group-parameters): Display as sexp. -1999-06-19 Shenghuo ZHU +2001-09-22 Simon Josefsson - * gnus-cache.el (gnus-cache-braid-nov): Fix coding-system bug. - (gnus-cache-braid-heads): Ditto. - (gnus-cache-retrieve-headers): Ditto. + * nnml.el (nnml-open-marks): Remove unpropagatable marks. -1999-06-16 Shenghuo ZHU + * nnfolder.el (nnfolder-open-marks): Ditto. - * gnus-draft.el (gnus-draft-send): Fix encoding bug. + * gnus-sum.el (gnus-article-unpropagatable-p): New function. + (gnus-update-marks): Use it. + (gnus-update-marks): Use `gnus-article-mark-to-type' instead of + hardcoded list. -1999-06-16 10:17:29 Katsumi Yamaoka + * gnus.el (gnus-article-special-mark-lists): Add killed. + (gnus-article-unpropagated-mark-lists): New constant. - * gnus-art.el (gnus-article-read-summary-keys): Convert key events - to string under XEmacs. +2001-09-22 Simon Josefsson -1999-06-28 19:34:03 Petersen Jens-Ulrik + * gnus-sum.el (gnus-summary-mode-hook): Add gnus-pick-mode as + custom option. - * gnus-start.el (gnus-find-new-newsgroups): Doc fix. +2001-09-23 Simon Josefsson -1999-06-22 Shenghuo ZHU + * gnus-draft.el (gnus-draft-setup): Add mark in backend as well. - * mm-view.el (mm-inline-message): Fix message view bug. - * gnus-art.el (gnus-article-prepare): Ditto. +2001-09-23 02:00:00 ShengHuo ZHU -1999-06-16 Shenghuo ZHU + * gnus-msg.el (gnus-button-mailto): Hack save-selected-window-window. - * gnus-cache.el (gnus-cache-possibly-enter-article): Fetch headers. +2001-09-22 Per Abrahamsen -Tue Jun 15 04:13:01 1999 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-sort-function): Fix customize type to + accept lists of functions. - * gnus.el: Pterodactyl Gnus v0.88 is released. +2001-09-20 Simon Josefsson -1999-06-15 04:13:45 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-catchup): Update expire marks in + backend. Also, if ALL also set expire marks on tick/dormant. - * gnus-sum.el (gnus-summary-save-parts): Destroy handles after - usage. +2001-09-20 Kai Gro,b_(Bjohann - * nnmail.el (nnmail-get-new-mail): Save info. + * message.el (message-tab-body-function): New variable. + * message.el (message-tab): Use it. -Mon Jun 14 01:15:59 1999 Lars Magne Ingebrigtsen +2001-09-19 Sam Steingold - * gnus.el: Pterodactyl Gnus v0.87 is released. + * gnus-win.el (gnus-buffer-configuration): Respect + `gnus-bug-create-help-buffer'. -1999-06-14 02:46:05 Lars Magne Ingebrigtsen +2001-09-18 Simon Josefsson - * mail-source.el (mail-source-fetch-file): Use prescript-delay. - (mail-source-run-script): New function. - (mail-source-fetch-pop): Use it. + * gnus-spec.el (gnus-correct-pad-form): Re-revert. + (gnus-parse-simple-format): Re-revert. -1999-06-13 09:52:11 Lars Magne Ingebrigtsen +2001-09-16 Katsuhiro Hermit Endo + Trivial patch. - * gnus-art.el (gnus-article-setup-highlight-words): Moved here. + * gnus-spec.el (gnus-parse-complex-format): Don't fold search + case. (Thanks to Daiki Ueno .) -Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen +2001-09-18 Simon Josefsson - * gnus.el: Pterodactyl Gnus v0.86 is released. + * gnus-spec.el (gnus-correct-pad-form): Remove until papers are + signed. + (gnus-parse-simple-format): Don't use it. -1999-06-13 08:51:25 Lars Magne Ingebrigtsen +2001-09-17 Miles Bader - * 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-srvr.el (gnus-server-insert-server-line): Don't let an + error querying a backend abort the whole process. -1999-06-09 Markus Rost +2001-09-17 08:00:00 ShengHuo ZHU - * gnus/gnus-group.el (gnus-permanently-visible-groups): Fix custom - type. + * gnus-srvr.el (gnus-server-mode): Fix bogus fontification. + From Gerd M,Av(Bllmann . -1999-06-13 05:15:52 Lars Magne Ingebrigtsen +2001-09-17 Didier Verna - * gnus-art.el (article-babel): Narrow a bit. + * nndiary.el: version 0.2-b14. + * gnus-diary.el (gnus-diary-check-message): fix `read-string' + compatibility problem with XEmacs 21.1. - * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow. +2001-09-15 Simon Josefsson -1999-06-12 Simon Josefsson + * gnus-group.el (gnus-group-line-format): Document %c. - (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. + * nnml.el (nnml-parse-head): Handle CRLF files. + (nnml-generate-nov-file): Ditto. + (nnml-retrieve-headers): Ditto. -1999-06-13 03:01:35 Lars Magne Ingebrigtsen +2001-09-15 Michael Welsh Duggan - * gnus-sum.el (gnus-summary-limit-to-extra): New command and - keystroke. + * gnus-spec.el (gnus-parse-format): Don't treat %c as %C. - * gnus-art.el (gnus-article-x-face-command): Ditto. +2001-09-13 Martin Kretzschmar - * gnus-uu.el (gnus-uu-default-view-rules): Default to "display". + * gnus-spec.el (gnus-correct-substring): Still stopped one + character before we wanted (never included last character). + (gnus-tilde-max-form, gnus-tilde-cut-form) Made readable again, + add missing "," (once per function) - * gnus.el (gnus-method-simplify): Accept server names. +2001-09-14 Simon Josefsson -1999-06-13 02:36:15 Per Abrahamsen + * gnus-start.el (gnus-group-mode-hook): Moved from gnus-group + (otherwise e.g. gnus-agentize in .gnus overrides the customized + default before gnus-group is loaded and the variable set.) - * gnus-art.el (article-babel-prompt): New function. - (article-babel): New command. + * nnimap.el (nnimap-request-set-mark): Do not store bookmark, + killed or unsent marks. -1999-06-13 01:01:52 Lars Magne Ingebrigtsen + * gnus-draft.el (gnus-draft-setup): Don't set mark when there + isn't an article to set it on (e.g. when you `a' in a group). - * gnus-art.el (gnus-article-part-wrapper): Go to part. +2001-09-12 Pavel Jan,Am(Bk - * mml.el (mml-generate-mime-1): Don't insert literally. + * mm-util.el (mm-charset-synonym-alist): add windows-1250 so we + can read e-mails from Microsoft Outlook users not using ISO + 8859-2 character set. - * 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. +2001-09-12 18:00:00 ShengHuo ZHU -Wed May 5 13:51:13 1999 Shenghuo ZHU + * gnus-diary.el: Minor modifications to avoid warnings. + (gnus-summary-misc-menu): defvar. + (gnus-diary-check-message): Use gnus-point-at-eol. + (gnus-diary-kill-entire-line): eval-and-compile. - * mm-view.el (mm-inline-text): Fix charset for text/html. +2001-09-12 Didier Verna -Wed May 5 01:15:08 1999 Shenghuo ZHU + * nndiary.el: new version (0.2-b13). + * nndiary.el (nndiary-mail-sources): doc update. + * nndiary.el (nndiary-split-methods): ditto. + * nndiary.el (nndiary-request-accept-article-hooks): New. + * nndiary.el (nndiary-request-accept-article): use it, check + message validity. + * nndiary.el (nndiary-get-new-mail): changed default to nil. + * nndiary.el (nndiary-schedule): fix bug (misplaced + condition-case): it didn't return nil on error. + * gnus-diary.el: new version. + * gnus-diary.el (gnus-diary-summary-line-format): removed %I. + * gnus-diary.el (gnus-diary-header-value-history): New. + * gnus-diary.el (gnus-diary-narrow-to-headers): New. + * gnus-diary.el (gnus-diary-add-header): New. + * gnus-diary.el (gnus-diary-check-message): New. + * gnus-diary.el (message-mode-map): bind the above to `C-c D c'. + * gnus-diary.el (gnus-article-edit-mode-map): ditto. - * message.el (message-draft-coding-system): Use emacs-mule-dos. +2001-09-10 TSUCHIYA Masatoshi -1999-06-12 07:29:39 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-select-newsgroup): Make + `gnus-current-select-method' buffer-local. - * 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. + * gnus-art.el (gnus-request-article-this-buffer): Refer + `gnus-current-select-method' in the current summary buffer. - * mail-source.el (mail-source-callback): Return the number from - the callback. +2001-09-10 Simon Josefsson + From Daniel Pittman - * message.el (message-send-mail): Generate Lines. + * gnus-spec.el (gnus-correct-pad-form): Fix. - * mail-source.el (mail-source-call-script): New function. - (mail-source-call-script): New function. +2001-09-09 Simon Josefsson -Sun May 2 02:00:27 1999 Shenghuo ZHU + * mm-decode.el (mm-inline-media-tests): Add + application/x-emacs-lisp. + (mm-attachment-override-types): Add + application/{x-,}pkcs7-signature. - * 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. + * gnus-srvr.el (gnus-server-mode-hook, gnus-server-exit-hook) + (gnus-server-line-format, gnus-server-mode-line-format) + (gnus-server-browse-in-group-buffer): Customize. -1999-06-12 03:59:56 Lars Magne Ingebrigtsen +2001-09-08 16:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-message-insert-stylings): Removed. - (gnus-posting-style-alist): Removed. - (gnus-message-style-insertions): Ditto. - (gnus-configure-posting-styles): Reimplementation. + * nnml.el (nnml-marks-changed-p): Typo. + (nnml-save-marks, nnml-open-marks): Use gnus-sethash. + (nnml-marks-changed-p): Use gnus-gethash. + (nnml-marks-modtime): Use gnus-make-hashtable. - * mail-source.el (mail-source-fetch): Error the message. + * nnfolder.el (nnfolder-marks-changed-p): Typo. + (nnfolder-request-expire-articles, nnfolder-save-marks) + (nnfolder-open-marks): Typo. + (nnfolder-save-marks, nnfolder-open-marks): Use gnus-sethash. + (nnfolder-marks-changed-p): Use gnus-gethash. + (nnfolder-marks-modtime): Use gnus-make-hashtable. - * gnus-msg.el (gnus-inews-do-gcc): Do mml and encoding. +2001-09-08 Simon Josefsson -Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen + * nnfolder.el (nnfolder-marks-modtime): New variable. + (nnfolder-marks-changed-p): New function. + (nnfolder-save-marks, nnfolder-open-marks): Save modtime. + (nnfolder-request-update-info): Don't update if marks didn't change. - * gnus.el: Pterodactyl Gnus v0.85 is released. + * nnml.el (nnml-marks-modtime): New variable. + (nnml-marks-changed-p): New function. + (nnml-save-marks, nnml-open-marks): Save modtime. + (nnml-request-update-info): Don't update if marks didn't change. -1999-04-20 Michael Cook + * gnus-agent.el (gnus-agent-any-covered-gcc) + (gnus-agent-add-server, gnus-agent-remove-server): Use + gnus-agent-method-p. - * gnus-cite.el (gnus-cite-attribution-prefix): Tweak for MS - Outlook citation regex. + * gnus-art.el (gnus-buttonized-mime-types): New variable. + (gnus-unbuttonized-mime-type-p): Use it. -1999-06-12 02:09:49 Lars Magne Ingebrigtsen + * gnus-agent.el (gnus-agent-fetch-group): If online, actually + fetch group. - * nndoc.el (nndoc-mime-parts-type-p): Accept space before - semicolon. +2001-09-08 Simon Josefsson + From Daniel Pittman -1999-05-24 Simon Josefsson + * gnus-spec.el (gnus-correct-pad-form): New function. + (gnus-parse-simple-format): Use it. - * gnus-range.el (gnus-remove-from-range): Document range1 - modification, protect range2. +2001-09-07 Simon Josefsson -1999-05-24 Simon Josefsson + * gnus-group.el (gnus-group-sort-groups): Unmark all groups. + (gnus-group-sort-selected-groups): Ditto. Suggested by Harry + Putnam . + (gnus-group-sort-selected-groups): Touch dribble file. - * gnus-sum.el (gnus-update-marks): Protect lists from - gnus-remove-from-range, don't sort twice. +2001-09-07 Raja R Harinath -1999-05-21 Simon Josefsson + * nnml.el (nnml-filenames-are-evil): New variable. + (nnml-article-to-file-alist): Rename to ... + (nnml-current-group-article-to-file-alist): ... this. + Respect `nnml-filenames-are-evil'. + (nnml-active-number): Update. + (nnml-update-file-alist): Update. + (nnml-request-article): Use nnheader-article-to-file-alist. + (nnml-request-rename-group): Likewise. - * gnus-start.el (gnus-read-descriptions-file): Protect if no - function in backend. +2001-09-06 Katsumi Yamaoka -1999-05-15 Simon Josefsson + * gnus-sum.el (gnus-summary-insert-line): Fix. - * gnus-sum.el (gnus-valid-move-group-p): Check for a - request-accept-article function in the backend instead of using - the 'respool capability. +2001-09-06 Bj,Av(Brn Torkelsson -1999-04-18 Hrvoje Niksic + * gnus-sum.el: Bind g-s-t-s to "W g". + * gnus-sum.el (gnus-summary-make-menu-bar): Add g-s-t-s. + * gnus-sum.el (gnus-summary-toggle-smiley): New function. Toggles + display of graphical smilies. - * mm-bodies.el (mm-decode-content-transfer-encoding): Handle - spurious whitespace at eob. +2001-09-07 02:00:00 ShengHuo ZHU -1999-06-12 02:02:06 Adrian Aichner + * gnus-start.el (gnus-setup-news): A typo. + From Bill White . - * nnmail.el (nnmail-get-new-mail): Check right variable. +2001-09-06 Simon Josefsson -1999-06-12 01:57:39 Karl Kleinpaste + * gnus-sum.el (gnus-summary-insert-line): Insert forwarded, recent + and unseen marks. - * mailcap.el (mailcap-mime-data): Fix rfc822. +2001-09-05 Kai Gro,b_(Bjohann -1999-06-11 23:48:50 TOZAWA Akihiko + * nnmail.el (nnmail-split-fancy): Document `junk'. - * nndoc.el (nndoc-nsmail-type-p): New function. - (nndoc-type-alist): Recognize nsmail. +2001-09-04 Simon Josefsson -1999-05-12 Mike McEwan + * imap.el (imap-search): Don't error if server is broken. - * gnus-art.el (gnus-treatment-function-alist): Display `x-face' - *before* `article-hide-headers' deletes the information. +2001-09-02 Benjamin Rutt -1999-05-22 00:26:46 Lars Magne Ingebrigtsen + * nnmbox.el (nnmbox-find-article): Fix infinite loop when + searching for an article that isn't in the mbox. - * gnus-sum.el (gnus-summary-save-parts): New command and - keystroke. - (gnus-summary-save-parts-1): New function. - (gnus-summary-iterate): Buggy. +2001-09-02 23:12:48 Lars Magne Ingebrigtsen - * mm-decode.el (mm-save-part-to-file): Made into own function. + * nnslashdot.el (nnslashdot-retrieve-headers-1): Get references + right, and get all the comments. -1999-05-11 05:53:16 Lars Magne Ingebrigtsen +2001-09-02 Simon Josefsson + Suggested by Dan Christensen - * gnus-group.el (gnus-group-set-info): Resist nils. + * nnfolder.el (nnfolder-request-update-info): Fix message. -1999-05-04 19:26:08 Lars Magne Ingebrigtsen + * nnml.el (nnml-request-update-info): Ditto. - * mailcap.el (mailcap-mime-data): Ditto. +2001-09-01 Simon Josefsson - * gnus-uu.el (gnus-uu-default-view-rules): Ditto. + * nnml.el (nnml-request-expire-articles): Also bind + `nnml-current-group' and `nnml-article-file-alist' when using + expiry-target. (Otherwise nnml will be in a inconsistent internal + state causing all kind of problems.) + (nnml-request-expire-articles): If `nnml-article-to-file' or + `file-attributes' failes, return article as un-expirable instead + of treating it as expired. - * gnus-art.el (gnus-article-x-face-command): Default to ee. +2001-08-31 Sam Steingold -1999-05-02 Gareth Jones + * imap.el (imap-mailbox-examine, imap-mailbox-examine-1): Fix a + typo: `exmine' --> `examine'. - * gnus-art.el (article-make-date-line): Put X-Sent below Date if - gnus-article-date-lapsed-new-header is t. +2001-08-30 13:00:00 ShengHuo ZHU -Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen + * nndoc.el (nndoc-forward-type-p): It is not a digest. - * gnus.el: Pterodactyl Gnus v0.84 is released. +2001-08-30 11:00:00 ShengHuo ZHU -1999-05-01 22:23:21 Lars Magne Ingebrigtsen + * nnml.el (nnml-check-directory-twice): Remove. + (nnml-retrieve-headers): Ditto. + (nnml-article-to-file): Use nnheader-directory-files-is-safe. - * gnus-msg.el (gnus-bug-message): Mime change. +2001-08-30 Andrew Innes -1999-04-22 Simon Josefsson + * nnheader.el (nnheader-directory-files-is-safe): No need to read + directory twice on Windows, or on GNU Emacs-21. - * gnus-sum.el (gnus-update-marks): Process null mark lists. +2001-08-30 Andrew Innes -1999-04-21 Hrvoje Niksic + * nnml.el (nnml-request-article): Use nnml-article-to-file-alist. + (nnml-request-rename-group): Ditto. + (nnml-active-number): Ditto. + (nnml-request-create-group): Use nnml-directory-articles. + (nnml-request-expire-articles): Use nnml-directory-articles, which + gets list from nov database if available. + (nnml-get-nov-buffer): New function. + (nnml-open-nov): Use it. + (nnml-update-file-alist): Use nnml-article-to-file-alist, which + gets alist from nov database if available. + (nnml-directory-articles): New function. + (nnml-article-to-file-alist): New function. - * mm-bodies.el (mm-decode-content-transfer-encoding): Recognize - `x-uue'. +2001-08-30 Andrew Innes -1999-03-04 Aaron M. Ucko + * mm-decode.el (mm-display-external): Use `name' as filename, if + `filename' attribute is not present. - * mail-source.el (mail-source-fetch-pop): Only prompt for password - when authentication is 'password. +2001-08-30 Andrew Innes -1999-05-01 22:17:55 + * mail-source.el (mail-source-flash): New defcustom. + (mail-source-new-mail-p): Ring visible bell if appropriate. + (mail-source-start-idle-timer): Use unwind-protect to ensure idle + timer is cleared even if mail check signals an error. - * gnus-win.el (gnus-configure-windows): Accept a setting. +2001-08-29 10:00:00 ShengHuo ZHU -1999-04-21 20:51:13 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-move-article): Only update marks of + type 'list. - * mm-util.el (mm-quote-arg): Moved here. +2001-08-29 00:00:00 ShengHuo ZHU - * mm-decode.el (mm-quote-arg): Quote more chars. + * flow-fill.el (fill-flowed): eol might be point-max. -1999-04-18 20:12:49 Lars Magne Ingebrigtsen +2001-08-27 Simon Josefsson - * nnheader.el (nnheader-parse-head): Message-ID in In-Reply-To - with newlines would create buggy .nov files. + * nnml.el (nnml-request-update-info): Fix message. + (nnml-open-marks): Ditto. - * gnus-art.el (gnus-article-date-lapsed-new-header): Default to nil. + * nnfolder.el (nnfolder-request-update-info): + (nnfolder-open-marks): Fix message. - * qp.el (quoted-printable-encode-region): Encode whitespace at the - end of lines. +2001-08-25 Simon Josefsson - * message.el (message-mode): Doc fix. + * nnfolder.el (nnfolder-save-marks): Don't create directory named + after group in ~/. - * gnus-art.el (article-hide-headers): Delete the hidden headers. +2001-08-25 Simon Josefsson + From Andreas Jaeger - * gnus-msg.el (gnus-setup-posting-charset): Default group to "". + * nnfolder.el (nnfolder-open-marks): Fix typo. + * nnml.el (nnml-open-marks): Likewise. - * gnus-art.el (article-date-ut): Rewrite. +2001-08-25 Simon Josefsson - * mm-decode.el (mm-preferred-alternative-precedence): Reverse the - order. + Make nnfolder groups self-contained as far as marks are concerned. - * gnus-msg.el (gnus-message-insert-stylings): Remove duplicate - headers. + * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil) + (nnfolder-marks, nnfolder-marks-file-suffix): New variables. + (nnfolder-open-server): Make marks directory. + (nnfolder-request-delete-group): Delete marks file. + (nnfolder-request-delete-group): Check of nov/marks file exist + before deleting. + (nnfolder-request-rename-group): Rename marks file. + (nnfolder-request-rename-group): Only rename nov/mark if they exists. + (nnfolder-request-set-mark, nnfolder-request-update-info) + (nnfolder-group-marks-pathname, nnfolder-save-marks) + (nnfolder-open-marks): New functions. + (top-level): Require gnus. - * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix. +2001-08-25 09:00:00 ShengHuo ZHU -1999-04-18 Didier Verna + * nnweb.el (nnweb-type-definition): Use google raw file. + (nnweb-google-parse-1): Ditto. + (nnweb-google-identity): Ditto. + (nnweb-reference-wash-article): Move nnweb-decode-entities here. + (nnweb-altavista-wash-article): Ditto. + (nnweb-request-article): Remove nnweb-decode-entities. - * gnus-art.el (gnus-article-date-lapsed-new-header): new variable. - (article-date-ut): use it. + * nnml.el: Require 'gnus. -1999-04-18 20:06:20 Lars Magne Ingebrigtsen +2001-08-25 Simon Josefsson - * mail-source.el (mail-source-fetch-pop): Call script - asynchronously. + * nnml.el (nnml-marks-is-evil): Add doc. -Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen +2001-08-25 Simon Josefsson - * gnus.el: Pterodactyl Gnus v0.83 is released. + * nnml.el (nnml-save-marks): Wrap saving marks in a + condition-case, to allow user to start Gnus if saving marks failed + for some reason. -1999-04-18 10:55:57 Lars Magne Ingebrigtsen +2001-08-24 16:05:38 Lars Magne Ingebrigtsen - * gnus-draft.el (gnus-draft-mode): Use mml minor mode. + * gnus-spec.el (gnus-compile): Don't compile gnus-version. - * gnus-cite.el (gnus-dissect-cited-text): Off-by-one error. + * gnus-group.el (gnus-update-group-mark-positions): Bind + gnus-group-update-hook to nil. - * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads. +2001-08-24 13:00:00 ShengHuo ZHU - * gnus-art.el (gnus-mime-inline-part): Don't do a charset param. + * mml.el (mml-generate-mime-1): Force as multibyte string. - * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp. +2001-08-24 12:00:00 ShengHuo ZHU - * message.el (message-generate-headers): Accept continuation - headers. + * gnus-sum.el (gnus-summary-insert-line) + (gnus-summary-prepare-threads): gnus-tmp-lines should be a string. + From Martin Kretzschmar -1999-04-18 10:48:57 Renaud Rioboo + * gnus-spec.el (gnus-correct-substring): Take optional END. - * gnus-demon.el (gnus-demon-time-to-step): Not strings. + * nnrss.el (nnrss-request-article): Remove \n. + (nnrss-retrieve-headers): Lines number is -1. -1999-04-18 08:21:52 Lars Magne Ingebrigtsen +2001-08-24 Simon Josefsson - * gnus-art.el (gnus-treatment-function-alist): use - maybe-hide-headers. + * gnus-group.el (gnus-info-clear-data): Call + nnfoo-request-set-mark to propagate marks. Fix bug: + `gnus-group-update-line' doesn't update read range unless we call + `gnus-get-unread-articles-in-group' first. - * message.el (message-inhibit-body-encoding): Typo. - (message-resend): Inhibit encoding. + * nnimap.el (nnimap-request-set-mark): Don't propagate seen flags + to server. - * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047. +2001-08-23 21:00:00 ShengHuo ZHU - * gnus-art.el (article-remove-cr): Use re-search. + * gnus-util.el (gnus-create-info-command): Return an interactive + function. - * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME - headers. +2001-08-23 19:00:00 ShengHuo ZHU + From Katsumi Yamaoka - * mm-decode.el (mm-quote-arg): Quote '. + * gnus-spec.el (gnus-parse-complex-format): Use equal. - * gnus-ems.el (gnus-x-splash): Would place splash wrongly. +2001-08-23 18:43:05 Lars Magne Ingebrigtsen - * mm-decode.el (mm-insert-part): Use multibyte for text. + * gnus-sum.el (gnus-select-newsgroup): Use it. - * gnus-start.el (gnus-read-newsrc-file): New variable. - (gnus-read-newsrc-file): Use it. + * gnus-util.el (gnus-not-ignore): New function. -1999-04-17 18:51:54 Lars Magne Ingebrigtsen + * lpath.el (featurep): Don't fbind char-int. - * nnvirtual.el (nnvirtual-request-expire-articles): New function. + * gnus-util.el (gnus-create-info-command): New function. - * gnus-group.el (gnus-group-expire-articles-1): Made into own - function. + * gnus-group.el (gnus-group-edit-group): Make C-c C-i go to the + right node. -Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-select-newsgroup): Clean up. + (gnus-summary-limit-children): Use 'identity instead of `all'. + (gnus-summary-limit-to-display-predicate): New command and + keystroke. - * gnus.el: Pterodactyl Gnus v0.82 is released. +2001-08-23 10:00:00 ShengHuo ZHU -1999-04-15 Hrvoje Niksic + * nnrss.el (nnrss-group-alist): Use fm-releases.rdf. - * gnus-sum.el (gnus-group-charset-alist): Include Croatian groups - for iso8859-2. + * gnus-spec.el (gnus-format-specs): Miss a right parenthesis. -1999-04-17 18:23:50 Lars Magne Ingebrigtsen +2001-08-23 18:43:05 Lars Magne Ingebrigtsen - * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from - synonym alist. + * gnus-spec.el: Add the Gnus version. + (gnus-update-format-specifications): If the Gnus version changes, + nix out the format spec cache. -1999-04-17 18:03:38 Adam P. Jenkins + * gnus.el (gnus-continuum-version): Made into a command and + optionalize the VERSION. - * gnus-sum.el (gnus-summary-local-variables): Mark as global. + * gnus-spec.el (gnus-parse-complex-format): Remove %C specs from + the start of the lines. -1999-04-17 18:02:05 Ettore Perazzoli +2001-08-22 00:06:52 Lars Magne Ingebrigtsen - * mail-source.el (mail-source-fetch): Ask before bugging out. + * gnus.el (gnus-visual-p): Define function before use of + function. -1999-03-19 Hrvoje Niksic +2001-08-21 23:28:02 Lars Magne Ingebrigtsen - * uudecode.el (uudecode-decode-region-external): Don't assume - uudecode-temporary-file-directory ends with a slash. + * gnus-sum.el (gnus-adjust-marked-articles): Use new variable. + (gnus-article-mark-to-type): New function. + (gnus-update-missing-marks): Only update marks of type 'list. -1999-03-18 Simon Josefsson + * gnus.el (gnus-article-special-mark-lists): New variable. - * gnus-sum.el (gnus-update-marks): - (gnus-update-read-articles): - (gnus-summary-expire-articles): Check server. +2001-08-21 12:00:00 ShengHuo ZHU -1999-03-16 Simon Josefsson + * gnus-sum.el (gnus-summary-limit-children): Check 'all. + (gnus-select-newsgroup): Still use 'all. + (gnus-summary-initial-limit): Comparing with 'all. - * mml.el (mml-preview): New function. +2001-08-20 16:00:00 ShengHuo ZHU -1999-04-17 17:10:21 William M. Perry + * gnus-start.el (gnus-activate-group): If dont-check, don't update + active. - * mail-source.el (mail-source-fetch-file): Return the right - value. +2001-08-20 15:00:00 ShengHuo ZHU -1999-04-17 07:52:17 Lars Magne Ingebrigtsen + * nnslashdot.el (nnslashdot-retrieve-headers-1): Replace + nnslashdot-*-retrieve-headers. + (nnslashdot-request-article): Fix for slashcode 2.2. + (nnslashdot-make-tuple): New function. + (nnslashdot-read-groups): Use it. - * mml.el (mml-insert-parameter): New function. - (mml-insert-parameter-string): New function. +2001-08-20 01:34:03 Lars Magne Ingebrigtsen - * nnmail.el (nnmail-get-new-mail): Say how many new articles. + * gnus.el (gnus-expand-group-parameters): Don't alter the variable + list. - * gnus-art.el (gnus-mime-multipart-functions): New variable. - (gnus-mime-display-part): Use it. + * gnus-sum.el (gnus-summary-move-article): Don't select article. - * mm-decode.el (mm-alternative-precedence): Removed. - (mm-discouraged-alternatives): New variable. - (mm-preferred-alternative-precedence): New function. +2001-08-20 Simon Josefsson - * nnmail.el (nnmail-get-new-mail): Use mail-sources. + * gnus-msg.el (gnus-inews-do-gcc): If archive server can't be + opened, error instead of continuing (and exploding later). - * mail-source.el (mail-sources): New variable. +2001-08-20 01:34:03 Lars Magne Ingebrigtsen - * gnus-art.el (article-remove-cr): Remove several trailing CRs. + * gnus.el (gnus-expand-group-parameters): Return the parameter + list. - * 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-sum.el (gnus-summary-show-article): Doc fix. + (gnus-summary-show-article): Guess at charset if required. - * gnus-agent.el (gnus-agent-fetch-groups): Error when unplugged. - (gnus-agent-fetch-group): Ditto. + * gnus-spec.el (gnus-correct-substring): Stopped one character + before we wanted. -1999-04-12 Didier Verna +2001-08-19 Pavel Jan,Am(Bk - * 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. + * earcon.el (earcon-auto-play): Remove unused option. -Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen +2001-08-19 16:14:41 Lars Magne Ingebrigtsen - * gnus.el: Pterodactyl Gnus v0.81 is released. + * gnus-score.el (gnus-score-headers): Move the "Scoring..." + message down in levels, since it happens very fast. -1999-04-16 15:54:02 Lars Magne Ingebrigtsen + * smiley-ems.el (smiley-update-cache): Respect the symbol version + of smiley-regexp-alist. - * gnus-sum.el (gnus-get-split-value): Reverse result. + * mm-view.el (mm-inline-text): Ignore vcard errors. -1999-04-03 00:17:24 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-ignored-headers): Added more junk headers. - * gnus-start.el (gnus-always-read-dribble-file): Doc fix. + * gnus-score.el (gnus-all-score-files): Use append instead of + nconc. -1999-04-02 15:33:43 Lars Magne Ingebrigtsen + * gnus.el (gnus-splash-face): Doc fix. - * mml.el (mml-insert-tag): Insert concluding part. + * mm-decode.el (mm-mailcap-command): Use + mm-path-name-rewrite-functions. + (mm-path-name-rewrite-functions): New variable. - * message.el (message-send-mail): Encode later. - (message-send-news): Ditto. + * gnus-spec.el (gnus-parse-complex-format): React to ?=. + (gnus-complex-form-to-spec): Insert tab. + (gnus-spec-tab): New function. - * nnfolder.el: Don't use mail delim. + * gnus-sum.el (gnus-select-newsgroup): Set the marks before + entering the group. -1999-03-28 19:14:27 Lars Magne Ingebrigtsen + * gnus-spec.el (gnus-complex-form-to-spec): Insert Lisp to match + the positional spec. + (gnus-parse-complex-format): React to %C. - * gnus-cus.el (gnus-group-customize): Put point at min. + * gnus-ems.el (gnus-char-width): Moved here. - * mm-view.el (mm-inline-text): Allow toggling html. + * gnus-sum.el (gnus-select-newsgroup): Set + gnus-newsgroup-articles. + (gnus-unseen-mark): New variable. + (gnus-newsgroup-unseen): Ditto. + (gnus-newsgroup-seen): Ditto. + (gnus-adjust-marked-articles): Use them. + (gnus-update-marks): Use them. + (gnus-summary-update-secondary-mark): Display. + (gnus-summary-prepare-threads): Display. -1999-03-28 17:11:15 William M. Perry + * gnus-msg.el (gnus-inews-group-method): Use and return the + method, not the server. - * mail-source.el: Added prescript and postscript to file. +2001-08-19 Simon Josefsson -1999-03-28 13:46:00 Lars Magne Ingebrigtsen + * gnus-srvr.el (gnus-server-agent-face): New. + (gnus-server-agent-face): New. + (gnus-server-mode): Turn on font-lock-mode. - * nnmail.el: Reverted. + * gnus.el (gnus-server-visual): Add defgroup. - * gnus-msg.el (gnus-setup-posting-charset): Didn't work. - (gnus-setup-posting-charset): Did work. +2001-08-19 Simon Josefsson + From Joe Casadonte -1999-03-28 13:19:50 Jae-you Chung + * gnus-srvr.el (gnus-server-opened-face, gnus-server-closed-face, + gnus-server-denied-face): New. + (gnus-server-opened-face, gnus-server-closed-face, + gnus-server-denied-face): New. + (gnus-server-font-lock-keywords): Add. - * gnus.el (gnus-short-group-name): Use - gnus-group-uncollapsed-levels. +2001-08-19 Simon Josefsson -1999-03-28 13:11:43 Lars Magne Ingebrigtsen + * nnml.el (nnml-request-set-mark): Return nil. + (nnml-save-marks): Use nnml-possibly-create-directory. + (nnml-open-marks): Only work in temp buffer when inserting/reading + .marks file. - * gnus-cite.el (gnus-dissect-cited-text): Don't remove overlays. +2001-08-18 19:00:00 ShengHuo ZHU -1999-03-26 13:18:45 Lars Magne Ingebrigtsen + * gnus.el (gnus-expand-group-parameters): Fix. - * gnus-art.el (gnus-treat-strip-headers-in-body): New variable. - (article-strip-headers-from-body): New command and keystroke. + * gnus-spec.el (gnus-char-width): New function. + (gnus-correct-substring, gnus-correct-length): Use it. -1999-03-14 16:09:10 Lars Magne Ingebrigtsen + * message.el (message-required-mail-headers): Fix doc. - * mail-source.el (mail-source-fetch-pop): Check for symbol first. +2001-08-18 18:00:00 ShengHuo ZHU - * nnheader.el (nnheader-insert-file-contents): Bind - enable-local-eval to nil. - (nnheader-find-file-noselect): Ditto. + * gnus-sum.el (gnus-group-make-articles-read): gnus-request-set-mark. - * nnmail.el (nnmail-article-group): Don't remove long lines. - (nnmail-remove-long-lines): New function. - (nnmail-split-header-length-limit): Removed. + * mm-decode.el (mm-save-part-to-file): Insert the handle. - * mml.el (mml-generate-mime-1): Use unibyte buffers. +2001-08-18 13:00:00 ShengHuo ZHU - * gnus-group.el (gnus-group-kill-all-zombies): Query user. + * nnslashdot.el (nnslashdot-threaded-retrieve-headers): + slashdot 2.2 (not fully fixed yet). + (nnslashdot-request-article): Ditto. -1999-03-06 07:20:05 Lars Magne Ingebrigtsen +2001-08-18 Simon Josefsson - * gnus-sum.el (gnus-summary-generic-mark): New function. + * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Moved from + nnimap. - * nnmail.el (nnmail-split-header-length-limit): Increased. - (nnmail-article-group): Allow nil. + * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Moved to + gnus-util. + (nnimap-request-update-info-internal): Use new functions. - * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion. + * nnml.el (nnml-request-set-mark, nnml-request-update-info): Use + new functions. - * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers - first. +2001-08-18 Simon Josefsson - * mml.el (mml-minibuffer-read-type): Include types from - mailcap-mime-data. + Make nnml groups self-contained as far as marks are concerned. - * nndraft.el (nndraft-request-article): Would clobber Japanese. + * nnml.el (nnml-request-delete-group): Delete marks file. + (nnml-request-rename-group): Move marks file. + (nnml-marks-file-name, nnml-marks-is-evil, nnml-marks): New server + variables. + (nnml-request-set-mark, nnml-request-update-info): New server + functions. + (nnml-save-marks, nnml-open-marks): New functions. -1999-03-05 Hrvoje Niksic +2001-08-18 Simon Josefsson - * 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. + * gnus-sum.el (gnus-summary-move-article): Use `add' instead of + `set' when setting marks. - * mml.el (mml-quote-region): Narrow the region. +2001-08-17 22:00:00 ShengHuo ZHU - * message.el (message-mode-menu): message-mime-attach-file is now - mml-attach-file. + * gnus.el (gnus-info-find-node): Take an argument. -1999-03-05 21:24:23 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-button-handle-info): New function. + (gnus-url-unhex-string): Replace "+" with " ". - * gnus-art.el (gnus-treatment-function-alist): Do emphasis earlier. +2001-08-17 21:00:00 ShengHuo ZHU -1999-03-05 21:08:10 Robert Bihlmeyer + * message.el (message-check-news-header-syntax): Check bad From. - * mml.el (mml-attach-buffer): New command. +2001-08-18 00:14:45 Lars Magne Ingebrigtsen -1999-02-27 Simon Josefsson + * gnus-spec.el (gnus-correct-length): New function. + (gnus-correct-substring): New function. + (gnus-tilde-max-form): Use it. - * gnus-sum.el (gnus-update-marks): Call gnus-remove-from-range - with a proper range. Compress range. +2001-08-17 Nevin Kapur - * gnus-range.el (gnus-remove-from-range): Protect arguments. + * nnmh.el: Docstring changes as below. -1999-03-05 20:59:54 Lars Magne Ingebrigtsen + * nnml.el: Docstring changes as below. - * mm-decode.el (mm-get-image): Create a temporary file for xbms. + * nnbabyl.el: Docstring changes as below. -1999-03-04 04:20:25 Lars Magne Ingebrigtsen + * nnmbox.el: Docstring changes as below. - * 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. + * nnfolder.el: Added docstrings identifying each virtual server + parameter. -Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen +2001-08-18 Simon Josefsson - * gnus.el: Pterodactyl Gnus v0.80 is released. + * mml.el (mml-menu): Collapse Attach, Insert and Security submenu. -1999-03-02 16:04:30 Lars Magne Ingebrigtsen +2001-08-17 Bj,Av(Brn Torkelsson - * gnus-art.el (gnus-mm-display-part): Narrow to the part itself. + * message.el: rename "Abort Message" to "Postpone Message". + Remove "Attach file as MIME" from Message menu, it's already in + the MIME menu. - * gnus-sum.el (gnus-with-article): Moved here. +2001-08-17 14:00:00 ShengHuo ZHU - * mail-source.el (mail-source-fetch-pop): Ask for password even - when program. + * smime.el (smime-point-at-eol): eval-and-compile. + (smime-make-temp-file): New function. + (smime-sign-region, smime-encrypt-region, smime-decrypt-region): + Use it. -1999-02-28 13:16:12 Lars Magne Ingebrigtsen +2001-08-17 10:41:14 Lars Magne Ingebrigtsen - * gnus-msg.el (gnus-bug): Add description. + * gnus-agent.el (gnus-agent-fetch-group): Go online if offline. + (gnus-agent-summary-fetch-group): New command and keystroke. - * mml.el (mml-insert-mml-markup): Insert disposition. + * gnus-art.el (gnus-insert-mime-button): Tiny clean-up. + (gnus-mime-display-security): Make it respect + gnus-unbuttonized-mime-type-p. - * message.el (message-send-mail): Always encode mail headers. + * gnus-sum.el (gnus-articles-to-read): Comments. + (gnus-article-marked-p): New function. + (gnus-summary-display-make-predicate): New function. + (gnus-select-newsgroup): Use them. - * smiley.el (gnus-smiley-display): Goto body. + * mm-decode.el (mm-save-part-to-file): Made it not error. -1999-02-28 13:15:47 Petr Konecny +2001-08-17 Simon Josefsson - * smiley.el (gnus-smiley-display): Don't search to blank line. + * imap.el (imap-wait-for-tag): If process-status isn't open or + run, return nil instead of sit-for looping. -1999-02-28 00:38:40 Lars Magne Ingebrigtsen +2001-08-17 10:41:14 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-treat-article): Only run the highlight stuff - when requested. + * lpath.el (featurep): fbind xml-parse-region. - * nnmail.el (nnmail-current-spool): Removed. + * gnus.el (gnus-message-archive-method): Default to "archive". + (gnus-message-archive-method): Doc fix. + (gnus-parameters-get-parameter): Cleaned up. + (gnus-expand-group-parameter): New function. - * gnus-salt.el (gnus-tree-inhibit): New varible. + * gnus-start.el (gnus-setup-news): Push the archive server only + the server list. - * gnus.el (mm-util): Required. + * mml.el (mml-menu): Changed name to "Attachments". -1999-02-27 23:44:52 paul stevenson + * mm-decode.el (mm-destroy-postponed-undisplay-list): Only message + when there is something to detroy. - * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first. +2001-05-21 17:11:46 Lars Magne Ingebrigtsen -1999-02-27 17:17:47 Lars Magne Ingebrigtsen + * gnus-srvr.el (gnus-server-browse-in-group-buffer): Default to + nil. - * mail-source.el (mail-source-bind): Doc fix. +2001-08-15 Kai Gro,b_(Bjohann -1999-02-26 20:35:57 Lars Magne Ingebrigtsen + * gnus-delay.el (gnus-delay-article): Allow "01:23" time spec, + which specifies a time today or tomorrow. - * message.el (message-mode): Doc fix. +2001-08-15 Simon Josefsson + From Pavel@Janik.cz (Pavel Jan,Am(Bk) - * mm-encode.el (mm-content-transfer-encoding-defaults): Use 8bit - encoding. + * gnus-agent.el (gnus-agent-make-mode-line-string) + (gnus-agent-toggle-plugged): Use new API. - * gnus.el (gnus-methods-equal-p): Moved here. +2001-08-14 Kai Gro,b_(Bjohann - * mail-source.el: pop at 110. + * gnus-delay.el (gnus-delay-send-drafts): Fix check whether + deadline has expired. - * pop3.el (pop3-movemail): Use write-region instead of - append-to-file to avoid excessive messaging. +2001-08-12 Simon Josefsson + Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE -1999-02-27 lantz moore + Support `recent' mark indicating newly arrived messages (to + separate from old but unread messages). - * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of - type directory. + * nnimap.el (nnimap-retrieve-groups): Push dummy article into + `nnmail-split-history' if recent is > 0. + (nnimap-request-update-info-internal): Update `recent' marks. + (nnimap-request-set-mark): Never set `recent' marks. + (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist): Add + recent. -1999-03-04 Robert Bihlmeyer + * gnus-sum.el (gnus-recent-mark): New mark. + (gnus-newsgroup-recent): New variable. + (gnus-summary-local-variables): Add gnus-newsgroup-recent. + (gnus-summary-prepare-threads): Mark recent articles. + (gnus-summary-add-mark): Support recent. + (gnus-summary-update-secondary-mark): Support recent. - * gnus-art.el (article-hide-boring-headers): Field names must not - contain whitespace. + * gnus.el (gnus-article-mark-lists): Add recent. -Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen +2001-08-12 Simon Josefsson - * gnus.el: Pterodactyl Gnus v0.79 is released. + * mm-bodies.el (mm-decode-content-transfer-encoding): Returns + whether successful decoding took place. Add doc. -1999-02-26 18:11:04 Lars Magne Ingebrigtsen +2001-08-12 Simon Josefsson + Suggested by Per Abrahamsen - * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting. + * gnus.el (gnus-summary-line-format, gnus-parameters): + * gnus-gl.el (gnus-summary-grouplens-line-format): + * gnus-salt.el (gnus-summary-pick-line-format): + * gnus-spec.el (gnus-format-specs): %n is 23 chars. - * mml.el (mml-mode): Don't use add-minor-mode. +2001-08-11 09:40:00 Karl Kleinpaste + Committed by Kai Gro,b_(Bjohann. - * message.el (messgage-inhibit-body-encoding): New variable. - (message-encode-message-body): Use it. + * gnus-score.el (gnus-score-string): Fix `match' regexp + for `extra' header case. -Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen +2001-08-10 23:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.78 is released. + * nnmbox.el (nnmbox-read-mbox): No warning. -1999-02-26 07:45:30 Lars Magne Ingebrigtsen +2001-08-10 21:00:00 ShengHuo ZHU - * message.el (message-mode): Switch on MML mode. + * nndoc.el (nndoc-article-type): Fix doc. + (nndoc-generate-article-function): New variable. + (nndoc-dissection-function): New variable. + (nndoc-type-alist): Add oe-dbx. + (nndoc-oe-dbx-type-p): New function. + (nndoc-oe-dbx-dissection): New function. + (nndoc-oe-dbx-generate-article): New function. - * mml.el: Included commands and functions. - (mml-mode-map): New keymap. +2001-08-11 Kai Gro,b_(Bjohann - * message.el: Removed the insertion commands and functions. + * gnus-delay.el (gnus-delay-send-drafts): Cleaner way to check + whether deadline has been reached. Patch from Dan Nicolaescu + . - * gnus-ems.el (gnus-mule-cite-add-face): Removed. +2001-08-10 02:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-sort-by-chars): New command and - keystroke. + * gnus-ml.el (turn-on-gnus-mailing-list-mode): Use + gnus-group-find-parameter. Suggested by Janne Rinta-Manty + . - * gnus-art.el (gnus-narrow-to-page): Revert. + * mail-source.el (mail-source-movemail): The error buffer is + modified, but nothing in it. - * gnus-cite.el (gnus-cite-delete-overlays): New function. - (gnus-cite-parse-maybe): Always reparse. +2001-08-10 01:00:00 ShengHuo ZHU - * message.el (message-encode-message-body): Don't insert - "multipart warning". + * message.el (message-bogus-system-names): New variable. + (message-make-fqdn): Use it. - * gnus-art.el (gnus-article-treat-head-custom): New variable. +2001-08-09 15:00:00 ShengHuo ZHU -1999-02-25 Miles Bader + * nndraft.el (nndraft-request-group): Use + nndraft-auto-save-file-name. - * mail-source.el (mail-source-fetch-pop): Return 1 for success. +2001-08-09 Simon Josefsson - * nnmail.el: Require mm-util. + * mm-view.el (mm-view-pkcs7-decrypt): Operate in current buffer. + Don't ask whether to decrypt. Just leave result in buffer (don't + call mm). -1999-02-26 07:39:33 Justin Sheehy + * mm-decode.el (mm-dissect-buffer): Possibly verify/decrypt single + parts as well. + (mm-inline-media-tests): Ignore application/{x-,}pkcs7-mime. + (mm-possibly-verify-or-decrypt): Support application/{x-,}pkcs7-mime. - * nnmail.el (nnmail-get-new-mail): Only get mail for the one - group. +2001-08-09 Simon Josefsson -1999-02-26 07:38:08 SeokChan LEE + * mm-decode.el (mm-insert-part): Return decoding success status. + (mm-save-part-to-file): Error if decoding failed. - * mm-bodies.el (mm-body-charset-encoding-alist): Add euc-kr. +2001-08-09 10:00:00 ShengHuo ZHU -1999-02-21 Simon Josefsson + * message.el (message-tab): Use indent-relative. + (message-mode): Don't bind indent-line-function to indent-relative. - * gnus-msg.el (gnus-extended-version): Better regexp. +2001-08-09 Simon Josefsson -1999-02-25 Didier Verna + * message.el (message-get-reply-headers): Fix string. Suggested by + Christoph Conrad . - * nnmail.el (nnmail-split-it): new syntax: `(! FUNC SPLIT)'. FUNC - is called with the result of SPLIT and should return a new split. +2001-08-08 15:00:00 ShengHuo ZHU - * gnus.texi: update the doc. + * message.el (message-tab): Use the current value of + indent-line-function. + (message-mode): Bind indent-line-function to indent-relative. -1999-02-23 Didier Verna +2001-08-08 Simon Josefsson - * 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'. + * imap.el (imap-gssapi-auth-p, imap-kerberos4-auth-p): Also check + whether `imtest' is installed. -1999-02-20 Aaron M. Ucko +2001-08-04 ShengHuo ZHU + Trivial patch from Nuutti Kotivuori - * mail-source.el (mail-source-fetch-pop): Typo. + * gnus-sum.el (gnus-summary-show-article): Call + gnus-summary-update-secondary-secondary-mark. + * gnus-sum.el (gnus-summary-edit-article-done): Ditto. + * gnus-sum.el (gnus-summary-reparent-thread): Ditto. -1999-02-26 07:15:12 Lars Magne Ingebrigtsen +2001-08-07 16:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-toggle-header): Save restriction. + * gnus-sum.el (gnus-summary-make-menu-bar): Misc -> Gnus. -1999-02-23 03:07:58 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-make-menu-bar): Ditto. - * gnus-cite.el (gnus-cite-parse-wrapper): Always parse. + * mm-uu.el (mm-uu-dissect): Autoload. From Gerd M,Av(Bllmann + . -1999-02-21 11:11:39 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-output-to-file): Bind file-name-coding-system. - * mml.el (mml-insert-buffer): New function. + * gnus-util.el (gnus-output-to-rmail): Ditto. + (gnus-output-to-mail): Ditto. - * message.el (message-forward): Insert the buffer in the buffer. + * nnmail.el (nnmail-pathname-coding-system): Set default to nil. -Sun Feb 21 01:20:50 1999 Shenghuo ZHU +2001-08-06 Florian Weimer - * mm-view.el (mm-inline-message): Insert part in narrowed region. + * message.el (message-indent-citation): Use + `message-yank-cited-prefix' for empty lines. -Sat Feb 20 23:09:40 1999 Shenghuo ZHU +2001-08-05 Florian Weimer - * gnus-sum.el (gnus-summary-toggle-header): Save restriction. + * message.el (message-indent-citation): Quote only lines starting + with ">" using `message-yank-cited-prefix'. -Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen +2001-08-05 Nuutti Kotivuori + Trivial patch. - * gnus.el: Pterodactyl Gnus v0.77 is released. + * gnus-cache.el (gnus-cache-possibly-enter-article): Use + gnus-cache-fully-p. -1999-02-20 17:32:17 Lars Magne Ingebrigtsen +2001-08-04 Simon Josefsson - * gnus-art.el (gnus-displaying-mime): New variable. - (article-narrow-to-head): New function. + * gnus-cache.el (gnus-cache-possibly-update-active): Create active + file if it doesn't exist (by calling gnus-cache-read-active). - * mail-source.el (mail-source-fetch-pop): Include pre/postscript. - Default to pop instead of pop3. +2001-08-04 Simon Josefsson -1999-02-19 16:16:04 Lars Magne Ingebrigtsen + * gnus-cache.el (gnus-cache-possibly-enter-article): Revert. + (gnus-cache-passively-or-fully-p): Removed. + (gnus-cache-fully-p): Fix it. - * gnus-art.el (article-hide-pgp): Goto body. + * mm-view.el (mm-pkcs7-signed-magic): Support more ASN.1 lengths. - * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer. +2001-08-04 Simon Josefsson - * gnus-cite.el: Don't use goto-line. + * gnus-cache.el (gnus-cache-fully-p) + (gnus-cache-passively-or-fully-p): New functions. + (gnus-cache-possibly-enter-article): Cosmetic change, use + `g-c-p-o-f-p'. + (gnus-cache-possibly-enter-article): Use `g-c-p-u-a'; last change + was bogus (`g-c-p-a-a' does not change active info, just change + the functions parameters). + (gnus-cache-possibly-remove-articles-1): Make sure articles are + not removed in groups that match `gnus-uncacheable-groups'. - * gnus-art.el (gnus-article-treat-html): Removed. - (gnus-treat-article): Save restriction. + Reported and modifications based on discussions with Nuutti + Kotivuori . -1999-02-17 Per Abrahamsen +2001-08-04 Simon Josefsson + Trivial patch from Nuutti Kotivuori - * message.el (message-send-mail): Don't untabify. - (message-mode): Don't use tabs for indentation. + * gnus-cache.el (gnus-cache-possibly-update-active): New function; + calls `gnus-cache-update-active' if bounds has been extended. -1999-02-19 14:54:13 Lars Magne Ingebrigtsen +2001-08-04 10:00:00 ShengHuo ZHU - * message.el (message-send-mail): Don't untabify. + * gnus-art.el (gnus-mime-security-verify-or-decrypt): Insert + before remove. + (gnus-mime-security-show-details): Ditto. - * nnml.el (nnml-save-mail): Typo fix. +2001-08-04 Kai Gro,b_(Bjohann -1999-02-19 Per Abrahamsen + * nnmail.el (nnmail-split-fancy-with-parent): Correct `mapconcat' + syntax. Protect string-match against nil string and regexp. - * message.el (message-cite-function): Add - `message-cite-original-without-signature' customization option. +2001-08-03 19:00:00 ShengHuo ZHU -1999-02-18 Per Abrahamsen + * mm-util.el (mm-find-charset-region): Remove control-1. - * nnmail.el (nnmail-fix-eudora-headers): Mark as option to - `nnmail-prepare-incoming-header-hook'. +2001-08-03 17:00:00 ShengHuo ZHU -1999-02-19 14:41:43 Justin Sheehy + * mm-decode.el (mm-readable-p): Emacs 20 takes one argument. - * gnus-util.el (gnus-make-sort-function-1): Typo fix. +2001-08-04 Simon Josefsson -1999-02-19 14:40:37 Lars Magne Ingebrigtsen + * smime.el (smime-sign-region, smime-encrypt-region): Fix details + buffer. Delete MIME-Version header. - * gnus-group.el (gnus-group-get-new-news): Require nnmail. +2001-08-03 Simon Josefsson -1999-02-18 Michael Cook + * gnus-cache.el (gnus-cache-possibly-enter-article): The article + that is entered does not necessarily have the highest article + number in the group, so use `gnus-cache-possibly-alter-active' + instead of `gnus-cache-update-active'. - * Recognize Microsoft Outlook's cite attribution conventions. +2001-08-03 10:00:00 ShengHuo ZHU -1999-02-19 14:33:11 James H. Cloos, Jr. + * mml2015.el (mml2015-gpg-extract-signature-details): Don't barf. - * gnus-sum.el: Bind M. +2001-08-03 Simon Josefsson -1999-02-19 14:31:29 Neil Crellin + * mml.el (mml-menu): Rename from MML to Mime. Collapse Security + menu. - * mail-source.el (mail-source-fetch-pop): Bind pop3-port. +2001-08-02 Katsumi Yamaoka -1999-02-15 Didier Verna + * gnus.el (post-method): New group parameter. It also provides + the user option `gnus-post-method-alist' and the internal function + `gnus-parameter-post-method'. - * gnus-picon.el (gnus-group-display-picons): ensures that - `article-goto-body' really goes to the article body. + * gnus-msg.el (gnus-post-method): Bind the value of + `gnus-post-method' to the group parameter if it is defined. -1999-02-19 12:57:19 Lars Magne Ingebrigtsen +2001-08-02 Simon Josefsson - * mm-view.el (mm-inline-text): Bind url-standalone-mode. + * smime.el (smime-extra-arguments): Removed. + (smime-call-openssl-region): Don't use it. - * gnus-msg.el (gnus-summary-mail-forward): Create unique names. +2001-08-02 Simon Josefsson - * mm-view.el (mm-view-message): Enable multibyte. + * smime.el (smime-sign-region): Handle stderr. + (smime-encrypt-region): Ditto. -1999-02-11 18:37:15 Lars Magne Ingebrigtsen + * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp. Don't + match the ASN.1 length bytes. + (mm-pkcs7-enveloped-magic): Ditto. + (mm-view-pkcs7-get-type): Don't regexp quote. - * nnmail.el (nnmail-get-new-mail): Message later. +2001-08-01 14:00:00 ShengHuo ZHU + From Andreas Fuchs - * mm-util.el (mm-find-charset-region): Revert to checking - multibyte. + * mml2015.el (mml2015-trust-boundaries-alist): Typo. -1999-02-11 Matt Pharr +2001-08-01 10:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-bug): Encode environment info as a MIME - attachment. + * gnus-art.el (gnus-header-button-alist): References regexp. -Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen +2001-08-01 Gerd Moellmann - * gnus.el: Pterodactyl Gnus v0.76 is released. + * mm-view.el (autoload): Don't autoload `diff-mode' if it's + already fboundp. Add INTERACTIVE arg to autoload form. -1999-02-06 Felix Lee +2001-08-01 09:00:00 ShengHuo ZHU - * gnus.el (gnus-group-change-level-function): Typo. + * nnslashdot.el (nnslashdot-init): Add as gnus buffer. -1999-02-11 05:47:51 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-cache-open): Ditto. - * gnus-sum.el (gnus-nov-skip-field): Removed. - (gnus-nov-field): Ditto. - (gnus-nov-parse-extra): Ditto. - (gnus-nov-read-integer): Ditto. +2001-07-31 21:00:00 ShengHuo ZHU -1999-02-05 09:44:20 Katsumi Yamaoka + * gnus-art.el (gnus-button-fetch-group): Fix the regexp. - * nnheader.el (nnheader-nov-read-message-id): New macro. - (nnheader-parse-nov): Use it. +2001-07-31 Katsumi Yamaoka - * gnus-sum.el (gnus-nov-read-message-id): New macro. - (gnus-nov-parse-line): Use it; use `(eobp)' instead of - `(eq (char-after) ?\n)'. + * gnus-msg.el (gnus-post-method): Refer to `gnus-parameters'. -1999-02-11 05:16:26 Lars Magne Ingebrigtsen +2001-07-31 17:00:00 ShengHuo ZHU + Originally from Pavel Jan,Am(Bk - * gnus.el (gnus-other-frame): Always pop up a new frame. + * gnus-agent.el (gnus-agent-make-mode-line-string): New function. + (gnus-agent-toggle-plugged): Use it. -Wed Feb 10 01:03:43 1999 Shenghuo ZHU +2001-07-31 ShengHuo ZHU - * gnus-range.el (gnus-range-add): Rewrite. + * gnus-start.el (gnus-startup-file-coding-system): Revert to binary. + (gnus-ding-file-coding-system): New variable. + (gnus-read-newsrc-el-file, gnus-save-newsrc-file) + (gnus-slave-save-newsrc): Use it. -1999-02-02 18:12:00 Carsten Leonhardt +2001-07-31 Kai Gro,b_(Bjohann - * nnmail.el (nnmail-split-incoming): Added detection of maildir - format. - (nnmail-process-maildir-mail-format): New function. + * gnus-delay.el (gnus-delay-initialize): Use standard define-key + syntax. - * 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". +2001-07-30 15:00:00 ShengHuo ZHU + Originally from Andreas Fuchs -1999-02-10 02:29:28 Lars Magne Ingebrigtsen + * mml2015.el (mml2015-trust-boundaries-alist): New variable. + (mml2015-gpg-pretty-print-fpr): New function. + (mml2015-gpg-extract-signature-details): More details, rename from + `m-g-e-from'. + (mml2015-gpg-verify): Use them. + (mml2015-gpg-clear-verify): Use them. - * mail-source.el (mail-source-fetcher-alist): Remove apop. +2001-07-31 Simon Josefsson - * nndoc.el (nndoc-type-alist): Remove MIME-digest. - (nndoc-mime-digest-type-p): Removed. + * mml-smime.el (mml-smime-sign, mml-smime-encrypt): Goto end of + buffer when done. -1999-02-09 15:25:52 Lars Magne Ingebrigtsen +2001-07-30 Simon Josefsson - * gnus-art.el (gnus-article-read-summary-keys): Set the point - where it is supposed to be. - (gnus-treat-play-sounds): New variable. + * smime.el (smime-call-openssl-region): Revert previous change, + just pass on buf to `call-process-region'. + (smime-verify-region): Doc fix. Don't message stuff. Use + `smime-new-details-buffer'. Inserts error messages into buffer. + (smime-noverify-region): Ditto. + (smime-decrypt-region): Ditto. Handles stderr separately. + (smime-verify-buffer, smime-noverify-buffer) + (smime-decrypt-buffer): Doc fix. + (smime-new-details-buffer): New function. + (smime-pkcs7-region, smime-pkcs7-certificates-region) + (smime-pkcs7-email-region): Use `smime-new-details-buffer'. + (smime-sign-region, smime-encrypt-region): Don't use + `insert-buffer'. - * gnus-sum.el (gnus-newsgroup-ignored-charsets): New variable. + * mml-smime.el (mml-smime-verify): Fix security button strings. - * 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. +2001-07-30 12:00:00 ShengHuo ZHU - * nnmail.el (nnmail-get-new-mail): Ignore procmail. + * gnus-art.el (gnus-mime-save-part-and-strip): Save + gnus-article-mime-handles. - * 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. +2001-07-29 Simon Josefsson - * nnvirtual.el (nnvirtual-request-article): Bind - gnus-article-decode-hook to nil. + * mail-source.el (top-level): Require message for message-directory. + (mail-source-directory): Change default to message-directory. -1999-02-06 16:55:25 Lars Magne Ingebrigtsen + * smime.el (smime-keys, smime-CA-directory, smime-CA-file) + (smime-certificate-directory, smime-openssl-program) + (smime-encrypt-cipher, smime-dns-server): Fix doc (leading "*"). + (smime-extra-arguments): New variable. + (smime-dns-server): Fix customize group. + (smime-call-openssl-region): Use `smime-extra-arguments'. - * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for - us-ascii. +2001-07-29 Simon Josefsson + From Vladimir Volovich -1999-02-04 00:00:35 Lars Magne Ingebrigtsen + * smime.el (smime-call-openssl-region): Ignore stderr. - * format-spec.el (format-spec): Be more robust. +2001-07-29 Simon Josefsson + From Christoph Conrad - * message.el (message-encode-message-body): Default - mail-parse-charset to mail-parse-charset. + * gnus-agent.el (gnus-agent-save-group-info): Don't destroy active + file. - * gnus-sum.el (gnus-summary-edit-article-done): Don't encode. - (gnus-summary-edit-article): Bind mail-parse-charset. +2001-07-29 Simon Josefsson - * mml.el (mml-read-tag): Ignore white space after end of tag. + * mm-view.el (mm-view-pkcs7-decrypt): Adhere to `mm-decrypt-option'. - * message.el (message-goto-body): Also work in separatorless - articles. + Support S/MIME decryption. - * mml.el (mml-translate-from-mime): New function. - (mml-insert-mime): Ditto. - (mml-to-mime): New function. - (mime-to-mml): New name. + * mm-decode.el (mm-inline-media-tests): + (mm-inlined-types): + (mm-automatic-display): + (mm-attachment-override-types): Add application/{x-,}pkcs7-mime. - * gnus-sum.el (gnus-summary-edit-article): Always select raw - article. + * mm-view.el (mm-pkcs7-signed-magic): + (mm-pkcs7-enveloped-magic): New variables. + (mm-view-pkcs7-get-type): New function; identify PKCS#7 type. + (mm-view-pkcs7): New function; mm viewer for PKCS#7 blobs. + (mm-view-pkcs7-decrypt): New function; mm viewer for encrypted + PKCS#7 blobs. - * gnus-group.el (gnus-group-catchup-current): Unmark groups. + * smime.el (smime-decrypt-region): Expand keyfile. - * gnus-sum.el (gnus-summary-setup-default-charset): Don't - special-case nndraft groups. +2001-07-29 Simon Josefsson -1999-02-03 16:44:19 Lars Magne Ingebrigtsen + * nntp.el (nntp-open-ssl-stream): Don't mess with internal + `ssl.el' variables. - * gnus-sum.el (gnus-get-newsgroup-headers): Bind charset. - (gnus-get-newsgroup-headers): Already bound. + * gnus-agent.el (gnus-agent-save-group-info): Delete everything + but line instead of narrowing to it, because `nnmail-parse-active' + calls widen. Thanks to Christoph Conrad + . - * message.el (message-encode-message-body): Use posting charset. +2001-07-29 Kai Gro,b_(Bjohann - * mm-bodies.el (mm-encode-body): Use MIME charsets. - (mm-body-encoding): Do CTE. - (mm-body-7-or-8): New function. + * gnus.el (gnus-summary-line-format): Mention `gnus-sum-thread-*' + for %B spec. - * 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. + * gnus-sum.el (gnus-summary-prepare-threads): If + gnus-sum-thread-tree-root is nil, use subject instead. + (gnus-sum-thread-tree-root, gnus-sum-thread-tree-single-indent) + (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent) + (gnus-sum-thread-tree-leaf-with-other) + (gnus-sum-thread-tree-single-leaf): Documentation. + (gnus-sum-thread-tree-single-indent): Allow nil. - * format-spec.el (format-spec-make): New function. +2001-07-28 09:00:00 ShengHuo ZHU - * mail-source.el (format-spec): Required. - (mail-source-fetch-with-program): Removed. - (mail-source-fetch-with-program): New function. + * message.el (message-fill-paragraph): Do nothing if the user + wants filladapt-mode. - * format-spec.el: New file. +2001-07-27 23:00:00 ShengHuo ZHU -1999-02-03 16:00:41 Tatsuya Ichikawa + * mm-decode.el (mm-image-type-from-buffer): New function. + (mm-get-image): Use it. - * mail-source.el (mail-source-fetch-with-program): Take optional - parameter. +2001-07-27 18:00:00 ShengHuo ZHU -1999-02-03 00:31:21 Lars Magne Ingebrigtsen + * gnus.el (gnus-large-newsgroup): Add doc, "If it is nil, ..." - * gnus-start.el: Ignore some groups. - (gnus-setup-news): Bind nnmail-fetched-sources. + * gnus-art.el (gnus-mime-view-all-parts): buffer-read-only covers + mm-display-parts too. - * message.el (message-send-mail): Remove all tabs. +2001-07-27 12:00:00 ShengHuo ZHU - * mm-util.el (mm-find-charset-region): Just check whether - find-charset-region is defined. + * nnfolder.el (nnfolder-request-accept-article): Bind + nntp-server-buffer. -1999-02-02 23:35:20 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-parse-active): Read from buffer instead of + nntp-server-buffer. - * gnus-group.el (gnus-group-get-new-news): Use - nnmail-fetched-sources. +2001-07-27 11:00:00 ShengHuo ZHU - * nnmail.el (nnmail-fetched-sources): New variable. - (nnmail-get-new-mail): Use it. + * message.el (message-check-news-header-syntax): Use + message-post-method. + (message-send-news): Bind message-post-method. - * mail-source.el (mail-source-fetched-sources): New variable. - (mail-source-fetch): Use it. +2001-07-27 07:00:00 ShengHuo ZHU -1999-02-02 23:20:20 Mark W. Eichin + * mml.el (mml-tweak-type-alist): New variable. + (mml-tweak-function-alist): New variable. + (mml-tweak-part): New function. + (mml-generate-mime-1): Use it. - * 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...) +2001-07-26 22:00:00 ShengHuo ZHU -1999-02-02 23:17:40 Kim-Minh Kaplan + * nnfolder.el (nnfolder-request-accept-article): Replace + nnfolder-request-list. - * gnus-picon.el (gnus-picons-parse-filenames): Quote group names. +2001-07-27 Simon Josefsson -1999-01-28 04:15:46 Katsumi Yamaoka + * nnimap.el (nnimap-open-server): Set nnimap-server-buffer if + nnoo-change-server failed to do it. - * gnus-start.el (gnus-read-active-file): Eliminate duplicated - select methods. +2001-07-26 16:00:00 ShengHuo ZHU -1999-01-27 Simon Josefsson + * gnus.el (gnus-parameters): Make it customizable. - * gnus-range.el (gnus-remove-from-range): Sort second argument. +2001-07-26 15:00:00 ShengHuo ZHU -1999-02-02 10:55:23 Scott Hofmann + * gnus-art.el (gnus-mm-display-part): Narrow to point if eobp. - * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd. + * message.el (message-set-auto-save-file-name): More + poor-system-types. -Mon Feb 1 23:23:03 1999 Shenghuo ZHU + * mailcap.el (mailcap-parse-mimetypes): poor-system-types. - * 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. + * gnus-ems.el (nnheader-file-name-translation-alist): M$Windows-NT + supports +. -1999-02-02 22:13:14 Lars Magne Ingebrigtsen +2001-07-26 14:00:00 ShengHuo ZHU - * mail-source.el (mail-source-fetch-directory): Use the predicate. - (mail-source-value): Don't do variables. + * mm-decode.el (mm-readable-p): New function. + (mm-inline-media-tests): Fix the default testers. - * nnmail.el (nnmail-get-new-mail): Set the predicate. +2001-07-26 Simon Josefsson - * gnus-sum.el (gnus-summary-toggle-header): Fix, and bound to t. + * nnimap.el (nnimap-version): Bump version number. -1999-02-01 Michael Cook +2001-07-26 10:00:00 ShengHuo ZHU + From Steven E. Harris - * Defenestrate spurious ?a. + * nnheader.el (nnheader-translate-file-chars): cygwin32 is running + in M$Windows too. -1999-02-02 21:59:51 Lars Magne Ingebrigtsen +2001-07-26 Kai Gro,b_(Bjohann - * mail-source.el (mail-source-fetch-pop): Instead use - :authentication. + * gnus-delay.el (gnus-delay-send-drafts): Don't `error'. -1999-02-01 Tatsuya Ichikawa +2001-07-25 21:00:00 ShengHuo ZHU - * lisp/mail-source.el : Support APOP authentication scheme. + * gnus-bcklg.el (gnus-backlog-shutdown): Make interactive. -1999-02-02 21:56:14 Tatsuya Ichikawa + * mm-decode.el (mm-get-image): Guess then use the type. - * pop3.el (pop3-movemail): Return t. + * gnus-art.el (gnus-mime-view-part-as-type): Don't copy cache. -1999-02-02 21:48:46 Lars Magne Ingebrigtsen +2001-07-25 12:54:00 Danny Siu - * rfc2047.el (rfc2047-fold-region): New function. - (rfc2047-encode-message-header): Use it. + * gnus-sum.el (gnus-summary-prepare-threads): Shouldn't do tree + display (%B) for threads if threading is off. -1999-02-02 21:07:27 Hallvard B. Furuseth +2001-07-25 14:00:00 ShengHuo ZHU + From Henrik Enberg - * gnus-sum.el (gnus-group-charset-alist): Add more. + * gnus-msg.el: Customization patch. -Mon Feb 1 21:18:00 1999 Lars Magne Ingebrigtsen +2001-07-25 22:22:22 Raymond Scholz - * gnus.el: Pterodactyl Gnus v0.75 is released. + * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): New + variable. + (nnmail-split-fancy-with-parent): Ignore certain groups. -1999-02-01 21:54:26 Lars Magne Ingebrigtsen +2001-07-25 11:00:00 ShengHuo ZHU - * gnus-art.el (article-display-x-face): Don't narrow to head. + * gnus-util.el (gnus-byte-compile): New function. + (gnus-use-byte-compile): New variable. + (gnus-make-sort-function): Use it. -1999-02-01 21:48:39 Michael Cook + * nnmail.el (nnmail-get-new-mail): Use it. - * gnus-cite.el (gnus-cited-lines-visible): Accept a cons. + * gnus-agent.el (gnus-category-make-function): Simple function or + compiled function. + (gnus-agent-fetch-group-1): Don't use (caaddr predicate). -1999-02-01 20:59:38 Lars Magne Ingebrigtsen + * gnus-gl.el (bbb-build-rate-command): Remove quote before lambda. + * gnus-topic.el (gnus-topic-sort-topics-1): Ditto. + (gnus-topic-sort-topics-1): Use gnus-byte-compile. - * mail-source.el (mail-source-fetch-directory): Ignore - directories. + * message.el (message-check-news-header-syntax): Remove quote. - * gnus-cus.el (gnus-group-parameters): Addition. +2001-07-24 19:00:00 ShengHuo ZHU - * gnus-art.el (article-strip-banner): Do symbolic banners. - (article-strip-banner): New keystroke. + * message.el (message-use-mail-followup-to): `t' is not a + documented value. -1999-02-01 20:54:32 Michael Cook +2001-07-24 13:00:00 ShengHuo ZHU - * gnus-art.el (article-strip-banner): New command. + * gnus-sum.el (gnus-summary-display-arrow): Test fboundp. -1999-02-01 20:53:45 Lars Magne Ingebrigtsen +2001-07-24 12:00:00 ShengHuo ZHU - * gnus-art.el (gnus-treat-strip-banners): New variable. + * mm-encode.el (mm-encode-buffer): Don't use 7bit encoding if + there are long lines. -1999-01-28 05:34:56 Katsumi Yamaoka +2001-07-24 Katsumi Yamaoka - * mail-source.el (mail-source-read-passwd): Use `read-passwd' if it - has been exist. + * dgnushack.el (copy-list): New compiler macro. -Thu Jan 28 01:38:34 1999 Shenghuo ZHU +2001-07-24 09:00:00 ShengHuo ZHU - * message.el (message-draft-coding-system): Check coding-system. - * mm-util.el (mm-text-coding-system): Ditto. + * message.el (message-bounce): If no Return-Path, the whole + content is considered as the original message. -1999-01-28 12:11:31 Katsumi Yamaoka + * nnml.el (nnml-check-directory-twice): New variable. + (nnml-article-to-file): Use it. + (nnml-retrieve-headers): Hack it. - * mail-source.el (mail-source-fetch-pop): Save excursion. +2001-07-24 02:00:00 ShengHuo ZHU -1999-01-28 08:14:21 Lars Magne Ingebrigtsen + * gnus-win.el (gnus-buffer-configuration): New configure. - * 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-mm-display-part): Don't select-window if it is + not alive. - * gnus-art.el (gnus-treat-date-iso8601): New variable. - (gnus-treat-date-user-defined): New variable. + * mm-decode.el (mm-remove-part): Don't murder the current window (nil). + (mm-display-external): Use display-term configure. -1999-01-28 08:07:12 Per Abrahamsen +2001-07-24 Kai Gro,b_(Bjohann - * nnmail.el (nnmail-fix-eudora-headers): New function. + * gnus-delay.el (gnus-delay-default-hour): New variable. + (gnus-delay-article): Allow specific date in YYYY-MM-DD format. -1999-01-28 08:05:19 Lars Magne Ingebrigtsen +2001-07-23 22:00:00 ShengHuo ZHU + From Karl Kleinpaste - * mm-bodies.el (mm-encode-body): Use mail-parse-charset. + * gnus-sum.el (gnus-summary-line-format-alist): Add %B. + (gnus-summary-prepare-threads): Ditto. -1999-01-27 08:06:38 Lars Magne Ingebrigtsen + * gnus.el (gnus-summary-line-format): Add %B. - * smiley.el (smiley-deformed-regexp-alist): Removed =>. - (smiley-nosey-regexp-alist): Ditto. +2001-07-23 19:00:00 ShengHuo ZHU - * 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-sum.el (gnus-articles-to-read): Use gnus-group-decoded-name. - * gnus-group.el (gnus-group-catchup-current): Do group. + * mm-util.el (mm-string-as-multibyte): New function. - * message.el (message-default-charset): Add group. + * nnmh.el (nnmh-request-list-1): Encode, not decode! -Wed Jan 27 05:24:53 1999 Lars Magne Ingebrigtsen +2001-07-23 18:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.74 is released. + * mm-util.el (mm-universal-coding-system): New variable. -1999-01-27 05:56:29 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-startup-file-coding-system): Use it. - * gnus-art.el (article-fill-long-lines): Renamed. - (article-fill-long-lines): New keystroke. + * score-mode.el (score-mode-coding-system): Use it. -1999-01-26 06:35:07 Lars Magne Ingebrigtsen +2001-07-23 Katsumi Yamaoka - * gnus-msg.el (gnus-setup-posting-charset): Check for group. + * gnus-start.el (gnus-setup-news): Call + `gnus-check-bogus-newsgroups' just after the native server is + opened. - * gnus-group.el (gnus-group-catchup-current): Skip groups now - displayed. - (gnus-group-catchup-current): Be more robus. +2001-07-23 Kai Gro,b_(Bjohann - * gnus-sum.el (gnus-summary-select-article): Reselect for showing - headers. + * nnmail.el (nnmail-do-request-post): Util function to be used by + `nnchoke-request-post' for all nnmail-derived backends. -1999-01-25 Dave Love + * nnml.el (nnml-request-post): Use it. - * message.el (message-mode-menu): Add message-mime-attach-file. - (message-mode): Doc fix. + * gnus.el (gnus-valid-select-methods): nnml is a post-mail + backend, for it groks nnml-request-post. -1999-01-26 05:24:19 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-highlight, gnus-group-highlight-line): + Treat `mail-post' backends like `mail' backends, not like `news' + backends. - * nnmail.el (nnmail-check-duplication): Insert the mail source - string. +2001-07-22 09:00:00 ShengHuo ZHU - * 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-msg.el (gnus-setup-message): make-local-hook. - * gnus-start.el (gnus-get-unread-articles): Nix out groups over - the level. +2001-07-22 Kai Gro,b_(Bjohann - * rfc2047.el (rfc2047-encodable-p): Convert to MIME charsets - before handling. + * gnus-delay.el (gnus-delay-article): Fix `read-string' for + XEmacs. Allow more units. Submitted by Karl Kleinpaste + , slightly changed by Kai. - * mm-util.el (mm-mime-charset): Use the parameters. - (mm-mime-charset): Removed region paremeters. + * message.el (message-check-news-header-syntax): When checking + whether the groups exist, check the right server based on + `gnus-post-method'. - * nnmail.el (nnmail-get-new-mail): Don't message the entire - source. +2001-07-21 Kai Gro,b_(Bjohann -1999-01-25 12:05:16 Lloyd Zusman + * gnus-delay.el: New file. - * nnmail.el (nnmail-get-split-group): Quote right. +2001-07-21 13:00:00 ShengHuo ZHU -1999-01-25 05:55:41 Lars Magne Ingebrigtsen + * mm-util.el (mm-read-coding-system): Take two arguments. - * mail-source.el (mail-source-movemail): Would kill an arbitrary - buffer. + * gnus-sum.el (gnus-summary-show-article): Use + mm-read-coding-system. -1999-01-24 03:02:31 Lars Magne Ingebrigtsen + * gnus-art.el (article-de-quoted-unreadable): + (article-de-base64-unreadable, article-wash-html): + (gnus-mime-inline-part, gnus-mime-view-part-as-charset): Ditto. - * gnus-group.el (gnus-clear-inboxes-moved): Removed. - (gnus-group-mode): Don't hook. +2001-07-21 Kai Gro,b_(Bjohann - * mail-source.el (mail-source-bind): Doc fix. - (mail-source-bind): Take only one param. + * nnml.el (nnml-request-post): New function. Can be used for + annotations in nnml groups. - * gnus-art.el (gnus-treat-highlight-signature): typep. +2001-07-19 Katsumi Yamaoka - * mail-source.el (mail-source-movemail): Ignore empty file. - (mail-source-callback): Check before deleting. + * nntp.el (nntp-request-newgroups): Use UTC date for NEWGROUPS + command. - * message.el (message-mime-attach-file): Include name. + * gnus-start.el (gnus-find-new-newsgroups): Use + `message-make-date' instead of `current-time-string'. + (gnus-ask-server-for-new-groups): Ditto. + (gnus-check-first-time-used): Ditto. -1999-01-23 17:01:12 Lars Magne Ingebrigtsen +2001-07-20 11:00:00 ShengHuo ZHU - * mm-util.el (mm-read-charset): Return a symbol. + * gnus-score.el (gnus-home-score-file): nnheader-translate-file-chars. - * mm-view.el (mm-inline-text): Insert signature separator. +2001-07-18 Per Abrahamsen - * gnus-art.el (gnus-treat-predicate): New function. - (gnus-treat-article): Allow all types to be checked. + * message.el (message-shorten-references): Change `maxcount' and + `cut' to obey USEFOR draft 5. - * gnus-util.el (gnus-or): New function. - (gnus-and): Ditto. +2001-07-12 Colin Walters - * gnus-art.el (gnus-mime-display-single): Use override. + * gnus-sum.el (gnus-summary-display-arrow): New variable. + (gnus-summary-set-article-display-arrow): New function. + (gnus-summary-goto-subject): Use it. - * mm-decode.el (mm-attachment-override-types): New variable. - (mm-attachment-override-p): New function. +2001-07-18 12:00:00 ShengHuo ZHU - * gnus-picon.el (gnus-group-display-picons): Don't go backward. + * gnus-sum.el (gnus-summary-import-article): Insert date if + doesn't exist. -1999-01-23 16:45:06 Andrew J. Cosgriff +2001-07-18 11:00:00 ShengHuo ZHU - * mm-view.el (mm-inline-text): Do vcards. + * mml.el (mml-content-type-parameters): New variable. + (mml-content-disposition-parameters): New variable. + (mml-insert-mime-headers): Use them. + (mml-parse-1): Accept charset. -Sat Jan 23 14:23:27 1999 Lars Magne Ingebrigtsen +2001-07-17 22:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.73 is released. + * gnus-group.el (gnus-group-select-group): Doc fix. -1999-01-23 11:38:36 Lars Magne Ingebrigtsen + * gnus-eform.el (gnus-edit-form-done): Return nil if end-of-file. - * 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. +2001-07-17 Katsumi Yamaoka - * mail-source.el: New file. + * dgnushack.el (dgnushack-make-auto-load): Advise `make-autoload' + to handle `define-derived-mode'. -1999-01-23 09:08:31 James H. Cloos, Jr. +2001-07-16 12:00:00 ShengHuo ZHU + From: Stefan Monnier - * gnus-art.el (gnus-article-mode-map): Bind backspace. + * message.el (message-mode): Use define-derived-mode. + (message-tab): message-completion-alist. -1999-01-23 09:05:04 Lars Magne Ingebrigtsen + * imap.el (imap-interactive-login): Use make-local-variable. + (imap-open): Ditto. + (imap-authenticate): Ditto. - * gnus-art.el (article-make-date-line): Fix iso8601 display. + * gnus-msg.el (gnus-setup-message): Change-major-mode-hook. -1999-01-20 02:53:52 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-edit-mode): Use define-derived-mode. - * gnus-art.el (gnus-treat-display-smileys): Check xpm. +2001-07-16 Kai Gro,b_(Bjohann - * gnus-picon.el (gnus-group-display-picons): Goto body. + * message.el (message-citation-line-function): Refer to + gnus-cite-attribution-suffix. - * gnus.el: Indented all functions; broke long lines; changed all - instances of illegal/legal to invalid/valid. Yes, I'm bored. +2001-07-15 Pavel Jan,Am(Bk -Wed Jan 20 00:50:53 1999 Lars Magne Ingebrigtsen + * gnus-art.el,...: Error convention changes. - * gnus.el: Pterodactyl Gnus v0.72 is released. +2001-07-13 20:00:00 ShengHuo ZHU -1999-01-20 01:39:48 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-rebuild-thread): Count hidden lines too. - * gnus.el: Cleaned up trailing whitespace. +2001-07-13 20:00:00 ShengHuo ZHU - * mm-util.el (mm-read-charset): Work. + * nnrss.el (nnrss-read-group-data): Nuke emacs-lisp-mode-hook. + (nnrss-read-server-data): Ditto. -1999-01-17 Matt Armstrong +2001-07-13 12:00:00 ShengHuo ZHU - * gnus-score.el (gnus-score-find-bnews): Match regexp on the - nnheader-translate-file-chars'd group name. + * gnus-setup.el (gnus-use-installed-gnus): Typo. + * Cleanup files. + From Pavel@Janik.cz (Pavel Jan,Am(Bk). -1999-01-20 01:30:30 Lars Magne Ingebrigtsen +2001-07-13 08:00:00 ShengHuo ZHU - * message.el (message-encode-message-body): Fold case. + * gnus.el (gnus-summary-line-format): Add %o. -1999-01-20 01:28:16 Alexei V. Barantsev + * gnus-sum.el (gnus-summary-pipe-output): Don't configure as pipe + unless shell outputs something. - * gnus-xmas.el (gnus-xmas-modeline-glyph): Backquote. +2001-07-13 07:00:00 ShengHuo ZHU -1999-01-20 00:46:15 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-boring-article-headers): Better doc. + (article-hide-headers): Better regexp. + Suggested by Matt Swift . - * mailcap.el (mailcap-add): New function. + * nnheader.el (nnheader-max-head-length): Better doc. + (nnheader-header-value): Skip spaces. + (nnheader-parse-head): Remove space. + Suggested by Matt Swift . -1999-01-18 09:40:37 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-show-raw-article): New function. + (gnus-get-newsgroup-headers): Remove space. - * gnus-art.el (article-goto-body-goes-to-point-min-p): New variable. - (article-goto-body): Use it. - (gnus-treat-article): Ditto. +2001-07-12 23:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-get-undownloaded-list): Remove the - downloaded articles from the downloadeble list. + * gnus-msg.el (gnus-msg-treat-broken-reply-to): Add force. + (gnus-summary-reply): Use it. + (gnus-summary-reply-broken-reply-to): New function. + (gnus-msg-force-broken-reply-to): New function. -1999-01-16 17:31:08 Lars Magne Ingebrigtsen + * mm-view.el (mm-inline-text): Showing as text/plain when error. - * message.el (message-encode-message-body): Bind - mail-parse-charset. +2001-07-12 21:00:00 ShengHuo ZHU - * 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-draft.el (gnus-draft-setup): Restore gnus-newsgroup-name. - * 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. +2001-07-12 15:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-setup-posting-charset): Check elem. + * mm-decode.el (mm-external-terminal-program): New variable. + (mm-display-external): Use it. Use term to display when no + window-system. - * gnus-art.el (gnus-mm-display-part): Fix the MIME button after - displaying. +2001-07-12 Bj,Av(Brn Torkelsson - * mm-decode.el (mm-insert-part): Use insert-buffer-substring. + * gnus-srvr.el (gnus-browse-make-menu-bar): Changed one of the + Browse->Next entries to Browse->Prev - * gnus-score.el (gnus-score-find-bnews): Protect against invalid - regexp file names. +2001-07-11 22:00:00 ShengHuo ZHU -Sat Jan 16 03:15:57 1999 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-inews-do-gcc): Don't test gnus-alive-p. - * gnus.el: Pterodactyl Gnus v0.71 is released. +2001-07-11 18:00:00 ShengHuo ZHU -1999-01-16 00:13:31 Lars Magne Ingebrigtsen + * mm-encode.el (mm-content-transfer-encoding-defaults): Use base64 + for the default encoding. - * mm-view.el (mm-inline-image): Don't add a dot. + * nnrss.el (nnrss-url-field): New field. + (nnrss-request-article): Add newsgroups. - * gnus-art.el (gnus-treat-article): New function. + * nnfolder.el (nnfolder-read-folder): Force to use a multibyte buffer. - * gnus.el (gnus-article-display-hook): Removed. +2001-07-11 04:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-treat-custom): New variable. + * nndraft.el (nndraft-request-restore-buffer): Don't remove Date. - * gnus-start.el (gnus-ignored-newsgroups-has-to-p): Removed. + * gnus-draft.el (gnus-draft-edit-message): Remove Date here. + (gnus-draft-setup): Remove backlog. - * gnus-msg.el (gnus-setup-posting-charset): Allow variables and - functions. +2001-07-10 Pavel Jan,Am(Bk - * message.el (message-posting-charset): New variable. - (message-send-mail): Use it. + * gnus-logic.el, gnus-srvr.el, gnus-vm.el, nnheaderxm.el, nnoo.el: + Cleanup. - * gnus-msg.el (gnus-group-posting-charset-alist): Moved here. - (gnus-setup-posting-charset): New function. - (gnus-setup-message): Use it. +2001-07-09 23:00:00 ShengHuo ZHU - * message.el (message-encode-message-body): Just look for - Content-Type before inserting a new one. + * gnus-msg.el (gnus-bug): Erase buffer. -1999-01-15 23:08:47 Lars Magne Ingebrigtsen + * nnfolder.el (nnfolder-possibly-change-group): Don't create group. - * rfc2047.el (rfc2047-default-charset): Removed. +2001-07-09 19:00:00 ShengHuo ZHU - * mail-prsvr.el: New file. - (mail-parse-charset): New variable. + * mm-decode.el (mm-attachment-override-p): Fix typo. - * gnus-sum.el (gnus-newsgroup-charset): Changed name. - Changed name. +2001-03-19 05:28:00 Katsumi Yamaoka - * gnus.el (gnus-charset): New group. + * gnus-kill.el (gnus-execute): Work with the extra headers. + * gnus-sum.el (gnus-summary-execute-command): Ditto. - * nnmail.el (nnmail-pathname-coding-system): Default to binary. +2001-07-09 17:00:00 ShengHuo ZHU - * 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-view.el (mm-inline-text): w3-coding-system-for-mime-charset + may not defined. From: Raja R Harinath . - * mm-util.el (mm-known-charsets): Removed. - (mm-default-coding-system): Removed. - (mm-default-charset): Removed. - (mm-read-charset): New function. + * message.el (message-send-mail-real-function): New variable. + (message-send-mail-partially, message-send-mail): - * message.el (message-default-charset): Removed. + * nngateway.el (nngateway-request-post): Use it. - * rfc2047.el (rfc2047-default-charset): Default to nil. + * gnus-agent.el (gnus-agentize): Use it. - * mm-util.el (mm-charset-iso-8859-1-forced): Removed. + * nnsoup.el (nnsoup-old-functions, nnsoup-set-variables) + (nnsoup-revert-variables): Use it. -Fri Jan 15 20:50:38 1999 Lars Magne Ingebrigtsen +2001-07-09 Colin Walters - * gnus.el: Pterodactyl Gnus v0.70 is released. + * mm-decode.el (mm-inline-media-tests): Default to displaying as + text/plain if the type doesn't match any other media types. + (mm-inlined-types): Doc fix. + (mm-display-inline): Revert previous change (now handled by a + default type in `mm-inline-media-tests'. + (mm-inlinable-p): Revive. + (mm-display-part): Call `mm-inlinable-p'. + (mm-attachment-override-p): Ditto. + (mm-inlined-p): Doc fix. -1999-01-15 00:06:04 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-mime-display-single): Call `mm-inlinable-p' as + well as `mm-inlined-p'. - * 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. +2001-07-09 13:00:00 ShengHuo ZHU - * mm-view.el (mm-inline-text): Ditto. + * nntp.el (nntp-send-command, nntp-send-command-nodelete): + (nntp-send-command-and-decode): Use gnus-point-at-bol. - * gnus-move.el (gnus-move-group-to-server): Protect against nil - ranges. +2001-07-09 13:00:00 ShengHuo ZHU + From Paul Jarc - * mm-decode.el (mm-display-external): Save the buffer. - (mm-remove-part): Kill it. + * message.el (message-use-mail-followup-to): New variable. + (message-get-reply-headers): Use it. - * qp.el (quoted-printable-decode-region): Do the right thing at eobp. +2001-07-04 Gerd Moellmann - * nnagent.el (nnagent-request-set-mark): Defined stub. + * nnheader.el (nnheader-init-server-buffer): Make sure the + *nntpd* buffer is made multibyte instead of a random buffer. -1999-01-14 23:05:31 Lars Magne Ingebrigtsen +2001-07-09 12:00:00 ShengHuo ZHU - * gnus-score.el (gnus-score-load-score-alist): Bind - coding-system-for-read. + * gnus-sum.el (gnus-get-newsgroup-headers-xover): Get headers only + when it returns headers. - * gnus-sum.el (gnus-summary-exit): Do adaptive scoring before - prepare-exit-hook. +2001-07-07 Simon Josefsson - * mm-view.el (mm-setup-w3): Require w3. + * rfc2047.el (rfc2047-encode-message-header): Skip header when + trying to fold. Thanks to Colin Walters + -1999-01-13 Kiyokazu SUTO +2001-07-06 Simon Josefsson - * lisp/nnspool.el (nnspool-retrieve-headers): Protect against empty - body. + * imap.el (imap-parse-address-list, imap-parse-flag-list) + (imap-parse-body-extension, imap-parse-body-ext, imap-parse-body): + Add information in `assert's. -1999-01-14 21:17:35 Lars Magne Ingebrigtsen + * nnimap.el (nnimap-possibly-change-group): Ignore uidvalidity + changes. (From nnimaps' point of view, `nnimap-verify-uidvalidity' + and `nnimap-group-overview-filename', should handle all + change-of-uidvalidity related issues. But there may be other + problems.) - * mm-encode.el: Ditto. +2001-07-05 Colin Walters - * mm-bodies.el (mm-decode-content-transfer-encoding): Message the - error. + * rfc2047.el (rfc2047-encode-message-header): Don't include the + header name when folding. - * mailcap.el (mailcap-mime-data): SAFER ps. +2001-07-05 Colin Walters - * message.el (message-encode-message-body): Always insert a - Content-Type header. + * mm-decode.el (mm-inlined-types): Document relationship with + `mm-inline-media-tests'. + (mm-display-inline): Default to displaying as plain text if no + inlining handler is available. + (mm-inlinable-p): Remove. + (mm-inlined-p): Don't call `mm-inlinable-p'. + (mm-automatic-display-p): Ditto. + (mm-attachment-override-p): Ditto. - * mm-decode.el (mm-inline-media-tests): Default all text/* to be - shown inline. +2001-07-04 Simon Josefsson - * mm-view.el (mm-inline-text): Handle all sorts of text. + * nnimap.el (nnimap-importantize-dormant): New variable. + (nnimap-request-update-info-internal): Use it. + (nnimap-request-set-mark): Ditto. - * mailcap.el (mailcap-mime-data): non-viewer for viewers that - don't view. +2001-07-04 Didier Verna - * mm-decode.el (mm-display-external): Use it. + * nntp.el (nntp-send-command): don't pass a buffer argument to + `point'. Only XEmacs accepts this. + * nntp.el (nntp-send-command-nodelete): ditto. + * nntp.el (nntp-send-command-and-decode): ditto. - * gnus-art.el (gnus-visible-headers): Added bcc, gcc, fcc. +2001-07-04 Didier Verna - * mm-decode.el (mm-save-part): Removed double code. + * nntp.el (nntp-open-connection-function): doc update. + * nntp.el (nntp-pre-command): New. + * nntp.el (nntp-via-rlogin-command): New. + * nntp.el (nntp-via-telnet-command): New. + * nntp.el (nntp-via-telnet-switches): New. + * nntp.el (nntp-via-user-name): New. + * nntp.el (nntp-via-user-password): New. + * nntp.el (nntp-via-address): New. + * nntp.el (nntp-via-envuser): New. + * nntp.el (nntp-via-shell-prompt): New. + * nntp.el (nntp-open-telnet-stream): New. + * nntp.el (nntp-open-via-rlogin-and-telnet): New. + * nntp.el (nntp-open-via-telnet-and-telnet): New. + * nntp.el (nntp-wait-for): check for possibly echo'ed commands. + * nntp.el (nntp-send-command): ditto. + * nntp.el (nntp-send-command-nodelete): ditto. + * nntp.el (nntp-send-command-and-decode): ditto. -1999-01-12 Dave Love +2001-06-30 YAGI Tatsuya + Trivial patch. - * mm-decode.el (mm-save-part): Avoid doubly-compressed - application/octet-stream .gz & al files with jka-compr. + * gnus-start.el (gnus-check-first-time-used): Use `if' instead of + `when'. -1999-01-12 Dave Love +2001-07-03 Simon Josefsson + From Nuutti Kotivuori - * 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. + * flow-fill.el (fill-flowed): Use (1+ (point-at-eol)) instead. -1999-01-13 19:41:57 Lars Magne Ingebrigtsen +2001-07-03 Simon Josefsson - * mailcap.el (mailcap-mime-data): Added ImageMagic and ee. + * flow-fill.el (fill-flowed): If `fill-region' inserts empty line, + remove it (workaround XEmacs `fill-region' bug). -1999-01-12 17:34:43 Lars Magne Ingebrigtsen +2001-07-01 Simon Josefsson - * gnus-picon.el (gnus-picons-kill-buffer): Don't kill article - buffers. + * nnimap.el (nnimap-date-days-ago): Defeat locale. - * gnus-sum.el (gnus-summary-exit): Destroy all MIME. +2001-06-28 11:00:00 ShengHuo ZHU - * gnus-cache.el (gnus-cache-read-active): Reversed check. + * mml2015.el (mml2015-format-error): New function. + (mml2015-mailcrypt-decrypt, mml2015-mailcrypt-clear-decrypt) + (mml2015-mailcrypt-verify, mml2015-gpg-clear-verify) + (mml2015-mailcrypt-clear-verify, mml2015-gpg-verify): Use it. -1999-01-12 17:18:25 Matt Armstrong +2001-06-26 22:00:00 ShengHuo ZHU - * mml.el (mml-parameter-string): Strip directory component. + * nnrss.el (nnrss-retrieve-headers): The description may not exist. + Suggested by Christoph Conrad . -1999-01-12 17:02:58 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-set-local-parameters): Don't override + group variables. - * gnus.el (gnus-use-demon): Removed. +2001-06-25 10:00:00 ShengHuo ZHU -1999-01-12 05:53:23 Katsumi Yamaoka + * nnslashdot.el (nnslashdot-write-groups): Use gnus-prin1. - * nnmail.el (nnmail-article-group): Don't infloop. + * nnrss.el (nnrss-save-server-data): Bind print-level and print-length. + (nnrss-save-group-data): Ditto. -1999-01-11 Colin Rafferty + * gnus-agent.el (gnus-agent-save-alist): Ditto. - * 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. +2001-06-25 Katsumi Yamaoka -1999-01-12 07:20:31 Lars Magne Ingebrigtsen + * message.el (message-do-send-housekeeping): Narrow to headers. - * gnus-picon.el (gnus-picons-setup-buffer): Don't set major mode. - (gnus-picons-setup-p): New variable. +2001-06-24 Simon Josefsson -1999-01-11 02:13:12 Lars Magne Ingebrigtsen + * rfc2047.el (rfc2047-fold-region): The check to skip WSP + insertion when breaking lines looked for " \t" instead of "[ \t]". + (rfc2047-encode-message-header): Fold lines even if + no QP encoding is done. - * nnmail.el (nnmail-split-header-length-limit): Lowered to 512. +2001-06-23 Simon Josefsson + From Samuel Tardieu -1999-01-04 12:58:13 Lars Magne Ingebrigtsen + * smime.el (smime-keys): Support additional certificates. + (smime-make-certfiles): New function. + (smime-sign-region): Use previous variables. + (smime-get-certfiles): New function. + (smime-sign-buffer): Use it. + (smime-verify-region): Support both CAfile and CApath. - * gnus-sum.el (gnus-summary-exit-no-update): Don't use run-hooks. - (gnus-summary-exit-no-update): Use mapcar. +2001-06-23 Simon Josefsson -1999-01-02 14:36:32 Simon Josefsson + * smime.el (smime-decrypt-region): Perhaps work. - * gnus-agent.el (gnus-category-write): Make directory. +2001-06-22 10:00:00 ShengHuo ZHU -1998-09-26 19:39:31 Simon Josefsson + * gnus-msg.el (gnus-copy-article-buffer): Typo. - * gnus-sum.el (gnus-update-read-articles): - (gnus-update-marks): Request backend update of mark. +2001-04-06 Ralph Schleicher -1999-01-03 15:29:52 Lars Magne Ingebrigtsen + * mm-decode.el (mm-save-part): Rewrite file name. + (mm-file-name-rewrite-functions): New variable. + (mm-file-name-delete-whitespace): New function. + (mm-file-name-trim-whitespace): New function. + (mm-file-name-collapse-whitespace): New function. + (mm-file-name-replace-whitespace): New variable and function. - * mm-bodies.el (mm-body-encoding): Use mm-find. +2001-06-22 Simon Josefsson -1999-01-03 15:28:27 Kim-Minh Kaplan + * message.el (message-make-date): Workaround locale for weekdays. - * gnus-picon.el (gnus-article-display-picons): Fix. +2001-06-21 17:00:00 ShengHuo ZHU -Sun Jan 3 13:32:02 1999 Lars Magne Ingebrigtsen + * message.el (message-goto-body): Return nil if not found. (revert!) - * gnus.el: Pterodactyl Gnus v0.69 is released. +2001-06-21 10:00:00 ShengHuo ZHU + From Fremlin -1999-01-03 06:45:10 Lars Magne Ingebrigtsen + * message.el (message-goto-body): Some messages have no header. - * gnus-picon.el (gnus-picons-setup-buffer): Run the hook. + * gnus-msg.el (gnus-copy-article-buffer): Use it. - * gnus-agent.el (gnus-agent-remove-group): New command and - keystroke. +2001-06-21 Ralph Schleicher - * rfc2047.el (rfc2047-decode-region): Check for us-ascii. + * nnultimate.el (nnultimate-retrieve-headers): Date fix. -1999-01-02 14:12:41 Simon Josefsson +2001-06-21 10:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-write-servers): Make directory. + * message.el (message-make-date): Add week day. + Suggested by Jason R. Mastaler . -1998-12-26 02:38:01 Lars Magne Ingebrigtsen +2001-06-19 Simon Josefsson - * mm-view.el (mm-inline-text): Bind current id. + * message.el (message-yank-prefix): Doc fix. + (message-yank-cited-prefix): Ditto. + (message-delete-not-region): Keep citation prefix on first line, + if possible and appropriate. - * mm-decode.el (mm-handle-id): New macro. - (mm-make-handle): Accept id. - (mm-dissect-singlepart): Use it. +2001-06-19 Simon Josefsson -1998-12-23 Matt Pharr + * imap.el (imap-process-connection-type): New variable. + (imap-kerberos4-open, imap-gssapi-open): Use it. This makes + recent `imtest's work completely (no line length issues), while + making making old `imtest's unusable. Thanks to NAGY Andras + for his work. - * message.el (message-cite-original-without-signature): Use - message-signature-separator when searching for signature in - message-cite-original-without-signature. +2000-12-30 NAGY Andras -1998-12-24 16:25:38 Simon Josefsson + * imap.el (imap-ssl-program): Add -quiet to shut up + OpenSSL/SSLeay's internal debug talk. - * gnus.el (gnus-server-to-method): Check named methods. +2001-06-19 Matt Armstrong -1998-12-24 03:27:02 Lars Magne Ingebrigtsen + * imap.el (imap-parse-flag-list): Workaround bug in Courier IMAP + server. - * mm-view.el (mm-view-message): Goto point-min. +2001-06-19 10:00:00 ShengHuo ZHU - * nnmail.el (nnmail-article-group): Don't delete lines, only - shorten them. + * nnmail.el (nnmail-article-buffer): New variable. + (nnmail-split-incoming): Use it. - * gnus-msg.el (gnus-configure-posting-styles): Also do nil - values. +2001-06-15 Eli Zaretskii - * nnheader.el (nnheader-temp-directory): New variable. - (nnheader-temp-directory): Removed. + * qp.el (quoted-printable-decode-region): If called interactively, + use coding-system-for-read. -1998-12-22 Jack Vinson +2001-06-16 09:00:00 ShengHuo ZHU - * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the - list of files to check for mailcap entries under windows-nt. + * message.el (message-check-news-header-syntax): Check Reply-To. -1998-12-24 03:02:15 Lars Magne Ingebrigtsen +2001-06-16 08:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the - summary buffer exists. + * mml.el (mml-parse-1): Use message options. -1998-12-22 Aaron M. Ucko + * message.el (message-do-fcc): Don't do anything if there is no + FCC. - * nnsoup.el (nnsoup-store-reply): Remove code to deal with - irrelevant Sun sendmail bug. - (nnsoup-store-reply): Stop mucking with mail-header-separator. +2001-06-16 Simon Josefsson - * message.el (message-send-news): Bind mail-header-separator to - "" when asking backend to post. + * nnimap.el (nnimap-split-articles): Support 'junk to-groups. + (nnimap-expunge-search-string): New variable. + (nnimap-request-expire-articles): Use it. -1998-12-22 Karl Kleinpaste +2001-06-15 19:00:00 ShengHuo ZHU - * mm-uu.el (mm-dissect-disposition): New variable. - (mm-uu-dissect): Use it. + * message.el (message-send-mail-with-qmail): wrong exit status is + 100 not 1. Reported by Paul Jarc . -1998-12-21 21:34:22 Lars Magne Ingebrigtsen +2001-06-15 09:00:00 ShengHuo ZHU - * mm-view.el (mm-inline-text): Bind url-current-object. + * gnus-art.el (article-strip-multiple-blank-lines): Use + delete-region instead of replace-match. -1998-12-06 03:05:41 Simon Josefsson +2001-06-14 16:00:00 ShengHuo ZHU - * gnus-range.el (gnus-remove-from-range): Rewrite. + * nnweb.el (nnweb-google-parse-1): Fix Google content regexp. + (nnweb-google-wash-article): Ditto. -1998-12-09 SL Baur +2001-06-14 Ferenc Wagner - * gnus-picon.el (annotations): Remove bogus require 'xpm. + * nnweb.el (nnweb-google-parse-1): Fix Google url regexp. -1998-12-18 Hrvoje Niksic +2001-06-13 Katsumi Yamaoka - * message.el (message-encode-message-body): Insert `MIME-Version' - instead of `Mime-Version'. + * gnus.el (gnus-define-group-parameter): Don't quote the defcustom + specs. -1998-12-04 Hrvoje Niksic +2001-06-13 15:00:00 ShengHuo ZHU - * 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. + * gnus.el (gnus-email-address): Move it here. -1998-12-19 23:02:26 Lars Magne Ingebrigtsen + * gnus-art.el (article-de-quoted-unreadable): Read charset if + requested. + (article-de-base64-unreadable): Ditto. + (article-wash-html): Ditto. - * nnmail.el (nnmail-split-header-length-limit): New variable. +2001-06-12 14:00:00 ShengHuo ZHU - * mm-decode.el (mm-dissect-buffer): Check syntax. + * message.el (message-options-set-recipient): Don't add ", " + unless necessary. Suggested by Josh Huber . - * rfc2231.el (rfc2231-parse-string): Remove check for syntax. +2001-06-12 12:00:00 ShengHuo ZHU - * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region. - (rfc2047-dissect-region): Ditto. + * nnrss.el (nnrss-group-alist): Use |fr| instead of [fr]. -1998-12-17 18:36:43 Lars Magne Ingebrigtsen +2001-06-12 11:00:00 ShengHuo ZHU - * mm-view.el (mm-view-message): Decode charset. + * gnus-art.el (gnus-plain-save-name): Use file-relative-name. + From Marc Lefranc . -1998-12-16 16:01:22 Lars Magne Ingebrigtsen + * nnrss.el (nnrss-node-text): Node might be nil. - * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid - CT headers. +2001-06-11 10:00:00 ShengHuo ZHU -Wed Dec 16 01:44:40 1998 Shenghuo ZHU + * gnus-uu.el (gnus-uu-save-article): Use mml tag instead of + part. From Katsumi Yamaoka . - * mm-bodies.el (mm-decode-content-transfer-encoding): Use - mm-uu-*-function. - * mm-uu.el (mm-uu-dissect): Use x-uuencode. + * nnrss.el (nnrss-group-alist): More items. -1998-12-16 10:20:52 Lars Magne Ingebrigtsen +2001-06-09 23:00:00 ShengHuo ZHU - * message.el (message-send-mail): Do MML first. - (message-send-news): Ditto. + * nnrss.el (nnrss-node-text): Use cddr instead xml-node-children. -1998-12-15 20:57:18 Lars Magne Ingebrigtsen +2001-06-03 ShengHuo ZHU + Trivial patch from Dale Hagglund - * gnus-picon.el (gnus-picons-face): New face. - (gnus-picons-try-face): Use it. + * gnus-mlspl.el (gnus-group-split-fancy): Fix generation of split + restrict clauses. -Tue Dec 15 19:17:43 1998 Lars Magne Ingebrigtsen +2001-06-07 16:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.68 is released. + From Benjamin Rutt -Tue Dec 15 18:28:24 1998 Lars Magne Ingebrigtsen + * message.el (message-wide-reply-confirm-recipients): New variable. - * gnus.el: Pterodactyl Gnus v0.67 is released. +2001-06-06 ShengHuo ZHU + Trivial patch from Mark Thomas -Tue Dec 15 17:31:44 1998 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-fix-eudora-headers): Change the In-Reply-To + fix so it works with XEmacs. - * gnus.el: Pterodactyl Gnus v0.66 is released. +2001-06-07 16:00:00 ShengHuo ZHU -1998-12-13 11:00:43 Lars Magne Ingebrigtsen + * nnrss.el (nnrss-retrieve-headers): Support description as extra + headers. - * gnus-art.el (gnus-insert-mime-button): Decode description. +2001-06-07 15:00:00 ShengHuo ZHU -Sat Dec 5 16:50:49 1998 Shenghuo ZHU + * nnrss.el: Fix a few bugs. - * 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. +2001-06-05 Simon Josefsson -1998-12-13 10:04:39 Lloyd Zusman + * mm-decode.el (mm-handle-set-external-undisplayer): Don't + generate compiler warnings. From Alex Schroeder . - * gnus-xmas.el (gnus-xmas-summary-recenter): Allow numbers. +2001-06-04 Hrvoje Niksic -1998-12-13 09:32:38 Lars Magne Ingebrigtsen + * mm-decode.el (mm-pipe-part): Bind coding-system-for-write to + binary so that we don't transmit ISO 2022 garbage to the process. + This is needed under XEmacs. - * mml.el (mml-insert-mime-headers): Encode description. +2001-06-03 Simon Josefsson - * nnfolder.el (nnfolder-request-expire-articles): Go to the date - line. + * imap.el (imap-ssl-open): Require ssl. (Otherwise ssl.el is + autoloaded incorrectly below because ssl-program-* is bound.) + Thanks to Amos Gouaux for report. - * gnus-sum.el (gnus-default-charset): Doc fix. +2001-06-02 Simon Josefsson -Wed Dec 9 15:18:39 1998 Shenghuo ZHU + * imap.el (imap-kerberos4-open): + (imap-gssapi-open): + (imap-ssl-open): + (imap-network-open): + (imap-shell-open): + (imap-starttls-open): Set buffer to workaround spurious + `accept-process-output' buffer changes. Thanks to Mats Lidell + for report and partial patch and Jake + Colman for report. - * mm-decode.el (mm-display-part): Forward a line. +2001-05-31 13:00:00 ShengHuo ZHU -Wed Dec 9 13:30:29 1998 Shenghuo ZHU + * gnus-sum.el (gnus-summary-catchup): New argument. + (gnus-summary-catchup-from-here): New function. - * 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. +2001-05-30 Kai Gro,b_(Bjohann -1998-12-13 08:52:45 Lars Magne Ingebrigtsen + * mm-view.el (mm-inline-image-xemacs): Insert newline, then move + back, then insert glyph. (Before, the glyph was inserted first, + then the newline.) This works around a behavior in XEmacs where + it is not possible to insert a character after a glyph which is at + the end of a buffer. Patch by Lloyd Zusman . - * gnus-picon.el (gnus-picons-network-display-internal): Don't set - buffer. +2001-05-28 Kai Gro,b_(Bjohann - * message.el (message-insert-headers): New command and keystroke. + From Jaap-Henk Hoepman (jhh@xs4all.nl). -1998-12-07 23:42:14 Lars Magne Ingebrigtsen + * mm-decode.el (mm-keep-viewer-alive-types): New variable. + (mm-keep-viewer-alive-p, mm-handle-set-external-undisplayer, + mm-destroy-postponed-undisplay-list): New functions. + (mm-display-external): Use them. - * mm-decode.el (mm-inline-media-tests): Recognize x-xbitmap. - (mm-get-image): Ditto. +2001-05-27 Kai Gro,b_(Bjohann - * mm-bodies.el (mm-decode-content-transfer-encoding): Only for - base64, uudecode and binhex. + * gnus-salt.el (gnus-tree-highlight-node): Bind `default-high' and + `default-low' when evaluating `gnus-summary-highlight'. + From Raja R Harinath . -Sun Dec 6 21:58:31 1998 Shenghuo ZHU +2001-05-27 Simon Josefsson - * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF - in text/plain. - * mm-uu.el (mm-uu-dissect): Use inline. + * message.el (message-yank-cited-prefix): New variable. + (message-indent-citation): Use it. -1998-12-07 23:19:14 Lars Magne Ingebrigtsen + * mml2015.el (mml2015-mailcrypt-verify): Store gpg stderr output + as details. + (mml2015-mailcrypt-clear-verify): Ditto. - * mm-view.el (mm-view-message): New function. +2001-05-24 Kai Gro,b_(Bjohann + From Nevin Kapur . - * mm-encode.el (mm-content-transfer-encoding-defaults): Changed to - qp. + * gnus-sum.el (gnus-summary-default-high-score, + gnus-summary-default-low-score): New variables. + (gnus-summary-highlight): Use them. -1998-12-07 Karl Kleinpaste +2001-05-16 Didier Verna - * mm-encode.el (mm-content-transfer-encoding-defaults): Add an - entry for message/rfc822 as 8bit. + * message.el (message-mail): pass the 'send-actions argument to + `message-setup'. -1998-12-07 23:16:54 Lars Magne Ingebrigtsen +2001-05-16 Simon Josefsson + From Raymond Scholz - * mailcap.el (mailcap-mime-extensions): Add patch. + * gnus-art.el (gnus-mime-view-part-as-charset): + (gnus-mime-internalize-part): Doc fixes. -1998-12-05 Dale Hagglund +2001-05-11 Simon Josefsson - * gnus-sum.el (gnus-summary-display-buttonized): Use prefix - argument to force all multipart/* to look like multipart/mixed. + * gnus-start.el (gnus-ignored-newsgroups): Also ignore NNTP type + status lines without any text ("^215$"). - * gnus-art.el (gnus-mime-display-multipart-as-mixed): New - variable. - (gnus-mime-display-part): Use it. +2001-05-06 21:00:00 ShengHuo ZHU -1998-12-07 22:46:37 Lars Magne Ingebrigtsen + * nnrss.el (nnrss-check-group): Reverse. - * gnus-draft.el (gnus-draft-send): Only disable checks for - non-interactive use. - (gnus-draft-send-message): Use it. +2001-05-07 Simon Josefsson -Sun Dec 6 19:36:53 1998 Lars Magne Ingebrigtsen + * message.el (message-get-reply-headers): + (message-followup): Fix typo, suggested by David Green + - * gnus.el: Pterodactyl Gnus v0.65 is released. +2001-05-05 15:00:00 ShengHuo ZHU -1998-12-06 20:11:02 Lars Magne Ingebrigtsen + * nnslashdot.el (nnslashdot-request-expire-articles): Fix. - * gnus-art.el (gnus-article-prepare-display): Don't init w3. + * nnrss.el (nnrss-open-server): Read server data when it is called. + (nnrss-request-expire-articles): Fix. - * mm-view.el (mm-inline-text): Bind url-standalone-mode here. +2001-05-05 09:00:00 ShengHuo ZHU -Sat Dec 5 18:35:42 1998 Lars Magne Ingebrigtsen + * message.el (message-do-send-housekeeping): mail-abbrevs may + rename buffer behind Gnus. - * gnus.el: Pterodactyl Gnus v0.64 is released. +2001-05-04 14:00:00 ShengHuo ZHU -1998-12-05 18:51:13 Lars Magne Ingebrigtsen + * nnrss.el (nnrss-check-group): Use nnheader-translate-file-chars. + (nnrss-group-alist): Add more resources. + (nnrss-check-group): Ignore errors. - * mm-view.el (mm-setup-w3): Don't load. +2001-05-04 00:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-setup-message): Set group name. - (gnus-group-mail): Avoid leaking local vars. + * nnrss.el (nnrss-request-expire-articles): Correct the return value. - * message.el (message-attach-file): Renamed. - (message-mime-attach-file): Renamed again. + * nnslashdot.el (nnslashdot-request-list): Add time. + (nnslashdot-request-expire-articles): New function. -1998-12-05 Hrvoje Niksic + * gnus-start.el (gnus-check-bogus-newsgroups): Remove bogus + secondary methods too. - * gnus-art.el (article-decode-encoded-words): Bind - rfc2047-default-charset here. +2001-05-03 23:00:00 ShengHuo ZHU - * gnus-art.el (gnus-insert-mime-button): Nix slashes in file name. + * message.el (message-use-followup-to): Set default value to t. -1998-12-05 18:33:27 Lars Magne Ingebrigtsen +2001-05-03 Florian Weimer - * gnus-picon.el (gnus-picons-setup-buffer): Run picons hook. - (gnus-picons-setup-hook): New hook. + * message.el (message-dont-reply-to-names): Fix documentation. + (message-get-reply-headers): Use Mail-Followup-To only for wide + replies. -1998-12-05 Per Abrahamsen +2001-05-03 12:00:00 ShengHuo ZHU - * mailcap.el (mailcap-mime-data): Remove "*" from documentation - string. - (mailcap-mime-extensions): Ditto. Made first sentense fit a - line. + * nnrss.el (nnrss-request-expire-articles): Calculate # of days + correctly. + (nnrss-check-group): Use time. -1998-12-05 17:11:04 Lars Magne Ingebrigtsen +2001-05-01 19:21:19 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. + * gnus.el: Oort Gnus v0.03 is released. - * mm-view.el (mm-setup-w3): Require url-vars. +2001-05-01 19:06:21 Lars Magne Ingebrigtsen -Fri Dec 4 12:13:12 1998 Shenghuo ZHU + * nnultimate.el (nnultimate-topic-article-to-article): Use the + group. - * message.el (message-draft-coding-system): Fix for XEmacs-NT. - * mm-util.el (mm-find-charset-region): Ditto. +2001-04-24 19:50:14 Lars Magne Ingebrigtsen -1998-12-05 16:30:01 Lars Magne Ingebrigtsen + * gnus-srvr.el (gnus-server-insert-server-line): Add a space. - * message.el (message-send): Don't encode here. - (message-send-mail): But here. - (message-send-news): And here. +2001-04-15 14:55:03 Lars Magne Ingebrigtsen -1998-12-04 15:29:02 Lars Magne Ingebrigtsen + * nnultimate.el (nnultimate-retrieve-headers): Return all + available headers. - * gnus-msg.el (gnus-message-insert-stylings): Don't insert twice. + * gnus-sum.el (gnus-read-all-available-headers): New variable. + (gnus-get-newsgroup-headers-xover): Use it. -Fri Dec 4 04:09:15 1998 Lars Magne Ingebrigtsen +2001-04-14 15:47:26 Lars Magne Ingebrigtsen - * gnus.el: Pterodactyl Gnus v0.63 is released. + * nnultimate.el (nnultimate-retrieve-headers): Clean up. -1998-12-04 04:59:20 Lars Magne Ingebrigtsen +2001-04-30 17:00:00 ShengHuo ZHU - * mml.el (mml-base-boundary): Shorten. + * nntp.el (nntp-retrieve-groups): Use throw instead of error. - * message.el (message-insert-mime-part): Use default. +2001-04-29 09:00:00 ShengHuo ZHU - * gnus-art.el (gnus-insert-mime-button): Bind gnus-tmp-type-long. + * nnrss.el (nnrss-insert-w3): Use cache before I figure out how to + disable it. -1998-12-03 Per Abrahamsen + * gnus.el (gnus-info-nodes): Remove a few The's. - * gnus-art.el (gnus-mime-display-alternative): Use (*) for radio - buttons, not [*]. +2001-04-29 08:00:00 ShengHuo ZHU -1998-12-04 Hrvoje Niksic + * mail-source.el (mail-source-movemail): Call-process may return a + signal description string. - * gnus-art.el (gnus-insert-mime-button): Do proper help-echo. + * gnus-start.el (gnus-read-newsrc-el-file): + gnus-newsrc-file-version may be nil. -1998-12-04 04:48:37 Hrvoje Niksic + * nnmail.el (nnmail-get-new-mail): Use the exact file only. + Suggested by Michael Sperber [Mr. Preprocessor] + . - * gnus-art.el (gnus-insert-mime-button): Fix. +2001-04-25 Per Abrahamsen -1998-12-03 Hrvoje Niksic + * mm-uu.el (mm-uu-configure-list): Fixed customize type. - * 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. +2001-04-24 Hrvoje Niksic -1998-12-04 04:41:58 Lars Magne Ingebrigtsen + * mm-view.el (mm-display-inline-fontify): Allow XEmacs to fully + fontify HANDLE. - * gnus-art.el (gnus-mime-internalize-part): Bugged out. +2001-04-18 Simon Josefsson -1998-12-03 Hrvoje Niksic + * smime.el (smime-ask-passphrase): Rework to return value. + (smime-sign-region): Rework to bind value and use it. + (smime-decrypt-region): Ditto. - * gnus-art.el (gnus-mime-button-line-format): Nicify. - (gnus-insert-mime-button): Modify accordingly. +2001-04-18 Simon Josefsson + Trivial patch from Mathias Herberts -1998-12-04 01:50:53 Lars Magne Ingebrigtsen + * smime.el (smime-ask-passphrase): New function. + (smime-sign-region): Use it. + (smime-encrypt-cipher): New variable. + (smime-decrypt-region): Ditto. - * gnus-art.el (gnus-display-mime): Set window point. +2001-04-12 Jason Merrill + Committed by Simon Josefsson - * mm-decode.el (mm-display-external): Only decode when not - saving. - (mm-alternative-precedence): Prefer multiparts. - (mm-inline-media-tests): Inline multiparts. + * imap.el (imap-shell-open): Erase the buffer *after* copying it into + the log. - * gnus-picon.el (gnus-picons-next-job-internal): Do bar if asked. - Ignore errors when requiring url. +2001-04-14 01:14:42 Lars Magne Ingebrigtsen - * mml.el (mml-quote-region): New command. + * gnus.el: Oort Gnus v0.02 is released. - * message.el (message-cite-original): Use it. - (message-cite-original-without-signature): Ditto. +2001-04-14 00:48:42 Lars Magne Ingebrigtsen -Thu Dec 3 12:53:58 1998 Lars Magne Ingebrigtsen + * gnus.el: Oort Gnus v0.01 is released. - * gnus.el: Pterodactyl Gnus v0.62 is released. +2001-04-13 22:01:46 Lars Magne Ingebrigtsen -1998-12-03 13:38:36 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-highlight): Highlight read + undownloaded articles as read articles. - * gnus-art.el (gnus-mime-view-all-parts): Work with multiparts. + * gnus-agent.el (gnus-agent-get-undownloaded-list): Clean up. + (gnus-agent-get-undownloaded-list): Mark all undownloaded + articles, even read ones, as such. -1998-12-03 Hrvoje Niksic + * gnus-sum.el (gnus-summary-find-matching): Clean up. + (gnus-find-matching-articles): New function. + (gnus-summary-limit-include-matching-articles): New command. + (gnus-summary-limit-include-thread): Include articles that have + matching subjects. + (gnus-offer-save-summaries): Clean up. - * mm-view.el (mm-inline-text): Use `point-min-marker' and - `point-max-marker'. +2001-04-13 Kai Gro,b_(Bjohann -1998-12-03 13:22:57 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-split-fancy-with-parent): Add docstring. - * mailcap.el (mailcap-mime-extensions): Use image/xpm for xpms. +2001-04-12 19:00:00 ShengHuo ZHU + From Jason Merrill - * gnus-art.el (gnus-mime-display-single): Check for attachment - before other tests. + * gnus-sum.el (gnus-summary-insert-new-articles): Reverse the articles. -1998-12-03 Didier Verna +2001-04-10 08:01:15 Katsumi Yamaoka + Committed by ShengHuo ZHU - * gnus-msg.el (gnus-configure-posting-styles): find a - posting-style entry in the group parameters, if any, and honor it - at the end. + * gnus-msg.el (gnus-post-news): Fill the Newsgroups header by the + newsgroup names when the original article is a news message. -1998-12-03 13:03:37 Felix Lee +2001-04-12 19:00:00 ShengHuo ZHU - * nntp.el (nntp-after-change-function): Fix. + * message.el (message-cite-prefix-regexp): Use POSIX regexp if + supported. Suggest by Jim Meyering . -1998-12-03 12:44:30 Mike McEwan +2001-04-02 Nevin Kapur + Committed by Kai Gro,b_(Bjohann . - * mml.el (mml-generate-mime-1): Insert literally. + * nnmail.el (nnmail-split-it): Added check for .* at the end of + regexp in nnmail-split-fancy. -1998-12-03 00:23:17 Lars Magne Ingebrigtsen +2001-04-10 Simon Josefsson - * mml.el (mml-insert-mime-headers): Removed debug. + * message.el (message-options-set-recipient): Look at Cc and Bcc too. -1998-12-02 22:22:03 Lars Magne Ingebrigtsen +2001-04-10 Colin Marquardt - * gnus-sum.el (gnus-summary-show-article): Destroy parts when - prefixed. + * message.el (message-send-mail): Improve the interaction with the + user. - * mm-encode.el (mm-content-transfer-encoding-defaults): Default - application/emacs-lisp to 8bit. +2001-04-10 Simon Josefsson -1998-12-03 Dale Hagglund + * imap.el (imap-message-copy): Work around buggy servers that + doesn't send TRYCREATE tags. - * mm-decode.el (mm-quote-arg): Add quoting of '()', '<>', and '|'. +2001-04-09 01:15:54 Katsumi Yamaoka -Wed Dec 2 20:24:27 1998 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-read-newsrc-el-file): Work with Semi-gnusae. - * gnus.el: Pterodactyl Gnus v0.61 is released. +2001-04-05 21:43:25 Lars Magne Ingebrigtsen -1998-12-02 21:12:56 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-update-summary-mark-positions): Use a valid + date. - * 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. +2001-04-04 16:13:17 Lars Magne Ingebrigtsen -Wed Dec 2 20:07:16 1998 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-quit): Check that the dribble buffer + lives. - * gnus.el: Pterodactyl Gnus v0.60 is released. +2001-04-02 00:40:12 Lars Magne Ingebrigtsen -1998-12-02 20:11:28 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-parse-news-url): New function. + (gnus-button-handle-news): New function. + (gnus-button-alist): Point to new functions. - * mml.el (mml-parse-1): Don't throw contents away. + * gnus-group.el (gnus-group-quit): Only mark buffer in non-empty. -1998-12-02 Hrvoje Niksic + * gnus-start.el (gnus-read-newsrc-el-file): Nix out + gnus-format-specs. - * mml.el (mml-compute-boundary-1): Regexp-quote the boundary. + * message.el (message-check-news-header-syntax): Question even + when Gnus doesn't know the group names. + (message-send-news): Clean up. -1998-12-02 18:42:24 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-dribble-read-file): Say whether Gnus was + exited on purpose without saving. - * mml.el (mml-parse-singlepart-with-multiple-charsets): New - function. - (mml-parse-1): Use it. + * gnus-group.el (gnus-group-quit): Mark the dribble file as `Q'. -Tue Dec 1 23:04:25 1998 Shenghuo ZHU +2001-04-01 00:37:14 Lars Magne Ingebrigtsen - * 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. + * gnus-score.el (gnus-score-orphans): Clean up. -1998-12-02 03:14:20 Lars Magne Ingebrigtsen + * gnus-win.el (gnus-remove-some-windows): Leave one Gnus window. - * message.el (message-send-mail): Don't encode here. - (message-send-news): Nor here. - (message-send): ... but here instead. + * gnus-sum.el (gnus-summary-exit): Kill the summary buffer a bit + later. - * 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. + * gnus-start.el (gnus-close-all-servers): Find the right items to + close. - * message.el (message-fetch-field): Remove text props. + * qp.el (quoted-printable-decode-region): Just message + malformation; don't quit. - * gnus-art.el (gnus-article-normalized-header-length): New - variable. - (article-normalize-headers): New command and keystroke. +2001-03-31 21:00:00 ShengHuo ZHU + From Gerd Moellmann . - * gnus-picon.el (gnus-picons-xbm-face): Changed colors. + * gnus.el (gnus-interactive): A typo. -Wed Dec 2 01:43:48 1998 Lars Magne Ingebrigtsen +2001-03-26 Juanma Barranquero + Committed by ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.59 is released. + * gnus-util.el (gnus-delete-alist): Declare it as an alias of + `assq-delete-all', if that function exists; otherwise use the old + definition. Documentation changed to match the one in + `assq-delete-all'. -1998-12-02 01:38:31 Lars Magne Ingebrigtsen +2001-04-01 00:37:14 Lars Magne Ingebrigtsen - * mml.el (mml-insert-mime-headers): Beep at multiple charsets. + * gnus-start.el (gnus-close-all-servers): New function. - * gnus-art.el (gnus-mime-copy-part): Set buffer-file-name. + * gnus-srvr.el (gnus-server-close-all-servers): Clean up. + (gnus-server-remove-denials): Clean up. -1998-11-30 Hrvoje Niksic + * gnus-sum.el (gnus-summary-sort-by-original): New command and + keystroke. - * mml.el (mml-generate-mime-1): Handle unquoting end-tags. +2001-03-31 02:56:55 Lars Magne Ingebrigtsen -1998-12-02 00:15:30 Lars Magne Ingebrigtsen + * message.el (message-send-news): Message where we are sending. + (message-send-mail): Ditto. - * mm-decode.el (mm-all-images-fit): New variable. - (mm-image-fit-p): Use it. + * gnus.el (gnus-server-string): New function. - * gnus-art.el (gnus-mime-display-single): Use it. - (gnus-mime-internalize-part): New command and keystroke. + * gnus-sum.el (gnus-summary-up-thread): Doc fix. - * mm-decode.el (mm-user-automatic-external-display): New - variable. - (mm-automatic-external-display-p): New function. + * mm-decode.el (mm-default-directory): Customized. + (mm-tmp-directory): Ditto. - * gnus-picon.el (gnus-picons-xbm-face): Default to sensible - colors. + * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. + (gnus-get-newsgroup-headers): Return -1 for articles without Lines + or Chars. + (gnus-summary-line-format-alist): ?l is now a string. + (gnus-summary-prepare-threads): Output ? for unknown lines. + (gnus-summary-insert-line): Ditto. + (gnus-summary-print-article): Unbalanced parentheses. -1998-12-01 23:52:05 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-inews-do-gcc): Check group to allow it to find + out whether new stuff has arrived. - * gnus-sum.el (gnus-summary-repair-multipart): Reselect article. +2001-03-31 02:14:38 Alan Shutko - * gnus-art.el (gnus-with-article): Work in the original article - buffer. - (gnus-with-article): Work in read-only groups. + * gnus-sum.el: Let printing work on ttys on Emacs. -Tue Dec 1 00:15:36 1998 Shenghuo ZHU +2001-03-31 01:11:14 Lars Magne Ingebrigtsen - * mm-bodies.el (mm-decode-string): Return original string if not - decode. + * gnus-msg.el (gnus-post-news): Add an empty Newsgroups header + when forcing news. -Mon Nov 30 23:38:02 1998 Shenghuo ZHU + * gnus-sum.el (gnus-summary-mark-article-as-replied): Make into a + command. - * mm-uu.el (mm-uu-dissect): Use mm-make-handle. +2001-03-31 01:04:54 Francis Litterio -1998-12-01 01:53:49 Francois Pinard + * message.el (message-set-auto-save-file-name): Don't use + asterisks under nt. - * nndoc.el (nndoc-mime-parts-type-p): Do related. +2001-03-31 00:03:42 Lars Magne Ingebrigtsen -Tue Dec 1 00:46:20 1998 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-inews-insert-draft-meta-information): Allow + lists of articles. - * gnus.el: Pterodactyl Gnus v0.58 is released. + * gnus-uu.el (gnus-uu-digest-mail-forward): Mark as forwarded. -1998-11-30 Hrvoje Niksic + * gnus-msg.el (gnus-put-message): Clean up. + (gnus-summary-reply): Mark all replied-to articles as replied to. + (gnus-inews-add-send-actions): Also mark as forwarded. + (gnus-summary-mail-forward): Mark as forwarded. - * mm-decode.el (mm-get-image): Return a glyph, not an image - specifier. + * gnus-sum.el (gnus-summary-mark-article-as-replied): Take a list + of articles. + (gnus-summary-mark-article-as-forwarded): Ditto. -1998-11-29 Hrvoje Niksic + * gnus-msg.el (gnus-summary-resend-message): Mark article as + forwarded. + (gnus-summary-mail-forward): Clean up. - * rfc2047.el (rfc2047-decode): Bind mm-default-charset. + * gnus.el (gnus-article-mark-lists): Added forward. -1998-12-01 01:23:35 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-forwarded-mark): New variable. + (gnus-summary-prepare-threads): Use it. + (gnus-summary-update-secondary-mark): Ditto. + (gnus-newsgroup-forwarded): New variable. - * mail-parse.el (rfc2045): Required. +2001-03-30 23:13:37 Lars Magne Ingebrigtsen -1998-12-01 00:59:53 William M. Perry + * gnus-msg.el (gnus-summary-reply): Allow very wide replies. + (gnus-summary-very-wide-reply): New command and keystroke. + (gnus-summary-very-wide-reply-with-original): Ditto. - * mm-view.el (mm-inline-text): Remove props. + * gnus-score.el (gnus-adaptive-word-length-limit): New variable. + (gnus-score-adaptive): Use it. -1998-12-01 00:18:47 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-get-unread-articles): Clean up. - * mm-view.el (mm-setup-w3): Protect url-misc. +2001-03-21 20:00:43 Lars Magne Ingebrigtsen - * message.el (message-ignored-resent-headers): Remove - Gnus-Warning. + * nnultimate.el (nnultimate-retrieve-headers): Work for other + boards. - * mml.el (mml-insert-mime-headers): Use encoding. - (mml-parameter-string): Ditto. +2001-03-21 Didier Verna - * rfc2045.el: New file. - (rfc2045-encode-string): New function. + * gnus-start.el (gnus-subscribe-newsgroup-hooks): New. + * gnus-start.el (gnus-subscribe-newsgroup): use it. -1998-11-30 23:11:22 Lars Magne Ingebrigtsen +2001-03-15 09:47:23 Lars Magne Ingebrigtsen - * mail-parse.el (mail-header-encode-parameter): New function. + * nnultimate.el (nnultimate-retrieve-headers): Understand + long-form month names. - * rfc2231.el (rfc2231-encode-string): New function. +2001-03-18 23:00:00 ShengHuo ZHU -Mon Nov 30 13:52:50 1998 Shenghuo ZHU + * gnus-sum.el (gnus-summary-show-all-headers): + gnus-article-show-all-headers is broken. Use + gnus-summary-toggle-header instead. - * mm-bodies.el (mm-decode-string): New function. - * mm-view.el (mm-inline-text): Use mm-decode-string. + * mml2015.el (mml2015-gpg-extract-from): No error. -Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen +2001-03-18 23:00:00 ShengHuo ZHU + From Bj,Ax(Brn Mork . - * gnus.el: Pterodactyl Gnus v0.57 is released. + * mml2015.el (mml2015-gpg-extract-from): New function. + (mml2015-gpg-verify): Use it. + (mml2015-gpg-clear-verify): Use it. -1998-11-23 Felix Lee +2001-03-17 10:00:00 ShengHuo ZHU - * 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. + * message.el (message-setup-fill-variables): Use + fill-paragraph-function. + (message-fill-paragraph): Take an argument. + (message-newline-and-reformat): Take another argument. - * gnus-async.el (gnus-async-request-fetched-article): fixed. - (gnus-async-wait-for-article): new function. - (gnus-async-with-semaphore): s/asynch/async/. +2001-03-16 20:00:00 ShengHuo ZHU -1998-11-30 16:54:56 Lars Magne Ingebrigtsen + * message.el (rmail-output): It is in rmailout.el not rmail.el. - * 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. +2001-03-16 16:00:00 ShengHuo ZHU - * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in - broken parts. + * message.el (message-forward): local-variable-p takes an extra + argument in XEmacs. - * gnus-art.el (gnus-with-article): Flush cache and backlog. +2001-03-16 Simon Josefsson - * mm-bodies.el (mm-decode-content-transfer-encoding): Also do - binhex. + * nnimap.el (nnimap-dont-use-nov-p): Renamed from + `nnimap-use-nov-p' (it really tested the negative). + (nnimap-retrieve-headers): Use it. - * gnus-sum.el (gnus-summary-reparent-thread): Use new macro. - (gnus-summary-repair-multipart): New command and keystroke. +2001-03-11 Kai Gro,b_(Bjohann - * gnus-art.el (gnus-with-article-buffer): New macro. + * message.el (message-generate-headers-first): Update doc. -Sun Nov 29 23:51:57 1998 Shenghuo ZHU +2001-03-10 Matthias Wiehl + Trivial patch. - * gnus-art.el (gnus-mime-inline-part): Do not get part when - undisplay the part. + * gnus.el (gnus-summary-line-format): Typo. -1998-11-30 03:38:35 Lars Magne Ingebrigtsen +2001-03-11 Simon Josefsson - * gnus-util.el (gnus-make-sort-function-1): Allow lambdas. + * mailcap.el (mailcap-mime-data): Add application/sieve. + (mailcap-mime-extensions): Add .siv, .xls. - * mml.el (mml-read-part): Partition right. +2001-03-14 20:00:00 ShengHuo ZHU + From Christoph Conrad - * 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. + * gnus-score.el (gnus-summary-lower-thread): Typo. -1998-11-29 23:44:44 Lars Magne Ingebrigtsen +2001-03-14 19:00:00 ShengHuo ZHU - * gnus-art.el (gnus-mime-display-mixed): Rewrite. - (gnus-mime-display-single): Don't insert lines between parts. + * message.el (message-forward-decoded-p): New variable. + (message-forward-subject-author-subject): Use it. + (message-make-forward-subject): Use it. + (message-forward): Use it. -Sun Nov 29 04:55:40 1998 Shenghuo ZHU + * gnus-uu.el (gnus-uu-digest-mail-forward): Use it. - * 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. + * mm-util.el, message.el, rfc2047.el, gnus-sum.el, gnus-score.el: + Sync with Emacs 21 (tag EMACS_PRETEST_21_0_100). -Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen +;;Has been fixed -- zsh. +;;2001-03-05 Dave Love +;; +;; * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case. +;; Move it after definition of mm-coding-system-p. +;; +2001-03-01 Dave Love - * gnus.el: Pterodactyl Gnus v0.56 is released. + * mm-util.el (mm-inhibit-file-name-handlers): Add + image-file-handler. -1998-11-29 00:52:53 Lars Magne Ingebrigtsen +2001-02-11 Dave Love - * gnus-art.el (gnus-mime-display-part): New function. - (gnus-mime-display-mixed): Use it. + * message.el (message-signature-file): Fix doc, :type. - * mm-view.el (mm-setup-w3): Don't register. +2001-02-08 Dave Love - * message.el (message-cite-original): Cite parts. + * rfc2047.el (rfc2047-fold-region): Don't forward-char at EOB. + (message-posting-charset): Defvar when compiling again. + (rfc2047-encodable-p): Require message. -1998-11-28 23:51:25 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-alter-articles-to-read-function): + * gnus-score.el (gnus-score-after-write-file-function): Fix :type. - * mml.el (mml-parameter-string): New function. - (mml-insert-mime-headers): Separated into new function. +2001-03-08 20:00:00 ShengHuo ZHU -1998-11-28 Hrvoje Niksic + * nnrss.el: New file. - * mml.el (mml-make-boundary): Use `make-string'. +2001-03-08 02:41:36 Katsumi Yamaoka + Committed by ShengHuo ZHU -1998-11-27 Hrvoje Niksic + * rfc2047.el (rfc2047-unfold-region): Fix arg of + `skip-chars-forward'. - * binhex.el (binhex-insert-char): Ditto. +2001-03-07 13:00:00 ShengHuo ZHU - * base64.el (base64-insert-char): Ditto. + * nndraft.el (nndraft-request-group): Restore auto save files if + the original files do not exist. - * uudecode.el (uudecode-insert-char): Code correctly. +2001-03-07 11:00:00 ShengHuo ZHU -1998-11-28 01:08:19 Lars Magne Ingebrigtsen + * gnus-score.el (gnus-score-find-bnews): Print messages on illegal + SCORE paths. - * mml.el (mml-generate-mime): Don't generate multiparts for - empties. + * mm-decode.el (mm-dissect-buffer): Call + mail-extract-address-components only if necessary. - * gnus-art.el (gnus-display-mime): Save excursion. +2001-03-06 13:00:00 ShengHuo ZHU - * message.el (message-remove-first-header): New function. - (message-encode-message-body): Use it. + * gnus-score.el (gnus-score-find-bnews): Maybe there is no + directory part. + (gnus-score-search-global-directories): Use file-directory-p. -Fri Nov 27 12:26:10 1998 Lars Magne Ingebrigtsen + * gnus-score.el (gnus-score-score-files-1): Use + gnus-kill-files-directory. + From Adrian Aichner . - * gnus.el: Pterodactyl Gnus v0.55 is released. +2001-03-05 08:00:00 ShengHuo ZHU -1998-11-27 12:38:52 Lars Magne Ingebrigtsen + * gnus.el (charset): Move here from gnus-sum.el. - * mm-view.el (mm-setup-w3): New function. +2001-03-04 11:00:00 ShengHuo ZHU - * 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. + * mml.el (mml-preview): Disable local map. -1998-11-25 Colin Rafferty + * gnus-sum.el (gnus-summary-make-menu-bar): Make + gnus-article-post-menu here. - * message.el (message-generate-new-buffers): Fix tag. + * gnus-art.el (gnus-article-make-menu-bar): Make summary-menu bar + if it has not been made. -1998-11-25 10:43:28 Lars Magne Ingebrigtsen +2001-03-02 02:00:00 ShengHuo ZHU - * message.el (message-buffer-name): Check for unique first. + * gnus-art.el (gnus-article-describe-key): Map key to event. + (gnus-article-describe-key-briefly): Ditto - * gnus-art.el (gnus-unbuttonized-mime-type-p): use - gnus-inhibit-mime-unbuttonizing. +2001-03-01 23:00:00 ShengHuo ZHU - * gnus-sum.el (t): Bind M-t. - (gnus-inhibit-unbuttonizing): New variable. - (gnus-summary-toggle-display-buttonized): New command. + * gnus-sum.el (gnus-summary-limit-include-expunged): Fix. - * gnus-art.el (gnus-display-mime): Select article window. - (article-strip-trailing-space): New command and keystroke. +2001-03-01 22:00:00 ShengHuo ZHU + From Katsumi Yamaoka . - * nneething.el (nneething-include-files): New variable. - (nneething-create-mapping): Use it. + * dgnushack.el (coerce, merge, subseq): defmacro. - * nntp.el (nntp-possibly-change-group): Use nntp-send-command. +2001-03-01 22:00:00 ShengHuo ZHU - * nnvirtual.el (nnvirtual-request-update-mark): Only yodate - ayto-expirable marks. + * lpath.el (nndraft-request-group): Move it here from nndraft.el. + A fake defalias in nndraft.el results a not-activated bug in + uncompiled versions. -1998-11-24 21:00:02 Lars Magne Ingebrigtsen +2001-02-26 11:27:27 Paul Jarc + Committed by ShengHuo ZHU - * gnus-art.el (gnus-mime-view-all-parts): Set buffer. + * gnus-util.el (gnus-split-references): Handle malformed References:. - * gnus-sum.el (gnus-summary-display-buttonized): Don't pass on - ARG. +2001-02-26 08:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-mode-line-format): Doc fix. + * gnus-art.el (gnus-article-mime-part-status): 1 part. -Tue Nov 24 14:57:41 1998 Shenghuo ZHU +2001-02-25 10:00:00 ShengHuo ZHU + From NAGY Andras . - * 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. + * gnus.el (gnus-parameters): Typo. -Tue Nov 24 10:43:06 1998 Lars Magne Ingebrigtsen +2001-02-24 00:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.54 is released. + * gnus.el (gnus-read-method): Remove redundancy. -1998-11-24 11:21:32 Katsumi Yamaoka +2001-02-23 23:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-newsgroup-default-charset-alist): Note fj. + * nnslashdot.el (nnslashdot-backslash-url): New variable. + (nnslashdot-request-list): Use it. -1998-11-24 11:14:54 Lars Magne Ingebrigtsen +2001-02-23 22:00:00 ShengHuo ZHU - * mm-decode.el (mm-save-part): Unquote. + * nnml.el (nnml-generate-active-info): Fix the case when there is + no file. -1998-11-24 11:14:39 Matt Armstrong + * gnus-sum.el (gnus-summary-import-article): Display it. Enable edit. + (gnus-summary-create-article): New function. - * mm-decode.el (mm-save-part): Bind coding system for write. + * gnus-group.el (gnus-group-mark-article-read): New function. -1998-11-24 10:42:30 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-inews-do-gcc): Use it. - * gnus-art.el (gnus-article-mode-line-format): New default. - (gnus-article-mime-part-status): New function. + * gnus-art.el (gnus-article-edit-article): Set modified-p nil. - * message.el (message-send-news): Check the body syntax before - encoding. +2001-02-23 17:00:00 ShengHuo ZHU - * gnus-art.el (gnus-unbuttonized-mime-type): New function. - (gnus-mime-display-single): Use it. - (gnus-mime-display-alternative): Ditto. + * gnus-art.el (gnus-article-edit-done): Don't use + gnus-article-edit-exit. + (gnus-article-edit-exit): Confirm and insert original-article-buffer. - * 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. + * gnus.el (gnus-parameters): New variable. + Suggested by NAGY Andras . + (gnus-parameters-get-parameter): New function. + (gnus-group-find-parameter): Use it. -Mon Nov 23 00:54:33 1998 Shenghuo ZHU +2001-02-23 Simon Josefsson - * 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. + * gnus-msg.el (gnus-post-method): Fix documentation to reflect + change of default value to `current'. -Sun Nov 22 04:42:22 1998 Shenghuo ZHU +2001-02-23 08:00:00 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. + * nneething.el (nneething-get-head): Insert unreadable file too. -Sat Nov 21 09:57:01 1998 Lars Magne Ingebrigtsen +2001-02-22 23:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.53 is released. + * gnus-sum.el (gnus-summary-insert-articles): Remove fetched headers. -1998-11-21 05:54:19 Lars Magne Ingebrigtsen + * webmail.el (webmail-type-definition): Deja is bought by google. - * mm-decode.el (mm-get-image): New function. - (mm-image-fit-p): New function. +2001-02-22 22:00:00 ShengHuo ZHU - * gnus-xmas.el (gnus-xmas-annotation-in-region-p): Ditto. + * gnus-sum.el (gnus-fetch-headers): New function. + (gnus-select-newsgroup): Use it. + (gnus-summary-insert-articles): New function. + (gnus-summary-insert-old-articles): New function. + (gnus-summary-insert-new-articles): New function. - * gnus-util.el (gnus-annotation-in-region-p): New definition. + * gnus-group.el (gnus-group-prepare-flat-list-dead): Use decoded-name. + (gnus-group-list-active): Ditto. + * gnus-sum.el (gnus-set-mode-line): Ditto. + (gnus-summary-read-group-1): Ditto. - * gnus-art.el (gnus-article-insert-newline): New function. - (article-goto-body): New function. +2001-02-21 15:00:00 ShengHuo ZHU -1998-11-20 10:34:04 Lars Magne Ingebrigtsen + * gnus-topic.el (gnus-topic-get-new-news-this-topic): Redraw the + current topic. - * gnus-art.el (gnus-mime-display-single): Insert blank line before - buttons. +2001-02-21 01:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-display-buttonized): New command and - keystroke. + * smiley.el (gnus-smiley-display): Don't do widening. - * gnus-art.el (gnus-mime-display-single): Don't insert a blank - line between parts. + * smiley-ems.el (gnus-smiley-display): Don't do widening. Smiley + within body. - * message.el (message-remove-header): Go to end if wanted. + * gnus-msg.el (gnus-inews-do-gcc): Activate group anyway. -1998-11-20 Karl Kleinpaste + * gnus-art.el (gnus-mime-display-multipart-alternative-as-mixed): + New variable. + (gnus-mime-display-multipart-related-as-mixed): New variable. + (gnus-mime-display-part): Use them. - * gnus-art.el (gnus-mime-display-alternative): Avoid window - movement with save-window-excursion. +2001-02-20 16:00:00 ShengHuo ZHU -Fri Nov 20 03:50:30 1998 Shenghuo ZHU + * gnus-start.el (gnus-setup-news): Allow gnus-group-line-format to be + something special. - * gnus-art.el (gnus-mime-inline-part): Use argument as charset. +2001-02-20 00:00:00 ShengHuo ZHU -Fri Nov 20 03:37:53 1998 Shenghuo ZHU + * nnweb.el (nnweb-request-group): Set nnweb-group anyway. + (nnweb-request-article): Call reference if exists. + (nnweb-type-definition): Dejanews is bought by google.com. + Beta! - * mm-bodies.el (mm-decode-body): Remove buffer-file-coding-system. +2001-02-19 19:00:00 ShengHuo ZHU -Fri Nov 20 01:20:38 1998 Shenghuo ZHU + * gnus-draft.el (gnus-draft-reminder): "Confirm to exit?" - * 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. +2001-02-19 Kai Gro,b_(Bjohann -Fri Nov 20 00:54:37 1998 Shenghuo ZHU + * gnus-sum.el (gnus-thread-sort-functions): Doc fix. Refer to + gnus-article-sort-functions. + (gnus-article-sort-functions): Doc fix. Refer to + gnus-thread-sort-functions. - * 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. +2001-02-18 20:00:00 ShengHuo ZHU + From Paul Jarc . -Fri Nov 20 05:30:26 1998 Lars Magne Ingebrigtsen + * message.el (message-get-reply-headers): More fixes. - * gnus.el: Pterodactyl Gnus v0.52 is released. +2001-02-17 Paul Jarc + Committed by ShengHuo ZHU -1998-11-20 04:32:23 Lars Magne Ingebrigtsen + * message.el (message-get-reply-headers): Fix bug with + Mail-Followup-To/to-address interaction. - * rfc2047.el (rfc2047-encode-message-header): Encode the default - encoding. +2001-02-17 13:00:00 ShengHuo ZHU - * gnus-art.el (gnus-mime-display-single): Insert buttons for - undisplayed text types. + * gnus-msg.el (gnus-configure-posting-styles): Match header in + gnus-article-copy. - * mm-decode.el (mm-automatic-display-p): Only prefer inlinable - types. +2001-02-16 22:00:00 ShengHuo ZHU -1998-11-19 Felix Lee + * message.el (message-do-send-housekeeping): Rename to a better + name. - * nntp.el (nntp-after-change-function-callback): recover from C-g. +2001-02-16 18:00:00 ShengHuo ZHU -1998-11-19 Felix Lee + * message.el (message-cancel-news): Check article first, then ask + yes or no. - * gnus-async.el (gnus-asynch-obarray): rename to - gnus-async-hashtb, and don't buffer-local it. +2001-02-16 14:00:00 ShengHuo ZHU - (gnus-async-article-callback): new function. - (gnus-make-async-article-function): use it. + * mm-uu.el (mm-uu-type-alist): Add emacs-sources. - (gnus-async-current-prefetch-group): new var. - (gnus-async-current-prefetch-article): new var. - (gnus-async-request-fetched-article): are we fetching it already? +2001-02-16 11:00:00 ShengHuo ZHU - (gnus-async-delete-prefected-entry): s/prefected/prefetched/ + * gnus-range.el (gnus-range-normalize): New function. -1998-11-20 02:49:21 Lars Magne Ingebrigtsen +2001-02-15 NAGY Andras - * gnus-sum.el (gnus-summary-show-article): Require. + * imap.el (imap-gssapi-open): Set imap-c-l-s-first. - * message.el: Provide before hooks. - (message-send-news): Do MIME before headers. +2001-02-14 21:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-check-buffer): New function. - (gnus-article-read-summary-keys): Use it. + * gnus-srvr.el (gnus-server-regenerate-server): Use gnus-get-function. - * mm-decode.el (mm-user-automatic-display): Display all inline - images. + * nnagent.el (nnagent-request-regenerate): New function. - * gnus-art.el (gnus-mime-display-single): Don't buttonize so - much. - (gnus-unbuttonized-mime-types): New variable. + * nnfolder.el (nnfolder-request-regenerate): New deffoo. -1998-11-19 06:29:03 Lars Magne Ingebrigtsen + * nnml.el (nnml-generate-nov-databases): Accept argument + server. Don't open server if it is opened. + (nnml-request-regenerate): Use it. Change to deffoo. - * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t. +2001-02-14 Katsumi Yamaoka + Committed by ShengHuo ZHU - * mm-decode.el (mm-quote-arg): Quote semicolons. + * gnus.el (gnus-define-group-parameter): Fix. - * gnus-art.el (gnus-mime-display-single): Don't display - attachments. - (gnus-mime-externalize-part): New command and keystroke. +2001-02-14 15:00:00 ShengHuo ZHU - * mm-decode.el (mm-dissect-buffer): Pass on the description info. - (mm-alternative-precedence): Changed order. + * gnus.el (gnus-define-group-parameter): Improved. -1998-11-07 17:41:47 Simon Josefsson + * gnus-sum.el (charset): Define parameter. + (ignored-charsets): Ditto. + (gnus-summary-setup-default-charset): Use them. - * 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-read-descriptions-file): Use them. - * gnus-start.el (gnus-group-change-level): Shorten select method. + * gnus-cus.el (gnus-group-parameters): Remove them. -Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen +2001-02-14 00:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.51 is released. + * gnus-sum.el (gnus-summary-print-article): Redo highlight. -1998-11-19 04:02:34 Lars Magne Ingebrigtsen +2001-02-13 21:00:00 ShengHuo ZHU - * gnus.el: Applied patches from 5.6.45. + * gnus-sum.el (gnus-summary-read-group-1): Remove + gnus-summary-set-local-parameters. + (gnus-summary-setup-buffer): Put it here. - * gnus-score.el (gnus-score-find-trace): Print complete file - paths. - (gnus-score-find-trace): Truncate lines. +2001-02-13 20:00:00 ShengHuo ZHU - * gnus.el (gnus-message-archive-group): Allow function. + * gnus.el (to-address): Define parameter. + (to-list): Ditto. + * gnus-art.el (article-hide-boring-headers): Use them. + * gnus-msg.el (gnus-post-news): Ditto. + * gnus-cus.el (gnus-group-parameters): Remove them. - * message.el (message-encode-message-body): Remove Mime-Version - before inserting. +2001-02-13 19:00:00 ShengHuo ZHU - * gnus-cus.el (gnus-group-customize): Optional topic. + * gnus-draft.el (gnus-draft-reminder): New function. - * gnus-sum.el (gnus-summary-customize-parameters): New command and - keystroke. + * gnus-art.el (gnus-sender-save-name): New function. -Wed Nov 18 13:46:08 1998 Shenghuo ZHU +2001-02-13 18:00:00 ShengHuo ZHU - * message.el (message-encode-message-body): Rewrite. + * mm-util.el (mm-mime-charset): Error message. -1998-11-18 07:37:47 Lars Magne Ingebrigtsen +2001-02-13 11:00:00 ShengHuo ZHU - * mml.el (mml-base-boundary): New variable. - (mml-make-boundary): New function. + * message.el (message-check-news-body-syntax): Don't check mml lines. - * gnus-cache.el (gnus-cache-coding-system): New variable. - (gnus-cache-request-article): Use it. +2001-02-12 11:00:00 ShengHuo ZHU - * message.el (message-insert-mime-part): Delete duplicates. + * gnus-topic.el (gnus-subscribe-topics): Return nil if not + subscribe. -Wed Nov 18 11:52:19 1998 Shenghuo ZHU + * gnus-start.el (gnus-call-subscribe-functions): New function. + (gnus-find-new-newsgroups): Use it. + (gnus-ask-server-for-new-groups): Use it. + (gnus-check-first-time-used): Use it. + (gnus-subscribe-newsgroup-method): Grok a list of functions. + (gnus-subscribe-options-newsgroup-method): Ditto. + (gnus-subscribe-hierarchically): Return gnus-subscribe-newsgroup's + return . - * gnus-art.el (gnus-mime-display-alternative): Set end of - multipart and display even when nothing is preferred. +2001-02-12 Kai Gro,b_(Bjohann -Wed Nov 18 05:06:44 1998 Lars Magne Ingebrigtsen + * gnus-cus.el (gnus-score-customize): Doc fix. - * gnus.el: Pterodactyl Gnus v0.50 is released. +2001-02-11 Jesper Harder -1998-11-18 04:42:01 Lars Magne Ingebrigtsen + * dgnushack.el (my-getenv): Typo. - * mm-decode.el (mm-inline-media-tests): Check that device-type is - fbound. +2001-02-11 11:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-sort): Didn't do reverse. + * dgnushack.el (dgnushack-make-load): Don't autoload smiley functions. -1998-11-07 23:39:48 Simon Josefsson +2001-02-11 09:00:00 ShengHuo ZHU - * gnus.el (gnus-similar-server-opened): Compare backend. + * gnus-group.el (gnus-group-suspend): Offer save summaries. -1998-11-08 03:37:42 Simon Josefsson + * gnus-art.el (gnus-treat-leading-whitespace): New variable. + (gnus-treatment-function-alist): Use it. + (article-remove-leading-whitespace): New function. + (gnus-article-make-menu-bar): Use it. - * gnus-topic.el (gnus-topic-expire-articles): New function. - (gnus-topic-mode-map): Bind it. + * gnus-sum.el (gnus-summary-wash-empty-map): Add + remove-leading-whitespace. + (gnus-summary-wash-map): Bind strip-headers-in-body to `W a', + because of conflict. - * gnus.texi (Topic Commands): New expiry command. Reordered. +2001-02-09 23:00:00 ShengHuo ZHU -1998-11-10 Miles Bader + * Makefile.in: Hack generating gnus-load.el. + * dgnushack.el: Ditto. + * gnus-load.el: Remove it. - * 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'. +2001-02-09 20:00:00 ShengHuo ZHU -1998-11-18 03:30:26 Lars Magne Ingebrigtsen + * dgnushack.el : Add URLDIR. - * mml.el (mml-compute-boundary): New function. - (mml-compute-boundary-1): New function. - (mml-generate-mime-1): Use it. + * Makefile.in (EMACS_COMP): Ditto. -1998-11-18 Hrvoje Niksic +2001-02-09 19:00:00 ShengHuo ZHU - * mml.el (mml-generate-mime-1): Always precede closing boundary - with newline. + * gnus-cus.el (gnus-score-customize): Error on no score file. -1998-11-18 02:36:37 Lars Magne Ingebrigtsen +2001-02-09 08:00:00 ShengHuo ZHU - * mml.el (mml-generate-mime-1): Do right boundaries when several - multiparts. + * mm-decode.el (mm-merge-handles): New function. - * mm-decode.el (mm-user-automatic-display): Default to inline - jpeg. + * mm-view.el (mm-inline-message): Use it. + (mm-view-message): Ditto. - * mml.el (mml-generate-mime-1): Encode non-text parts. + * mm-partial.el (mm-inline-partial): Ditto. -Wed Nov 18 02:22:23 1998 Lars Magne Ingebrigtsen + * mm-extern.el (mm-inline-external-body): Ditto. - * gnus.el: Pterodactyl Gnus v0.49 is released. + * gnus-art.el (gnus-mime-view-part): Ditto. + (gnus-mime-view-part-as-type): Ditto. + (gnus-mime-save-part-and-strip): Prevent users to strip in some + cases. -1998-11-18 00:37:43 Lars Magne Ingebrigtsen +2001-02-08 20:00:00 ShengHuo ZHU - * mm-view.el (mm-inline-text): Require w3-vars. + * message.el (message-cancel-news): Allow to shoot foot. + (message-supersede): Ditto. - * gnus-setup.el (gnus-use-tm): Removed. +2001-02-08 Tommi Vainikainen + Trivial patch. - * 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. + * gnus-sum.el (gnus-simplify-subject-re): Use + message-subject-re-regexp. - * mml.el (mml-generate-mime-1): Don't use a unibyte buffer. - (mml-generate-mime-1): Use unibyte for binaries. +2001-02-08 18:00:00 ShengHuo ZHU - * 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. + * nnmail.el (nnmail-expiry-target-group): Bind + nnmail-cache-accepted-message-ids to nil. - * mml.el (mml-generate-mime-1): Don't insert so many newlines. + * gnus-xmas.el (gnus-xmas-article-display-xface): Use binary + coding system. -1998-11-16 06:44:19 Lars Magne Ingebrigtsen +2001-02-07 23:00:00 ShengHuo ZHU - * mml.el (mml-generate-mime-1): Do it in unibyte buffers. + * qp.el (quoted-printable-encode-region): Make sure characters are + between 00 and FF. Don't check charset. - * message.el (message-font-lock-keywords): Highlight MML. - (message-mml-face): New font. + * mm-encode.el (mm-encode-content-transfer-encoding): Use unibyte + in Emacs 20. + * rfc2047.el (rfc2047-q-encode-region): Ditto. -Mon Nov 16 23:34:12 1998 Shenghuo ZHU +2001-02-07 11:00:00 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. + * message.el (message-make-forward-subject): Argument decoded. + (message-forward): Use it when digest. -Mon Nov 16 02:26:40 1998 Shenghuo ZHU + * gnus-uu.el (gnus-uu-grab-articles): Shoot down original article + buffer. - * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m. +2001-02-07 Kai Gro,b_(Bjohann -Mon Nov 16 02:00:05 1998 Lars Magne Ingebrigtsen + * message.el (message-generate-headers-first): Doc fix. - * gnus.el: Pterodactyl Gnus v0.48 is released. +2001-02-07 10:00:00 ShengHuo ZHU -1998-11-15 23:18:56 Lars Magne Ingebrigtsen + * gnus-art.el (article-make-date-line): Error proof. - * mm-bodies.el (mm-encode-body): Disbabled for nonmule. +2001-02-06 21:00:00 ShengHuo ZHU - * mm-util.el (mm-find-charset-region): Bogus change for non-Mule. + * gnus-group.el (gnus-group-listing-limit): New variable. + (gnus-group-prepare-flat-list-dead): Use old trick to speed up. - * message.el (message-cite-original-without-signature): Ditto. - (message-cite-original): Quote parts. + * gnus-topic.el (gnus-group-prepare-topics): Use gnus-killed-hashtb. -Sun Nov 15 22:01:55 1998 Lars Magne Ingebrigtsen +2001-02-06 18:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.47 is released. + * message.el (message-newline-and-reformat): Special case for + breaking at BOL. -1998-11-15 20:11:33 Lars Magne Ingebrigtsen +2001-02-06 Per Abrahamsen - * message.el (message-encode-message-body): Insert MIME warning. + * gnus-uu.el (gnus-uu-save-article): Make the topics summary a + message/rfc822. - * mml.el (mml-read-tag): Look for #tag. +2001-02-06 09:00:00 ShengHuo ZHU - * mm-util.el (mm-find-charset-region): Check whether - enable-multibyte-characters is bound. + * message.el (message-encode-message-body): Don't insert + Content-Type if it is inside a mail. -Sun Nov 15 02:01:31 1998 Lars Magne Ingebrigtsen +2001-02-06 02:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.46 is released. + * gnus-xmas.el (gnus-xmas-article-menu-add): Add + gnus-article-commands-menu. -1998-11-15 01:54:40 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-make-menu-bar): Don't share menu bar + in Emacs. - * message.el (message-encode-message-body): Insert headers at the - right spot. + * gnus-start.el (gnus-read-descriptions-file): Use + gnus-group-name-charset and gnus-group-charset-alist. -Sun Nov 15 01:13:41 1998 Lars Magne Ingebrigtsen +2001-02-04 23:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.45 is released. + * gnus-sum.el (gnus-summary-mark-as-processable): Understand + active region. -1998-11-15 00:28:49 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-group-change-level): Remove from both + gnus-zombie-list and gnus-killed-list. - * nndraft.el (nndraft-save-mime-part): Removed. - (nndraft-get-mime-part): Ditto. +2001-02-04 11:00:00 ShengHuo ZHU - * message.el (message-format-mime-old): Removed. - (message-encode-message-body): Removed. - (message-encode-message-body): Renamed. + * gnus-start.el (gnus-subscribe-options-newsgroup-method): Add + gnus-subscribe-topics. -1998-11-14 18:27:19 Lars Magne Ingebrigtsen + * gnus-cus.el (gnus-extra-topic-parameters): Fix doc. - * gnus-sum.el (gnus-get-newsgroup-headers): Translate \r's. +2001-02-04 11:00:00 ShengHuo ZHU - * message.el (message-format-mime): Check message-mime-part. + * gnus-art.el (gnus-article-make-menu-bar): Make + gnus-article-post-menu. - * mm-encode.el (mm-mime-file-types): Removed. - (mm-default-file-encoding): New definition. + * gnus-xmas.el (gnus-xmas-article-menu-add): Add post menu. -Sat Nov 14 01:29:39 1998 Shenghuo ZHU + * gnus-sum.el (gnus-summary-make-menu-bar): Use t if XEmacs. - * mm-view.el (mm-inline-image): Use mm-insert-inline. - * gnus-art.el (gnus-mm-display-part): Go to correct position. + * gnus-group.el (gnus-group-make-menu-bar): Ditto. -Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen + * message.el (message-mode-menu): Ditto. - * gnus.el: Pterodactyl Gnus v0.44 is released. + * gnus-art.el (defvar): eval-when-compile. -1998-11-14 03:59:14 Lars Magne Ingebrigtsen +2001-02-02 17:00:00 ShengHuo ZHU - * message.el (message-format-mime): New function. + * gnus-agent.el (gnus-agentize): Fix doc. - * nndraft.el (nndraft-save-mime-part): New function. - (nndraft-get-mime-part): New function. +2001-02-02 Karl Kleinpaste - * mm-encode.el (mm-default-file-encoding): New function. - (mm-content-transfer-encoding): New function. - (mm-encode-buffer): New function. + * mml.el (mml-preview): Bind `q'. - * message.el: New command. - (message-mime-part): New variable. - (message-insert-mime-part): New command. +2001-02-02 12:00:00 ShengHuo ZHU - * mm-encode.el (mm-encode-content-transfer-encoding): New - function. + * mm-util.el (mm-mime-mule-charset-alist): non-Mule case. - * mm-util.el (mm-content-transfer-encoding-defaults): New - variable. - (mm-mime-file-types): Taken from TM. +2001-01-31 Dave Love -Sat Nov 14 01:51:06 1998 Lars Magne Ingebrigtsen + * mm-util.el (mm-mime-mule-charset-alist) + (mm-find-mime-charset-region): Consider mule-utf-8. - * gnus.el: Pterodactyl Gnus v0.43 is released. +2001-01-31 Dave Love -1998-11-07 Karl Kleinpaste + * gnus-art.el (gnus-article-x-face-command) + (gnus-treat-display-xface, gnus-treat-display-smileys): Add + :version. - * 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. +2001-01-26 Dave Love -1998-11-13 20:30:40 Lars Magne Ingebrigtsen + * mm-util.el (mm-multibyte-string-p): New. - * message.el (message-resend): Bind message-required-mail-headers - to nil. +;; * qp.el: Remove un-logged bogus changes from 2000-12-20. +;; (quoted-printable-encode-region): Doc fix. Don't call +;; string-as-multibyte on class. Clarify line-folding. + (quoted-printable-encode-string): Make temp buffer inherit + string's multibyteness. - * mm-view.el (mm-inline-text): Bind w3-strict-width. +2001-01-23 Gerd Moellmann - * nngateway.el (require): Require cl. + * nnheader.el (toplevel): Don't require `gnus-util' at + compile-time; this creates a circular dependency, and prevents + a bootstrap. - * gnus-art.el (gnus-button-alist): Exclude more chars from news: - things. +2001-01-22 Andreas Schwab -Wed Nov 11 02:15:06 1998 Shenghuo ZHU + * nnheader.el (gnus-delete-line): Autoload it as a macro. - * gnus-agent.el (gnus-agent-fetch-headers): Create directory even - when no articles. +2001-01-31 18:00:00 ShengHuo ZHU -1998-11-13 19:25:10 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-remove-list-identifiers): Use consp. - * message.el (message-ignored-resent-headers): Remove X-Gnus. + * gnus-art.el (article-hide-list-identifiers): Ditto. -1998-11-10 Colin Rafferty + * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto. - * gnus-sum.el (gnus-ignored-from-addresses): Only quote - user-mail-address if non-nil. +2001-01-31 15:00:00 ShengHuo ZHU -1998-11-13 18:50:18 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-remove-list-identifiers): Similar. - * gnus-util.el (gnus-make-sort-function): Do `reverse'. - (gnus-make-sort-function-1): Ditto. + * gnus-art.el (article-hide-list-identifiers): Similar. - * gnus-art.el (gnus-mm-display-part): Switch to mm in right - window. +2001-01-31 Karl Kleinpaste -1998-11-12 22:31:58 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-remove-list-identifiers): Improved. - * mm-util.el (mm-with-unibyte-buffer): Ditto. +2001-01-31 09:00:00 ShengHuo ZHU - * binhex.el (binhex-decode-region): Quote. + * gnus-score.el (gnus-summary-score-entry): match may be an integer. -1998-11-10 05:32:28 Lars Magne Ingebrigtsen +2001-01-30 10:00:00 ShengHuo ZHU - * gnus-art.el (article-decode-charset): Don't downcase charset. + * gnus-util.el (gnus-string-equal): New function. - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Translate CR's. + * gnus-art.el (article-hide-boring-headers): Use it. -Sun Nov 8 23:17:24 1998 Lars Magne Ingebrigtsen +2001-01-27 Karl Kleinpaste - * gnus.el: Pterodactyl Gnus v0.42 is released. + * gnus-art.el (gnus-article-banner-alist): eGroups new banner. -Sun Nov 8 02:36:33 1998 Shenghuo ZHU +2001-01-27 00:00:00 ShengHuo ZHU - * gnus-art.el (gnus-display-mime): Add id for alternative part. + * gnus-msg.el (gnus-msg-mail): Support switch-action. -1998-11-08 02:24:47 Simon Josefsson +2001-01-26 08:00:00 ShengHuo ZHU - * nntp.el (nntp-send-mode-reader): Revert. + * gnus-art.el (gnus-summary-save-in-pipe): Prompt for saving + command if there is not last-saver. -Sun Nov 8 00:45:13 1998 Shenghuo ZHU +2001-01-24 19:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-fetch-articles): Use with-temp-buffer. + * nntp.el (nntp-open-connection): 201 is possible. -Sat Nov 7 23:07:24 1998 Shenghuo ZHU +2001-01-24 18:00:00 ShengHuo ZHU - * message.el (message-make-date): Fix for negative time zones. + * rfc2047.el (rfc2047-encode): MIME charset is not coding system. + (rfc2047-charset-encoding-alist): Add big5. -Sun Nov 8 01:00:16 1998 Lars Magne Ingebrigtsen +2001-01-24 17:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.41 is released. + * gnus-agent.el (gnus-agent-add-server): Redraw the line. + (gnus-agent-remove-server): Ditto. + (autoload): gnus-server-update-server. -1998-11-08 00:52:38 Hrvoje Niksic + * gnus-srvr.el (gnus-server-line-format): Add %a. + (gnus-server-line-format-alist): Add gnus-tmp-agent. + (gnus-server-insert-server-line): Use it. - * mm-decode.el (mm-dissect-multipart): Quote regexp. +2001-01-24 09:00:00 ShengHuo ZHU -1998-10-29 Sudish Joseph + * mm-util.el (mm-mime-mule-charset-alist): Preferred MIME names + GB2312 and Big5. - * gnus.el (gnus-short-group-name): When shortening foreign select - methods, do not scan for plusses beyond the first colon. +2001-01-24 Simon Josefsson -1998-11-07 Mike McEwan + * mail-source.el (mail-sources): Add :program specifier to IMAP + mail source. + (mail-source-fetch-imap): Map :program to `imap-shell-program'. - * gnus-agent.el (gnus-agent-save-group-info): Cater for group info - lines where `group' is the last thing on the line. +2001-01-24 08:00:00 ShengHuo ZHU -1998-11-08 00:35:09 Lars Magne Ingebrigtsen + * gnus-score.el (gnus-score-lower-thread): Fix a doc typo. - * gnus-art.el (gnus-article-view-part): Do alternative. - (gnus-mime-display-alternative): Insert marker. +2001-01-24 12:22:47 Lars Magne Ingebrigtsen -1998-11-07 14:33:46 Lars Magne Ingebrigtsen + * nntp.el (nntp-wait-for): Return the success code. + (nntp-open-connection): Use it. - * mm-decode.el (mm-dissect-multipart): Quote regexp. +2001-01-11 11:49:02 Lars Magne Ingebrigtsen - * nnmail.el (nnmail-expired-article-p): Protect against bogus - dates. + * gnus-int.el (gnus-check-server): Allow breaking the opening. - * gnus-cus.el (gnus-topic): Required. +2001-01-23 11:00:00 ShengHuo ZHU - * nnheader.el (nnheader-parse-nov): Parse extra. - (nnheader-nov-parse-extra): New macro. + * gnus-sum.el (gnus-summary-print-article): Remove process mark. -1998-10-31 12:33:22 Lars Magne Ingebrigtsen +2001-01-22 17:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-view-part): Internal move. + * gnus-sum.el (gnus-summary-print-article): Take one prefix + argument. Allow to print several articles in one file. -1998-10-28 Per Abrahamsen +2001-01-21 12:00:00 ShengHuo ZHU - * gnus-cus-new.el (gnus-custom-topic): New free variable. - (gnus-group-customize): Support editing topic parameters. + * webmail.el (webmail-type-definition): netaddress changes. -1998-10-29 12:09:20 Karl Kleinpaste +2001-01-21 00:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add - indicators. + * gnus.el: Fix copyright. Remove trailing spaces. -1998-10-29 11:31:11 Lars Magne Ingebrigtsen + * message.el (message-forward): Use mule4. - * gnus-art.el (gnus-mm-display-part): Return. - (gnus-article-view-part): Only go if external. - (gnus-article-dumbquotes-map): Do 205. +2001-01-20 09:00:00 ShengHuo ZHU - * mm-decode.el (mm-display-part): Return what was done. + * mm-util.el (mm-string-as-unibyte): New function. - * 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. + * message.el (message-forward): Use it. - * gnus-sum.el (gnus-summary-recenter): Allow - gnus-auto-center-summary to be a number. +2001-01-19 23:00:00 ShengHuo ZHU -Wed Nov 4 02:24:39 1998 Shenghuo ZHU + * message.el (message-cite-original-without-signature): Don't peel + off the blank line. + (message-get-reply-headers): Add Cc if it is not in follow-to. - * pop3.el (pop3-open-server): Use "binary" instead of - "no-conversion". +2001-01-20 Simon Josefsson -Sun Nov 1 01:26:42 1998 Shenghuo ZHU + * mm-decode.el (mm-handle-multipart-from): Add. + (mm-dissect-buffer): Save From: header value. + (mm-security-from): Remove. + (mm-possibly-verify-or-decrypt): Don't set mm-security-from. - * gnus-srvr.el (gnus-browse-foreign-server): Set - gnus-browse-current-method to the result of gnus-server-to-method. + * mml-smime.el (mml-smime-verify): Use `mm-handle-multipart-from' + instead of `mml-security-from'. Protect null from value. -Thu Oct 29 01:47:44 1998 Shenghuo ZHU +2001-01-20 Simon Josefsson - * gnus-util.el (gnus-pull): Another optional argument. - * nnweb.el (nnweb-request-delete-group): Delete from - nnweb-group-alist and update active file. + * mailcap.el (mailcap-mime-data): Run `gnumeric' on + application/vnd.ms-excel attachments. -Thu Oct 29 01:05:08 1998 Shenghuo ZHU +2001-01-19 Simon Josefsson - * gnus-group.el (gnus-group-make-group): Accept group of new - method. + * gnus-art.el (gnus-button-alist): Add `?=' to mailto URL regexp. -Wed Oct 28 02:19:16 1998 Shenghuo ZHU +2001-01-19 13:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble. + * message.el (message-ignored-mail-headers): Ditto. -Tue Oct 27 11:59:31 1998 Shenghuo ZHU +2001-01-19 Simon Josefsson - * mm-view.el (mm-inline-text): Postion of html portion. + * message.el (message-ignored-news-headers): Only search beginning + of line. -1998-10-29 10:26:54 Lars Magne Ingebrigtsen +2001-01-19 ShengHuo Zhu + Trivial patch from Alberto Lusiani - * nntp.el (nntp-list-active-group): Waited for short strings. - (nntp-send-mode-reader): Ditto. - (nntp-open-connection): Ditto. + * message.el (message-send-mail): Content-Type may not be there. - * gnus-int.el (gnus-request-group-articles): New function. +2001-01-18 23:00:00 ShengHuo ZHU - * nntp.el (nntp-request-listgroup): New function. - (nntp-request-group-articles): Renamed. + * gnus-ems.el (gnus-article-display-xface): Add BUFFER. + * gnus-xmas.el (gnus-xmas-article-display-xface): Ditto. -1998-10-27 10:37:52 Karl Kleinpaste + * gnus-art.el (article-display-x-face): Insert X-Face if there is + not. - * nnheader.el (nnheader-parse-nov): Supply extra. +2001-01-18 19:00:00 ShengHuo ZHU -1998-10-26 23:03:48 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-read-group-1): Don't test dead + non-native groups. - * gnus-art.el (gnus-button-push): Don't go to - gnus-article-buffer. +2001-01-18 18:00:00 ShengHuo ZHU - * mm-view.el (mm-inline-image): Add a newline. + * message.el (message-yank-original): Understand + universal-argument. - * gnus-start.el (gnus-check-first-time-used): Check more. +2001-01-18 16:00:00 ShengHuo ZHU -1998-10-26 23:03:29 Francois Felix Ingrand + * gnus-art.el (gnus-boring-article-headers): Add to-address. + (article-hide-boring-headers): Ditto. - * gnus-start.el (gnus-check-first-time-used): Check current. + * mm-view.el (mm-inline-message): Insert a newline unless bolp. -1998-10-26 22:07:52 Lars Magne Ingebrigtsen +2001-01-18 08:00:00 ShengHuo ZHU - * mm-util.el (mm-find-charset-region): New function. + * rfc2047.el (rfc2047-fold-region): Don't insert LWSP if there is + one. - * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header. +2001-01-16 Simon Josefsson - * gnus-art.el (gnus-mime-button-menu): Fix. + * message.el (message-make-in-reply-to): Add comment to message-id + (old syntax, see 2000-08-02 change). -1998-10-26 22:07:43 Michael Welsh Duggan +2001-01-16 13:00:00 ShengHuo ZHU - * gnus-art.el (gnus-mime-button-menu): New definition. + * gnus-art.el (gnus-url-mailto): Use gnus-msg-mail. + (gnus-button-mailto): Setup message. Moved to gnus-msg.el. + (gnus-button-reply): Ditto. -1998-10-26 01:46:11 Lars Magne Ingebrigtsen +2001-01-16 Katsumi Yamaoka - * 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. + * gnus-art.el (article-display-x-face): Fix. - * nnheader.el (nnheader-insert-nov): Work when not Xref. +2001-01-15 16:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-ignored-from-addresses): Default to - user-mail-address. - (gnus-nov-parse-extra): Didn't return right thing. + * gnus-art.el (article-display-x-face): Use + gnus-original-article-buffer. -1998-10-25 23:25:27 Lars Magne Ingebrigtsen +2001-01-15 Jack Twilley - * gnus-xmas.el: Use compiled-function-p. + * message.el (message-add-header): Move to point-max. -Mon Oct 26 14:37:19 1998 Shenghuo ZHU +2001-01-15 Simon Josefsson - * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header. + * smime.el (smime-CA-directory, smime-CA-file): Change default to + nil, improve documentation. + (smime-certificate-directory): Comment out false hints (until it + is implemented). -Sun Oct 25 23:11:44 1998 Lars Magne Ingebrigtsen + * mml-smime.el (mml-smime-sign): Place user in customize buffer if + there aren't any keys. + (mml-smime-verify): If smime-CA-{file,directory} set, also try to + verify certificate. Default is changed to only check integrity. + Improved security status texts. If a certificate doesn't contain + a email address, don't fail. - * gnus.el: Pterodactyl Gnus v0.40 is released. + * smime.el (smime-noverify-region): + (smime-noverify-buffer): New functions. Verifies integrity only. -1998-10-25 21:41:05 Lars Magne Ingebrigtsen +2001-01-12 22:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-mark-forward): Show thread. + * gnus-group.el (gnus-group-sort-by-score): Reverse order. - * gnus-start.el (gnus-check-first-time-used): Ignore dribble. +2001-01-12 17:00:00 ShengHuo ZHU - * gnus-agent.el (gnus-agent-fetch-group-1): Bind name. + * gnus-win.el (gnus-configure-windows): switch-to-buffer in XEmacs. + (gnus-remove-some-windows): Ditto. - * nnml.el (nnml-possibly-create-directory): Check before making. +2001-01-12 14:00:00 ShengHuo ZHU -1998-10-25 19:43:08 Kai Grossjohann + * gnus-art.el (article-make-date-line): 11th. - * nnheader.el (nnheader-insert-nov): Don't infloop. +2001-01-11 23:00:00 ShengHuo ZHU -1998-10-25 19:26:11 Lars Magne Ingebrigtsen + * mml2015.el (mml2015-gpg-encrypt): Remove CR. + (mml2015-gpg-sign): Ditto. - * gnus-sum.el (gnus-set-mode-line): Check that the spec has been - set up. +2001-01-10 14:00:00 ShengHuo ZHU -1998-10-25 19:22:03 Joerg Lenneis + * gnus.el: Sync with EMACS_PRETEST_21_0_95. + * gnus.el (gnus-default-posting-charset): Bogus. Removed. - * nneething.el (nneething-file-name): New definition. +2001-01-08 Dave Love -1998-10-25 17:56:23 Lars Magne Ingebrigtsen + * mm-encode.el (mm-qp-or-base64): Don't base64 for the sake of a + single character. - * gnus-art.el (gnus-treatment-function-alist): Fix. - (gnus-summary-save-in-rmail): Use gnus-output-to-rmail. + * mm-util.el (mm-mime-mule-charset-alist): Add Latin-{8,9}. - * nndoc.el (nndoc-dissect-mime-parts-sub): Recognize first part. + * message.el: Doc and message fixes. + (message-send-rename-function) + (message-make-forward-subject-function) + (message-send-mail-function, message-reply-to-function) + (message-wide-reply-to-function, message-followup-to-function) + (message-distribution-function, message-auto-save-directory): Fix + :type. -Sun Oct 25 06:23:13 1998 Lars Magne Ingebrigtsen + * gnus/mml.el (mml-parse-1): Frob mml-confirmation-set when + proceeding after warnings. Amend multipart warning message. - * gnus.el: Pterodactyl Gnus v0.39 is released. +2001-01-04 Dave Love -1998-10-25 00:34:39 Lars Magne Ingebrigtsen + * gnus-util.el (nnmail-pathname-coding-system): Defvar when + compiling. + (gnus-make-directory): Require nnmail. - * gnus-art.el (gnus-ignored-mime-types): New variable. - (gnus-mime-display-single): Use it. - (gnus-treatment-function-alist): New variable. + * mm-decode.el (mm-inline-media-tests): Add + image/x-portable-bitmap. + (mm-get-image): Grok pbm. - * gnus.el (gnus-mime): New group. +2001-01-10 Paul Stevenson - * gnus-art.el (gnus-mime-display-alternative): Don't destroy - things for other parts. - (gnus-mime-display-alternative): Place point. + * nnvirtual.el (nnvirtual-request-expire-articles): delq nil. - * gnus.el: autoload gnus-uu-post-news. +2001-01-09 Didier Verna - * mailcap.el (mailcap-mailcap-entry-passes-test): Also check - needsterm/DISPLAY. + * dgnushack.el (dgnushack-compile): give a dummy value to + `gnus-xmas-glyph-directory' for the time of compilation. + * gnus-agent.el: moved some XEmacs specific hook add-ons from + `gnus-xmas-[re]define' to avoid loosing user custom settings. + * gnus-art.el: ditto. + * gnus-group.el: ditto. + * gnus-salt.el: ditto. + * gnus-sum.el: ditto. + * gnus-topic.el: ditto. + * gnus-xmas.el (gnus-xmas-define): see above. + * gnus-xmas.el (gnus-xmas-redefine): see above. + * gnus-xmas.el (gnus-xmas-glyph-directory): generate a + non-continuable error when the directory can't be found. - * mm-decode.el (mm-display-part): Default to inline text/.* - parts. +2001-01-09 01:00:00 ShengHuo ZHU - * mm-bodies.el (mm-decode-content-transfer-encoding): Default to - 8bit. + * mm-decode.el (mm-interactively-view-part): Don't copy-sequence + handle. + * gnus-art.el (gnus-mime-view-part): Copy it. + (gnus-mime-view-part-as-type): Add into gnus-article-mime-handles. - * 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. +2001-01-09 Michael Downes -1998-10-24 21:38:37 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-read-group-1): More useful message. - * nnml.el (nnml-possibly-create-directory): Rewrite. - (nnml-request-create-group): Change to right server. +2001-01-08 23:00:00 ShengHuo ZHU - * gnus-xmas.el (gnus-xmas-define): Use byte-code-function-p. + * nnmail.el (nnmail-get-new-mail): Find group only if file is not + orig-file. Use ',source. - * gnus-sum.el (gnus-set-mode-line): Use truncate-string-to-width. +2001-01-08 22:00:00 ShengHuo ZHU - * gnus.el: rmail-output-to-rmail-file autoload. + * gnus-xmas.el (gnus-xmas-modeline-glyph): + (gnus-xmas-group-startup-message): + Detect gnus-xmas-glyph-directory when it is nil. - * gnus-util.el (gnus-output-to-rmail): Didn't work if not in - Gnus. +2001-01-08 09:00:00 ShengHuo ZHU - * nnheader.el (nnheader-parse-head): Checked wrong variable. + * pop3.el (pop3-get-message-count): Andrew Innes + 's patch of 1999-12-01 was not fully committed. - * gnus-sum.el (gnus-summary-update-mark): Ignore nil'd marks. +2001-01-05 06:49:37 Lars Magne Ingebrigtsen -Tue Oct 20 23:37:43 1998 Shenghuo ZHU + * gnus-agent.el (gnus-agent-fetch-session): Say what we quit. - * gnus-art.el (gnus-mime-display-mixed): Multipart in - mixed part. + * time-date.el (time-to-number-of-days): New function. -Tue Oct 20 23:36:43 1998 Shenghuo ZHU +2001-01-04 11:06:14 Gregory Chernov + Trivial patch. - * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. + * nnslashdot.el (nnslashdot-request-list): Always get the right + sid. - * gnus-sum.el (gnus-summary-exit-no-update): Ditto. +2001-01-05 00:00:00 ShengHuo ZHU -Tue Oct 20 16:22:51 1998 Shenghuo ZHU + * message.el (message-minibuffer-local-map): New keymap. + (message-read-from-minibuffer): Use it. + * gnus-msg.el (gnus-summary-resend-message): Use it - * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. +2001-01-04 22:00:00 ShengHuo ZHU -1998-10-24 20:51:53 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-display-time-event-handler): New function. + (gnus-after-getting-new-news-hook): Use it. - * gnus-sum.el (gnus-valid-move-group-p): Make sure group has a - value. +2001-01-03 07:26:58 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-article-hidden-text-p): Return nil when not - hidden. + * message.el (message-ignored-mail-headers): Add draft header. - * gnus-spec.el (gnus-update-format-specifications): Use the - article mode line spec. +2001-01-02 06:28:28 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-insert-mime-button): Put right type. - (gnus-insert-prev-page-button): Ditto. - (gnus-insert-next-page-button): Dutti. + * gnus-sum.el (gnus-summary-expire-articles): Don't save + excursion. - * pop3.el: New version installed. + * nnslashdot.el (nnslashdot-request-list): Get the right year. -Sat Oct 24 16:48:51 1998 Shenghuo ZHU +2001-01-01 00:52:44 Ed L. Cashin + A revoked patch. - * mm-uu.el (mm-uu-dissect): Delete the begining spurious newline - and display last part. + * gnus-sum.el (gnus-summary-expire-articles): Save excursion. -Sat Oct 24 20:31:55 1998 Lars Magne Ingebrigtsen +2000-12-31 11:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.38 is released. + * qp.el (quoted-printable-decode-region): Don't backward-char. -1998-10-24 07:54:58 Lars Magne Ingebrigtsen +2000-12-31 03:57:31 Lars Magne Ingebrigtsen - * gnus-art.el (article-mime-decode-quoted-printable-buffer): - Removed. - (article-de-quoted-unreadable): Narrow to default. + * gnus-draft.el: Mark articles as replied. - * qp.el (quoted-printable-encode-region): Encode before QP-ing. + * gnus-sum.el (gnus-summary-add-mark): New function. - * gnus-art.el (article-decode-charset): Decode even when broken - MIME. + * gnus-group.el (gnus-add-mark): New function. - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Return - name. + * gnus-sum.el (gnus-summary-buffer-name): New function. + (gnus-summary-setup-buffer): Use it. - * gnus-msg.el (gnus-copy-article-buffer): Delete headers. + * gnus-draft.el: Set things up with the right post method and + stuff. - * gnus-cache.el (gnus-cache-possibly-enter-article): Use - nnheader. + * message.el (message-ignored-news-headers): Remove X-Draft-From. - * nnmail.el (nnmail-extra-headers): New variable. + * gnus-msg.el (gnus-inews-insert-draft-meta-information): New function. - * nnheader.el (nnheader-insert-nov): Insert extra. + * gnus.el (gnus-draft-meta-information-header): New variable. - * gnus.el (gnus-summary-line-format): Doc fix. +2000-12-30 00:17:38 Lars Magne Ingebrigtsen - * 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-art.el (gnus-treatment-function-alist): Move the date + functions before the header sorting functions. - * gnus.el (gnus-extra-headers): New variable. + * mm-uu.el (mm-uu-pgp-signed-extract-1): Unquote "- " quotes. - * nnheader.el (make-mail-header): Expand. - (mail-header-extra): New macro. - (mail-header-set-extra): Ditto. - (make-full-mail-header): Expand. + * dgnushack.el (dgnushack-compile): Message whether there is w3. + Don't (push "/usr/share/emacs/site-lisp" load-path). -Sat Oct 24 07:41:42 1998 Lars Magne Ingebrigtsen + * gnus-cite.el (gnus-article-fill-cited-article): Don't add space + to empty fill prefixes. - * gnus.el: Pterodactyl Gnus v0.37 is released. +2000-12-30 10:00:00 ShengHuo ZHU -1998-10-24 07:29:11 Lars Magne Ingebrigtsen + * nntp.el (nntp-open-connection): Kill pbuffer if process is nil. + Suggested by Christoph Conrad . - * mm-bodies.el (mm-decode-body): Check for multibyticity. +2000-12-30 09:00:00 ShengHuo ZHU - * mm-util.el (mm-enable-multibyte): Don't always switch multibyte - on. + * nnheader.el (autoload): Autoload gnus-sorted-intersection. -1998-10-22 Didier Verna + * nnml.el (autoload): Move to nnheader.el. - * gnus-spec.el (gnus-balloon-face-function): new function - (gnus-parse-format): understand the %< %> specifiers - (gnus-parse-complex-format): ditto. + * nnfolder.el (nnfolder-existing-articles): Reversed, i.e. sorted. + (nnfolder-request-expire-articles): Use gnus-sorted-intersection. + (nnfolder-retrieve-headers): Use intersection. Suggested by Jonas + Kvarnstr,Av(Bm . -1998-10-24 06:31:33 Lars Magne Ingebrigtsen +2000-12-30 00:17:38 Lars Magne Ingebrigtsen - * gnus.el: Changed following-char to char-after throughout. + * gnus-art.el (article-make-date-line): Get the hours right. + (gnus-ignored-headers): More hiding. -1998-10-22 04:05:55 Lars Magne Ingebrigtsen + * nnmail.el (nnmail-expiry-wait): Not an integer. - * mm-decode.el (mm-display-external): Protect more and message. + * message.el (message-goto-body): Only expand abbrev when called + interactively. + (message-make-lines): Use it. -Wed Oct 21 03:26:30 1998 Shenghuo ZHU +2000-12-29 20:00:00 ShengHuo ZHU - * gnus-xmas.el (gnus-xmas-article-push-button): Go to the - position. + * gnus-msg.el (gnus-inews-yank-articles): Reparse headers. -Tue Oct 20 23:37:43 1998 Shenghuo ZHU +2000-12-30 00:17:38 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-mime-display-mixed): Multipart in - mixed part. + * gnus-sum.el (gnus-summary-limit-include-expunged): Really + include the expunged articles. -Tue Oct 20 23:36:43 1998 Shenghuo ZHU + * gnus-group.el (gnus-group-sort-by-server): New function. - * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. + * gnus.el (gnus-method-to-server-name): New function. + (gnus-group-prefixed-name): Use it. - * gnus-sum.el (gnus-summary-exit-no-update): Ditto. + * gnus-group.el (gnus-group-sort-function): Doc fix. + (gnus-group-sort-groups-by-server): New command. -Tue Oct 20 16:22:51 1998 Shenghuo ZHU +2000-12-29 13:25:10 Lars Magne Ingebrigtsen - * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. + * gnus-art.el (gnus-treat-date-english): New variable. + (article-date-english): New command. + (gnus-english-month-names): New variable. + (article-make-date-line): Do 'english. -1998-10-21 Hrvoje Niksic + * gnus-cite.el (gnus-article-fill-cited-article): Add a space + after the fill prefix. - * mailcap.el (mailcap-save-binary-file): Use unwind-protect. + * gnus-sum.el (gnus-summary-make-menu-bar): Removed "Enter + score...". - * mm-decode.el (mm-display-external): Set undisplayer to mm - buffer, not the current buffer; use unwind-protect. + * gnus-art.el (gnus-ignored-headers): Hide more headers. -1998-10-21 00:07:59 Lars Magne Ingebrigtsen + * message.el (message-mode-map): Bind comment-region. - * gnus-sum.el (gnus-summary-exit): Destroy parts. - (gnus-summary-exit-no-update): Ditto. + * gnus-art.el (gnus-mime-display-part): Let w3 display + multipart/related. -1998-10-20 22:02:05 Lars Magne Ingebrigtsen + * mm-bodies.el (mm-long-lines-p): New function. + (mm-body-encoding): Use it. + (mm-body-encoding): Encode articles with lines longer than 1000 + characters. - * mm-decode.el (mm-inline-media-tests): Look for w3. +2000-12-29 01:00:00 ShengHuo ZHU - * mailcap.el (mailcap-mime-data): Inline html. + * mm-util.el (mm-enable-multibyte): Use + default-enable-multibyte-characters. + (mm-enable-multibyte-mule4): Ditto. + (mm-disable-multibyte): Test XEmacs. + (mm-disable-multibyte-mule4): Ditto. + (mm-with-unibyte-current-buffer): Simplified. + (mm-with-unibyte-current-buffer-mule4): Ditto. -Tue Oct 20 20:25:03 1998 Lars Magne Ingebrigtsen +2000-12-28 19:44:56 Lars Magne Ingebrigtsen - * gnus.el: Pterodactyl Gnus v0.36 is released. + * nnheaderxm.el (nnheader-string-as-multibyte): New alias. -1998-10-20 18:13:08 Lars Magne Ingebrigtsen + * nnheader.el (nnheader-string-as-multibyte): New alias. - * gnus-art.el (article-translate-strings): - (gnus-article-dumbquotes-map): Don't dot. + * mm-view.el (mm-inline-text): Warn when bugging out in w3. - * pop3.el (pop3-open-server): Set point right. + * gnus-uu.el (gnus-message-process-mark): New function. + (gnus-uu-mark-by-regexp): Use it. + (gnus-new-processable): New function. - * 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. +2000-12-28 19:21:57 Inge Frick + Trivial patch. - * gnus-art.el (gnus-mm-display-part): Don't move point. + * gnus-sum.el (gnus-no-mark): New variable. -Tue Oct 20 02:16:36 1998 Shenghuo ZHU +2000-11-01 01:12:29 Lars Magne Ingebrigtsen - * mm-uu.el : New file. + * nnwfm.el (nnwfm-create-mapping): Remove quote marks and + backslashes. - * gnus-art.el (gnus-display-mime): Dissect uu stuffs. +2000-12-26 Katsumi Yamaoka - * mm-bodies.el (mm-decode-content-transfer-encoding): Encoding as - a function. + * gnus-art.el (gnus-article-banner-alist): Remove duplicate + definition. -1998-10-20 00:35:05 Lars Magne Ingebrigtsen +2000-12-25 00:00:00 ShengHuo ZHU - * mm-decode.el (mm-display-external): Check before selecting. + * dgnushack.el (dgnushack-compile): elc is in the current directory. -Sat Sep 26 02:03:00 1998 Shenghuo ZHU + * qp.el (quoted-printable-encode-region): Don't check multibyte in + XEmacs. - * gnus-sum.el (gnus-multi-decode-encoded-word-string): Rewrite. +2000-12-25 Lloyd Zusman + Trivial patch. - * gnus-sum.el (gnus-decode-encoded-word-methods): New variable. + * mml.el (mml-read-tag): Save tag location. - * gnus-sum.el (gnus-decode-encoded-word-methods-cache): New - variable. +2000-12-25 Simon Josefsson - * gnus-sum.el (gnus-encoded-word-method-alist): Deleted. + * starttls.el: Sync with Emacs 21. - * gnus-art.el (gnus-decode-header-methods): New variable. +2000-12-24 11:00:00 ShengHuo ZHU - * gnus-art.el (gnus-decode-header-methods-cache): New variable. + * message.el (message-mail): Support yank-action. - * gnus-art.el (gnus-multi-decode-header): New function. + * message.el (message-setup): Revoke the last change. -Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen +2000-12-24 01:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.35 is released. + * message.el (message-setup): Use cons. Suggested by Johan Vromans + . -1998-10-20 00:00:36 Lars Magne Ingebrigtsen +2000-12-24 Simon Josefsson - * uudecode.el (uudecode-decode-region-external): Insert - literally. + * mm-bodies.el (mm-decode-content-transfer-encoding): Preserve + mailing list junk at end of part. - * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here. +2000-12-23 Simon Josefsson - * mm-bodies.el (mm-decode-body): Optional encoding. + * nnimap.el (nnimap-expiry-target): New function. + (nnimap-request-expire-articles): Use it. -1998-10-19 23:57:57 Lars Magne Ingebrigtsen +2000-12-22 21:00:00 ShengHuo ZHU - * gnus-ems.el (gnus-mouse-3): New variable. + * gnus.el (gnus-group-parameters-more): New variable. + * gnus-cus.el (gnus-group-customize): Use it. - * binhex.el (binhex-decode-region-external): Don't use -internally. + * gnus.el (gnus-define-group-parameter): New macro. + (auto-expire): Use it + (total-expire): Use it. + * gnus-art.el (banner): Use it. -1998-10-16 14:54:02 Simon Josefsson + * mml.el (mml-parse): save-excursion. Suggested by Lloyd Zusman + . - * mailcap.el (mailcap-parse-mailcaps): Only open regular - files. +2000-12-22 12:00:00 ShengHuo ZHU -1998-09-26 22:28:01 Simon Josefsson + * gnus-topic.el (gnus-topic-create-topic): Use list. - * gnus-group.el (gnus-add-marked-articles): Request backend update - of flags. + * gnus-vm.el (gnus-summary-save-article-vm): Require gnus-art + before binding gnus-default-article-saver. -1998-09-26 19:39:31 Simon Josefsson + * gnus-sum.el (gnus-summary-save-article): + (gnus-summary-pipe-output): + (gnus-summary-save-article-mail): + (gnus-summary-save-article-rmail): + (gnus-summary-save-article-file): + (gnus-summary-write-article-file): + (gnus-summary-save-article-body-file): Ditto. - * gnus-sum.el (gnus-update-read-articles): - (gnus-update-marks): Request backend update of mark. + * gnus-mh.el (gnus-summary-save-article-folder): Ditto. -1998-09-26 19:33:58 Simon Josefsson +2000-12-22 10:00:00 ShengHuo ZHU - * gnus.texi (Optional Backend Functions): New item, - nnchoke-request-set-mark. + * gnus-art.el (gnus-mime-security-button-map): + (gnus-mime-button-map): Add parent. -1998-09-26 16:27:27 Simon Josefsson +2000-12-22 09:00:00 ShengHuo ZHU - * gnus-range.el (gnus-remove-from-range): Don't add stuff in - list to range. + * messagexmas.el (message-xmas-redefine): New function. -1998-10-19 23:45:13 Simon Josefsson + * message.el: Use it. - * gnus-sum.el (gnus-summary-exit-no-update): Don't expire. + * gnus-art.el (gnus-article-check-hidden-text): Return t. -1998-10-14 SL Baur + * gnus-util.el (gnus-remove-text-properties-when): Return t. - * gnus-sum.el: Move gnus-save-hidden-threads above where it is - first used. +2000-12-22 03:00:00 ShengHuo ZHU -1998-10-10 SL Baur + * mm-decode.el (mm-dissect-multipart): Avoid errors owing to + malformatted messages. - * mm-view.el: Require mm-decode for macros. +2000-12-22 02:00:00 ShengHuo ZHU - * mm-decode.el (mm-handle-type): Move macro declarations above the - place where they are used. + * mm-util.el (mm-image-load-path): New function. -Sun Oct 18 13:59:07 1998 Kurt Swanson + * gnus-group.el (gnus-group-make-tool-bar): Use it. - * gnus-msg.el (gnus-summary-mail-forward): Erase old forward - buffer. + * gnus-sum.el (gnus-summary-make-tool-bar): Use it. -1998-10-19 23:38:11 Katsumi Yamaoka + * message.el (message-tool-bar-map): Use it. - * nnagent.el (nnagent-open-server): Error message. + * Makefile.in (install-el): New rule. -1998-10-19 23:35:08 Joerg Lenneis +2000-12-21 Katsumi Yamaoka - * nnheader.el (nnheader-article-p): Recognize lower-case headers. + * gnus-art.el (article-treat-dumbquotes): Quote \. -1998-10-19 Hrvoje Niksic +2000-12-21 22:00:00 ShengHuo ZHU - * score-mode.el (gnus-score-mode-map): Ditto. + * gnus-art.el (gnus-treat-emphasize): Don't treat emphasis if + Emacs 20 runs on a terminal. - * message.el (message-mode-map): Ditto. +2000-12-21 14:00:00 ShengHuo ZHU - * gnus-uu.el (gnus-uu-post-news): Ditto. + * gnus-msg.el (gnus-bug): Revert to save-excursion. - * gnus-kill.el (gnus-kill-file-mode-map): Ditto. + * mml.el (gnus-add-minor-mode): Autoload. - * gnus-eform.el (gnus-edit-form-mode-map): Ditto. + * message.el (message-forward): Save-restriction. - * gnus-art.el (gnus-article-edit-mode-map): Use - `set-keymap-parent' rather than `copy-keymap'. +2000-12-21 Kai Gro,b_(Bjohann -1998-10-18 Hrvoje Niksic + * gnus-art.el (article-treat-dumbquotes): More doc, provided by + Paul Stevenson - * 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'. +2000-12-21 10:00:00 ShengHuo ZHU -1998-10-11 Hrvoje Niksic + * gnus-ml.el (gnus-mailing-list-mode-map): Use C-c C-n prefix. - * message.el (message-insert-to): Make `nobody' and `poster' - synonymous to `never' and `always' in Mail-Copies-To. - (message-reply): Ditto. - (message-followup): Ditto. + * mml.el (gnus-ems): Don't require. -1998-10-19 23:17:41 Lars Magne Ingebrigtsen + * gnus.el (gnus-decode-rfc1522): Removed. + (gnus-set-text-properties): Define. - * mailcap.el (mailcap-mime-data): Save sound. +2000-12-21 09:00:00 ShengHuo ZHU -1998-09-24 Hrvoje Niksic + * gnus-art.el (gnus-mime-*): handle may be nil. - * message.el (message-ignored-supersedes-headers): Include - `NNTP-Posting-Date'. + * gnus-sum.el (gnus-summary-mode): Turn on gnus-mailing-list-mode. -1998-10-19 01:25:27 Jonas Steverud + * gnus.el (gnus-group-remove-excess-properties): Not defined + in gnus-xmas. - * gnus-art.el (gnus-article-dumbquotes-table): New variable. +2000-12-20 21:00:00 ShengHuo ZHU -1998-10-19 00:50:22 Lars Magne Ingebrigtsen + * message.el (message-mail-user-agent): Add :version. - * mm-bodies.el (mm-decode-content-transfer-encoding): Use - uudecode. +2000-12-21 Miles Bader -1998-10-18 18:20:34 Lars Magne Ingebrigtsen + * message.el (message-mode): Set `comment-start' to the yank prefix. - * mm-decode.el (mm-display-external): Don't switch on save. +2000-12-20 17:00:00 ShengHuo ZHU -1998-10-18 18:14:06 Andy Piper + * 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. - * nnmail.el (nnmail-movemail-args): New variable. + * gnus-msg.el (gnus-bug): Support mail-user-agent. -1998-10-18 00:17:02 Lars Magne Ingebrigtsen +2000-12-20 15:00:00 ShengHuo ZHU - * gnus-art.el (article-translate-strings): + * 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. -1998-10-17 22:51:31 Lars Magne Ingebrigtsen +2000-12-20 11:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-view-part): Use it. - (gnus-mm-display-part): New function. - (article-de-quoted-unreadable): Yse mm-default-coding-system. + * uudecode.el (uudecode-decode-region-external): make-temp-file + may not be defined. - * mm-decode.el (mm-handle-displayed-p): New function. + * binhex.el (defalias): eval-and-compile. - * gnus-art.el (gnus-mime-copy-part): Create better names. - (gnus-mime-button-line-format): Include dots spec. + * message.el (message-tool-bar-map): New function. + (message-mode): Use it. -1998-10-15 Matt Pharr +2000-12-20 09:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old - forward buffer first. + * nntp.el (nntp-find-connection): Remove the entry. + (nntp-retrieve-groups): (gnus-buffer-live-p buf). -1998-10-17 21:16:46 Lars Magne Ingebrigtsen +2000-12-20 05:00:00 ShengHuo ZHU - * gnus-util.el (gnus-set-window-start): New function. + * gnus-msg.el (gnus-summary-mail-forward): Use original buffer. - * message.el (message-send): Don't check changed. + * message.el (message-forward): Copy buffer in unibyte mode. -1998-10-12 15:26:41 Lars Magne Ingebrigtsen +2000-12-20 04:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-setup-buffer): Set params. + * message.el (message-make-forward-subject): Don't widen. Decode. + (message-forward): Don't decode subject. - * mm-decode.el (mm-user-display-methods): Inline - "message/delivery-status". +2000-12-20 Christoph Conrad -1998-10-11 07:06:38 Lars Magne Ingebrigtsen + * qp.el (quoted-printable-encode-region): Upcase QP. - * message.el (message-auto-save-directory): Rename. - (message-mode): Dof fix. +2000-12-20 03:00:00 ShengHuo ZHU - * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat". - (gnus-summary-save-in-pipe): No, check gnus-last-shell-command. + * mm-decode.el (mm-possibly-verify-or-decrypt): Use + mail-extract-a-c instead. Don't depend on Gnus. - * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving. + * mml.el (gnus-ems): Require it. - * message.el (message-make-date): Avoid locale. + * gnus-msg.el (gnus-summary-mail-forward): - * gnus-art.el (gnus-article-edit-done): Allow update before doing - cache. + * message.el (message-forward): Move mime-to-mml here. - * mm-decode.el (mm-display-inline): Goto point-min. +2000-12-20 02:00:00 ShengHuo ZHU - * gnus-art.el (gnus-article-prepare-display): Not read-only. + * 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. - * mm-decode.el (mm-display-external): Reverse before sorting. +2000-12-20 01:00:00 ShengHuo ZHU - * gnus-draft.el (gnus-draft-send): Allow mail. + * 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. -1998-10-10 -SL Baur +2000-12-20 00:00:00 ShengHuo ZHU - * message.el (message-check): Move message-check macro above where - it is first used. + * gnus-start.el (gnus-group-change-level): Remove group from + gnus-active-hashtb if real killed. - * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line. +2000-12-19 22:00:00 ShengHuo ZHU -1998-10-11 06:45:37 Lloyd Zusman + * gnus-art.el (gnus-insert-mime-button): Emacs20 needs local-map. + (gnus-mime-display-alternative): Ditto. + (gnus-insert-mime-security-button): Ditto. - * gnus-sum.el (gnus-summary-make-menu-bar): Fix. +2000-12-19 21:00:00 ShengHuo ZHU -Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen + * gnus-start.el (gnus-group-change-level): Don't add it into + killed-list if it was killed. - * gnus.el: Pterodactyl Gnus v0.34 is released. +2000-12-19 19:00:00 ShengHuo ZHU -1998-10-11 02:15:41 Lars Magne Ingebrigtsen + * nnmbox.el (nnmbox-file-coding-system): Use binary. + (nnmbox-active-file-coding-system): Ditto. - * mm-decode.el (mm-inline-media-tests): delivery-status. + * gnus-cus.el (gnus-group-parameters): Add posting-style. - * mm-view.el (mm-inline-text): Provide default. +2000-12-19 18:00:00 ShengHuo ZHU -1998-10-11 01:01:37 Lloyd Zusman + * gnus.el (gnus-version): + (gnus-version-number): Set to Oort Gnus 0.01. - * mailcap.el (mailcap-possible-viewers): Fix nils. + * gnus-art.el (gnus-mime-security-button-map): + (gnus-insert-mime-security-button): Fix for Emacs21. -1998-10-11 00:03:37 Lars Magne Ingebrigtsen +2000-12-19 17:00:00 ShengHuo ZHU - * 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. + * gnus-group.el, gnus-sum.el, message.el: Comment out :help in + easymenu, because XEmacs doesn't understand :help. - * nnml.el (nnml-generate-nov-databases-1): Ditto. + * mm-uu.el: Require binhex. - * gnus-score.el (gnus-score-score-files-1): Ignore dotted files. +2000-12-19 16:00:00 ShengHuo ZHU - * gnus-art.el (gnus-insert-mime-button): Mark buttons as - annoations. + * gnus.el: Merged. Emacs21 CVS tag is zsh-merge-ognus-1. - * gnus-msg.el (gnus-summary-mail-forward): Decode properly. +2000-12-19 ShengHuo ZHU -1998-10-10 22:07:03 Lars Magne Ingebrigtsen + * mm-util.el (mm-charset-synonym-alist): Fix a typo. - * gnus-agent.el (gnus-category-add): Change default category to - 'false. +2000-12-18 Gerd Moellmann - * nnvirtual.el (nnvirtual-update-read-and-marked): Don't nix out - scores. + * *.xpm, *.pbm: Convert icons icons to size 24x24. - * gnus-draft.el (gnus-draft-send): Check server more. +2000-12-18 Dave Love - * gnus-art.el (gnus-article-view-part): New command and keystroke. - (gnus-article-goto-part): New function. + * gnus-msg.el (news-setup, news-reply-mode): Don't autoload + (unused). - * mm-view.el (mm-inline-text): Insert richtext properly. +2000-12-13 Miles Bader - * gnus-art.el (gnus-insert-mime-button): Store handle in alist. + * 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. -1998-10-03 15:04:27 Lars Magne Ingebrigtsen +2000-12-12 Gerd Moellmann - * parse-time.el (parse-time-rules): Accept dates far into the past - and the future, and parse single-digit numbers as years. + * 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. -1998-10-02 04:46:46 Lars Magne Ingebrigtsen +2000-12-12 Eli Zaretskii - * mm-decode.el (mm-display-external): Chop off directories. + * message.el (message-mode): Doc fix. -1998-10-01 07:33:35 Lars Magne Ingebrigtsen +2000-12-12 Gerd Moellmann - * uudecode.el (uu-decode-region-external): Use - insert-file-contents-literally. + * smiley-ems.el (smiley-region): Doc fix. - * gnus-cache.el (gnus-cache-generate-active): Translate _ to :. +2000-12-11 Miles Bader -1998-10-01 07:02:11 Shenghuo ZHU + * 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. - * uudecode.el: New file. +2000-12-07 Dave Love - * mm-bodies.el (mm-decode-content-transfer-encoding): Do - x-uuencode. + * mailcap.el (mailcap-download-directory) + * gnus-audio.el (gnus-audio-directory) + * smiley-ems.el (smiley-data-directory): Fix :type. -1998-10-01 05:19:35 Lars Magne Ingebrigtsen +2000-11-30 Dave Love - * gnus-art.el (gnus-mime-display-alternative): Set faces. + * 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. - * message.el (message-fetch-field): Unfold properly. +2000-11-29 Dave Love - * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF - in text/plain. + * qp.el (quoted-printable-decode-region): Use error, not message + to report malformed text (like base64). Amend message. -1998-09-30 05:47:49 Lars Magne Ingebrigtsen +2000-11-29 Miles Bader - * 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. + * message.el (message-header-lines): Fontify tag. -1998-09-29 13:21:06 Lars Magne Ingebrigtsen +2000-11-27 Dave Love - * message.el (message-fix-before-sending): Space. + * nnlistserv.el: Ignore errors when requiring nnweb and avoid a + compiler warning. - * nnmail.el (nnmail-find-file): Don't erase. +;2000-11-26 Dave Love +; +; * mm-uu.el (mm-uu-configure-list): Fix typo in :type. +; +2000-11-23 Dave Love -Wed Sep 30 23:49:03 1998 Shenghuo ZHU + * uu-post.pbm, uu-decode.pbm: new files from XPMs. - * gnus-agent.el (gnus-agent-fetch-headers): Do not decode headers. + * 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. -Wed Sep 30 23:46:29 1998 Shenghuo ZHU + * 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. - * gnus-soup.el (gnus-soup-add-article): Do not decode headers. + * rfc2047.el (rfc2047-encode-message-header): Don't encode if + default-enable-multibyte-characters is nil. -Wed Sep 30 23:44:08 1998 Shenghuo ZHU +2000-11-22 Gerd Moellmann - * gnus-soup.el (gnus-soup-pack-packet): Pack only if necesary. + * gnus-group.el (gnus-group-make-tool-bar): Fix a paren typo. -Sat Sep 26 03:04:18 1998 Shenghuo ZHU +2000-11-21 Dave Love - * mm-util.el (mm-with-unibyte-buffer): Make it work in XEmacs - 20.4. + * 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. -1998-09-29 11:35:09 Lars Magne Ingebrigtsen +2000-11-17 Dave Love - * gnus-art.el (gnus-mime-view-all-parts): New command and - keystroke. + * 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. - * mm-decode.el (mm-display-external): Translate slashes. +2000-11-14 Dave Love - * nnmail.el (nnmail-find-file): Restrict auto-mode-alist. + * 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. - * nndraft.el (nndraft-retrieve-headers): Don't copy so much. +2000-11-10 Dave Love - * mm-decode.el (mm-quote-arg): Quote spaces. - (mm-display-external): Quote args. + * 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. -1998-09-24 22:27:55 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-name-charset-method-alist): Add + :version. + (nnkiboze-score-file): Defvar when compiling. - * mm-decode.el (mm-inlinable-part-p): New function. + * gnus-start.el (gnus-read-newsrc-file): Add :version. -1998-09-25 22:28:01 Simon Josefsson + * 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. - * mm-util.el (mm-disable-multibyte): New function. + * nnmail.el (nnmail-expiry-target) + (nnmail-scan-directory-mail-source-once, nnmail-extra-headers) + (nnmail-split-header-length-limit): Add :version. -Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen + * 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. - * gnus.el: Pterodactyl Gnus v0.33 is released. + * 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. -1998-09-24 18:47:31 Lars Magne Ingebrigtsen + * 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. + + * time-date.el (timezone-make-date-arpa-standard): Autoload. + (date-to-time): Use it. + +; * 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. + + * 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. + + * gnus-int.el (gnus-start-news-server): Use expand-file-name, not + concat. + + * pop3.el (pop3-version): Deleted. + (pop3-make-date): New function, avoiding message-make-date. + (pop3-munge-message-separator): Use it. - * gnus-art.el (gnus-insert-mime-button): Get buffer size. +2000-11-09 Dave Love - * mm-decode.el (mm-display-external): Don't switch for externals. - (mm-dissect-multipart): Don't include end-sep. + * gnus-group.el (gnus-group-make-directory-group) + (gnus-group-fetch-faq): Use expand-file-name. + (gnus-group-fetch-faq): Simplify completing-read form. - * mm-util.el (mm-get-coding-system-list): New function. - (mm-coding-system-list): New variable. + * mm-bodies.el (mm-encode-body): Use mm-multibyte-p, don't just + test for Mule. -Thu Sep 24 02:08:10 1998 ZHU Shenghuo + * message.el (tool-bar-map): Defvar when compiling. - * gnus-cus.el (gnus-group-parameters): Add charset as a parameter + * 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. -Thu Sep 24 02:05:48 1998 ZHU Shenghuo +2000-11-08 Dave Love - * gnus-cus.el (gnus-group-customize): Use variable as cons not as - group + * mm-view.el: Use featurep for XEmacs test. + (mm-inline-message): Test for `remove-specifier'; don't use + condition-case. -Thu Sep 24 01:41:03 1998 ZHU Shenghuo + * mm-bodies.el (mm-encode-body): Use mm-multibyte-p. - * base64.el (base64-run-command-on-region): External base64 - decoder do not use coding system + * gnus-score.el (gnus-score-load-file): Use expand-file-name. + (gnus-score-find-bnews): Don't concat "". -Thu Sep 24 01:39:44 1998 ZHU Shenghuo + * 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. - * mm-decode.el (mm-interactively-view-part): Typo. + * 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. -Thu Sep 24 01:37:30 1998 ZHU Shenghuo + * gnus-group.el (gnus-group-toolbar-map): New variable. + (gnus-group-make-tool-bar): Rewritten. + (gnus-group-mode): Put kill-all-local-variables first. - * mm-decode.el (mm-dissect-multipart): Display last part when the - article has no close-delimiter + * rfc2047.el: Require gnus-util. -Thu Sep 24 01:28:54 1998 ZHU Shenghuo + * nnml.el (gnus-sorted-intersection): Autoload. - * mm-decode.el (mm-dissect-buffer): Display parts which have no - content-type. + * 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. -Thu Sep 24 01:23:57 1998 ZHU Shenghuo + * imap.el (imap-point-at-eol): New, replacing gnus-point-at-eol. - * gnus-art.el (gnus-display-mime): Typo. + * mm-encode.el (mm-body-7-or-8): Autoload. -Thu Sep 24 02:29:57 1998 Lars Magne Ingebrigtsen + * mm-decode.el (mm-insert-inline): Autoload. - * gnus.el: Pterodactyl Gnus v0.32 is released. + * mml.el: + * message.el: Put some defvars in eval-when-compile. -1998-09-24 00:27:11 Lars Magne Ingebrigtsen + * gnus-msg.el: Put some defvars in eval-when-compile. + (gnus-msg-mail): Move after gnus-setup-message. - * gnus-kill.el (gnus-batch-score): Protect against errors. + * smiley-ems.el (smiley-data-directory, smiley-regexp-alist): Doc fix. - * gnus-art.el: Protect against broken headers. +2000-11-07 Dave Love - * mm-decode.el (mm-display-external): Respect needsterm. - (mm-display-external): Create buffer for external commands. + * gnus-util.el (nnheader): Don't require message (recursive + autoload). -1998-09-23 22:04:05 Lars Magne Ingebrigtsen + * uudecode.el: Avoid compiler warnings. - * mailcap.el (mailcap-mime-info): Return the proper viewer. + * rfc2047.el: (rfc2047-fold-region): Use gnus-point-at-bol. + (rfc2047-charset-encoding-alist): Add iso-8859-1[45]. - * mm-decode.el (mm-display-external): Use file name. +2000-11-06 Dave Love -1998-09-22 Markus Rost + * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode. - * gnus-util.el (gnus-output-to-rmail): adjust to - `rmail-output-to-rmail-file' + * 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. + +; * 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-nocem.el (gnus-nocem-check-article-limit): Default to 500. + + * mm-partial.el (mm-inline-partial): Space-prefix temp buffer + name. -1998-09-23 20:07:00 Lars Magne Ingebrigtsen + * gnus-cus.el (gnus-group-parameters) : Fix custom type. + : Fix custom type, doc. - * gnus-util.el (gnus-output-to-rmail): Reinstated function. + * mm-decode.el (mm-display-external): Space-prefix temp buffer + name. Don't disable undo explicitly. - * gnus-sum.el (gnus-select-newsgroup): Set global variables before - headers. +;2000-11-02 Dave Love +; +; * message.el (message-font-lock-keywords): Use [:alpha:] for +; cite-prefix. - * gnus-art.el (article-decode-charset): Fold case. +2000-11-01 Dave Love -1998-09-17 15:49:10 Simon Josefsson + * rfc2047.el (base64): Require unconditionally. + (message-posting-charset): Defvar when compiling. + (rfc2047-encode-message-header, rfc2047-encodable-p): Require + message. - * mailcap.el (mailcap-save-binary-file): Goto point-min. + * gnus-sum.el (nnoo): Require. + (mm-uu-dissect): Autoload. -1998-09-23 19:48:52 Aaron M. Ucko + * mml.el (mml-parse-1): Clarify message. + (mml-minibuffer-read-type): Use mailcap-mime-types. - * nnmail.el (nnmail-check-duplication): Enter into duplicate list - after being stored. +2000-11-01 Stefan Monnier -Tue Sep 15 16:15:16 1998 Kurt Swanson + * mml.el: Fix a typo in the requiring of CL. - * gnus-salt.el (gnus-pick-setup-message): Return from whence ye - come. +2000-11-01 Dave Love -1998-09-23 19:42:03 Lars Magne Ingebrigtsen + * utf7.el: Require cl when compiling. - * gnus-xmas.el (wid-edit): Required. + * 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. - * gnus-ems.el (gnus-widget-button-keymap): New variable. +2000-10-30 Dave Love -Sun Sep 20 00:27:55 1998 ZHU Shenghuo + * gnus-art.el: Fix 2000-10-27 change properly. - * gnus-art.el (gnus-mime-inline-part): remove part if necessary +2000-10-28 Miles Bader -1998-09-23 19:30:52 Matt Armstrong + * gnus-art.el (gnus-read-save-file-name): Remove extraneous paren. - * gnus-art.el (article-decode-charset): Narrow to the correct - region. +2000-10-27 Dave Love - * mm-bodies.el: Fix autoload. + * gnus-group.el (gnus-group-make-menu-bar): Add some :help + strings. + (gnus-group-make-tool-bar): New function. + (gnus-group-mode): Use it. -1998-09-22 18:35:12 Lee Willis + * 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. - * gnus-art.el (gnus-mime-button-line-format): Doc fix. + * 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. -1998-09-22 14:53:35 Lars Magne Ingebrigtsen + * mm-decode.el (mm-valid-and-fit-image-p): Don't test + display-graphic-p here. - * rfc2047.el (rfc2047-decode): Use rfc2047-default-charset. +2000-10-27 Miles Bader -1998-09-19 13:58:35 Lars Magne Ingebrigtsen + * 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. - * gnus-art.el (gnus-insert-mime-button): Specify keymap. - (gnus-article-add-button): Ditto. +2000-10-26 Dave Love - * gnus-sum.el (gnus-summary-insert-pseudos): Use mm. + (defvar): Use rmail-spool-directory unconditionally. - * gnus-art.el (gnus-article-prepare-display): Make article mode. - (gnus-article-prepare-display): Bind url-standalone-mode. +2000-10-18 Dave Love - * mm-decode.el (mm-remove-part): Also delete directory. - (mm-display-external): Create a private sub-dir. + * mm-bodies.el (mm-uu-decode-function) + (mm-uu-binhex-decode-function): Defvar when compiling. - * mailcap.el (mailcap-binary-suffixes): New variable. - (mailcap-command-p): Use it. + * 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. -1998-09-16 10:38:21 Lars Magne Ingebrigtsen +2000-10-16 Stefan Monnier - * nnmbox.el (nnmbox-request-group): Change server. - (nnmbox-possibly-change-newsgroup): Enable multibyte. + * ietf-drums.el (mm-util): Require CL when compiling. - * message.el (message-encode-message-body): Don't stomp MIME - headers. +2000-10-15 Dave Love - * 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. + * qp.el: Require mm-util. - * gnus-int.el (gnus-request-replace-article): Accept no-encode - param. +2000-10-13 Dave Love - * gnus-sum.el (gnus-article-decoded-p): New variable. + * qp.el (quoted-printable-decode-region): Avoid invalid + coding-systems. - * mm-decode.el (mm-display-external): Use no-conv. +2000-10-12 Gerd Moellmann - * rfc2047.el (rfc2047-q-encode-region): Bound properly. - (rfc2047-charset-encoding-alist): Use B encoding for koi8-r. + * mm-bodies.el: Don't require `mm-uu' at compile-time; it leads + to a recursive load. - * gnus-art.el (gnus-article-mode-map): Bind button2 to - mouse-click. +2000-10-12 Dave Love -1998-09-15 14:38:02 Lars Magne Ingebrigtsen + * mm-util.el (mm-charset-synonym-alist): Add windows-1252. - * gnus-agent.el (gnus-agent-expire): Protect against nil infos. + * gnus.el (gnus-group-startup-message): Check for PBM image. -Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen +2000-10-09 Dave Love - * gnus.el: Pterodactyl Gnus v0.31 is released. + * mail-source.el (mail-source-fetch-imap): Bind + default-enable-multibyte-characters rather than using + mm-disable-multibyte. -1998-09-14 15:12:59 Lars Magne Ingebrigtsen +2000-10-05 Dave Love - * gnus-sum.el (gnus-summary-exit): Destroy MIME. + * 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-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. - * mm-decode.el (mm-display-part): Accept no-default. + * 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-art.el (gnus-insert-mime-button): buffer-size doesn't take - a parameter. +2000-10-04 Dave Love - * gnus-sum.el (gnus-summary-insert-line): Don't exclude faces. - (gnus-summary-prepare-threads): Ditto. + * gnus-ems.el: Don't turn off compiler warnings in local vars. + Require ring when compiling. + (gnus-article-compface-xbm): New variable. - * gnus.el (gnus-article-mode-map): Make sparse keymap. +2000-10-04 Dave Love - * 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. + * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use + pbm images. - * gnus.el ((featurep 'gnus-xmas)): Defalias gnus-decode-rfc1522 to - ignore. + * frown.pbm, smile.pbm, wry.pbm: New files. - * mm-decode.el (mm-alternative-precedence): Ditto. + * frown.xbm, smile.xbm, wry.xbm: Deleted. -1998-09-14 15:12:49 Conrad Sauerwald +2000-10-03 Dave Love - * mm-decode.el (mm-user-automatic-display): Use enriched. + * mail-source.el (mail-sources): Revert to nil. -1998-09-14 15:09:12 Paul Fisher + * nnmail.el (nnmail-spool-file): Revert to `((file))'. - * mm-decode.el (mm-dissect-multipart): Have the part start on the - right place. + * 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. -1998-09-14 14:33:34 Lars Magne Ingebrigtsen +2000-09-29 Gerd Moellmann - * gnus-msg.el (gnus-inews-add-send-actions): Mark silently. + * smiley-ems.el (smiley-update-cache): Use `:ascent center'. - * 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. +2000-09-21 Dave Love -1998-09-14 08:16:43 Lars Magne Ingebrigtsen + * smiley-ems.el (smiley-region): Test if display-graphic-p bound + (for Emacs 20). Tidy somewhat. - * gnus-art.el (gnus-mime-inline-part): New command and keystroke. +2000-09-21 Dave Love - * mm-view.el (mm-insert-inline): New function. + * gnus-ems.el (gnus-article-display-xface): Use unibyte for the + image processing. Rationalize logic somewhat. - * mm-decode.el (mm-pipe-part): Bugged. +2000-09-20 Dave Love - * gnus-agent.el (gnus-agent-send-mail): Don't encode. + * gnus-start.el (gnus-1) : Don't test for X + specifically. - * mm-bodies.el (mm-encode-body): Move over the body. + * gnus.el (gnus-version-number): Avoid some redundant + autoloads. - * nnmbox.el (nnmbox-read-mbox): Enable multibyte. +2000-09-20 Gerd Moellmann - * rfc2047.el (rfc2047-q-encode-region): Would bug out. + * gnus-ems.el (gnus-article-display-xface): Don't convert PBM + to XBM; we always have PBM support. -1998-09-13 Francois Pinard +2000-09-14 Dave Love - * 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. + * gnus.el (gnus-charset): + * mm-decode.el (mime-display): + * imap.el (imap) : Add :version. -1998-09-14 07:36:38 Hallvard B. Furuseth +2000-09-13 Gerd Moellmann - * mailcap.el (mailcap-command-p): New version. + * parse-time.el: Fix author's mail address. -1998-09-13 Mike McEwan + * 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-agent.el (gnus-agent-expire): Stop expiry barfing on killed - groups. + * nnweb.el (toplevel): To make the file bootstrap in Emacs, + require `w3' at load-time only if not running in batch mode. -1998-09-13 18:34:06 Lars Magne Ingebrigtsen +2000-12-19 16:00:00 ShengHuo ZHU - * message.el (message-make-date): Remove weekday name. + * gnus.el: Before merge with Emacs21. - * mm-decode.el (mm-dissect-buffer): Protect against broken - headers. +2000-12-19 Raymond Scholz - * mailcap.el (mailcap-command-in-path-p): New function. - (mailcap-command-p): Renamed. + * gnus-art.el (gnus-article-dumbquotes-map): Add EUR symbol. -1998-09-13 17:58:47 Hallvard B. Furuseth +2000-12-19 Per Abrahamsen - * rfc2047.el (eval): Autoload. + * 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. -1998-09-13 12:22:40 Lars Magne Ingebrigtsen +2000-12-17 10:00:00 ShengHuo ZHU - * 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. + * mm-extern.el (mm-inline-external-body): g-a-m-h may be a handle. -1998-09-13 Shenghuo ZHU + * mm-util.el (mm-enable-multibyte-mule4): Test charsetp. + (mm-disable-multibyte-mule4): Ditto. + (mm-with-unibyte-current-buffer-mule4): Ditto. - * gnus-int.el (gnus-request-replace-article): Replace - message-narrow-to-headers with message-narrow-to-head +2000-12-15 10:00:00 ShengHuo ZHU -1998-09-13 12:05:41 Lars Magne Ingebrigtsen + * pop3.el (pop3-movemail): Use binary. + (pop3-movemail-file-coding-system): Removed. - * drums.el (drums-quote-string): Reversed match. +2000-12-14 13:00:00 ShengHuo ZHU - * message.el (message-make-date): Use weekday name. + * mm-util.el (mm-charset-synonym-alist): Add cn-gb. -Sun Sep 11 10:27:15 1998 Lars Magne Ingebrigtsen +2000-12-13 21:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.30 is released. + * nnspool.el (nnspool-lib-dir): Check whether /usr/lib/news/active + exists. -1998-09-13 08:00:41 Lars Magne Ingebrigtsen +2000-12-13 13:00:00 ShengHuo ZHU - * gnus-art.el (article-decode-encoded-words): Use it. - (gnus-decode-header-function): New variable. + * gnus-msg.el (gnus-post-method): Use backend name when the + address is "". - * gnus-sum.el (gnus-nov-parse-line): Use it. - (gnus-decode-encoded-word-function): New variable. +2000-12-08 10:00:00 ShengHuo ZHU - * gnus-msg.el (gnus-copy-article-buffer): Decode the right - buffer. + * 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. - * 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. +2000-12-04 22:00:00 ShengHuo ZHU - * gnus.el (gnus-article-mode-map): Inherit from widget. - (gnus-article-mode-map): No, don't. + * gnus-win.el (gnus-configure-frame): Save selected window. - * mm-decode.el (mm-dissect-buffer): Store Content-ID things. - (mm-content-id-alist): New variable. - (mm-get-content-id): New function. +2000-02-15 Andrew Innes + + * 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-art.el (gnus-request-article-this-buffer): Only decode - articles if we are fetching to the article buffer. + * mail-source.el (mail-source-report-new-mail): Use + nnheader-run-at-time. -1998-09-13 07:58:59 Shenghuo ZHU +2000-02-15 Andrew Innes - * gnus-sum.el (gnus-summary-move-article): Don't decode accepting - articles. + * 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. -1998-09-13 07:23:28 Lars Magne Ingebrigtsen +2000-12-04 14:00:00 ShengHuo ZHU - * mm-util.el (mm-mime-charset): Try to use safe-charsets. - (mm-default-mime-charset): New variable. + * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if + succeed. - * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials. +2000-12-04 13:00:00 ShengHuo ZHU - * drums.el (drums-quote-string): Reversed test. + * gnus-win.el (gnus-configure-windows): Make sure + nntp-server-buffer is live. + (gnus-remove-some-windows): switch-to-buffer -> set-buffer. -1998-09-12 14:29:21 Lars Magne Ingebrigtsen +2000-11-21 Stefan Monnier - * mm-util.el (mm-insert-rfc822-headers): Possibly not quote - string. + * gnus-win.el (gnus-configure-windows): switch-to-buffer -> set-buffer. - * drums.el (drums-quote-string): New function. +2000-12-04 Andreas Jaeger - * rfc2047.el (rfc2047-encode-message-header): Goto point-min. - (rfc2047-b-encode-region): Chop lines. - (rfc2047-q-encode-region): Ditto. + * gnus-msg.el (gnus-summary-mail-forward): Fix typos in description. -Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen +2000-12-03 12:00:00 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.29 is released. + * mml2015.el (mml2015-fix-micalg): Alg might be nil. -1998-09-12 12:46:30 Istvan Marko +2000-12-01 ShengHuo ZHU + Trivial patch from Christopher Splinter - * mm-decode.el (mm-save-part): Message right. + * gnus-sum.el (gnus-summary-limit-to-age): Fix typo. -1998-09-12 11:30:01 Lars Magne Ingebrigtsen +2000-12-01 Simon Josefsson - * drums.el (drums-parse-address): Returned a list instead of a - string. - (drums-remove-whitespace): Skip comments. - (drums-parse-addresses): Didn't work. + * mml-smime.el (mml-smime-verify): Fix address parsing. -Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen +2000-12-01 Simon Josefsson - * gnus.el: Pterodactyl Gnus v0.28 is released. + * 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). -1998-09-12 04:57:25 Lars Magne Ingebrigtsen + * smime.el (smime-verify-region): Output to /dev/null. + (smime-buffer-as-string-region): Don't parse empty lines. - * gnus-art.el (gnus-mime-button-map): Use the article keymap as a - starting point. - (article-decode-encoded-words): Rename. +2000-11-30 23:00:00 ShengHuo ZHU - * message.el (message-narrow-to-headers-or-head): New function. + * 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. - * gnus-int.el (gnus-request-accept-article): Narrow to the right - region. + * 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. - * message.el (message-send-news): Encode body after checking - syntax. +2000-11-30 19:00:00 ShengHuo ZHU - * gnus-art.el (gnus-mime-button-line-format): Allow descriptions. + * gnus-util.el (gnus-add-text-properties-when): New function. + (gnus-remove-text-properties-when): Ditto. - * mm-decode.el (mm-save-part): Use Content-Disposition filename. + * gnus-cite.el (gnus-article-hide-citation): Use them. + (gnus-article-toggle-cited-text): Use them. - * gnus-art.el (gnus-display-mime): Respect disposition. + * gnus-art.el (gnus-signature-toggle): Use them. + (gnus-article-show-hidden-text): Ditto. + (gnus-article-hide-text): Ditto. - * mm-decode.el (mm-preferred-alternative): Respect disposition. +2000-11-30 14:00:00 ShengHuo ZHU - * gnus-art.el (article-strip-multiple-blank-lines): Don't delete - text with annotations. + * mm-util.el (mm-find-charset-region): Remove eight-bit-*. - * message.el (message-make-date): Fix sign for negative time - zones. +2000-11-30 Simon Josefsson - * mm-view.el (mm-inline-image): Insert a space at the end of the - image. + * smime.el (smime-point-at-eol): New alias. + (smime-buffer-as-string-region): Use it. - * mail-parse.el: New file. +2000-11-29 21:00:00 ShengHuo ZHU - * rfc2231.el: New file. + * nndraft.el (nndraft-request-restore-buffer): Remove Date field. - * drums.el (drums-content-type-get): Removed. - (drums-parse-content-type): Ditto. +2000-11-29 20:00:00 ShengHuo ZHU - * mailcap.el (mailcap-mime-data): Use symbols instead of strings. + * nnfolder.el (nnfolder-request-expire-articles): expiry-target. -Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen + * nnbabyl.el (nnbabyl-request-expire-articles): Ditto. - * gnus.el: Pterodactyl Gnus v0.27 is released. + * nnmbox.el (nnmbox-request-expire-articles): Ditto. -1998-09-11 12:42:07 Lars Magne Ingebrigtsen- +2000-11-22 Jan Nieuwenhuizen - * mm-decode.el (mm-alternative-precedence): New variable. - (mm-preferred-alternative): New function. + * nnmh.el (nnmh-request-expire-articles): Implemented + expiry-target for nnmh backend. - * gnus-art.el (gnus-mime-copy-part): New command. +2000-11-30 Simon Josefsson - * mm-decode.el (mm-get-part): New function. + * mm-decode.el (mm-security-from): New variable. + (mm-possibly-verify-or-decrypt): Use it rather than `from'. - * mm-view.el: New file. + * mml-smime.el (mml-smime-verify): Use `mm-security-from' rather + than `from'. - * mm-decode.el (mm-dissect-buffer): Downcase cte. - (mm-display-part): Default to mailcap-save-binary-file. +2000-11-30 Simon Josefsson -Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen + * mml-smime.el (mml-smime-verify): Verify that certificate mail + address match sender address. - * gnus.el: Pterodactyl Gnus v0.26 is released. + * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address. -1998-09-11 08:25:33 Lars Magne Ingebrigtsen + * 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. - * mm-decode.el (mm-interactively-view-part): New function. + * gnus-art.el (gnus-mime-security-show-details): Goto beginning of + buffer. - * gnus-art.el (gnus-mime-view-part): New command. +2000-11-23 Jens Krinke - * mm-decode.el (mm-last-shell-command): New variable. + * smime.el (smime-decrypt-region): Fix keyfile argument. - * mailcap.el (mailcap-mime-info): Allow returning all matches. +2000-11-29 00:00:00 ShengHuo ZHU - * mm-decode.el (mm-save-part): New function. + * nnmail.el (nnmail-cache-accepted-message-ids): Add doc. - * 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. +2000-11-28 17:00:00 ShengHuo ZHU - * gnus-util.el (gnus-dd-mmm): Removed length spec. + * message.el (message-shoot-gnksa-feet): New variable. + (message-gnksa-enable-p): New function. + (message-send): Use it. + (message-check-news-body-syntax): Ditto. - * mm-decode.el (mm-inline-text): Decode charsets. +2000-11-28 Katsumi Yamaoka - * gnus-art.el (gnus-article-save): Comment fix. + * message.el (message-make-message-id): Remove the redundancy. - * gnus-int.el (gnus-start-news-server): When in batch, don't - prompt. +2000-11-22 17:00:00 ShengHuo ZHU - * gnus-cache.el (gnus-cache-possibly-enter-article): Don't - decode. + * message.el (message-setup): Discourage using mc-install-*-mode. - * mm-decode.el (mm-inline-media-tests): Add audio. - (mm-inline-audio): New function. + * gnus-setup.el (gnus-use-mailcrypt): Don't hook mail-crypt. -1998-09-11 08:19:22 Katsumi Yamaoka +2000-11-22 16:00:00 ShengHuo ZHU - * gnus-art.el (article-make-date-line): Didn't work. + * gnus-cite.el (gnus-cite-parse): Guess citation length. - * parse-time.el (parse-time-string): One too many nils. +2000-11-22 14:00:00 ShengHuo ZHU -Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen + * gnus-ml.el (gnus-mailing-list-insinuate): New function. - * gnus.el: Pterodactyl Gnus v0.25 is released. +2000-11-22 13:00:00 ShengHuo ZHU -1998-09-11 07:38:14 Lars Magne Ingebrigtsen + * gnus-ml.el (gnus-mailing-list-archive): Find the real url. - * gnus-art.el (article-remove-trailing-blank-lines): Don't remove - annotations. +2000-11-22 11:00:00 ShengHuo ZHU - * gnus.el ((featurep 'gnus-xmas)): New - 'gnus-annotation-in-region-p alias. + * gnus-xmas.el (gnus-xmas-article-display-xface): Use + insert-buffer-substring. -1998-09-10 06:20:52 Lars Magne Ingebrigtsen + * message.el (message-send-mail): Use buffer-substring-no-properties. + (message-send-news): Ditto. - * mm-util.el (mm-with-unibyte-buffer): New function. +2000-11-22 David Edmondson - * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Renamed. + * imap.el (imap-wait-for-tag): Message read info. - * mm-decode.el (mm-inline-media-tests): New variable. +2000-11-21 20:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-summary-exit): Destroy handles. + * mml2015.el (mml2015-mailcrypt-encrypt): Ensure the part is encrypted. + (mml2015-mailcrypt-encrypt): Use unibyte-buffer. + (mml2015-gpg-encrypt): Ditto. - * gnus-art.el (gnus-article-mime-handles): New variable. +2000-11-21 09:00:00 ShengHuo ZHU - * drums.el (drums-narrow-to-header): New function. + * mm-decode.el (mm-verify-option): Default value. - * gnus-art.el (article-decode-charset): Use it. + * mml-sec.el (mml-secure-part): Error message. - * drums.el (drums-content-type-get): New function. +2000-11-20 18:00:00 ShengHuo ZHU - * mm-util.el (mm-content-type-charset): Removed. + * gnus-ml.el (gnus-mailing-list-archive): Use browse-url. - * drums.el (drums-syntax-table): @ is word. - (drums-parse-content-type): New function. +2000-11-20 17:00:00 ShengHuo ZHU - * parse-time.el (parse-time-rules): Parse "Wed, 29 Apr 98 0:26:01 - EDT" times. + * gnus-art.el (gnus-article-make-menu-bar): Use easy-menu-add. - * gnus-util.el (gnus-date-get-time): Use safe date. +2000-11-20 16:00:00 ShengHuo ZHU - * gnus-sum.el (gnus-show-mime): Removed. - (gnus-summary-toggle-mime): Removed. + * gnus-art.el (gnus-article-describe-key): Use prompt. + (gnus-article-describe-key-briefly): Ditto. - * 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. +2000-11-20 15:00:00 ShengHuo ZHU -Thu Sep 10 04:03:29 1998 Lars Magne Ingebrigtsen + * gnus-agent.el (gnus-agent-expire): Ignore corrupted history. - * gnus.el: Pterodactyl Gnus v0.24 is released. +2000-11-20 10:00:00 ShengHuo ZHU -1998-09-10 01:58:24 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-describe-key): New function. + (gnus-article-describe-key-briefly): New function. - * gnus-sum.el (gnus-summary-show-article): Don't decode chars if - PREFIX. +2000-11-19 23:00:00 ShengHuo ZHU - * parse-time.el (parse-time-rules): Accept times that look like - "h:mm". + * mm-decode.el (mm-decrypt-option): Doc typo. - * message.el (message-make-date): Use zone properly. + * gnus-art.el (gnus-article-read-summary-keys): lookup-key may + return a number. - * gnus.el: Autoload gnus-batch. +2000-11-19 21:00:00 ShengHuo ZHU - * gnus-art.el (article-de-quoted-unreadable): Do not do - gnus-article-decode-rfc1522. + * message.el (message-newline-and-reformat): Typo. - * gnus-msg.el (gnus-inews-do-gcc): Use it. +2000-11-19 12:00:00 ShengHuo ZHU - * gnus-int.el (gnus-request-accept-article): Accept a no-encode - param. + * gnus-art.el (article-verify-x-pgp-sig): Check whether + original-article-buffer exists. - * message.el (message-encode-message-body): Check for us-ascii. + * 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-msg.el (gnus-extended-version): Move Gnus version comments - to the left. +2000-11-19 00:00:00 ShengHuo ZHU -1998-09-09 13:18:13 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-art.el (article-decode-charset): Rename. + * 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. + + * 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. + + * mml2015.el (mml2015-mailcrypt-verify): Use mm-h-m-c-p. + (mml2015-gpg-verify): Ditto. + +2000-11-18 Simon Josefsson + + * mml2015.el (mml2015-mailcrypt-clear-verify): New function. + (mml2015-function-alist): Use it. + + * 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. + + * 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. + +2000-11-16 Simon Josefsson + + * mml2015.el (mml2015-gpg-clear-verify): New function. + (mml2015-function-alist): Add it. + +2000-11-17 14:21 ShengHuo ZHU + + * 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. + +2000-11-17 13:44 ShengHuo ZHU -Wed Sep 9 12:25:48 1998 Lars Magne Ingebrigtsen + * lpath.el: Shut up. - * gnus.el: Pterodactyl Gnus v0.23 is released. +2000-11-17 Per Abrahamsen -1998-09-09 12:14:47 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-group-posting-charset-alist): No longer allow + raw 8-bit in headers in dk.* newsgroups. - * gnus-util.el (gnus-parent-id): Ditto. - (gnus-put-text-property-excluding-newlines): Ditto. +2000-11-17 08:02 ShengHuo ZHU - * gnus-sum.el (gnus-dependencies-add-header): Make into subst. + * message.el (message-newline-and-reformat): Match extra WSPs. -1998-09-08 Karl Kleinpaste +2000-11-16 23:31 ShengHuo ZHU - * message.el (message-generate-headers): Generate User-Agent - instead of X-Mailer & X-Newsreader. + * mml.el (mml-generate-mime-1): Ignore ascii. - * gnus-msg.el (gnus-extended-version): Reformat for USEFOR - User-Agent header format. +2000-11-16 Justin Sheehy -Tue Sep 8 22:38:27 1998 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-make-menu-bar): Fix menu items. - * gnus.el: Pterodactyl Gnus v0.22 is released. +2000-11-16 17:00 ShengHuo ZHU -1998-09-08 22:36:54 Lars Magne Ingebrigtsen + * message.el (message-cite-prefix-regexp): Prefix should not end + at space. - * mm-util.el (mm-multibyte-p): Typo. +2000-11-15 18:09 ShengHuo ZHU -Tue Sep 8 22:25:53 1998 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. - * gnus.el: Pterodactyl Gnus v0.21 is released. +2000-11-15 13:21 ShengHuo ZHU -1998-09-08 Hrvoje Niksic + * gnus-msg.el (gnus-inews-do-gcc): Expire the article. - * gnus-art.el (article-treat-dumbquotes): Handle \224 correctly. +2000-11-12 David Edmondson -1998-09-08 22:18:03 Lars Magne Ingebrigtsen + * message.el (message-font-lock-keywords): use + message-cite-prefix-regexp. - * mm-util.el (mm-multibyte-p): New function. +2000-11-15 Kai Gro,b_(Bjohann -Tue Sep 8 21:43:03 1998 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-jump-to-group-prompt): New variable by + Stein Arild Str,Ax(Bmme. + (gnus-group-jump-to-group): Use it. + (gnus-group-jump-to-group-prompt): Customize. - * gnus.el: Pterodactyl Gnus v0.20 is released. +2000-11-14 10:32:42 ShengHuo ZHU -1998-09-08 11:40:45 Lars Magne Ingebrigtsen + * mailcap.el (mailcap-possible-viewers): Match the entire string. - * rfc2047.el (rfc2047-decode-region): Only decode when in - multibyte. +2000-11-14 10:20:56 ShengHuo ZHU - * nnheader.el (nnheader-pathname-coding-system): Changed to binary. + * mml2015.el (mml2015-mailcrypt-verify): replace-match is + incompatible. + (mml2015-mailcrypt-sign): Ditto. - * gnus-int.el (gnus-request-replace-article): Encode. - (gnus-request-accept-article): Encode. +2000-11-14 10:12:05 ShengHuo ZHU - * gnus-art.el (gnus-request-article-this-buffer): Decode charsets - here. + * gnus-msg.el (gnus-inews-do-gcc): Update summary data when the + group is open. - * gnus.el (gnus-article-display-hook): Take the charset functions - out. +2000-11-14 00:48:52 ShengHuo ZHU - * time-date.el (safe-date-to-time): New function. + * gnus-bcklg.el (gnus-backlog-enter-article): Don't enter + nnvirtual articles. + (gnus-backlog-request-article): Don't request nnvirtual articles. - * gnus-util.el (gnus-dd-mmm): Protect against bogus dates. +2000-11-13 22:08:09 ShengHuo ZHU -Tue Sep 8 07:09:28 1998 Lars Magne Ingebrigtsen + * mml2015.el (mml2015-mailcrypt-sign): Remove "-" escape. + * mml.el (mml-generate-mime-1): Save cont. skip multipart attributes. - * gnus.el: Pterodactyl Gnus v0.19 is released. +2000-11-13 20:43:37 ShengHuo ZHU -1998-09-08 04:51:39 Lars Magne Ingebrigtsen + * 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. - * base64.el (base64-encode-region): Accept no-line-break. +2000-11-13 16:09:09 ShengHuo ZHU - * mm-util.el (mm-mime-charset): New function. + * 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. - * gnus-draft.el (gnus-draft-edit-message): Delete article. +2000-11-13 15:29:58 ShengHuo ZHU -Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen + * 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. - * gnus.el: Pterodactyl Gnus v0.18 is released. +2000-11-13 09:50:29 ShengHuo ZHU -1998-09-08 02:21:36 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-repair-multipart): Fix Mime-Version + anyway. - * message.el (message-send-and-exit): Return t on success. - (message-make-date): Make a proper time zone. +2000-11-13 Simon Josefsson - * gnus-draft.el (gnus-draft-send): Only remove article if the - sending is successful. + * mm-uu.el (mm-uu-pgp-signed-extract): Explain why clear + verification doesn't work. - * drums.el (drums-get-comment): Return the last comment. - (drums-parse-address): Parse old-style From headers. +2000-11-12 23:36:45 ShengHuo ZHU -1998-09-07 SL Baur + * gnus-msg.el (gnus-inews-mark-gcc-as-read): New variable. + (gnus-inews-do-gcc): Use it. - * gnus-sum.el (gnus-data-compute-positions): Move below - `gnus-save-hidden-threads' so the former is correctly detected as - a macro. +2000-11-12 21:35:04 ShengHuo ZHU -1998-09-06 Dave Love + * rfc2231.el (rfc2231-encode-string): Insert semi-colon and + leading space. + * mm-extern.el (mm-inline-external-body): Report error when no + access-type. - * 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. +2000-11-12 19:48:30 ShengHuo ZHU -1998-09-08 00:38:39 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-select-newsgroup): Change the error message. - * time-date.el (time-to-seconds): Renamed. +2000-11-12 11:53:18 ShengHuo ZHU - * parse-time.el (parse-time-string): Downcase before handling. - (parse-time-rules): Times without seconds have 0 seconds. + * gnus-art.el (gnus-mime-button-menu): Use select-window. - * rfc2047.el (rfc2047-encode-region): New version. - (rfc2047-dissect-region): New function. +2000-11-12 09:47:54 ShengHuo ZHU -1998-09-07 01:08:35 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-mime-display-part): Display multipart/related + as multipart/mixed. - * message.el (message-make-date): Use symbolic zone. +2000-11-12 David Edmondson -1998-09-06 23:23:06 Lars Magne Ingebrigtsen + * 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'. - * time-date.el (parse-time): Always use parse-time. +2000-11-12 08:52:46 ShengHuo ZHU - * parse-time.el (parse-time-syntax): Use vectors. + * mml2015.el (mml2015-mailcrypt-verify): Replace armors with + PGP SIGNATURE. Escape leading "-"'s. + (mml2015-mailcrypt-sign): Replace armors with PGP MESSAGE. -Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen +2000-11-11 15:55:35 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.17 is released. + * mm-uu.el (mm-uu-type-alist): Stricter shar regexp. -1998-09-06 05:45:17 Lars Magne Ingebrigtsen +2000-11-11 Simon Josefsson - * time-date.el: Renamed from "date". + * mml2015.el (mml2015-gpg-verify): Set "OK" security status. - * gnus.el: Removed all timezone dependencies. + * 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. - * score-mode.el: Removed. - (gnus-score-edit-insert-date): Use date. + * mml-smime.el (mml-smime-verify): Support security info. - * date.el (float-to-time): New function. +2000-11-10 17:11:22 ShengHuo ZHU - * nnspool.el (nnspool-seconds-since-epoch): Removed. + * mm-decode.el (mm-verify-option): Set default to nil. + (mm-decrypt-option): Ditto. + * gnus-art.el (article-verify-x-pgp-sig): New function. - * date.el (time-to-float): New function. +2000-11-10 09:01:25 ShengHuo ZHU - * message.el (message-make-date): Use format-time-string. - (message-make-expires): Use make-date. + * gnus-art.el (gnus-mime-display-alternative): Show button if no + preferred part. - * gnus-xmas.el (gnus-xmas-seconds-since-epoch): Removed. +2000-11-07 Kai Gro,b_(Bjohann - * gnus-util.el (gnus-dd-mmm): Use date. - (gnus-sortable-date): Ditto. + * gnus-sum.el (gnus-move-split-methods): Say that + `gnus-split-methods' uses file names, whereas this uses group + names. (Report from Nevin Kapur) - * message.el (message-make-date): Take an optional time. +2000-11-10 01:23:20 ShengHuo ZHU - * gnus: Applied patches from 5.6.43. + * mm-partial.el (mm-inline-partial): Insert MIME-Version. - * date.el (if): Use parse-time. +2000-11-09 17:02:50 ShengHuo ZHU - * gnus-score.el (gnus-summary-score-entry): Make into a command - again. + * nnheader.el (nnheader-directory-files-is-safe): New variable. + (nnheader-directory-articles): Use it. + (nnheader-article-to-file-alist): Ditto. - * gnus-group.el (gnus-group-get-new-news-this-group): Only call if - gnus-agent. +2000-11-09 16:20:37 ShengHuo ZHU - * gnus.el (gnus-agent-meta-information-header): Moved here. + * rfc2047.el (rfc2047-pad-base64): New function. + (rfc2047-decode): Use it. -1998-09-05 Mike McEwan +2000-11-09 08:53:04 ShengHuo ZHU - * 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'. + * gnus-srvr.el (gnus-browse-foreign-server): Bind the original + select method. -1998-09-06 01:56:02 Lars Magne Ingebrigtsen +2000-11-08 19:58:58 ShengHuo ZHU - * gnus-score.el (gnus-score-load-score-alist): Bind coding system. + * mml2015.el (mml2015-gpg-decrypt-1): + (mml2015-gpg-verify): buffer-string has no argument in Emacs. - * gnus-art.el (gnus-article-setup-buffer): Enable multibyte. +2000-11-08 16:37:02 ShengHuo ZHU - * score-mode.el (score-mode-coding-system): New variable. - (gnus-score-edit-exit): Use it. + * gnus-cache.el (gnus-cache-generate-nov-databases): Reopen cache. -1998-09-04 Jason R Mastaler +2000-11-08 08:38:30 ShengHuo ZHU - * drums.el: Corrected typo. + * pop3.el (pop3-munge-message-separator): A message may have an + empty body. -1998-09-05 23:24:43 Hallvard B. Furuseth +2000-11-07 18:02:26 ShengHuo ZHU - * mm-bodies.el (mm-body-encoding): Faster version. + * 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. -1998-09-05 22:23:03 Lars Magne Ingebrigtsen +2000-11-07 14:33:19 ShengHuo ZHU - * gnus-art.el (gnus-article-decode-charset): Only decode text - things. + * 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. - * message.el (message-output): Use rmail. +2000-11-07 08:49:36 ShengHuo ZHU - * rfc2047.el (rfc2047-encoded-word-regexp): Allow spaces in the - word part. + * mm-decode.el (mm-display-parts): New function. + * gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first. - * mm-util.el (mm-charset-to-coding-system): Use - rfc2047-default-charset. - (mm-known-charsets): New variable. +2000-02-02 Alexandre Oliva - * message.el (message-caesar-region): Bugged out. + * gnus-mlspl.el: Documentation tweaks. -1998-09-06 Mike McEwan +2000-11-06 22:06:44 ShengHuo ZHU - * gnus-agent.el (gnus-agent-fetch-group-1): Allow lists when - specifying `agent-predicate' in a group's parameters. + * mm-decode.el (mm-possibly-verify-or-decrypt): Fix. + * gnus-art.el (gnus-article-encrypt-body): Rename and support prefix + argument. -Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen +2000-11-06 19:10:14 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.16 is released. + * rfc2231.el (rfc2231-encode-string): Use us-ascii if charset is nil. -1998-09-05 17:30:11 Lars Magne Ingebrigtsen +2000-11-06 18:17:53 ShengHuo ZHU - * nnmail.el (nnmail-expired-article-p): Use predicate. + * 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. - * date.el (time-less-p): Renamed. +2000-11-06 16:02:52 ShengHuo ZHU - * gnus-art.el (gnus-article-decode-charset): Really fetch headers - from the headers. + * 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. - * rfc2047.el (rfc2047-decode-region): Use the mm decoding - functions. +2000-11-06 14:03:10 ShengHuo ZHU - * 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. + * 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'. -Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen +2000-11-06 13:51:37 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.15 is released. + * 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. -1998-09-05 00:21:22 Lars Magne Ingebrigtsen +2000-11-06 13:01:27 ShengHuo ZHU - * date.el: New file. + * gnus-art.el (gnus-mime-view-part-as-charset): New function. + (gnus-article-view-part-as-charset): New function. - * gnus-util.el (gnus-encode-date): Removed. - (gnus-time-less): Ditto. +2000-11-05 22:34:07 ShengHuo ZHU - * nnmail.el (nnmail-date-to-time): Removed. - (nnmail-time-less): Ditto. - (nnmail-days-to-time): Ditto. - (nnmail-time-since): Ditto. + * mm-decode.el (mm-verify-option): Default value. + (mm-possibly-verify-or-decrypt): Dealing with broken messages. - * drums.el: New file. +2000-11-05 15:06:05 ShengHuo ZHU -1998-09-04 00:25:52 Lars Magne Ingebrigtsen + * nnvirtual.el (nnvirtual-request-expire-articles): Uncompress range. - * message.el (message-encode-message-body): Encode headers with - body encoding. +2000-11-05 Simon Josefsson - * rfc2047.el (rfc2047-default-charset): Renamed. - (rfc2047-encodable-p): Use it. + * mml-smime.el (mml-smime-verify): Work in original multipart + buffert. - * base64.el (mm-util): Required. + * 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. -1998-09-03 16:28:30 Lars Magne Ingebrigtsen + * mml-smime.el (mml-smime-sign): Not used. + (mml-smime-encrypt): Ditto. - * gnus-msg.el (gnus-post-method): Peel off real info from opened - servers. + * mm-decode.el (mml-smime-verify): Autoload mml-smime. - * gnus-util.el (gnus-output-to-rmail): Removed. + Verify S/MIME signature support. - * gnus-art.el (gnus-summary-save-in-rmail): Use - gnus-output-to-rmailrmail-output-to-rmail-file. + * 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. - * rfc2047.el (rfc2047-decode-region): Fold case. - (rfc2047-decode): Use decode-string. + * mml-smime.el (mml-smime-verify): New function. - * mm-util.el: Provide mm-char-int. +2000-11-04 20:38:50 ShengHuo ZHU -Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen + * mm-view.el (mm-inline-text): Move point to the end of inserted text. - * gnus.el: Pterodactyl Gnus v0.14 is released. +2000-11-04 19:07:08 ShengHuo ZHU -1998-09-03 15:08:30 Lars Magne Ingebrigtsen + * 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 variable. - * mm-bodies.el (mm-body-encoding): Go through the buffer to make - sure we have 7bit. +2000-11-04 13:08:02 ShengHuo ZHU -1998-09-02 14:38:18 Lars Magne Ingebrigtsen + * 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. - * gnus-msg.el (gnus-post-method): Use opened servers, and remove - ducplicates. - (gnus-inews-insert-mime-headers): Removed. +2000-11-04 ShengHuo Zhu - * message.el (message-caesar-region): Protect against MULE chars. + * base64.el, md5.el: Moved to contrib directory. -1998-09-02 00:36:23 Hallvard B. Furuseth +2000-11-04 11:13:56 ShengHuo ZHU - * mm-util.el (if): fset the right function. + * gnus-sum.el (gnus-summary-search-article-forward): Don't move + the last article when search. -1998-09-02 00:31:53 Lars Magne Ingebrigtsen +2000-11-04 10:34:29 ShengHuo ZHU - * gnus-art.el (gnus-article-decode-charset): Use real - read-coding-system. + * nnheader.el (nnheader-pathname-coding-system): Default iso-8859-1. + * nnmail.el (nnmail-pathname-coding-system): Ditto. -1998-09-01 17:58:40 Lars Magne Ingebrigtsen +2000-09-29 David Edmondson - * mm-bodies.el (mm-decode-body): Protect against malformed - base64. - (mm-decode-body): Check that buffer-file-coding-system is - non-nil. + * message.el (message-newline-and-reformat): Typo. -Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen +2000-11-04 10:11:05 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.13 is released. + * rfc2231.el (rfc2231-decode-encoded-string): Test mm-multibyte-p. -1998-09-01 09:14:33 Lars Magne Ingebrigtsen +2000-11-04 09:53:42 ShengHuo ZHU - * gnus-util.el (gnus-strip-whitespace): Already defined. - Removed. + * nntp.el (nntp-decode-text): Delete bogus status lines. - * gnus-art.el (gnus-article-decode-charset): Strip whitespace. +2000-11-03 Stefan Monnier - * gnus-util.el (gnus-strip-whitespace): New function. + * message.el (message-font-lock-keywords): Match a final newline + to help font-lock's multiline support. - * mm-util.el (mm-content-type-charset): Downcase. +2000-11-04 09:11:44 ShengHuo ZHU -1998-08-31 23:04:29 Lars Magne Ingebrigtsen + * nnoo.el (nnoo-set): New function. - * gnus-art.el (gnus-article-decode-charset): Accept a prefix. - (gnus-article-decode-charset): Don't fetch all headers. +2000-11-04 ShengHuo Zhu - * mm-util.el (mm-read-coding-system): New function. + * gpg.el, gpg-ring.el: Moved to contrib directory. - * mm-bodies.el (mm-decode-body): Check the right charset. +2000-11-04 Simon Josefsson - * gnus-sum.el (gnus-summary-mode-line-format): Ditto. + * nnimap.el (nnimap-split-inbox): Typo. - * gnus-art.el (gnus-article-mode-line-format): Use short group - format. +2000-11-03 10:46:44 ShengHuo ZHU -Mon Aug 31 23:03:13 1998 Lars Magne Ingebrigtsen + * gnus-msg.el (gnus-msg-mail): Move it backwards. - * gnus.el: Pterodactyl Gnus v0.12 is released. +2000-11-03 Simon Josefsson -1998-08-31 22:39:36 Lars Magne Ingebrigtsen + * rfc2231.el (rfc2231-parse-qp-string): New function. + (require): rfc2047. - * mm-bodies.el (mm-decode-body): Don't do charset unless MULE. + * mail-parse.el (mail-header-parse-content-type): + (mail-header-parse-content-disposition): Support invalid QP + encoded strings, by using `rfc2231-parse-qp-string'. - * gnus-art.el (gnus-article-decode-charset): Supply cte. - (gnus-article-decode-charset): Always run. +2000-11-03 08:58:08 ShengHuo ZHU - * mm-bodies.el (mm-decode-body): Decode cte. + * 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. -Mon Aug 31 22:14:50 1998 Lars Magne Ingebrigtsen +2000-11-02 23:35:50 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.11 is released. + * 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. -1998-08-31 14:27:25 Lars Magne Ingebrigtsen +2000-11-02 21:08:49 ShengHuo ZHU - * message.el (message-encode-message-body): Ditto. + * gnus-art.el (gnus-insert-mime-button): Show url. - * 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. +2000-11-02 19:51:19 ShengHuo ZHU - * mm-util.el (mm-content-type-charset): New function. + * mml.el (mml-generate-mime-1): Support external url. + * nnwarchive.el (nnwarchive-mail-archive-article): Use external url. - * nnmail.el (nnmail-delete-incoming): Changed to nil. +2000-11-02 16:53:32 ShengHuo ZHU - * 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-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. - * mm-bodies.el (mm-body-encoding): New function. +2000-11-02 Simon Josefsson - * message.el (message-encode-message-body): New function. + * gnus-art.el (gnus-visible-headers): Add Mail-Followup-To. - * mm-bodies.el: New file. + * message.el (message-get-reply-headers): Better handling when + Mail-Followup-To is very large. - * mm-util.el (mm-narrow-to-head): New function. +2000-11-02 13:27:56 ShengHuo ZHU - * rfc2047.el (rfc2047-encode): Use it. + * 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. - * mm-util.el: Provide mm-encode-coding-region. +2000-11-02 09:33:01 ShengHuo ZHU - * gnus-sum.el (gnus-summary-mode): Enable multibyte. + * 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-util.el (gnus-set-work-buffer): Enable multibyte. +2000-11-02 Hrvoje Niksic - * mm-util.el (mm-enable-multibyte): New function. + * rfc2047.el (rfc2047-encoded-word-regexp): Allow empty encoded + word. - * message.el (message-set-work-buffer): Set multibyte. +2000-11-01 10:07:13 ShengHuo ZHU - * gnus.el (gnus-continuum-version): Be valid forever and ever. + * 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. - * gnus-util.el (gnus-point-at-eol): Removed. - (gnus-point-at-bol): Ditto. +2000-11-01 08:54:11 ShengHuo ZHU - * base64.el (base64-decode-region): Commented out messaging. + * mml.el (mml-read-tag): Remove spaces and LF. -1998-08-31 Didier Verna +2000-11-01 08:01:03 ShengHuo ZHU - * 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). + * mml2015.el (mml2015-mailcrypt-encrypt): Use from and sign parameters. + * mml.el (mml-generate-mime-1): Add sender and recipients attributes. -1998-08-31 12:53:32 Lars Magne Ingebrigtsen +2000-11-01 07:39:24 ShengHuo ZHU - * gnus.el (gnus-article-display-hook): Added - gnus-article-decode-rfc1522 to hook. + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): New function. -Mon Aug 31 12:43:46 1998 Lars Magne Ingebrigtsen +2000-10-31 22:06:13 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.10 is released. + * 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. -1998-08-31 11:45:13 Lars Magne Ingebrigtsen +2000-11-01 01:12:29 Lars Magne Ingebrigtsen - * nnfolder.el (nnfolder-delete-mail): Narrow to mail and allow - hook to be run. + * nnultimate.el (nnultimate-create-mapping): Use nreverse. -1998-08-30 17:59:07 Lars Magne Ingebrigtsen +2000-10-31 23:45:31 Lars Magne Ingebrigtsen - * rfc2047.el (rfc2047-encodable-p): Use find-charset-region. + * nnwfm.el: New file. - * mm-util.el (mm-charsets-in-region): Removed. + * nnweb.el (nnweb-replace-in-string): New function. - * rfc2047.el: Renamed file. +2000-10-31 17:32:02 ShengHuo ZHU - * gnus-msg.el (gnus-copy-article-buffer): Multibyte. + * mml2015.el: Wrap gpg.el. + * gpg.el (gpg-verify): The last argument of apply is a list. + (gpg-encrypt): Add passphrase as a parameter. - * message.el (message-mode): Set multibyte. +2000-10-31 17:28:45 ShengHuo ZHU - * mm-util.el (mm-charsets-in-region): Copied here. + * gpg.el: New file. + * gpg-ring.el: New file. - * gnus-util.el: Removed gnus-truncate-string. +2000-10-31 11:44:29 ShengHuo ZHU - * gnus-art.el (gnus-article-decode-mime-words): Use 1522. + * gnus-sum.el (gnus-summary-show-article): Fix the summary line. - * rfc1522.el (rfc1522-unencoded-charsets): New variable. - (rfc1522-encodable-p): New function. - (rfc1522-encode-message-header): Use it. +2000-10-31 Katsumi Yamaoka -Sun Aug 30 17:46:01 1998 Lars Magne Ingebrigtsen + * gnus-sum.el (gnus-summary-insert-line): Work with quoted + double-quote characters. + (gnus-summary-prepare-threads): Ditto. - * gnus.el: Pterodactyl Gnus v0.9 is released. +2000-10-31 08:36:03 ShengHuo ZHU -1998-08-30 16:13:08 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. - * mm-util.el: Shadow encode-coding-string. +2000-10-31 00:04:35 ShengHuo ZHU - * base64.el (base64-encode-region): Don't add newline. + * mml2015.el: Fix doc. Remove bogus mml2015-setup. - * rfc1522.el (rfc1522-narrow-to-field): Copied here. +2000-10-30 23:37:07 ShengHuo ZHU - * mm-util.el: New file. + * 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. - * mm-decode.el: Somewhat depleted. - * mm-encode.el: Ditto. +2000-10-16 11:36:52 Lars Magne Ingebrigtsen - * rfc1522.el: New file. + * nnultimate.el (nnultimate-forum-table-p): Be a bit more + restrictive. + (nnultimate-table-regexp): New variable. + (nnultimate-forum-table-p): Use it. - * mm-util.el (mm-replace-chars-in-string): Copied here. +2000-10-30 Ed L Cashin + Trivial patch. - * mm-encode.el (mm-q-encode-region): New function. + * gnus-sum.el (gnus-summary-expire-articles): Save point. - * qp.el (quoted-printable-encode-region): Take an optional CLASS - param. +2000-10-30 08:52:50 ShengHuo ZHU - * mm-encode.el (mm-encode-word-region): Downcase. + * mml-sec.el (mml-pgpmime-sign-buffer): Use mml2015-sign. + (mml-pgpmime-encrypt-buffer): Use mml2015-encrypt. -Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen +2000-10-30 08:38:12 ShengHuo ZHU - * gnus.el: Pterodactyl Gnus v0.8 is released. + * mml2015.el: Shut up. -1998-08-30 12:23:03 Lars Magne Ingebrigtsen +2000-10-30 08:17:46 ShengHuo ZHU - * message.el (message-send-mail): Encode headers. + * 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. - * qp.el (quoted-printable-encode-region): Encode 8-bit words. - (quoted-printable-encode-region): Upcase. +2000-10-30 01:52:40 ShengHuo ZHU - * message.el (message-default-charset): New variable. + * 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. - * qp.el (quoted-printable-encode-region): Optional param FOLD. +2000-10-30 01:23:49 ShengHuo ZHU - * message.el (message-narrow-to-field): Changed name. + * mml.el (mml-mode): Show menu in XEmacs. - * mm-encode.el: New file. +2000-10-30 00:49:33 ShengHuo ZHU - * message.el (message-narrow-to-header): New function. + * 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. - * gnus-art.el (gnus-article-decode-mime-words): Place point in the - right buffer. +2000-10-29 22:31:40 ShengHuo ZHU -Sun Aug 30 12:15:54 1998 Lars Magne Ingebrigtsen + * nnfolder.el (nnfolder-open-nov): Use group. - * gnus.el: Pterodactyl Gnus v0.7 is released. +2000-10-29 17:23:15 ShengHuo ZHU -1998-08-30 01:26:12 Lars Magne Ingebrigtsen + * nnfolder.el: Add NOV. Set version to 2.0. + (nnfolder-nov-is-evil): If non-nil, nnfolder acts like 1.0. - * gnus.el: Remove autoload for - gnus-article-mime-decode-quoted-printable. +2000-10-29 10:35:08 ShengHuo ZHU - * mm-decode.el (mm-charset-to-coding-system): Allow iso-8859-1 to - be decoded in non-MULE Emacsen. + * mml2015.el (mml2015-mailcrypt-sign): Use mc-sign-generic. - * gnus-xmas.el (gnus-xmas-logo-color-alist): More brown. +2000-10-29 09:42:05 ShengHuo ZHU -1998-08-29 SL Baur + * gnus-srvr.el (gnus-browse-foreign-server): Show level mark. + (gnus-browse-unsubscribe-group): Unsubscribed is not killed. - * gnus-xmas.el (gnus-xmas-logo-color-alist): Try shades of brown. +2000-10-29 08:28:58 ShengHuo ZHU -1998-08-30 01:04:57 Lars Magne Ingebrigtsen + * nnfolder.el (nnfolder-read-folder): Don't goto point-min. - * mm-decode.el: Check for coding-system-list. +2000-10-28 19:11:01 ShengHuo ZHU -Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen + * 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.el: Pterodactyl Gnus v0.6 is released. +2000-10-28 16:54:45 ShengHuo ZHU -1998-08-30 00:36:28 Lars Magne Ingebrigtsen + * 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. - * nnheader.el (fboundp): Protect code-coding-string. +2000-10-28 Simon Josefsson - * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte - is available. + * imap.el (imap-parse-resp-text-code): Workaround bug in Stalker + Communigate Pro 3.3.1 server. -Sat Aug 29 23:24:31 1998 Lars Magne Ingebrigtsen + * 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. - * gnus.el: Pterodactyl Gnus v0.5 is released. + * smime.el (smime-dns-server): New variable. + (smime-mail-to-domain): + (smime-cert-by-dns): New functions. -1998-08-29 22:38:35 Lars Magne Ingebrigtsen + * dig.el: New file. - * gnus-art.el (gnus-article-mode): Make article buffer multibyte. - (gnus-hack-decode-rfc1522): Removed. +2000-10-28 10:09:41 ShengHuo ZHU - * mm-decode.el (mm-charset-coding-system-alist): Check better. + * 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. -Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen + * 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. - * gnus.el: Gnus v0.4 is released. +2000-10-28 Simon Josefsson -1998-08-29 20:53:29 Lars Magne Ingebrigtsen + * nnimap.el (nnimap-retrieve-which-headers): + (nnimap-request-article-part): Quote message-id. - * gnus-art.el (gnus-article-decode-mime-words): New command and - keystroke. + * 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. - * qp.el (quoted-printable-decode-region): Don't use hexl. + * 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. - * gnus-xmas.el (gnus-xmas-logo-color-style): Changed to dino. + * mml-sec.el: New file. - * gnus-sum.el (gnus-parse-headers-hook): Default to nil. - (gnus-structured-field-decoder): Removed. - (gnus-unstructured-field-decoder): Ditto. +2000-10-28 03:43:03 ShengHuo ZHU - * mm-decode.el: New file. + * 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. - * qp.el: New file. +2000-10-28 03:38:39 ShengHuo ZHU - * gnus-art.el (article-mime-decode-quoted-printable): Removed. + * rfc2047.el (rfc2047-encode-message-header): Make sure no + unencoded stuff in the header. - * gnus-ems.el (fboundp): Removed gnus-split-string. +2000-10-28 02:40:46 ShengHuo ZHU - * gnus.el (gnus-splash-face): Doc fix. + * 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. - * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p. +2000-10-27 Paul Jarc - * gnus-art.el (article-mime-decode-quoted-printable): Don't use - hexl. + * message.el (message-insert-to, message-get-reply-headers): + (message-reply, message-followup): Mail-{Followup,Reply}-To. - * nnheader.el (nnheader-temp-write): Removed. +2000-10-27 19:45:58 ShengHuo ZHU -Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen + * mml2015.el: New file. + * smime.el: New file. + * mml-smime.el: New file. - * gnus.el: Gnus v0.3 is released. +2000-10-27 19:42:12 ShengHuo ZHU -Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen + * ChangeLog: Moved to ChangeLog.1. - * gnus.el: Gnus v0.2 is released. + Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. + Copying and distribution of this file, with or without modification, + are permitted provided the copyright notice and this notice are preserved. ;; Local Variables: ;; coding: iso-2022-7bit diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 6ea8e34..00ae7ed 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -6,38 +6,44 @@ subdir = lisp top_srcdir = @top_srcdir@ EMACS = @EMACS@ -FLAGS = -batch -q -no-site-file -l $(srcdir)/dgnushack.el +FLAGS = @FLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ SHELL = /bin/sh VPATH = @srcdir@ PACKAGEDIR = @PACKAGEDIR@ W3DIR = @W3@ +URLDIR = @URL@ +EMACS_COMP = URLDIR=$(URLDIR) W3DIR=$(W3DIR) lispdir=$(lispdir) srcdir=$(srcdir) $(EMACS) $(FLAGS) GNUS_PRODUCT_NAME = @GNUS_PRODUCT_NAME@ -EXPORTING_FILES = $(EMACS) $(FLAGS) -f dgnushack-exporting-files 2>/dev/null +EXPORTING_FILES = $(EMACS_COMP) -f dgnushack-exporting-files 2>/dev/null -all total: - rm -f *.elc auto-autoloads.el custom-load.el - W3DIR=$(W3DIR) lispdir=$(lispdir) \ - srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile +# We should never use `COMMAND && ...' form, use `if COMMAND then ...' +# form instead. Because, as far as we know, FreeBSD's native make will +# be discontinued if COMMAND returns a non-zero exit status. -warn: - rm -f *.elc - 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" +all total: clean-some gnus-load.el + $(EMACS_COMP) -f dgnushack-compile + +clean-some: + rm -f *.elc gnus-load.el + +warn: clean-some gnus-load.el + $(EMACS_COMP) --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: +clever some l: gnus-load.el @if test -f $(srcdir)/gnus.elc; then \ echo \ - "checking for whether the all elc files should be recompiled..."; \ + "checking whether the all elc files should be recompiled..."; \ RM_ELC=nil; \ if test `$(EMACS) -batch -q -no-site-file \ - -eval "(princ (format \"%s\" (featurep (quote xemacs))))" \ + -eval '(prin1 (featurep (quote xemacs)))' \ 2>/dev/null` = t; then \ - test ! -f $(srcdir)/gnus-xmas.elc && RM_ELC=t; \ + if test ! -f $(srcdir)/gnus-xmas.elc; then RM_ELC=t; fi; \ else \ - test -f $(srcdir)/gnus-xmas.elc && RM_ELC=t; \ + if test -f $(srcdir)/gnus-xmas.elc; then RM_ELC=t; fi; \ fi; \ if test $$RM_ELC = t; then \ echo " => maybe yes;" \ @@ -47,8 +53,7 @@ clever some: echo " => maybe unnecessary"; \ fi; \ fi - W3DIR=$(W3DIR) lispdir=$(lispdir) \ - srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile + $(EMACS_COMP) -f dgnushack-compile install: clever install-without-compiling @@ -65,19 +70,25 @@ install-without-compiling: # Rule for XEmacs package. install-package-manifest: - srcdir=$(srcdir) $(EMACS) $(FLAGS) \ - -f dgnushack-install-package-manifest \ + $(EMACS_COMP) -f dgnushack-install-package-manifest \ $(PACKAGEDIR) $(GNUS_PRODUCT_NAME) -compose-package: - srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-make-autoloads +compose-package: gnus-load.el + $(EMACS_COMP) -f dgnushack-compose-package remove-extra-files-in-package: - srcdir=$(srcdir) $(EMACS) $(FLAGS) \ - -f dgnushack-remove-extra-files-in-package \ + $(EMACS_COMP) -f dgnushack-remove-extra-files-in-package \ $(PACKAGEDIR) $(GNUS_PRODUCT_NAME) # +install-el: + $(SHELL) $(top_srcdir)/mkinstalldirs $(lispdir) + cd $(srcdir) \ + && for p in *.el; do \ + echo " $(INSTALL_DATA) $$p $(lispdir)/$$p"; \ + $(INSTALL_DATA) $$p $(lispdir)/$$p; \ + done + tags: etags *.el @@ -88,20 +99,13 @@ pot: xpot -drgnus -r`cat ./version` *.el > rgnus.pot gnus-load.el: - echo ";;; gnus-load.el --- automatically extracted custom dependencies" > gnus-load.el - echo ";;" >> gnus-load.el - echo ";;; Code:" >> gnus-load.el - echo >> gnus-load.el - $(EMACS) $(FLAGS) -l ./dgnushack.el -l cus-edit.el *.el \ - -f custom-make-dependencies >> gnus-load.el - echo >> gnus-load.el - echo "(provide 'gnus-load)" >> gnus-load.el - echo >> gnus-load.el - echo ";;; gnus-load.el ends here" >> gnus-load.el + $(EMACS_COMP) -f dgnushack-make-cus-load $(srcdir) + $(EMACS_COMP) -f dgnushack-make-auto-load $(srcdir) + $(EMACS_COMP) -f dgnushack-make-load clean: - rm -f *.orig *.rej *.elc *~ - rm -f auto-autoloads.el custom-load.el + rm -f *.orig *.rej *.elc *~ \ + auto-autoloads.el custom-load.el gnus-load.el dgnuskwds.el distclean: clean rm -f Makefile dgnuspath.el diff --git a/lisp/binhex.el b/lisp/binhex.el index 0147921..7622881 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -1,5 +1,5 @@ -;;; binhex.el -- elisp native binhex decode -;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. +;;; binhex.el --- elisp native binhex decode +;; Copyright (c) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: binhex news @@ -27,19 +27,31 @@ (eval-when-compile (require 'cl)) +(require 'path-util) + (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. +(defcustom binhex-decoder-program "hexbin" + "*Non-nil value should be a string that names a binhex decoder. The program should expect to read binhex data on its standard -input and write the converted data to its standard output.") +input and write the converted data to its standard output." + :type 'string + :group 'gnus-extract) + +(defcustom binhex-decoder-switches '("-d") + "*List of command line flags passed to the command `binhex-decoder-program'." + :group 'gnus-extract + :type '(repeat string)) -(defvar binhex-decoder-switches '("-d") - "*List of command line flags passed to the command named by binhex-decoder-program.") +(defcustom binhex-use-external + (exec-installed-p binhex-decoder-program) + "*Use external binhex program." + :group 'gnus-extract + :type 'boolean) (defconst binhex-alphabet-decoding-alist '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) @@ -69,13 +81,16 @@ input and write the converted data to its standard output.") ((boundp 'temporary-file-directory) temporary-file-directory) ("/tmp/"))) -(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))) - (insert-char char count) - (with-current-buffer buffer - (insert-char char count))))) +(eval-and-compile + (defalias 'binhex-insert-char + (if (featurep 'xemacs) + 'insert-char + (lambda (char &optional count ignored buffer) + "Insert COUNT copies of CHARACTER into BUFFER." + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (with-current-buffer buffer + (insert-char char count))))))) (defvar binhex-crc-table [0 4129 8258 12387 16516 20645 24774 28903 @@ -184,8 +199,9 @@ input and write the converted data to its standard output.") (t (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) -(defun binhex-decode-region (start end &optional header-only) - "Binhex decode region between START and END. +;;;###autoload +(defun binhex-decode-region-internal (start end &optional header-only) + "Binhex decode region between START and END without using an external program. If HEADER-ONLY is non-nil only decode header and return filename." (interactive "r") (let ((work-buffer nil) @@ -232,7 +248,7 @@ If HEADER-ONLY is non-nil only decode header and return filename." (>= (buffer-size) data-fork-start))) (progn (binhex-verify-crc work-buffer - 1 data-fork-start) + (point-min) data-fork-start) (setq header (binhex-header work-buffer)) (if header-only (setq tmp nil counter 0)))) (setq tmp (and tmp (not (eq inputpos end))))) @@ -258,12 +274,14 @@ If HEADER-ONLY is non-nil only decode header and return filename." (and work-buffer (kill-buffer work-buffer))) (if header (aref header 1)))) +;;;###autoload (defun binhex-decode-region-external (start end) "Binhex decode region between START and END using external decoder." (interactive "r") (let ((cbuf (current-buffer)) firstline work-buffer status (file-name (expand-file-name - (concat (binhex-decode-region start end t) ".data") + (concat (binhex-decode-region-internal start end t) + ".data") binhex-temporary-file-directory))) (save-excursion (goto-char start) @@ -296,6 +314,14 @@ If HEADER-ONLY is non-nil only decode header and return filename." (ignore-errors (if file-name (delete-file file-name)))))) +;;;###autoload +(defun binhex-decode-region (start end) + "Binhex decode region between START and END." + (interactive "r") + (if binhex-use-external + (binhex-decode-region-external start end) + (binhex-decode-region-internal start end))) + (provide 'binhex) ;;; binhex.el ends here diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index f96815e..505f844 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -1,5 +1,5 @@ ;;; dgnushack.el --- a hack to set the load path for byte-compiling -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -49,17 +49,27 @@ (defalias 'facep 'ignore) (require 'cl) -(unless (dolist (var nil t)) - ;; Override the macro `dolist' which may have been defined in egg.el. + +(unless (and + ;; `dolist' might not be available because of ``-no-autoloads''. + (fboundp 'dolist) + ;; It may have been defined in egg.el. + (dolist (var nil t))) (load "cl-macs" nil t)) (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)) +(defvar dgnushack-w3-directory (let ((w3dir (getenv "W3DIR"))) + (unless (zerop (length w3dir)) + (file-name-as-directory w3dir)))) + +(let ((urldir (getenv "URLDIR"))) + (unless (zerop (length urldir)) + (setq urldir (file-name-as-directory urldir)) + (push (file-name-as-directory urldir) load-path)) + (when (and dgnushack-w3-directory + (not (string-equal urldir dgnushack-w3-directory))) + (push dgnushack-w3-directory 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 @@ -80,15 +90,59 @@ (t (concat filename ".elc")))) (require 'bytecomp) +;; To avoid having defsubsts and inlines happen. +;(if (featurep 'xemacs) +; (require 'byte-optimize) +; (require 'byte-opt)) +;(defun byte-optimize-inline-handler (form) +; "byte-optimize-handler for the `inline' special-form." +; (cons 'progn (cdr form))) +;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun) -(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) +(when (boundp 'MULE) + (let (current-load-list) + ;; Make the function to be silent at compile-time. + (defun locate-library (library &optional nosuffix) + "Show the full path name of Emacs library LIBRARY. +This command searches the directories in `load-path' like `M-x load-library' +to find the file that `M-x load-library RET LIBRARY RET' would load. +Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' +to the specified name LIBRARY (a la calling `load' instead of `load-library')." + (interactive "sLocate library: ") + (catch 'answer + (mapcar + '(lambda (dir) + (mapcar + '(lambda (suf) + (let ((try (expand-file-name (concat library suf) dir))) + (and (file-readable-p try) + (null (file-directory-p try)) + (progn + (or noninteractive + (message "Library is file %s" try)) + (throw 'answer try))))) + (if nosuffix '("") '(".elc" ".el" "")))) + load-path) + (or noninteractive + (message "No library %s in search path" library)) + nil)) + (byte-compile 'locate-library))) + +(setq max-specpdl-size 3000) + +(when (equal + (cadr + (byte-optimize-form + '(and + (< 0 1) + (message "The subform `(< 0 1)' should be optimized to t")) + 'for-effect)) + '(< 0 1)) + (defadvice byte-optimize-form-code-walker + (around fix-bug-in-and/or-forms (form for-effect) activate) + "Fix a bug in the optimizing and/or forms. +It has already been fixed in XEmacs since 1999-12-06." (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 @@ -98,16 +152,11 @@ (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) + (when backwards + (setcdr backwards + (mapcar 'byte-optimize-form (cdr backwards)))) + (setq ad-return-value (cons fn (nreverse backwards)))) + ad-do-it))) (condition-case nil (char-after) @@ -137,10 +186,44 @@ ;; 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") + +;; If the APEL modules are installed under the non-standard directory, +;; for example "/var/home/john/lisp/apel-VERSION/", you should add that +;; name using the configure option "--with-addpath=". +;; And also the directory where the EMU modules are installed, for +;; example "/usr/local/share/mule/19.34/site-lisp/", it should be +;; included in the standard `load-path' or added by the configure +;; option "--with-addpath=". +(let ((path (or (locate-library "path-util") + (locate-library "apel/path-util")));; backward compat. + parent lpath) + (if path + (progn + (when (string-match "/$" (setq path (file-name-directory path))) + (setq path (substring path 0 (match-beginning 0)))) + ;; path == "/var/home/john/lisp/apel-VERSION" + (when (string-match "/$" (setq parent (file-name-directory path))) + (setq parent (substring path 0 (match-beginning 0)))) + ;; parent == "/var/home/john/lisp" + (if (setq lpath (or (member path load-path) + (member (file-name-as-directory path) load-path))) + (unless (or (member parent load-path) + (member (file-name-as-directory parent) load-path)) + (push parent (cdr lpath))) + (push path load-path) + (unless (or (member parent load-path) + (member (file-name-as-directory parent) load-path)) + (push parent (cdr load-path)))) + (require 'advice) + (require 'path-util)) + (error " +APEL modules are not found in %s. +Try to re-configure with --with-addpath=APEL_PATH and run make again. +" + load-path))) + +(unless (locate-library "mel") + (add-path "flim")) (unless (module-installed-p 'mel) ;; FLIM 1.14 may have installed in two "flim" subdirectories. (push (expand-file-name "flim" @@ -148,17 +231,27 @@ load-path) (unless (module-installed-p 'mel) (error " -FLIM package does not found in %s. +FLIM modules does not found in %s. Try to re-configure with --with-addpath=FLIM_PATH and run make again. " - (progn - (add-path "semi") - load-path)))) + load-path))) (add-path "semi") (push srcdir load-path) (load (expand-file-name "lpath.el" srcdir) nil t t) +(load (expand-file-name "gnus-clfns.el" srcdir) nil t t) + +(when (boundp 'MULE) + ;; Bind the function `base64-encode-string' before loading canlock. + ;; Since canlock will bind it as an autoloaded function, it causes + ;; damage to define the function by MEL. + (load (expand-file-name "base64.el" srcdir) nil t t) + ;; Load special macros for compiling canlock.el. + (load (expand-file-name "canlock-om.el" srcdir) nil t t)) + +(require 'custom) + ;; Bind functions defined by `defun-maybe'. (put 'defun-maybe 'byte-hunk-handler 'byte-compile-file-form-defun-maybe) (defun byte-compile-file-form-defun-maybe (form) @@ -173,28 +266,135 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (condition-case nil :symbol-for-testing-whether-colon-keyword-is-available-or-not (void-variable - ;; Bind keywords. - (dolist (keyword '(:button-keymap :data :file :mime-handle - :key-type :value-type)) - (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 ------ + (defun dgnushack-bind-colon-keywords () + "Bind all the colon keywords for old Emacsen." + (let ((cache (expand-file-name "dgnuskwds.el" srcdir)) + (makefile (expand-file-name "Makefile" srcdir)) + (buffer (get-buffer-create " *colon keywords*")) + keywords ignores files file dirs dir form elem make-backup-files) + (save-excursion + (set-buffer buffer) + (let (buffer-file-format + format-alist + insert-file-contents-post-hook + insert-file-contents-pre-hook + jam-zcat-filename-list + jka-compr-compression-info-list) + (if (and (file-exists-p cache) + (file-exists-p makefile) + (file-newer-than-file-p cache makefile)) + (progn + (insert-file-contents cache nil nil nil t) + (setq keywords (read buffer))) + (setq + ignores + '(:symbol-for-testing-whether-colon-keyword-is-available-or-not + ;; The following keywords will be bound by CUSTOM. + :get :group :initialize :link :load :options :prefix + :require :set :tag :type) + files (list (locate-library "semi-def") + (locate-library "mailcap") + (locate-library "mime-def") + (locate-library "path-util") + (locate-library "poem")) + dirs (list (file-name-as-directory (expand-file-name srcdir)))) + (while files + (when (setq file (pop files)) + (setq dir (file-name-directory file)) + (unless (member dir dirs) + (push dir dirs)))) + (message "Searching for all the colon keywords in:") + (while dirs + (setq dir (pop dirs)) + (message " %s..." dir) + (setq files (directory-files dir t + "\\.el\\(\\.gz\\|\\.bz2\\)?$")) + (while files + (setq file (pop files)) + (if (string-match "\\(\\.gz$\\)\\|\\.bz2$" file) + (let ((temp (expand-file-name "dgnustemp.el" srcdir))) + (when + (let* ((binary (if (boundp 'MULE) + '*noconv* + 'binary)) + (coding-system-for-read binary) + (coding-system-for-write binary) + (input-coding-system binary) + (output-coding-system binary) + (default-process-coding-system + (cons binary binary)) + call-process-hook) + (insert-file-contents file nil nil nil t) + (when + (condition-case code + (progn + (if (match-beginning 1) + (call-process-region + (point-min) (point-max) + "gzip" t buffer nil "-cd") + (call-process-region + (point-min) (point-max) + "bzip2" t buffer nil "-d")) + t) + (error + (erase-buffer) + (message "In file %s: %s" file code) + nil)) + (write-region (point-min) (point-max) temp + nil 'silent) + t)) + (unwind-protect + (insert-file-contents temp nil nil nil t) + (delete-file temp)))) + (insert-file-contents file nil nil nil t)) + (while (setq form (condition-case nil + (read buffer) + (error nil))) + (when (listp form) + (while form + (setq elem (car-safe form) + form (cdr-safe form)) + (unless (memq (car-safe elem) + '(defcustom defface defgroup + define-widget quote)) + (while (consp elem) + (push (car elem) form) + (setq elem (cdr elem))) + (when (and elem + (symbolp elem) + (not (eq ': elem)) + (eq ?: (aref (symbol-name elem) 0)) + (not (memq elem ignores)) + (not (memq elem keywords))) + (push elem keywords)))))))) + (setq keywords (sort keywords + (lambda (a b) + (string-lessp (symbol-name a) + (symbol-name b))))) + (erase-buffer) + (insert (format "%s" keywords)) + (write-region (point-min) (point) cache nil 'silent) + (message + "The following colon keywords will be bound at run-time:\n %s" + keywords)))) + (kill-buffer buffer) + (defconst dgnushack-colon-keywords keywords) + (while keywords + (set (car keywords) (car keywords)) + (setq keywords (cdr keywords))))) + (byte-compile 'dgnushack-bind-colon-keywords) + (dgnushack-bind-colon-keywords))) + +(when (boundp 'MULE) + (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))) (when (boundp 'MULE) (put 'custom-declare-face 'byte-optimizer @@ -239,7 +439,18 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (car (cdr args)))))) (setq args (cdr (cdr args)))) newform) - form)))) + form))) + + (defadvice byte-compile-inline-expand (around ignore-built-in-functions + (form) activate) + "Ignore built-in functions." + (let* ((name (car form)) + (fn (and (fboundp name) + (symbol-function name)))) + (if (subrp fn) + ;; Give up on inlining. + (setq ad-return-value form) + ad-do-it)))) ;; Unknown variables and functions. (unless (boundp 'buffer-file-coding-system) @@ -247,7 +458,6 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (unless (featurep 'xemacs) (defalias 'Custom-make-dependencies 'ignore) (defalias 'update-autoloads-from-directory 'ignore)) -(autoload 'texinfo-parse-line-arg "texinfmt") (defalias 'device-sound-enabled-p 'ignore) (defalias 'play-sound-file 'ignore) @@ -256,47 +466,146 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (defalias 'ange-ftp-re-read-dir 'ignore) (defalias 'define-mail-user-agent 'ignore) +(eval-and-compile + (when (featurep 'xemacs) + ;; XEmacs 21.1 needs some extra hand holding + (when (eq emacs-minor-version 1) + (autoload 'custom-declare-face "cus-face" nil t) + (autoload 'cl-compile-time-init "cl-macs" nil t) + (autoload 'defadvice "advice" nil nil 'macro)) + (unless (fboundp 'defadvice) + (autoload 'defadvice "advice" nil nil 'macro)) + (autoload 'Info-directory "info" nil t) + (autoload 'Info-menu "info" nil t) + (autoload 'annotations-at "annotations") + (autoload 'apropos "apropos" nil t) + (autoload 'apropos-command "apropos" nil t) + (autoload 'bbdb-complete-name "bbdb-com" nil t) + (autoload 'browse-url "browse-url" nil t) + (autoload 'customize-apropos "cus-edit" nil t) + (autoload 'customize-save-variable "cus-edit" nil t) + (autoload 'customize-variable "cus-edit" nil t) + (autoload 'delete-annotation "annotations") + (autoload 'dolist "cl-macs" nil nil 'macro) + (autoload 'enriched-decode "enriched") + (autoload 'info "info" nil t) + (autoload 'make-annotation "annotations") + (autoload 'make-display-table "disp-table") + (autoload 'pp "pp") + (autoload 'ps-despool "ps-print" nil t) + (autoload 'ps-spool-buffer "ps-print" nil t) + (autoload 'ps-spool-buffer-with-faces "ps-print" nil t) + (autoload 'read-passwd "passwd") + (autoload 'regexp-opt "regexp-opt") + (autoload 'reporter-submit-bug-report "reporter") + (if (emacs-version>= 21 5) + (autoload 'setenv "process" nil t) + (autoload 'setenv "env" nil t)) + (autoload 'smtpmail-send-it "smtpmail") + (autoload 'sort-numeric-fields "sort" nil t) + (autoload 'sort-subr "sort") + (autoload 'trace-function-background "trace" nil t) + (autoload 'w3-do-setup "w3") + (autoload 'w3-prepare-buffer "w3-display") + (autoload 'w3-region "w3-display" nil t) + (defalias 'frame-char-height 'frame-height) + (defalias 'frame-char-width 'frame-width) + (defalias 'frame-parameter 'frame-property) + (defalias 'make-overlay 'ignore) + (defalias 'overlay-end 'ignore) + (defalias 'overlay-get 'ignore) + (defalias 'overlay-put 'ignore) + (defalias 'overlay-start 'ignore) + (defalias 'overlays-in 'ignore) + (defalias 'replace-dehighlight 'ignore) + (defalias 'replace-highlight 'ignore) + (defalias 'run-with-idle-timer 'ignore) + (defalias 'w3-coding-system-for-mime-charset 'ignore))) + +;; T-gnus stuff. +(eval-and-compile + (when (featurep 'xemacs) + (autoload 'c-mode "cc-mode" nil t) + (autoload 'font-lock-mode "font-lock" nil t) + (autoload 'read-kbd-macro "edmacro" nil t) + (autoload 'turn-on-font-lock "font-lock" nil t)) + (autoload 'nnheader-detect-coding-region "nnheader") + (autoload 'std11-extract-addresses-components "nnheader") + (autoload 'std11-fold-region "nnheader") + (autoload 'std11-narrow-to-field "nnheader") + (autoload 'std11-unfold-region "nnheader")) + (defconst dgnushack-unexporting-files - (append '("dgnushack.el" "dgnuspath.el" "lpath.el" "ptexinfmt.el") + (append '("dgnushack.el" "dgnuspath.el" "dgnuskwds.el" "lpath.el") + (condition-case nil + (progn (require 'shimbun) nil) + (error '("nnshimbun.el"))) (unless (or (condition-case code - (require 'w3-forms) + (require 'w3-parse) (error - (message "No w3: %s %s retrying..." code - (locate-library "w3-forms")) + (message "No w3: %s%s, retrying..." + (error-message-string code) + (if (setq code (locate-library "w3-parse")) + (concat " (" code ")") + "")) nil)) ;; Maybe mis-configured Makefile is used (e.g. ;; configured for FSFmacs but XEmacs is running). - (let ((lp (delete dgnushack-w3-dir + (let ((lp (delete dgnushack-w3-directory (copy-sequence load-path)))) (if (let ((load-path lp)) (condition-case nil - (require 'w3-forms) + (require 'w3-parse) (error nil))) ;; If success, fix `load-path' for compiling. (progn (setq load-path lp) (message " => fixed; W3DIR=%s" (file-name-directory - (locate-library "w3-forms"))) + (locate-library "w3-parse"))) t) (message " => ignored") nil))) - '("nnweb.el" "nnlistserv.el" "nnultimate.el" - "nnslashdot.el" "nnwarchive.el" "webmail.el" - "nnwfm.el")) - (condition-case nil + '("nnultimate.el" "webmail.el" "nnwfm.el")) + (condition-case code + (progn (require 'mh-e) nil) + (error + (message "No mh-e: %s%s (ignored)" + (error-message-string code) + (if (setq code (locate-library "mh-e")) + (concat " (" code ")") + "")) + '("gnus-mh.el"))) + (condition-case code + (progn (require 'xml) nil) + (error + (message "No xml: %s%s (ignored)" + (error-message-string code) + (if (setq code (locate-library "xml")) + (concat " (" code ")") + "")) + '("nnrss.el"))) + (condition-case code (progn (require 'bbdb) nil) - (error '("gnus-bbdb.el"))) + (error + (message "No bbdb: %s%s (ignored)" + (error-message-string code) + (if (setq code (locate-library "bbdb")) + (concat " (" code ")") + "")) + '("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")) + '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el")) + (when (and (not (featurep 'xemacs)) + (<= emacs-major-version 20)) + '("smiley.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"))) + '("md5.el")) + (unless (boundp 'MULE) + '("canlock-om.el"))) "Files which will not be installed.") (defconst dgnushack-exporting-files @@ -310,6 +619,26 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. "Print name of files which will be installed." (princ (mapconcat 'identity dgnushack-exporting-files " "))) +(defconst dgnushack-dont-compile-files + '("mm-bodies.el" "mm-decode.el" "mm-encode.el" "mm-extern.el" + "mm-partial.el" "mm-url.el" "mm-uu.el" "mm-view.el" "mml-sec.el" + "mml-smime.el" "mml.el" "mml1991.el" "mml2015.el") + "Files which should not be byte-compiled.") + +(defun dgnushack-compile-verbosely () + "Call dgnushack-compile with warnings ENABLED. If you are compiling +patches to gnus, you should consider modifying make.bat to call +dgnushack-compile-verbosely. All other users should continue to use +dgnushack-compile." + (dgnushack-compile t)) + +(defun dgnushack-compile-verbosely () + "Call dgnushack-compile with warnings ENABLED. If you are compiling +patches to gnus, you should consider modifying make.bat to call +dgnushack-compile-verbosely. All other users should continue to use +dgnushack-compile." + (dgnushack-compile t)) + (defun dgnushack-compile (&optional warn) ;;(setq byte-compile-dynamic t) (unless warn @@ -335,134 +664,208 @@ Modify to suit your needs.")) (file-newer-than-file-p file elc)) (delete-file elc))) + ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet + ;; installed. + (when (featurep 'xemacs) + (setq gnus-xmas-glyph-directory "dummy")) + (let ((files dgnushack-exporting-files) ;;(byte-compile-generate-call-tree t) file elc) (while (setq file (pop files)) - (setq file (expand-file-name file srcdir)) - (when (or (not (file-exists-p - (setq elc (concat (file-name-nondirectory file) "c")))) - (file-newer-than-file-p file elc)) - (ignore-errors - (byte-compile-file file)))))) + (unless (member file dgnushack-dont-compile-files) + (setq file (expand-file-name file srcdir)) + (when (or (not (file-exists-p + (setq elc (concat (file-name-nondirectory file) "c")))) + (file-newer-than-file-p file elc)) + (ignore-errors + (byte-compile-file file))))))) (defun dgnushack-recompile () (require 'gnus) (byte-recompile-directory "." 0)) +(defvar dgnushack-gnus-load-file (expand-file-name "gnus-load.el" srcdir)) +(defvar dgnushack-cus-load-file (expand-file-name "cus-load.el" srcdir)) +(defvar dgnushack-auto-load-file (expand-file-name "auto-autoloads.el" srcdir)) + +(defun dgnushack-make-cus-load () + (when (condition-case nil + (load "cus-dep") + (error nil)) + (let ((cusload-base-file dgnushack-cus-load-file)) + (if (fboundp 'custom-make-dependencies) + (custom-make-dependencies) + (Custom-make-dependencies))))) + +(defun dgnushack-make-auto-load () + (require 'autoload) + (unless (make-autoload '(define-derived-mode child parent name + "docstring" body) + "file") + (defadvice make-autoload (around handle-define-derived-mode activate) + "Handle `define-derived-mode'." + (if (eq (car-safe (ad-get-arg 0)) 'define-derived-mode) + (setq ad-return-value + (list 'autoload + (list 'quote (nth 1 (ad-get-arg 0))) + (ad-get-arg 1) + (nth 4 (ad-get-arg 0)) + t nil)) + ad-do-it)) + (put 'define-derived-mode 'doc-string-elt 3)) + (let ((generated-autoload-file dgnushack-gnus-load-file) + (make-backup-files nil) + (autoload-package-name "gnus")) + (if (featurep 'xemacs) + (progn + (if (file-exists-p generated-autoload-file) + (delete-file generated-autoload-file)) + (if (file-exists-p dgnushack-auto-load-file) + (delete-file dgnushack-auto-load-file))) + (with-temp-file generated-autoload-file + (insert ?\014))) + (if (featurep 'xemacs) + (let ((si:message (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 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 + (batch-update-autoloads) + (fset 'message si:message))) + (batch-update-autoloads)))) + +(defun dgnushack-make-load () + (message (format "Generating %s..." dgnushack-gnus-load-file)) + (with-temp-file dgnushack-gnus-load-file + (if (file-exists-p dgnushack-cus-load-file) + (progn + (insert-file-contents dgnushack-cus-load-file) + (delete-file dgnushack-cus-load-file) + (goto-char (point-min)) + (search-forward ";;; Code:") + (forward-line) + (delete-region (point-min) (point)) + (unless (re-search-forward "\ +^[\t ]*(autoload[\t\n ]+\\('\\|(quote[\t\n ]+\\)custom-add-loads[\t\n ]" + nil t) + (insert "\n(autoload 'custom-add-loads \"cus-load\")\n")) + (goto-char (point-min)) + (insert "\ +;;; gnus-load.el --- automatically extracted custom dependencies and autoload +;; +;;; Code: +") + (goto-char (point-max)) + (if (search-backward "custom-versions-load-alist" nil t) + (forward-line -1) + (forward-line -1) + (while (eq (char-after) ?\;) + (forward-line -1)) + (forward-line)) + (delete-region (point) (point-max)) + (insert "\n")) + (insert "\ +;;; gnus-load.el --- automatically extracted autoload +;; +;;; Code: +")) + ;; smiley-* are duplicated. Remove them all. + (let ((point (point))) + (insert-file-contents dgnushack-gnus-load-file) + (goto-char point) + (while (search-forward "smiley-" nil t) + (beginning-of-line) + (if (looking-at "(autoload ") + (delete-region (point) (progn (forward-sexp) (point))) + (forward-line)))) + ;; + (goto-char (point-max)) + (when (search-backward "\n(provide " nil t) + (forward-line -1) + (delete-region (point) (point-max))) + (insert "\ + +\(provide 'gnus-load) + +;;; Local Variables: +;;; version-control: never +;;; no-byte-compile: t +;;; no-update-autoloads: t +;;; End: +;;; gnus-load.el ends here +") + ;; Workaround the bug in some version of XEmacs. + (when (featurep 'xemacs) + (condition-case nil + (require 'cus-load) + (error nil)) + (goto-char (point-min)) + (when (and (fboundp 'custom-add-loads) + (not (search-forward "\n(autoload 'custom-add-loads " nil t))) + (search-forward "\n;;; Code:" nil t) + (forward-line 1) + (insert "\n(autoload 'custom-add-loads \"cus-load\")\n")))) + (message (format "Compiling %s..." dgnushack-gnus-load-file)) + (byte-compile-file dgnushack-gnus-load-file)) + -(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 'ptexinfmt) - (let ((auto-save-default nil) - (find-file-run-dired nil) - coding-system-for-write - output-coding-system) - (let ((error 0) - file - (files ())) - (while command-line-args-left - (setq file (expand-file-name (car command-line-args-left))) - (cond ((not (file-exists-p file)) - (message ">> %s does not exist!" file) - (setq error 1 - command-line-args-left (cdr command-line-args-left))) - ((file-directory-p file) - (setq command-line-args-left - (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 (setq file (pop files)) - (condition-case err - (progn - (if buffer-file-name (kill-buffer (current-buffer))) - (find-file file) - (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)) - ;; formerly EMACSINFOHACK in texi/Makefile. - (while (re-search-forward "@\\(end \\)?ifnottex\n*" nil t) - (replace-match "")) - (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") - (goto-char (point-min))) - ;; process @include before updating node - ;; This might produce some problem if we use @lowersection or - ;; such. - (let ((input-directory default-directory) - (texinfo-command-end)) - (while (re-search-forward "^@include" nil t) - (setq texinfo-command-end (point)) - (let ((filename (concat input-directory - (texinfo-parse-line-arg)))) - (re-search-backward "^@include") - (delete-region (point) (save-excursion - (forward-line 1) - (point))) - (message "Reading included file: %s" filename) - (save-excursion - (save-restriction - (narrow-to-region - (point) - (+ (point) - (car (cdr (insert-file-contents filename))))) - (goto-char (point-min)) - ;; Remove `@setfilename' line from included file, - ;; if any, so @setfilename command not duplicated. - (if (re-search-forward "^@setfilename" - (save-excursion - (forward-line 100) - (point)) - t) - (progn - (beginning-of-line) - (delete-region (point) (save-excursion - (forward-line 1) - (point)))))))))) - (texinfo-mode) - (texinfo-every-node-update) - (set-buffer-modified-p nil) - (message "texinfo formatting %s..." file) - (texinfo-format-buffer nil) - (if (buffer-modified-p) - (progn (message "Saving modified %s" (buffer-file-name)) - (save-buffer)))) - (error - (message ">> Error: %s" (prin1-to-string err)) - (message ">> point at") - (let ((s (buffer-substring (point) - (min (+ (point) 100) - (point-max)))) - (tem 0)) - (while (setq tem (string-match "\n+" s tem)) - (setq s (concat (substring s 0 (match-beginning 0)) - "\n>> " - (substring s (match-end 0))) - tem (1+ tem))) - (message ">> %s" s)) - (setq error 1)))) - (kill-emacs error)))) +(defun dgnushack-compose-package () + "Re-split the file gnus-load.el into custom-load.el and +auto-autoloads.el. It is silly, should be improved!" + (message " +Re-splitting gnus-load.el into custom-load.el and auto-autoloads.el...") + (let ((customload (expand-file-name "custom-load.el" srcdir)) + (autoloads (expand-file-name "auto-autoloads.el" srcdir)) + start) + (with-temp-buffer + (insert-file-contents dgnushack-gnus-load-file) + (delete-file dgnushack-gnus-load-file) + (when (file-exists-p (concat dgnushack-gnus-load-file "c")) + (delete-file (concat dgnushack-gnus-load-file "c"))) + (while (prog1 + (looking-at "[\t ;]") + (forward-line 1))) + (setq start (point)) + (insert "\ +;;; custom-load.el --- automatically extracted custom dependencies\n +;;; Code:\n\n") + (goto-char (point-max)) + (while (progn + (forward-line -1) + (not (looking-at "[\t ]*(custom-add-loads[\t\n ]")))) + (forward-list 1) + (forward-line 1) + (insert "\n;;; custom-load.el ends here\n") + (write-region start (point) customload) + (while (looking-at "[\t ]*$") + (forward-line 1)) + (setq start (point)) + (if (re-search-forward "^[\t\n ]*(if[\t\n ]+(featurep[\t\n ]" nil t) + (let ((from (goto-char (match-beginning 0)))) + (delete-region from (progn + (forward-list 1) + (forward-line 1) + (point)))) + (while (looking-at "[\t ;]") + (forward-line 1))) + (insert "(if (featurep 'gnus-autoloads) (error \"Already loaded\"))\n") + (goto-char (point-max)) + (while (progn + (forward-line -1) + (not (looking-at "[\t ]*(provide[\t\n ]")))) + (insert "(provide 'gnus-autoloads)\n") + (write-region start (point) autoloads)) + (byte-compile-file customload) + (byte-compile-file autoloads)) + (message "\ +Re-splitting gnus-load.el into custom-load.el and auto-autoloads.el...done +\n")) (defconst dgnushack-info-file-regexp-en @@ -483,42 +886,6 @@ Modify to suit your needs.")) regexp) "Regexp matching Japanese info files.") -(defun dgnushack-make-autoloads () - "Make auto-autoloads.el, custom-load.el and then compile them." - (let ((auto-autoloads (expand-file-name "auto-autoloads.el" srcdir)) - (custom-load (expand-file-name "custom-load.el" srcdir))) - (unless (and (file-exists-p auto-autoloads) - (file-exists-p (concat auto-autoloads "c")) - (file-newer-than-file-p (concat auto-autoloads "c") - auto-autoloads) - (file-exists-p custom-load) - (file-exists-p (concat custom-load "c")) - (file-newer-than-file-p (concat custom-load "c") - custom-load)) - (let (make-backup-files) - (message "Updating autoloads for directory %s..." default-directory) - (let ((generated-autoload-file auto-autoloads) - (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) - (with-temp-buffer - (let ((standard-output (current-buffer))) - (Custom-make-dependencies ".")) - (message "%s" (buffer-string))) - (require 'cus-load) - (byte-compile-file custom-load))))) - (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/" @@ -527,6 +894,7 @@ Modify to suit your needs.")) "/") ;; PACKAGEDIR (car command-line-args-left)))) + (setq command-line-args-left nil) (when (file-directory-p lisp-dir) (let (files) (dolist (file dgnushack-exporting-files) @@ -541,11 +909,15 @@ Modify to suit your needs.")) (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)) + (let* ((package-dir (pop command-line-args-left)) + (product-name (pop command-line-args-left)) + (pkginfo-dir (expand-file-name "pkginfo" package-dir)) + (name (expand-file-name (concat "MANIFEST." product-name) + pkginfo-dir)) make-backup-files) + (unless (file-directory-p pkginfo-dir) + (message "Creating directory %s/..." pkginfo-dir) + (make-directory pkginfo-dir)) (message "Generating %s..." name) (with-temp-file name (insert "pkginfo/MANIFEST." product-name "\n") diff --git a/lisp/earcon.el b/lisp/earcon.el index 7c42e8b..e9691e1 100644 --- a/lisp/earcon.el +++ b/lisp/earcon.el @@ -1,6 +1,6 @@ ;;; earcon.el --- Sound effects for messages -;; Copyright (C) 1996, 2000 Free Software Foundation +;; Copyright (C) 1996, 2000, 2001, 2003 Free Software Foundation ;; Author: Steven L. Baur @@ -35,11 +35,6 @@ "Turn ** sounds ** into noise." :group 'gnus-visual) -(defcustom earcon-auto-play nil - "*When True, automatically play sounds as well as buttonize them." - :type 'boolean - :group 'earcon) - (defcustom earcon-prefix "**" "*String denoting the start of an earcon." :type 'string @@ -55,7 +50,7 @@ ("evil[ \t]+laugh" 1 "Evil_Laugh.au") ("gag\\|puke" 1 "Puke.au") ("snicker" 1 "Snicker.au") - ("meow" 1 "catmeow.au") + ("meow" 1 "catmeow.wav") ("sob\\|boohoo" 1 "cry.wav") ("drum[ \t]*roll" 1 "drumroll.au") ("blast" 1 "explosion.au") @@ -83,7 +78,7 @@ call it with the value of the `earcon-data' text property." (interactive "e") (set-buffer (window-buffer (posn-window (event-start event)))) (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'earcon-data)) + (data (get-text-property pos 'earcon-data)) (fun (get-text-property pos 'earcon-callback))) (if fun (funcall fun data)))) diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index 64946f9..987113d 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -1,6 +1,6 @@ ;;; flow-fill.el --- interprete RFC2646 "flowed" text -;; Copyright (C) 2000 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: mail @@ -35,32 +35,71 @@ ;; paragraph and we let `fill-region' fill the long line into several ;; lines with the quote prefix as `fill-prefix'. -;; Todo: encoding, implement basic `fill-region' (Emacs and XEmacs +;; Todo: implement basic `fill-region' (Emacs and XEmacs ;; implementations differ..) -;; History: +;;; 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-03-26 committed to gnus cvs ;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule ;; work when first line is at level 0. +;; 2002-01-12 probably incomplete encoding support ;;; Code: (eval-when-compile (require 'cl)) +(defcustom fill-flowed-display-column 'fill-column + "Column beyond which format=flowed lines are wrapped, when displayed. +This can be a lisp expression or an integer." + :type '(choice (const :tag "Standard `fill-column'" fill-column) + (const :tag "Fit Window" (- (window-width) 5)) + (sexp) + (integer))) + +(defcustom fill-flowed-encode-column 66 + "Column beyond which format=flowed lines are wrapped, in outgoing messages. +This can be a lisp expression or an integer. +RFC 2646 suggests 66 characters for readability." + :type '(choice (const :tag "Standard fill-column" fill-column) + (const :tag "RFC 2646 default (66)" 66) + (sexp) + (integer))) + (eval-and-compile (defalias 'fill-flowed-point-at-bol - (if (fboundp 'point-at-bol) - 'point-at-bol - 'line-beginning-position)) - - (defalias 'fill-flowed-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) + (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-encode (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + ;; No point in doing this unless hard newlines is used. + (when use-hard-newlines + (let ((start (point-min)) end) + ;; Go through each paragraph, filling it and adding SPC + ;; as the last character on each line. + (while (setq end (text-property-any start (point-max) 'hard 't)) + (let ((fill-column (eval fill-flowed-encode-column))) + (fill-region start end t 'nosqueeze 'to-eop)) + (goto-char start) + ;; `fill-region' probably distorted end. + (setq end (text-property-any start (point-max) 'hard 't)) + (while (and (< (point) end) + (re-search-forward "$" (1- end) t)) + (insert " ") + (setq end (1+ end)) + (forward-char)) + (goto-char (setq start (1+ end))))) + t))) (defun fill-flowed (&optional buffer) (save-excursion @@ -70,7 +109,8 @@ (when (save-excursion (beginning-of-line) (looking-at "^\\(>*\\)\\( ?\\)")) - (let ((quote (match-string 1)) sig) + (let ((quote (match-string 1)) + sig) (if (string= quote "") (setq quote nil)) (when (and quote (string= (match-string 2) "")) @@ -79,6 +119,7 @@ (beginning-of-line) (when (> (skip-chars-forward ">") 0) (insert " ")))) + ;; XXX slightly buggy handling of "-- " (while (and (save-excursion (ignore-errors (backward-char 3)) (setq sig (looking-at "-- ")) @@ -86,17 +127,25 @@ (save-excursion (unless (eobp) (forward-char 1) - (looking-at (format "^\\(%s\\)\\([^>]\\)" (or quote " ?")))))) + (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)))))))) + (condition-case nil + (let ((fill-prefix (when quote (concat quote " "))) + (fill-column (eval fill-flowed-display-column)) + filladapt-mode) + (fill-region (fill-flowed-point-at-bol) + (min (1+ (fill-flowed-point-at-eol)) + (point-max)) + 'left 'nosqueeze)) + (error + (forward-line 1) + nil)))))))) (provide 'flow-fill) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 852a525..247de0a 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,5 +1,6 @@ ;;; gnus-agent.el --- unplugged support for Semi-gnus -;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Tatsuya Ichikawa @@ -29,15 +30,23 @@ (require 'gnus) (require 'gnus-cache) +(require 'nnmail) (require 'nnvirtual) (require 'gnus-sum) (require 'gnus-score) +(require 'gnus-srvr) +(require 'gnus-util) (eval-when-compile (if (featurep 'xemacs) (require 'itimer) (require 'timer)) (require 'gnus-group)) +(eval-and-compile + (autoload 'gnus-server-update-server "gnus-srvr") + (autoload 'gnus-agent-customize-category "gnus-cus") +) + (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") "Where the Gnus agent will store its files." :group 'gnus-agent @@ -53,15 +62,23 @@ :group 'gnus-agent :type 'hook) +(defcustom gnus-agent-fetched-hook nil + "Hook run when finished fetching articles." + :group 'gnus-agent + :type 'hook) + (defcustom gnus-agent-handle-level gnus-level-subscribed "Groups on levels higher than this variable will be ignored by the Agent." :group 'gnus-agent :type 'integer) (defcustom gnus-agent-expire-days 7 - "Read articles older than this will be expired." + "Read articles older than this will be expired. +This can also be a list of regexp/day pairs. The regexps will be +matched against group names." :group 'gnus-agent - :type 'integer) + :type '(choice (number :tag "days") + (sexp :tag "List" nil))) (defcustom gnus-agent-expire-all nil "If non-nil, also expire unread, ticked and dormant articles. @@ -74,18 +91,31 @@ If nil, only read articles will be expired." :group 'gnus-agent :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add)) + (defcustom gnus-agent-summary-mode-hook nil "Hook run in Agent summary minor modes." :group 'gnus-agent :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add)) + (defcustom gnus-agent-server-mode-hook nil "Hook run in Agent summary minor modes." :group 'gnus-agent :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add)) + (defcustom gnus-agent-confirmation-function 'y-or-n-p "Function to confirm when error happens." + :version "21.1" :group 'gnus-agent :type 'function) @@ -100,18 +130,78 @@ fetched will be limited to it. If not a positive integer, never consider it." (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) + +(defcustom gnus-agent-go-online 'ask + "Indicate if offline servers go online when you plug in. +If this is `ask' the hook will query the user." + :version "21.1" :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask)) :group 'gnus-agent) +(defcustom gnus-agent-mark-unread-after-downloaded t + "Indicate whether to mark articles unread after downloaded." + :version "21.1" + :type 'boolean + :group 'gnus-agent) + +(defcustom gnus-agent-download-marks '(download) + "Marks for downloading." + :version "21.1" + :type '(repeat (symbol :tag "Mark")) + :group 'gnus-agent) + +(defcustom gnus-agent-consider-all-articles nil + "If non-nil, consider also the read articles for downloading." + :version "21.4" + :type 'boolean + :group 'gnus-agent) + +(defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb + "Chunk size for `gnus-agent-fetch-session'. +The function will split its article fetches into chunks smaller than +this limit." + :group 'gnus-agent + :type 'integer) + +(defcustom gnus-agent-enable-expiration 'ENABLE + "The default expiration state for each group. +When set to ENABLE, the default, `gnus-agent-expire' will expire old +contents from a group's local storage. This value may be overridden +to disable expiration in specific categories, topics, and groups. Of +course, you could change gnus-agent-enable-expiration to DISABLE then +enable expiration per categories, topics, and groups." + :group 'gnus-agent + :type '(radio (const :format "Enable " ENABLE) + (const :format "Disable " DISABLE))) + +(defcustom gnus-agent-expire-unagentized-dirs t +"Have gnus-agent-expire scan the directories under +\(gnus-agent-directory) for groups that are no longer agentized. When +found, offer to remove them.") + ;;; Internal variables (defvar gnus-agent-history-buffers nil) (defvar gnus-agent-buffer-alist nil) -(defvar gnus-agent-article-alist nil) +(defvar gnus-agent-article-alist nil + "An assoc list identifying the articles whose headers have been fetched. +If successfully fetched, these headers will be stored in the group's overview +file. The key of each assoc pair is the article ID, the value of each assoc +pair is a flag indicating whether the identified article has been downloaded +\(gnus-agent-fetch-articles sets the value to the day of the download). +NOTES: +1) The last element of this list can not be expired as some + routines (for example, get-agent-fetch-headers) use the last + value to track which articles have had their headers retrieved. +2) The function `gnus-agent-regenerate' may destructively modify the value.") (defvar gnus-agent-group-alist nil) -(defvar gnus-agent-covered-methods nil) (defvar gnus-category-alist nil) (defvar gnus-agent-current-history nil) (defvar gnus-agent-overview-buffer nil) @@ -121,6 +211,13 @@ If this is `ask' the hook will query the user." (defvar gnus-agent-file-name nil) (defvar gnus-agent-send-mail-function nil) (defvar gnus-agent-file-coding-system 'raw-text) +(defvar gnus-agent-file-loading-cache nil) +(defvar gnus-agent-file-header-cache nil) + +(defvar gnus-agent-auto-agentize-methods '(nntp nnimap) + "Initially, all servers from these methods are agentized. +The user may remove or add servers using the Server buffer. See Info +node `(gnus)Server Buffer'.") ;; Dynamic variables (defvar gnus-headers) @@ -151,8 +248,7 @@ If this is `ask' the hook will query the user." (gnus-add-shutdown 'gnus-close-agent 'gnus) (defun gnus-close-agent () - (setq gnus-agent-covered-methods nil - gnus-category-predicate-cache nil + (setq gnus-category-predicate-cache nil gnus-category-group-cache nil gnus-agent-spam-hashtb nil) (gnus-kill-buffer gnus-agent-overview-buffer)) @@ -176,26 +272,128 @@ If this is `ask' the hook will query the user." (cadr gnus-command-method)))) (defsubst gnus-agent-directory () - "Path of the Gnus agent directory." + "The name of the Gnus agent directory." (nnheader-concat gnus-agent-directory (nnheader-translate-file-chars (gnus-agent-method)) "/")) (defun gnus-agent-lib-file (file) - "The full path of the Gnus agent library FILE." - (concat (gnus-agent-directory) "agent.lib/" file)) + "The full name of the Gnus agent library FILE." + (expand-file-name file + (file-name-as-directory + (expand-file-name "agent.lib" (gnus-agent-directory))))) + +(defun gnus-agent-cat-set-property (category property value) + (if value + (setcdr (or (assq property category) + (let ((cell (cons property nil))) + (setcdr category (cons cell (cdr category))) + cell)) value) + (let ((category category)) + (while (cond ((eq property (caadr category)) + (setcdr category (cddr category)) + nil) + (t + (setq category (cdr category))))))) + category) + +(eval-when-compile + (defmacro gnus-agent-cat-defaccessor (name prop-name) + "Define accessor and setter methods for manipulating a list of the form +\(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)). +Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be +manipulated as follows: + (func LIST): Returns VALUE1 + (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1." + `(progn (defmacro ,name (category) + (list (quote cdr) (list (quote assq) + (quote (quote ,prop-name)) category))) + + (define-setf-method ,name (category) + (let* ((--category--temp-- (make-symbol "--category--")) + (--value--temp-- (make-symbol "--value--"))) + (list (list --category--temp--) ; temporary-variables + (list category) ; value-forms + (list --value--temp--) ; store-variables + (let* ((category --category--temp--) ; store-form + (value --value--temp--)) + (list (quote gnus-agent-cat-set-property) + category + (quote (quote ,prop-name)) + value)) + (list (quote ,name) --category--temp--) ; access-form + ))))) + + (defmacro gnus-agent-cat-name (category) + `(car ,category)) + ) + +(gnus-agent-cat-defaccessor + gnus-agent-cat-days-until-old agent-days-until-old) +(gnus-agent-cat-defaccessor + gnus-agent-cat-enable-expiration agent-enable-expiration) +(gnus-agent-cat-defaccessor + gnus-agent-cat-groups agent-groups) +(gnus-agent-cat-defaccessor + gnus-agent-cat-high-score agent-high-score) +(gnus-agent-cat-defaccessor + gnus-agent-cat-length-when-long agent-length-when-long) +(gnus-agent-cat-defaccessor + gnus-agent-cat-length-when-short agent-length-when-short) +(gnus-agent-cat-defaccessor + gnus-agent-cat-low-score agent-low-score) +(gnus-agent-cat-defaccessor + gnus-agent-cat-predicate agent-predicate) +(gnus-agent-cat-defaccessor + gnus-agent-cat-score-file agent-score-file) + +(eval-when-compile + (defsetf gnus-agent-cat-groups (category) (groups) + (list 'gnus-agent-set-cat-groups category groups))) + +(defun gnus-agent-set-cat-groups (category groups) + (unless (eq groups 'ignore) + (let ((new-g groups) + (old-g (gnus-agent-cat-groups category))) + (cond ((eq new-g old-g) + ;; gnus-agent-add-group is fiddling with the group + ;; list. Still, Im done. + nil + ) + ((eq new-g (cdr old-g)) + ;; gnus-agent-add-group is fiddling with the group list + (setcdr (or (assq 'agent-groups category) + (let ((cell (cons 'agent-groups nil))) + (setcdr category (cons cell (cdr category))) + cell)) new-g)) + (t + (let ((groups groups)) + (while groups + (let* ((group (pop groups)) + (old-category (gnus-group-category group))) + (if (eq category old-category) + nil + (setf (gnus-agent-cat-groups old-category) + (delete group (gnus-agent-cat-groups + old-category)))))) + ;; Purge cache as preceeding loop invalidated it. + (setq gnus-category-group-cache nil)) + + (setcdr (or (assq 'agent-groups category) + (let ((cell (cons 'agent-groups nil))) + (setcdr category (cons cell (cdr category))) + cell)) groups)))))) + +(defsubst gnus-agent-cat-make (name &optional default-agent-predicate) + (list name `(agent-predicate . ,(or default-agent-predicate 'false)))) ;;; Fetching setup functions. (defun gnus-agent-start-fetch () "Initialize data structures for efficient fetching." - (gnus-agent-open-history) - (setq gnus-agent-current-history (gnus-agent-history-buffer)) (gnus-agent-create-buffer)) (defun gnus-agent-stop-fetch () "Save all data structures and clean up." - (gnus-agent-save-history) - (gnus-agent-close-history) (setq gnus-agent-spam-hashtb nil) (save-excursion (set-buffer nntp-server-buffer) @@ -212,6 +410,13 @@ If this is `ask' the hook will query the user." (put 'gnus-agent-with-fetch 'lisp-indent-function 0) (put 'gnus-agent-with-fetch 'edebug-form-spec '(body)) +(defmacro gnus-agent-append-to-list (tail value) + `(setq ,tail (setcdr ,tail (cons ,value nil)))) + +(defmacro gnus-agent-message (level &rest args) + `(if (<= ,level gnus-verbose) + (message ,@args))) + ;;; ;;; Mode infestation ;;; @@ -241,7 +446,13 @@ If this is `ask' the hook will query the user." buffer)))) minor-mode-map-alist)) (when (eq major-mode 'gnus-group-mode) - (gnus-agent-toggle-plugged gnus-plugged)) + (let ((init-plugged gnus-plugged) + (gnus-agent-go-online nil)) + ;; g-a-t-p does nothing when gnus-plugged isn't changed. + ;; Therefore, make certain that the current value does not + ;; match the desired initial value. + (setq gnus-plugged :unknown) + (gnus-agent-toggle-plugged init-plugged))) (gnus-run-hooks 'gnus-agent-mode-hook (intern (format "gnus-agent-%s-mode-hook" buffer))))) @@ -252,9 +463,10 @@ If this is `ask' the hook will query the user." "Jj" gnus-agent-toggle-plugged "Js" gnus-agent-fetch-session "JY" gnus-agent-synchronize-flags - "JS" gnus-group-send-drafts + "JS" gnus-group-send-queue "Ja" gnus-agent-add-group - "Jr" gnus-agent-remove-group) + "Jr" gnus-agent-remove-group + "Jo" gnus-agent-toggle-group-plugged) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -262,15 +474,23 @@ If this is `ask' the hook will query the user." gnus-agent-group-menu gnus-agent-group-mode-map "" '("Agent" ["Toggle plugged" gnus-agent-toggle-plugged t] + ["Toggle group plugged" gnus-agent-toggle-group-plugged t] ["List categories" gnus-enter-category-buffer t] - ["Send drafts" gnus-group-send-drafts gnus-plugged] + ["Add (current) group to category" gnus-agent-add-group t] + ["Remove (current) group from category" gnus-agent-remove-group t] + ["Send queue" gnus-group-send-queue gnus-plugged] ("Fetch" ["All" gnus-agent-fetch-session gnus-plugged] - ["Group" gnus-agent-fetch-group gnus-plugged]))))) + ["Group" gnus-agent-fetch-group gnus-plugged]) + ["Synchronize flags" gnus-agent-synchronize-flags t] + )))) (defvar gnus-agent-summary-mode-map (make-sparse-keymap)) (gnus-define-keys gnus-agent-summary-mode-map "Jj" gnus-agent-toggle-plugged + "Ju" gnus-agent-summary-fetch-group + "JS" gnus-agent-fetch-group + "Js" gnus-agent-summary-fetch-series "J#" gnus-agent-mark-article "J\M-#" gnus-agent-unmark-article "@" gnus-agent-toggle-mark @@ -285,6 +505,7 @@ If this is `ask' the hook will query the user." ["Mark as downloadable" gnus-agent-mark-article t] ["Unmark as downloadable" gnus-agent-unmark-article t] ["Toggle mark" gnus-agent-toggle-mark t] + ["Fetch downloadable" gnus-agent-summary-fetch-group t] ["Catchup undownloaded" gnus-agent-catchup t])))) (defvar gnus-agent-server-mode-map (make-sparse-keymap)) @@ -302,20 +523,47 @@ If this is `ask' the hook will query the user." ["Add" gnus-agent-add-server t] ["Remove" gnus-agent-remove-server t])))) -(defun gnus-agent-toggle-plugged (plugged) +(defun gnus-agent-make-mode-line-string (string mouse-button mouse-func) + (if (and (fboundp 'propertize) + (fboundp 'make-mode-line-mouse-map)) + (propertize string 'local-map + (make-mode-line-mouse-map mouse-button mouse-func)) + string)) + +(defun gnus-agent-toggle-plugged (set-to) "Toggle whether Gnus is unplugged or not." (interactive (list (not gnus-plugged))) - (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) - (setq gnus-plugged plugged) - (gnus-run-hooks 'gnus-agent-unplugged-hook) - (setcar (cdr gnus-agent-mode-status) " Unplugged")) - (force-mode-line-update)) + (cond ((eq set-to gnus-plugged) + nil) + (set-to + (setq gnus-plugged set-to) + (gnus-run-hooks 'gnus-agent-plugged-hook) + (setcar (cdr gnus-agent-mode-status) + (gnus-agent-make-mode-line-string " Plugged" + 'mouse-2 + 'gnus-agent-toggle-plugged)) + (gnus-agent-go-online gnus-agent-go-online) + (gnus-agent-possibly-synchronize-flags)) + (t + (gnus-agent-close-connections) + (setq gnus-plugged set-to) + (gnus-run-hooks 'gnus-agent-unplugged-hook) + (setcar (cdr gnus-agent-mode-status) + (gnus-agent-make-mode-line-string " Unplugged" + 'mouse-2 + 'gnus-agent-toggle-plugged)))) + (force-mode-line-update) + (set-buffer-modified-p t)) + +(defmacro gnus-agent-while-plugged (&rest body) + `(let ((original-gnus-plugged gnus-plugged)) + (unwind-protect + (progn (gnus-agent-toggle-plugged t) + ,@body) + (gnus-agent-toggle-plugged original-gnus-plugged)))) + +(put 'gnus-agent-while-plugged 'lisp-indent-function 0) +(put 'gnus-agent-while-plugged 'edebug-form-spec '(body)) (defun gnus-agent-close-connections () "Close all methods covered by the Gnus agent." @@ -338,6 +586,13 @@ If this is `ask' the hook will query the user." (gnus)) ;;;###autoload +(defun gnus-slave-unplugged (&optional arg) + "Read news as a slave unplugged." + (interactive "P") + (setq gnus-plugged nil) + (gnus arg nil 'slave)) + +;;;###autoload (defun gnus-agentize () "Allow Gnus to be an offline newsreader. The normal usage of this command is to put the following as the @@ -345,26 +600,40 @@ last form in your `.gnus.el' file: \(gnus-agentize) -This will modify the `gnus-before-startup-hook', `gnus-post-method', -and `message-send-mail-function' variables, and install the Gnus -agent minor mode in all Gnus buffers." +This will modify the `gnus-setup-news-hook', and +`message-send-mail-real-function' variables, and install the Gnus agent +minor mode in all Gnus buffers." (interactive) (gnus-open-agent) (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup) (unless gnus-agent-send-mail-function - (setq gnus-agent-send-mail-function message-send-mail-function - message-send-mail-function 'gnus-agent-send-mail)) - (unless gnus-agent-covered-methods - (setq gnus-agent-covered-methods (list gnus-select-method)))) + (setq gnus-agent-send-mail-function + (or message-send-mail-real-function + message-send-mail-function) + message-send-mail-real-function 'gnus-agent-send-mail)) -(defun gnus-agent-queue-setup () - "Make sure the queue group exists." - (unless (gnus-gethash "nndraft:queue" gnus-newsrc-hashtb) - (gnus-request-create-group "queue" '(nndraft "")) + (unless gnus-agent-covered-methods + (mapcar + (lambda (server) + (if (memq (car (gnus-server-to-method server)) + gnus-agent-auto-agentize-methods) + (setq gnus-agent-covered-methods + (cons (gnus-server-to-method server) + gnus-agent-covered-methods )))) + (append (list gnus-select-method) gnus-secondary-select-methods)))) + +(defun gnus-agent-queue-setup (&optional group-name) + "Make sure the queue group exists. +Optional arg GROUP-NAME allows to specify another group." + (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue")) + gnus-newsrc-hashtb) + (gnus-request-create-group (or group-name "queue") '(nndraft "")) (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group "nndraft:queue" nil '(nndraft ""))) + (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue")) + nil '(nndraft ""))) (gnus-group-set-parameter - "nndraft:queue" 'gnus-dummy '((gnus-draft-mode))))) + (format "nndraft:%s" (or group-name "queue")) + 'gnus-dummy '((gnus-draft-mode))))) (defun gnus-agent-send-mail () (if gnus-plugged @@ -378,7 +647,7 @@ agent minor mode in all Gnus buffers." (defun gnus-agent-insert-meta-information (type &optional method) "Insert meta-information into the message that says how it's to be posted. -TYPE can be either `mail' or `news'. If the latter METHOD can +TYPE can be either `mail' or `news'. If the latter, then METHOD can be a select method." (save-excursion (message-remove-header gnus-agent-meta-information-header) @@ -408,11 +677,11 @@ be a select method." gcc " ,"))))) covered) (while (and (not covered) methods) - (setq covered - (member (car methods) gnus-agent-covered-methods) + (setq covered (gnus-agent-method-p (car methods)) methods (cdr methods))) covered))) +;;;###autoload (defun gnus-agent-possibly-save-gcc () "Save GCC if Gnus is unplugged." (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc)) @@ -438,17 +707,18 @@ be a select method." (error "Groups can't be fetched when Gnus is unplugged")) (gnus-group-iterate n 'gnus-agent-fetch-group)) -(defun gnus-agent-fetch-group (group) +(defun gnus-agent-fetch-group (&optional group) "Put all new articles in GROUP into the Agent." (interactive (list (gnus-group-group-name))) - (unless gnus-plugged - (error "Groups can't be fetched when Gnus is unplugged")) + (setq group (or group gnus-newsgroup-name)) (unless group (error "No group on the current line")) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (gnus-agent-with-fetch - (gnus-agent-fetch-group-1 group gnus-command-method) - (gnus-message 5 "Fetching %s...done" group)))) + + (gnus-agent-while-plugged + (let ((gnus-command-method (gnus-find-method-for-group group))) + (gnus-agent-with-fetch + (gnus-agent-fetch-group-1 group gnus-command-method) + (gnus-message 5 "Fetching %s...done" group))))) (defun gnus-agent-add-group (category arg) "Add the current group to an agent category." @@ -465,10 +735,12 @@ be a select method." c groups) (gnus-group-iterate arg (lambda (group) - (when (cadddr (setq c (gnus-group-category group))) - (setf (cadddr c) (delete group (cadddr c)))) + (when (gnus-agent-cat-groups (setq c (gnus-group-category group))) + (setf (gnus-agent-cat-groups c) + (delete group (gnus-agent-cat-groups c)))) (push group groups))) - (setf (cadddr cat) (nconc (cadddr cat) groups)) + (setf (gnus-agent-cat-groups cat) + (nconc (gnus-agent-cat-groups cat) groups)) (gnus-category-write))) (defun gnus-agent-remove-group (arg) @@ -477,8 +749,9 @@ be a select method." (let (c) (gnus-group-iterate arg (lambda (group) - (when (cadddr (setq c (gnus-group-category group))) - (setf (cadddr c) (delete group (cadddr c)))))) + (when (gnus-agent-cat-groups (setq c (gnus-group-category group))) + (setf (gnus-agent-cat-groups c) + (delete group (gnus-agent-cat-groups c)))))) (gnus-category-write))) (defun gnus-agent-synchronize-flags () @@ -505,11 +778,10 @@ be a select method." (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)) + (gnus-message 1 "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)) + (gnus-delete-line) (write-file (gnus-agent-lib-file "flags")) (error "Couldn't set flags from file %s" (gnus-agent-lib-file "flags")))) @@ -535,11 +807,12 @@ be a select method." (unless server (error "No server on the current line")) (let ((method (gnus-server-get-method nil (gnus-server-server-name)))) - (when (member method gnus-agent-covered-methods) + (when (gnus-agent-method-p method) (error "Server already in the agent program")) (push method gnus-agent-covered-methods) + (gnus-server-update-server server) (gnus-agent-write-servers) - (message "Entered %s into the Agent" server))) + (gnus-message 1 "Entered %s into the Agent" server))) (defun gnus-agent-remove-server (server) "Remove SERVER from the agent program." @@ -547,18 +820,27 @@ be a select method." (unless server (error "No server on the current line")) (let ((method (gnus-server-get-method nil (gnus-server-server-name)))) - (unless (member method gnus-agent-covered-methods) + (unless (gnus-agent-method-p method) (error "Server not in the agent program")) (setq gnus-agent-covered-methods (delete method gnus-agent-covered-methods)) + (gnus-server-update-server server) (gnus-agent-write-servers) - (message "Removed %s from the agent" server))) + (gnus-message 1 "Removed %s from the agent" server))) (defun gnus-agent-read-servers () "Read the alist of covered servers." - (setq gnus-agent-covered-methods - (gnus-agent-read-file - (nnheader-concat gnus-agent-directory "lib/servers")))) + (mapcar (lambda (m) + (let ((method (gnus-server-get-method + nil + (or m "native")))) + (if method + (unless (member method gnus-agent-covered-methods) + (push method gnus-agent-covered-methods)) + (gnus-message 1 "Ignoring disappeared server `%s'" m) + (sit-for 1)))) + (gnus-agent-read-file + (nnheader-concat gnus-agent-directory "lib/servers")))) (defun gnus-agent-write-servers () "Write the alist of covered servers." @@ -568,7 +850,8 @@ be a select method." (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))))) + (prin1 (mapcar 'gnus-method-simplify gnus-agent-covered-methods) + (current-buffer))))) ;;; ;;; Summary commands @@ -610,60 +893,186 @@ the actual number of articles toggled is returned." (gnus-agent-mark-article n 'toggle)) (defun gnus-summary-set-agent-mark (article &optional unmark) - "Mark ARTICLE as downloadable." - (let ((unmark (if (and (not (null unmark)) (not (eq t unmark))) - (memq article gnus-newsgroup-downloadable) - unmark))) - (if unmark - (progn - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - (push article gnus-newsgroup-undownloaded)) - (setq gnus-newsgroup-undownloaded - (delq article gnus-newsgroup-undownloaded)) - (push article gnus-newsgroup-downloadable)) - (gnus-summary-update-mark - (if unmark gnus-undownloaded-mark gnus-downloadable-mark) - 'unread))) + "Mark ARTICLE as downloadable. If UNMARK is nil, article is marked. +When UNMARK is t, the article is unmarked. For any other value, the +article's mark is toggled." + (let ((unmark (cond ((eq nil unmark) + nil) + ((eq t unmark) + t) + (t + (memq article gnus-newsgroup-downloadable))))) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-mark + (if unmark + (progn + (setq gnus-newsgroup-downloadable + (delq article gnus-newsgroup-downloadable)) + (gnus-article-mark article)) + (progn + (setq gnus-newsgroup-downloadable + (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)) + gnus-downloadable-mark) + ) + 'unread)))) (defun gnus-agent-get-undownloaded-list () - "Mark all unfetched articles as read." + "Construct list of articles that have not been downloaded." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (and (not gnus-plugged) - (gnus-agent-method-p gnus-command-method)) - (gnus-agent-load-alist gnus-newsgroup-name) - ;; First mark all undownloaded articles as undownloaded. - (let ((articles (append gnus-newsgroup-unreads - gnus-newsgroup-marked - gnus-newsgroup-dormant)) - article) - (while (setq article (pop articles)) - (unless (or (cdr (assq article gnus-agent-article-alist)) - (memq article gnus-newsgroup-downloadable) - (memq article gnus-newsgroup-cached)) - (push article gnus-newsgroup-undownloaded)))) - ;; Then mark downloaded downloadable as not-downloadable, - ;; if you get my drift. - (let ((articles gnus-newsgroup-downloadable) - article) - (while (setq article (pop articles)) - (when (cdr (assq article gnus-agent-article-alist)) - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)))))))) + (when (set (make-local-variable 'gnus-newsgroup-agentized) + (gnus-agent-method-p gnus-command-method)) + (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name)) + (headers (sort (mapcar (lambda (h) + (mail-header-number h)) + gnus-newsgroup-headers) '<)) + (cached (and gnus-use-cache gnus-newsgroup-cached)) + (undownloaded (list nil)) + (tail-undownloaded undownloaded) + (unfetched (list nil)) + (tail-unfetched unfetched)) + (while (and alist headers) + (let ((a (caar alist)) + (h (car headers))) + (cond ((< a h) + ;; Ignore IDs in the alist that are not being + ;; displayed in the summary. + (setq alist (cdr alist))) + ((> a h) + ;; Headers that are not in the alist should be + ;; fictious (see nnagent-retrieve-headers); they + ;; imply that this article isn't in the agent. + (gnus-agent-append-to-list tail-undownloaded h) + (gnus-agent-append-to-list tail-unfetched h) + (setq headers (cdr headers))) + ((cdar alist) + (setq alist (cdr alist)) + (setq headers (cdr headers)) + nil ; ignore already downloaded + ) + (t + (setq alist (cdr alist)) + (setq headers (cdr headers)) + + ;; This article isn't in the agent. Check to see + ;; if it is in the cache. If it is, it's been + ;; downloaded. + (while (and cached (< (car cached) a)) + (setq cached (cdr cached))) + (unless (equal a (car cached)) + (gnus-agent-append-to-list tail-undownloaded a)))))) + + (while headers + (let ((num (pop headers))) + (gnus-agent-append-to-list tail-undownloaded num) + (gnus-agent-append-to-list tail-unfetched num))) + + (setq gnus-newsgroup-undownloaded (cdr undownloaded) + gnus-newsgroup-unfetched (cdr unfetched)))))) (defun gnus-agent-catchup () - "Mark all undownloaded articles as read." + "Mark as read all unhandled articles. +An article is unhandled if it is neither cached, nor downloaded, nor +downloadable." (interactive) (save-excursion - (while gnus-newsgroup-undownloaded - (gnus-summary-mark-article - (pop gnus-newsgroup-undownloaded) gnus-catchup-mark))) - (gnus-summary-position-point)) + (let ((articles gnus-newsgroup-undownloaded)) + (when (or gnus-newsgroup-downloadable + gnus-newsgroup-cached) + (setq articles (gnus-sorted-ndifference + (gnus-sorted-ndifference + (gnus-copy-sequence articles) + gnus-newsgroup-downloadable) + gnus-newsgroup-cached))) + + (while articles + (gnus-summary-mark-article + (pop articles) gnus-catchup-mark))) + (gnus-summary-position-point))) + +(defun gnus-agent-summary-fetch-series () + (interactive) + (when gnus-newsgroup-processable + (setq gnus-newsgroup-downloadable + (let* ((dl gnus-newsgroup-downloadable) + (gnus-newsgroup-downloadable + (sort (gnus-copy-sequence gnus-newsgroup-processable) '<)) + (fetched-articles (gnus-agent-summary-fetch-group))) + ;; The preceeding call to (gnus-agent-summary-fetch-group) + ;; updated gnus-newsgroup-downloadable to remove each + ;; article successfully fetched. + + ;; For each article that I processed, remove its + ;; processable mark IF the article is no longer + ;; downloadable (i.e. it's already downloaded) + (dolist (article gnus-newsgroup-processable) + (unless (memq article gnus-newsgroup-downloadable) + (gnus-summary-remove-process-mark article))) + (gnus-sorted-ndifference dl fetched-articles))))) + +(defun gnus-agent-summary-fetch-group (&optional all) + "Fetch the downloadable articles in the group. +Optional arg ALL, if non-nil, means to fetch all articles." + (interactive "P") + (let ((articles + (if all gnus-newsgroup-articles + gnus-newsgroup-downloadable)) + (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)) + fetched-articles) + (gnus-agent-while-plugged + (unless articles + (error "No articles to download")) + (gnus-agent-with-fetch + (setq gnus-newsgroup-undownloaded + (gnus-sorted-ndifference + gnus-newsgroup-undownloaded + (setq fetched-articles + (gnus-agent-fetch-articles + gnus-newsgroup-name articles))))) + (save-excursion + (dolist (article articles) + (let ((was-marked-downloadable + (memq article gnus-newsgroup-downloadable))) + (cond (gnus-agent-mark-unread-after-downloaded + (setq gnus-newsgroup-downloadable + (delq article gnus-newsgroup-downloadable)) + + ;; The downloadable mark is implemented as a + ;; type of read mark. Therefore, marking the + ;; article as unread is sufficient to clear + ;; its downloadable flag. + (gnus-summary-mark-article article gnus-unread-mark)) + (was-marked-downloadable + (gnus-summary-set-agent-mark article t))) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-download-mark article)))))) + fetched-articles)) + +(defun gnus-agent-fetch-selected-article () + "Fetch the current article as it is selected. +This can be added to `gnus-select-article-hook' or +`gnus-mark-article-hook'." + (let ((gnus-command-method gnus-current-select-method)) + (when (and gnus-plugged (gnus-agent-method-p gnus-command-method)) + (when (gnus-agent-fetch-articles + gnus-newsgroup-name + (list gnus-current-article)) + (setq gnus-newsgroup-undownloaded + (delq gnus-current-article gnus-newsgroup-undownloaded)) + (gnus-summary-update-download-mark gnus-current-article))))) ;;; ;;; Internal functions ;;; +;;; NOTES: +;;; The agent's active range is defined as follows: +;;; If the agent has no record of the group, use the actual active +;;; range. +;;; If the agent has a record, set the agent's active range to +;;; include the max limit of the actual active range. +;;; When expiring, update the min limit to match the smallest of the +;;; min article not expired or the min actual active range. + (defun gnus-agent-save-active (method) (gnus-agent-save-active-1 method 'gnus-active-to-gnus-format)) @@ -675,30 +1084,43 @@ the actual number of articles toggled is returned." (funcall function nil new) (gnus-agent-write-active file new) (erase-buffer) - (insert-file-contents-as-coding-system gnus-agent-file-coding-system - file)))) - -(defun gnus-agent-write-active (file new) - (let ((orig (gnus-make-hashtable (count-lines (point-min) (point-max)))) - (file (gnus-agent-lib-file "active")) - elem osym) - (when (file-exists-p file) + (nnheader-insert-file-contents file)))) + +(defun gnus-agent-write-active (file new &optional literal-replacement) + (let ((old new)) + (when (and (not literal-replacement) + (file-exists-p file)) + (setq old (gnus-make-hashtable (count-lines (point-min) (point-max)))) (with-temp-buffer - (insert-file-contents-as-coding-system gnus-agent-file-coding-system - file) - (gnus-active-to-gnus-format nil orig)) + (nnheader-insert-file-contents file) + (gnus-active-to-gnus-format nil old)) + ;; Iterate over the current active groups, the current active + ;; range may expand, but NOT CONTRACT, the agent's active range. (mapatoms - (lambda (sym) - (when (and sym (boundp sym)) - (if (and (boundp (setq osym (intern (symbol-name sym) orig))) - (setq elem (symbol-value osym))) - (setcdr elem (cdr (symbol-value sym))) - (set (intern (symbol-name sym) orig) (symbol-value sym))))) + (lambda (nsym) + (let ((new-active (and nsym (boundp nsym) (symbol-value nsym)))) + (when new-active + (let* ((osym (intern (symbol-name nsym) old)) + (old-active (and (boundp osym) (symbol-value osym)))) + (if old-active + (let ((new-min (car new-active)) + (old-min (car old-active)) + (new-max (cdr new-active)) + (old-max (cdr old-active))) + (if (and (integerp new-min) + (< new-min old-min)) + (setcar old-active new-min)) + (if (and (integerp new-max) + (> new-max old-max)) + (setcdr old-active new-max))) + (set osym new-active)))))) new)) (gnus-make-directory (file-name-directory file)) - ;; The hashtable contains real names of groups, no more prefix - ;; removing, so set `full' to `t'. - (gnus-write-active-file file orig t))) + (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) + ;; The hashtable contains real names of groups. However, do NOT + ;; add the foreign server prefix as gnus-active-to-gnus-format + ;; will add it while reading the file. + (gnus-write-active-file file old nil)))) (defun gnus-agent-save-groups (method) (gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format)) @@ -711,55 +1133,63 @@ the actual number of articles toggled is returned." (file-name-coding-system nnmail-pathname-coding-system) (pathname-coding-system nnmail-pathname-coding-system) (file (gnus-agent-lib-file "active")) - oactive) + oactive-min oactive-max) (gnus-make-directory (file-name-directory file)) (with-temp-file file + ;; Emacs got problem to match non-ASCII group in multibyte buffer. + (set-buffer-multibyte nil) (when (file-exists-p file) - (nnheader-insert-file-contents file)) - (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)) + (nnheader-insert-file-contents file) + + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote group) " ") nil t) + (save-excursion + (setq oactive-max (read (current-buffer)) ;; max + oactive-min (read (current-buffer)))) ;; min + (gnus-delete-line))) (insert (format "%S %d %d y\n" (intern group) - (cdr active) - (or (car oactive) (car active)))) + (max (or oactive-max (cdr active)) (cdr active)) + (min (or oactive-min (car active)) (car active)))) (goto-char (point-max)) (while (search-backward "\\." nil t) (delete-char 1)))))) (defun gnus-agent-group-path (group) - "Translate GROUP into a path." - (if nnmail-use-long-file-names - (gnus-group-real-name group) - (nnheader-translate-file-chars - (nnheader-replace-chars-in-string - (nnheader-replace-duplicate-chars-in-string - (nnheader-replace-chars-in-string - (gnus-group-real-name group) - ?/ ?_) - ?. ?_) - ?. ?/)))) - - - -(defun gnus-agent-method-p (method) - "Say whether METHOD is covered by the agent." - (member method gnus-agent-covered-methods)) + "Translate GROUP into a file name." + + ;; NOTE: This is what nnmail-group-pathname does as of Apr 2003. + ;; The two methods must be kept synchronized, which is why + ;; gnus-agent-group-pathname was added. + + (setq group + (nnheader-translate-file-chars + (nnheader-replace-duplicate-chars-in-string + (nnheader-replace-chars-in-string + (gnus-group-real-name group) + ?/ ?_) + ?. ?_))) + (if (or nnmail-use-long-file-names + (file-directory-p (expand-file-name group (gnus-agent-directory)))) + group + (mm-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnmail-pathname-coding-system))) + +(defun gnus-agent-group-pathname (group) + "Translate GROUP into a file name." + ;; nnagent uses nnmail-group-pathname to read articles while + ;; unplugged. The agent must, therefore, use the same directory + ;; while plugged. + (let ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group)))) + (nnmail-group-pathname (gnus-group-real-name group) (gnus-agent-directory)))) (defun gnus-agent-get-function (method) - (if (and (not gnus-plugged) - (gnus-agent-method-p method)) - (progn - (require 'nnagent) - 'nnagent) - (car method))) + (if (gnus-online method) + (car method) + (require 'nnagent) + 'nnagent)) ;;; History functions @@ -773,6 +1203,7 @@ the actual number of articles toggled is returned." (format " *Gnus agent %s history*" (gnus-agent-method))))) gnus-agent-history-buffers) + (set-buffer-multibyte nil) ;; everything is binary (erase-buffer) (insert "\n") (let ((file (gnus-agent-lib-file "history"))) @@ -780,14 +1211,6 @@ the actual number of articles toggled is returned." (nnheader-insert-file-contents file)) (set (make-local-variable 'gnus-agent-file-name) file)))) -(defun gnus-agent-save-history () - (save-excursion - (set-buffer gnus-agent-current-history) - (gnus-make-directory (file-name-directory gnus-agent-file-name)) - (write-region-as-coding-system - gnus-agent-file-coding-system - (1+ (point-min)) (point-max) gnus-agent-file-name nil 'silent))) - (defun gnus-agent-close-history () (when (gnus-buffer-live-p gnus-agent-current-history) (kill-buffer gnus-agent-current-history) @@ -795,37 +1218,6 @@ the actual number of articles toggled is returned." (delq (assoc (gnus-agent-method) gnus-agent-history-buffers) gnus-agent-history-buffers)))) -(defun gnus-agent-enter-history (id group-arts date) - (save-excursion - (set-buffer gnus-agent-current-history) - (goto-char (point-max)) - (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 - (set-buffer (gnus-agent-history-buffer)) - (goto-char (point-min)) - (search-forward (concat "\n" id "\t") nil t))) - -(defun gnus-agent-history-path (id) - (save-excursion - (set-buffer (gnus-agent-history-buffer)) - (goto-char (point-min)) - (when (search-forward (concat "\n" id "\t") nil t) - (let ((method (gnus-agent-method))) - (let (paths group) - (while (not (numberp (setq group (read (current-buffer))))) - (push (concat method "/" group) paths)) - (nreverse paths)))))) - ;;; ;;; Fetching ;;; @@ -833,76 +1225,137 @@ the actual number of articles toggled is returned." (defun gnus-agent-fetch-articles (group articles) "Fetch ARTICLES from GROUP and put them into the Agent." (when articles - ;; Prune off articles that we have already fetched. - (while (and articles - (cdr (assq (car articles) gnus-agent-article-alist))) - (pop articles)) - (let ((arts articles)) - (while (cdr arts) - (if (cdr (assq (cadr arts) gnus-agent-article-alist)) - (setcdr arts (cddr arts)) - (setq arts (cdr arts))))) - (when articles - (let ((dir (concat - (gnus-agent-directory) - (gnus-agent-group-path group) "/")) - (date (time-to-days (current-time))) - (case-fold-search t) - pos crosses id elem) - (gnus-make-directory dir) - (gnus-message 7 "Fetching articles for %s..." group) - ;; Fetch the articles from the backend. - (if (gnus-check-backend-function 'retrieve-articles group) - (setq pos (gnus-retrieve-articles articles group)) - (with-temp-buffer - (let (article) - (while (setq article (pop articles)) - (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))) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - (setq pos (nreverse pos))))) - ;; Then save these articles into the Agent. - (save-excursion - (set-buffer nntp-server-buffer) - (while pos - (narrow-to-region (cdar pos) (or (cdadr pos) (point-max))) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (when (search-backward "\nXrefs: " nil t) - ;; Handle crossposting. - (skip-chars-forward "^ ") - (skip-chars-forward " ") - (setq crosses nil) - (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +") - (push (cons (buffer-substring (match-beginning 1) - (match-end 1)) - (buffer-substring (match-beginning 2) - (match-end 2))) - crosses) - (goto-char (match-end 0))) - (gnus-agent-crosspost crosses (caar pos)))) - (goto-char (point-min)) - (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) - (setq id "No-Message-ID-in-article") - (setq id (buffer-substring (match-beginning 1) (match-end 1)))) - (write-region-as-coding-system - gnus-agent-file-coding-system - (point-min) (point-max) - (concat dir (number-to-string (caar pos))) nil 'silent) - (when (setq elem (assq (caar pos) gnus-agent-article-alist)) - (setcdr elem t)) - (gnus-agent-enter-history - id (or crosses (list (cons group (caar pos)))) date) - (widen) - (pop pos))) - (gnus-agent-save-alist group))))) - -(defun gnus-agent-crosspost (crosses article) + (gnus-agent-load-alist group) + (let* ((alist gnus-agent-article-alist) + (headers (if (< (length articles) 2) nil gnus-newsgroup-headers)) + (selected-sets (list nil)) + (current-set-size 0) + article + header-number) + ;; Check each article + (while (setq article (pop articles)) + ;; Skip alist entries preceeding this article + (while (> article (or (caar alist) (1+ article))) + (setq alist (cdr alist))) + + ;; Prune off articles that we have already fetched. + (unless (and (eq article (caar alist)) + (cdar alist)) + ;; Skip headers preceeding this article + (while (> article + (setq header-number + (let* ((header (car headers))) + (if header + (mail-header-number header) + (1+ article))))) + (setq headers (cdr headers))) + + ;; Add this article to the current set + (setcar selected-sets (cons article (car selected-sets))) + + ;; Update the set size, when the set is too large start a + ;; new one. I do this after adding the article as I want at + ;; least one article in each set. + (when (< gnus-agent-max-fetch-size + (setq current-set-size + (+ current-set-size + (if (= header-number article) + (let ((char-size (mail-header-chars + (car headers)))) + (if (<= char-size 0) + ;; The char size was missing/invalid, + ;; assume a worst-case situation of + ;; 65 char/line. If the line count + ;; is missing, arbitrarily assume a + ;; size of 1000 characters. + (max (* 65 (mail-header-lines + (car headers))) + 1000) + char-size)) + 0)))) + (setcar selected-sets (nreverse (car selected-sets))) + (setq selected-sets (cons nil selected-sets) + current-set-size 0)))) + + (when (or (cdr selected-sets) (car selected-sets)) + (let* ((fetched-articles (list nil)) + (tail-fetched-articles fetched-articles) + (dir (gnus-agent-group-pathname group)) + (date (time-to-days (current-time))) + (case-fold-search t) + pos crosses id) + + (setcar selected-sets (nreverse (car selected-sets))) + (setq selected-sets (nreverse selected-sets)) + + (gnus-make-directory dir) + (gnus-message 7 "Fetching articles for %s..." group) + + (unwind-protect + (while (setq articles (pop selected-sets)) + ;; Fetch the articles from the backend. + (if (gnus-check-backend-function 'retrieve-articles group) + (setq pos (gnus-retrieve-articles articles group)) + (with-temp-buffer + (let (article) + (while (setq article (pop articles)) + (gnus-message 10 "Fetching article %s for %s..." + 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))) + (copy-to-buffer + nntp-server-buffer (point-min) (point-max)) + (setq pos (nreverse pos))))) + ;; Then save these articles into the Agent. + (save-excursion + (set-buffer nntp-server-buffer) + (while pos + (narrow-to-region (cdar pos) (or (cdadr pos) (point-max))) + (goto-char (point-min)) + (unless (eobp) ;; Don't save empty articles. + (when (search-forward "\n\n" nil t) + (when (search-backward "\nXrefs: " nil t) + ;; Handle cross posting. + (goto-char (match-end 0)) ; move to end of header name + (skip-chars-forward "^ ") ; skip server name + (skip-chars-forward " ") + (setq crosses nil) + (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *") + (push (cons (buffer-substring (match-beginning 1) + (match-end 1)) + (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2)))) + crosses) + (goto-char (match-end 0))) + (gnus-agent-crosspost crosses (caar pos) date))) + (goto-char (point-min)) + (if (not (re-search-forward + "^Message-ID: *<\\([^>\n]+\\)>" nil t)) + (setq id "No-Message-ID-in-article") + (setq id (buffer-substring + (match-beginning 1) (match-end 1)))) + (write-region-as-coding-system + gnus-agent-file-coding-system (point-min) (point-max) + (concat dir (number-to-string (caar pos))) nil 'silent) + + (gnus-agent-append-to-list + tail-fetched-articles (caar pos))) + (widen) + (setq pos (cdr pos))))) + + (gnus-agent-save-alist group (cdr fetched-articles) date) + (gnus-message 7 "")) + (cdr fetched-articles)))))) + +(defun gnus-agent-crosspost (crosses article &optional date) + (setq date (or date t)) + (let (gnus-agent-article-alist group alist beg end) (save-excursion (set-buffer gnus-agent-overview-buffer) @@ -915,7 +1368,7 @@ the actual number of articles toggled is returned." (unless (setq alist (assoc group gnus-agent-group-alist)) (push (setq alist (list group (gnus-agent-load-alist (caar crosses)))) gnus-agent-group-alist)) - (setcdr alist (cons (cons (cdar crosses) t) (cdr alist))) + (setcdr alist (cons (cons (cdar crosses) date) (cdr alist))) (save-excursion (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*" group))) @@ -926,8 +1379,65 @@ the actual number of articles toggled is returned." (gnus-agent-article-name ".overview" group)))) (nnheader-find-nov-line (string-to-number (cdar crosses))) (insert (string-to-number (cdar crosses))) - (insert-buffer-substring gnus-agent-overview-buffer beg end)) - (pop crosses)))) + (insert-buffer-substring gnus-agent-overview-buffer beg end) + (gnus-agent-check-overview-buffer)) + (setq crosses (cdr crosses))))) + +(defun gnus-agent-backup-overview-buffer () + (when gnus-newsgroup-name + (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name)) + (cnt 0) + name) + (while (file-exists-p + (setq name (concat root "~" + (int-to-string (setq cnt (1+ cnt))) "~")))) + (write-region (point-min) (point-max) name nil 'no-msg) + (gnus-message 1 "Created backup copy of overview in %s." name))) + t) + +(defun gnus-agent-check-overview-buffer (&optional buffer) + "Check the overview file given for sanity. +In particular, checks that the file is sorted by article number +and that there are no duplicates." + (let ((prev-num -1) + (backed-up nil)) + (save-excursion + (when buffer + (set-buffer buffer)) + (save-restriction + (widen) + (goto-char (point-min)) + + (while (< (point) (point-max)) + (let ((p (point)) + (cur (condition-case nil + (read (current-buffer)) + (error nil)))) + (cond + ((or (not (integerp cur)) + (not (eq (char-after) ?\t))) + (or backed-up + (setq backed-up (gnus-agent-backup-overview-buffer))) + (gnus-message 1 + "Overview buffer contains garbage '%s'." + (buffer-substring + p (gnus-point-at-eol)))) + ((= cur prev-num) + (or backed-up + (setq backed-up (gnus-agent-backup-overview-buffer))) + (gnus-message 1 + "Duplicate overview line for %d" cur) + (delete-region (point) (progn (forward-line 1) (point)))) + ((< cur prev-num) + (or backed-up + (setq backed-up (gnus-agent-backup-overview-buffer))) + (gnus-message 1 "Overview buffer not sorted!") + (sort-numeric-fields 1 (point-min) (point-max)) + (goto-char (point-min)) + (setq prev-num -1)) + (t + (setq prev-num cur))) + (forward-line 1))))))) (defun gnus-agent-flush-cache () (save-excursion @@ -939,133 +1449,344 @@ the actual number of articles toggled is returned." (gnus-agent-article-name ".overview" (caar gnus-agent-buffer-alist)) nil 'silent) - (pop gnus-agent-buffer-alist)) + (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist))) (while gnus-agent-group-alist - (with-temp-file (caar gnus-agent-group-alist) + (with-temp-file (gnus-agent-article-name + ".agentview" (caar gnus-agent-group-alist)) (princ (cdar gnus-agent-group-alist)) + (insert "\n") + (princ 1 (current-buffer)) (insert "\n")) - (pop gnus-agent-group-alist)))) + (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) + +(defun gnus-agent-find-parameter (group symbol) + "Search for GROUPs SYMBOL in the group's parameters, the group's +topic parameters, the group's category, or the customizable +variables. Returns the first non-nil value found." + (or (gnus-group-find-parameter group symbol t) + (gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t) + (symbol-value + (cdr + (assq symbol + '((agent-short-article . gnus-agent-short-article) + (agent-long-article . gnus-agent-long-article) + (agent-low-score . gnus-agent-low-score) + (agent-high-score . gnus-agent-high-score) + (agent-days-until-old . gnus-agent-expire-days) + (agent-enable-expiration + . gnus-agent-enable-expiration) + (agent-predicate . gnus-agent-predicate))))))) (defun gnus-agent-fetch-headers (group &optional force) - (let* ((articles (gnus-list-of-unread-articles group)) - (len (length articles)) - (gnus-decode-encoded-word-function 'identity) - (file (gnus-agent-article-name ".overview" group)) - i) - ;; Check the number of articles is not too large. + "Fetch interesting headers into the agent. The group's overview +file will be updated to include the headers while a list of available +article numbers will be returned." + (let* ((fetch-all (and gnus-agent-consider-all-articles + ;; Do not fetch all headers if the predicate + ;; implies that we only consider unread articles. + (not (gnus-predicate-implies-unread + (gnus-agent-find-parameter group + 'agent-predicate))))) + (articles (if fetch-all + (gnus-uncompress-range (gnus-active group)) + (gnus-list-of-unread-articles group))) + (gnus-decode-encoded-word-function 'identity) + (file (gnus-agent-article-name ".overview" group))) + ;; Check whether the number of articles is not too large. (when (and (integerp gnus-agent-large-newsgroup) - (< 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. - (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. - (when (gnus-agent-load-alist group) - (setq articles (gnus-sorted-intersection - articles - (gnus-uncompress-range - (cons (1+ (caar (last gnus-agent-article-alist))) - (cdr (gnus-active group))))))) - ;; Fetch them. - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file) t)) - (when articles - (gnus-message 7 "Fetching headers for %s..." group) + (> gnus-agent-large-newsgroup 0)) + (setq articles (nthcdr (max (- (length articles) + gnus-agent-large-newsgroup) + 0) + articles))) + (unless fetch-all + ;; Add articles with marks to the list of article headers we want to + ;; fetch. Don't fetch articles solely on the basis of a recent or seen + ;; mark, but do fetch recent or seen articles if they have other, more + ;; interesting marks. (We have to fetch articles with boring marks + ;; because otherwise the agent will remove their marks.) + (dolist (arts (gnus-info-marks (gnus-get-info group))) + (unless (memq (car arts) '(seen recent killed cache)) + (setq articles (gnus-range-add articles (cdr arts))))) + (setq articles (sort (gnus-uncompress-sequence articles) '<))) + + ;; At this point, I have the list of articles to consider for + ;; fetching. This is the list that I'll return to my caller. Some + ;; of these articles may have already been fetched. That's OK as + ;; the fetch article code will filter those out. Internally, I'll + ;; filter this list to just those articles whose headers need to + ;; be fetched. + (let ((articles articles)) + ;; Remove known articles. + (when (and (or gnus-agent-cache + (not gnus-plugged)) + (gnus-agent-load-alist group)) + ;; Remove articles marked as downloaded. + (if fetch-all + ;; I want to fetch all headers in the active range. + ;; Therefore, exclude only those headers that are in the + ;; article alist. + ;; NOTE: This is probably NOT what I want to do after + ;; agent expiration in this group. + (setq articles (gnus-agent-uncached-articles articles group)) + + ;; I want to only fetch those headers that have never been + ;; fetched. Therefore, exclude all headers that are, or + ;; WERE, in the article alist. + (let ((low (1+ (caar (last gnus-agent-article-alist)))) + (high (cdr (gnus-active group)))) + ;; Low can be greater than High when the same group is + ;; fetched twice in the same session {The first fetch will + ;; fill the article alist such that (last + ;; gnus-agent-article-alist) equals (cdr (gnus-active + ;; group))}. The addition of one(the 1+ above) then + ;; forces Low to be greater than High. When this happens, + ;; gnus-list-range-intersection returns nil which + ;; indicates that no headers need to be fetched. -- Kevin + (setq articles (gnus-list-range-intersection + articles (list (cons low high))))))) + + (gnus-message + 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" + (gnus-compress-sequence articles t)) + (save-excursion - (set-buffer nntp-server-buffer) - (unless (eq 'nov (gnus-retrieve-headers articles group)) - (nnvirtual-convert-headers)) - ;; Save these headers for later processing. - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - (when (file-exists-p file) - (gnus-agent-braid-nov group articles file)) - (write-region-as-coding-system - gnus-agent-file-coding-system - (point-min) (point-max) file nil 'silent) - (gnus-agent-save-alist group articles nil) - (gnus-agent-enter-history - "last-header-fetched-for-session" - (list (cons group (nth (- (length articles) 1) articles))) - (time-to-days (current-time))) - articles)))) + (set-buffer nntp-server-buffer) + + (if articles + (progn + (gnus-message 7 "Fetching headers for %s..." group) + + ;; Fetch them. + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t)) + + (unless (eq 'nov (gnus-retrieve-headers articles group)) + (nnvirtual-convert-headers)) + (gnus-agent-check-overview-buffer) + ;; Move these headers to the overview buffer so that + ;; gnus-agent-braid-nov can merge them with the contents + ;; of FILE. + (copy-to-buffer + gnus-agent-overview-buffer (point-min) (point-max)) + (when (file-exists-p file) + (gnus-agent-braid-nov group articles file)) + (gnus-agent-check-overview-buffer) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) file nil 'silent) + (gnus-agent-save-alist group articles nil) + articles) + (ignore-errors + (erase-buffer) + (nnheader-insert-file-contents file))))) + articles)) (defsubst gnus-agent-copy-nov-line (article) - (let (b e) + (let (art b e) (set-buffer gnus-agent-overview-buffer) - (setq b (point)) - (if (eq article (read (current-buffer))) - (setq e (progn (forward-line 1) (point))) - (progn - (beginning-of-line) - (setq e b))) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e))) + (while (and (not (eobp)) + (< (setq art (read (current-buffer))) article)) + (forward-line 1)) + (beginning-of-line) + (if (or (eobp) + (not (eq article art))) + (set-buffer nntp-server-buffer) + (setq b (point)) + (setq e (progn (forward-line 1) (point))) + (set-buffer nntp-server-buffer) + (insert-buffer-substring gnus-agent-overview-buffer b e)))) (defun gnus-agent-braid-nov (group articles file) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents file) - (goto-char (point-max)) - (if (or (= (point-min) (point-max)) - (progn - (forward-line -1) - (< (read (current-buffer)) (car articles)))) - ;; We have only headers that are after the older headers, - ;; so we just append them. - (progn - (goto-char (point-max)) - (insert-buffer-substring gnus-agent-overview-buffer)) - ;; We do it the hard way. - (nnheader-find-nov-line (car articles)) - (gnus-agent-copy-nov-line (car articles)) - (pop articles) - (while (and articles - (not (eobp))) - (while (and (not (eobp)) - (< (read (current-buffer)) (car articles))) - (forward-line 1)) - (beginning-of-line) - (unless (eobp) - (gnus-agent-copy-nov-line (car articles)) - (setq articles (cdr articles)))) + "Merge agent overview data with given file. +Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given +FILE and places the combined headers into `nntp-server-buffer'." + (let (start last) + (set-buffer gnus-agent-overview-buffer) + (goto-char (point-min)) + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents file) + (goto-char (point-max)) + (forward-line -1) + (unless (looking-at "[0-9]+\t") + ;; Remove corrupted lines + (gnus-message + 1 "Overview %s is corrupted. Removing corrupted lines..." file) + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at "[0-9]+\t") + (forward-line 1) + (delete-region (point) (progn (forward-line 1) (point))))) + (forward-line -1)) + (unless (or (= (point-min) (point-max)) + (< (setq last (read (current-buffer))) (car articles))) + ;; We do it the hard way. + (when (nnheader-find-nov-line (car articles)) + ;; Replacing existing NOV entry + (delete-region (point) (progn (forward-line 1) (point)))) + (gnus-agent-copy-nov-line (pop articles)) + + (ignore-errors + (while articles + (while (let ((art (read (current-buffer)))) + (cond ((< art (car articles)) + (forward-line 1) + t) + ((= art (car articles)) + (beginning-of-line) + (delete-region + (point) (progn (forward-line 1) (point))) + nil) + (t + (beginning-of-line) + nil)))) + + (gnus-agent-copy-nov-line (pop articles))))) + + ;; Copy the rest lines + (set-buffer nntp-server-buffer) + (goto-char (point-max)) (when articles - (let (b e) + (when last (set-buffer gnus-agent-overview-buffer) - (setq b (point) - e (point-max)) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e))))) + (ignore-errors + (while (<= (read (current-buffer)) last) + (forward-line 1))) + (beginning-of-line) + (setq start (point)) + (set-buffer nntp-server-buffer)) + (insert-buffer-substring gnus-agent-overview-buffer start)))) + +;; Keeps the compiler from warning about the free variable in +;; gnus-agent-read-agentview. +(eval-when-compile + (defvar gnus-agent-read-agentview)) -(defun gnus-agent-load-alist (group &optional dir) +(defun gnus-agent-load-alist (group) "Load the article-state alist for GROUP." - (setq gnus-agent-article-alist - (gnus-agent-read-file - (if dir - (concat dir ".agentview") - (gnus-agent-article-name ".agentview" group))))) + ;; Bind free variable that's used in `gnus-agent-read-agentview'. + (let ((gnus-agent-read-agentview group)) + (setq gnus-agent-article-alist + (gnus-cache-file-contents + (gnus-agent-article-name ".agentview" group) + 'gnus-agent-file-loading-cache + 'gnus-agent-read-agentview)))) + +;; Save format may be either 1 or 2. Two is the new, compressed +;; format that is still being tested. Format 1 is uncompressed but +;; known to be reliable. +(defconst gnus-agent-article-alist-save-format 2) + +(defun gnus-agent-read-agentview (file) + "Load FILE and do a `read' there." + (with-temp-buffer + (ignore-errors + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (let ((alist (read (current-buffer))) + (version (condition-case nil (read (current-buffer)) + (end-of-file 0))) + changed-version) + + (cond + ((= version 0) + (let ((inhibit-quit t) + entry) + (gnus-agent-open-history) + (set-buffer (gnus-agent-history-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (if (and (looking-at + "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") + (string= (match-string 2) + gnus-agent-read-agentview) + (setq entry (assoc (string-to-number (match-string 3)) alist))) + (setcdr entry (string-to-number (match-string 1)))) + (forward-line 1)) + (gnus-agent-close-history) + (setq changed-version t))) + ((= version 1) + (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) + ((= version 2) + (let (uncomp) + (mapcar + (lambda (comp-list) + (let ((state (car comp-list)) + (sequence (gnus-uncompress-sequence + (cdr comp-list)))) + (mapcar (lambda (article-id) + (setq uncomp (cons (cons article-id state) uncomp))) + sequence))) + alist) + (setq alist (sort uncomp + (lambda (first second) + (< (car first) (car second)))))))) + (when changed-version + (let ((gnus-agent-article-alist alist)) + (gnus-agent-save-alist gnus-agent-read-agentview))) + alist)))) (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." - (let ((file-name-coding-system nnmail-pathname-coding-system) - (pathname-coding-system nnmail-pathname-coding-system)) + (let* ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) + (prev (cons nil gnus-agent-article-alist)) + (all prev) + print-level print-length item article) + (while (setq article (pop articles)) + (while (and (cdr prev) + (< (caadr prev) article)) + (setq prev (cdr prev))) + (cond + ((not (cdr prev)) + (setcdr prev (list (cons article state)))) + ((> (caadr prev) article) + (setcdr prev (cons (cons article state) (cdr prev)))) + ((= (caadr prev) article) + (setcdr (cadr prev) state))) + (setq prev (cdr prev))) + (setq gnus-agent-article-alist (cdr all)) + (if dir + (gnus-make-directory dir) + (gnus-make-directory (gnus-agent-article-name "" group))) (with-temp-file (if dir - (concat dir ".agentview") + (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)) + (cond ((eq gnus-agent-article-alist-save-format 1) + (princ gnus-agent-article-alist (current-buffer))) + ((eq gnus-agent-article-alist-save-format 2) + (let ((compressed nil)) + (mapcar (lambda (pair) + (let* ((article-id (car pair)) + (day-of-download (cdr pair)) + (comp-list (assq day-of-download compressed))) + (if comp-list + (setcdr comp-list + (cons article-id (cdr comp-list))) + (setq compressed + (cons (list day-of-download article-id) + compressed))) + nil)) gnus-agent-article-alist) + (mapcar (lambda (comp-list) + (setcdr comp-list + (gnus-compress-sequence + (nreverse (cdr comp-list))))) + compressed) + (princ compressed (current-buffer))))) + (insert "\n") + (princ gnus-agent-article-alist-save-format (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 article + (file-name-as-directory + (gnus-agent-group-pathname group)))) + +(defun gnus-agent-batch-confirmation (msg) + "Show error message and return t." + (gnus-message 1 msg) + t) ;;;###autoload (defun gnus-agent-batch-fetch () @@ -1087,102 +1808,222 @@ the actual number of articles toggled is returned." groups group gnus-command-method) (save-excursion (while methods - (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)) + (setq gnus-command-method (car methods)) + (when (and (or (gnus-server-opened gnus-command-method) + (gnus-open-server gnus-command-method)) + (gnus-online gnus-command-method)) + (setq groups (gnus-groups-from-server (car methods))) + (gnus-agent-with-fetch + (while (setq group (pop groups)) + (when (<= (gnus-group-level group) + gnus-agent-handle-level) + (if (or debug-on-error debug-on-quit) + (gnus-agent-fetch-group-1 + group gnus-command-method) + (condition-case err + (gnus-agent-fetch-group-1 + group gnus-command-method) + (error + (unless (funcall gnus-agent-confirmation-function + (format "Error %s. Continue? " + (error-message-string err))) + (error "Cannot fetch articles into the Gnus agent"))) + (quit + (unless (funcall gnus-agent-confirmation-function + (format + "Quit fetching session %s. Continue? " + (error-message-string err))) + (signal 'quit + "Cannot fetch articles into the Gnus agent"))))))))) + (setq methods (cdr methods))) + (gnus-run-hooks 'gnus-agent-fetched-hook) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) (defun gnus-agent-fetch-group-1 (group method) "Fetch GROUP." (let ((gnus-command-method method) (gnus-newsgroup-name group) - gnus-newsgroup-dependencies gnus-newsgroup-headers - gnus-newsgroup-scored gnus-headers gnus-score - gnus-use-cache articles arts - category predicate info marks score-param + (gnus-newsgroup-dependencies gnus-newsgroup-dependencies) + (gnus-newsgroup-headers gnus-newsgroup-headers) + (gnus-newsgroup-scored gnus-newsgroup-scored) + (gnus-use-cache gnus-use-cache) (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. + + gnus-headers + gnus-score + articles arts + category predicate info marks score-param ) (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)) - (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)) - (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. - (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)))) - (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 - (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)) - (while (setq gnus-headers (pop gnus-newsgroup-headers)) - (setq gnus-score - (or (cdr (assq (mail-header-number gnus-headers) - gnus-newsgroup-scored)) - gnus-summary-default-score)) - (when (funcall predicate) - (push (mail-header-number gnus-headers) - arts)))) - ;; Fetch the articles. - (when arts - (gnus-agent-fetch-articles group arts))) - ;; Perhaps we have some additional articles to fetch. - (setq arts (assq 'download (gnus-info-marks - (setq info (gnus-get-info group))))) - (when (cdr arts) - (gnus-agent-fetch-articles - group (gnus-uncompress-range (cdr arts))) - (setq marks (delq arts (gnus-info-marks info))) - (gnus-info-set-marks info marks) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string info) - ")"))))) + (when (or gnus-newsgroup-active + (gnus-active group) + (gnus-activate-group group)) + (let ((marked-articles gnus-newsgroup-downloadable)) + ;; Identify the articles marked for download + (unless gnus-newsgroup-active + ;; The variable gnus-newsgroup-active was selected as I need + ;; a gnus-summary local variable that is NOT bound to any + ;; value (its global value should default to nil). + (dolist (mark gnus-agent-download-marks) + (let ((arts (cdr (assq mark (gnus-info-marks + (setq info (gnus-get-info group))))))) + (when arts + (setq marked-articles (nconc (gnus-uncompress-range arts) + marked-articles)) + )))) + (setq marked-articles (sort marked-articles '<)) + + ;; Fetch any new articles from the server + (setq articles (gnus-agent-fetch-headers group)) + + ;; Merge new articles with marked + (setq articles (sort (append marked-articles articles) '<)) + + (when articles + ;; Parse them and see which articles we want to fetch. + (setq gnus-newsgroup-dependencies + (or gnus-newsgroup-dependencies + (make-vector (length articles) 0))) + (setq gnus-newsgroup-headers + (or 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. + (gnus-agent-create-buffer) + + ;; Figure out how to select articles in this group + (setq category (gnus-group-category group)) + + (setq predicate + (gnus-get-predicate + (gnus-agent-find-parameter group 'agent-predicate))) + + ;; If the selection predicate requires scoring, score each header + (unless (memq predicate '(gnus-agent-true gnus-agent-false)) + (let ((score-param + (gnus-agent-find-parameter group 'agent-score-file))) + ;; 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)))) + + (unless (and (eq predicate 'gnus-agent-false) + (not marked-articles)) + (let ((arts (list nil))) + (let ((arts-tail arts) + (alist (gnus-agent-load-alist group)) + (marked-articles marked-articles) + (gnus-newsgroup-headers gnus-newsgroup-headers)) + (while (setq gnus-headers (pop gnus-newsgroup-headers)) + (let ((num (mail-header-number gnus-headers))) + ;; Determine if this article is already in the cache + (while (and alist + (> num (caar alist))) + (setq alist (cdr alist))) + + (unless (and (eq num (caar alist)) + (cdar alist)) + + ;; Determine if this article was marked for download. + (while (and marked-articles + (> num (car marked-articles))) + (setq marked-articles + (cdr marked-articles))) + + ;; When this article is marked, or selected by the + ;; predicate, add it to the download list + (when (or (eq num (car marked-articles)) + (let ((gnus-score + (or (cdr + (assq num gnus-newsgroup-scored)) + gnus-summary-default-score)) + (gnus-agent-long-article + (gnus-agent-find-parameter + group 'agent-long-article)) + (gnus-agent-short-article + (gnus-agent-find-parameter + group 'agent-short-article)) + (gnus-agent-low-score + (gnus-agent-find-parameter + group 'agent-low-score)) + (gnus-agent-high-score + (gnus-agent-find-parameter + group 'agent-high-score)) + (gnus-agent-expire-days + (gnus-agent-find-parameter + group 'agent-days-until-old))) + (funcall predicate))) + (gnus-agent-append-to-list arts-tail num)))))) + + (let (fetched-articles) + ;; Fetch all selected articles + (setq gnus-newsgroup-undownloaded + (gnus-sorted-ndifference + gnus-newsgroup-undownloaded + (setq fetched-articles + (if (cdr arts) + (gnus-agent-fetch-articles group (cdr arts)) + nil)))) + + (let ((unfetched-articles + (gnus-sorted-ndifference (cdr arts) fetched-articles))) + (if gnus-newsgroup-active + ;; Update the summary buffer + (progn + (dolist (article marked-articles) + (gnus-summary-set-agent-mark article t)) + (dolist (article fetched-articles) + (if gnus-agent-mark-unread-after-downloaded + (gnus-summary-mark-article + article gnus-unread-mark)) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-download-mark article))) + (dolist (article unfetched-articles) + (gnus-summary-mark-article + article gnus-canceled-mark))) + + ;; Update the group buffer. + + ;; When some, or all, of the marked articles came + ;; from the download mark. Remove that mark. I + ;; didn't do this earlier as I only want to remove + ;; the marks after the fetch is completed. + + (dolist (mark gnus-agent-download-marks) + (when (eq mark 'download) + (let ((marked-arts + (assq mark (gnus-info-marks + (setq info (gnus-get-info group)))))) + (when (cdr marked-arts) + (setq marks + (delq marked-arts (gnus-info-marks info))) + (gnus-info-set-marks info marks))))) + (let ((read (gnus-info-read + (or info (setq info (gnus-get-info group)))))) + (gnus-info-set-read + info (gnus-add-to-range read unfetched-articles))) + + (gnus-group-update-group group t) + (sit-for 0) + + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string info) + ")")))))))))))) ;;; ;;; Agent Category Mode @@ -1192,11 +2033,21 @@ the actual number of articles toggled is returned." "Hook run in `gnus-category-mode' buffers.") (defvar gnus-category-line-format " %(%20c%): %g\n" - "Format of category lines.") + "Format of category lines. + +Valid specifiers include: +%c Topic name (string) +%g The number of groups in the topic (integer) + +General format specifiers can also be used. See Info node +`(gnus)Formatting Variables'.") (defvar gnus-category-mode-line-format "Gnus: %%b" "The format specification for the category mode line.") +(defvar gnus-agent-predicate 'false + "The selection predicate used when no other source is available.") + (defvar gnus-agent-short-article 100 "Articles that have fewer lines than this are short.") @@ -1236,6 +2087,7 @@ the actual number of articles toggled is returned." "k" gnus-category-kill "c" gnus-category-copy "a" gnus-category-add + "e" gnus-agent-customize-category "p" gnus-category-edit-predicate "g" gnus-category-edit-groups "s" gnus-category-edit-score @@ -1256,6 +2108,7 @@ the actual number of articles toggled is returned." ["Add" gnus-category-add t] ["Kill" gnus-category-kill t] ["Copy" gnus-category-copy t] + ["Edit category" gnus-agent-customize-category t] ["Edit predicate" gnus-category-edit-predicate t] ["Edit score" gnus-category-edit-score t] ["Edit groups" gnus-category-edit-groups t] @@ -1269,7 +2122,7 @@ the actual number of articles toggled is returned." All normal editing commands are switched off. \\ For more in-depth information on this mode, read the manual -(`\\[gnus-info-find-node]'). +\(`\\[gnus-info-find-node]'). The following commands are available: @@ -1292,8 +2145,8 @@ The following commands are available: (defalias 'gnus-category-position-point 'gnus-goto-colon) (defun gnus-category-insert-line (category) - (let* ((gnus-tmp-name (car category)) - (gnus-tmp-groups (length (cadddr category)))) + (let* ((gnus-tmp-name (format "%s" (car category))) + (gnus-tmp-groups (length (gnus-agent-cat-groups category)))) (beginning-of-line) (gnus-add-text-properties (point) @@ -1327,15 +2180,41 @@ The following commands are available: (gnus-category-position-point))) (defun gnus-category-name () - (or (get-text-property (gnus-point-at-bol) 'gnus-category) + (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category)) (error "No category on the current line"))) (defun gnus-category-read () "Read the category alist." (setq gnus-category-alist - (or (gnus-agent-read-file - (nnheader-concat gnus-agent-directory "lib/categories")) - (list (list 'default 'short nil nil))))) + (or + (with-temp-buffer + (ignore-errors + (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories")) + (goto-char (point-min)) + ;; This code isn't temp, it will be needed so long as + ;; anyone may be migrating from an older version. + + ;; Once we're certain that people will not revert to an + ;; earlier version, we can take out the old-list code in + ;; gnus-category-write. + (let* ((old-list (read (current-buffer))) + (new-list (ignore-errors (read (current-buffer))))) + (if new-list + new-list + ;; Convert from a positional list to an alist. + (mapcar + (lambda (c) + (setcdr c + (delq nil + (gnus-mapcar + (lambda (valu symb) + (if valu + (cons symb valu))) + (cdr c) + '(agent-predicate agent-score-file agent-groups)))) + c) + old-list))))) + (list (gnus-agent-cat-make 'default 'short))))) (defun gnus-category-write () "Write the category alist." @@ -1343,6 +2222,16 @@ The following commands are available: gnus-category-group-cache nil) (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories") + ;; This prin1 is temporary. It exists so that people can revert + ;; to an earlier version of gnus-agent. + (prin1 (mapcar (lambda (c) + (list (car c) + (cdr (assoc 'agent-predicate c)) + (cdr (assoc 'agent-score-file c)) + (cdr (assoc 'agent-groups c)))) + gnus-category-alist) + (current-buffer)) + (newline) (prin1 gnus-category-alist (current-buffer)))) (defun gnus-category-edit-predicate (category) @@ -1350,9 +2239,16 @@ The following commands are available: (interactive (list (gnus-category-name))) (let ((info (assq category gnus-category-alist))) (gnus-edit-form - (cadr info) (format "Editing the predicate for category %s" category) + (gnus-agent-cat-predicate info) + (format "Editing the select predicate for category %s" category) `(lambda (predicate) - (setcar (cdr (assq ',category gnus-category-alist)) predicate) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist)) + ;; predicate) + ;; use its expansion instead: + (gnus-agent-cat-set-property (assq ',category gnus-category-alist) + 'agent-predicate predicate) + (gnus-category-write) (gnus-category-list))))) @@ -1361,10 +2257,16 @@ The following commands are available: (interactive (list (gnus-category-name))) (let ((info (assq category gnus-category-alist))) (gnus-edit-form - (caddr info) + (gnus-agent-cat-score-file info) (format "Editing the score expression for category %s" category) - `(lambda (groups) - (setcar (nthcdr 2 (assq ',category gnus-category-alist)) groups) + `(lambda (score-file) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist)) + ;; score-file) + ;; use its expansion instead: + (gnus-agent-cat-set-property (assq ',category gnus-category-alist) + 'agent-score-file score-file) + (gnus-category-write) (gnus-category-list))))) @@ -1373,9 +2275,16 @@ The following commands are available: (interactive (list (gnus-category-name))) (let ((info (assq category gnus-category-alist))) (gnus-edit-form - (cadddr info) (format "Editing the group list for category %s" category) + (gnus-agent-cat-groups info) + (format "Editing the group list for category %s" category) `(lambda (groups) - (setcar (nthcdr 3 (assq ',category gnus-category-alist)) groups) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist)) + ;; groups) + ;; use its expansion instead: + (gnus-agent-set-cat-groups (assq ',category gnus-category-alist) + groups) + (gnus-category-write) (gnus-category-list))))) @@ -1392,8 +2301,10 @@ The following commands are available: "Copy the current category." (interactive (list (gnus-category-name) (intern (read-string "New name: ")))) (let ((info (assq category gnus-category-alist))) - (push (list to (gnus-copy-sequence (cadr info)) - (gnus-copy-sequence (caddr info)) nil) + (push (let ((newcat (gnus-copy-sequence info))) + (setf (gnus-agent-cat-name newcat) to) + (setf (gnus-agent-cat-groups newcat) nil) + newcat) gnus-category-alist) (gnus-category-write) (gnus-category-list))) @@ -1403,7 +2314,7 @@ The following commands are available: (interactive "SCategory name: ") (when (assq category gnus-category-alist) (error "Category %s already exists" category)) - (push (list category 'false nil nil) + (push (gnus-agent-cat-make category) gnus-category-alist) (gnus-category-write) (gnus-category-list)) @@ -1428,6 +2339,7 @@ The following commands are available: (long . gnus-agent-long-p) (low . gnus-agent-low-scored-p) (high . gnus-agent-high-scored-p) + (read . gnus-agent-read-p) (true . gnus-agent-true) (false . gnus-agent-false)) "Mapping from short score predicate symbols to predicate functions.") @@ -1459,9 +2371,18 @@ The following commands are available: "Say whether an article has a high score or not." (> gnus-score gnus-agent-high-score)) -(defun gnus-category-make-function (cat) - "Make a function from category CAT." - `(lambda () ,(gnus-category-make-function-1 cat))) +(defun gnus-agent-read-p () + "Say whether an article is read or not." + (gnus-member-of-range (mail-header-number gnus-headers) + (gnus-info-read (gnus-get-info gnus-newsgroup-name)))) + +(defun gnus-category-make-function (predicate) + "Make a function from PREDICATE." + (let ((func (gnus-category-make-function-1 predicate))) + (if (and (= (length func) 1) + (symbolp (car func))) + (car func) + (gnus-byte-compile `(lambda () ,func))))) (defun gnus-agent-true () "Return t." @@ -1471,33 +2392,55 @@ The following commands are available: "Return nil." nil) -(defun gnus-category-make-function-1 (cat) - "Make a function from category CAT." +(defun gnus-category-make-function-1 (predicate) + "Make a function from PREDICATE." (cond ;; Functions are just returned as is. - ((or (symbolp cat) - (gnus-functionp cat)) - `(,(or (cdr (assq cat gnus-category-predicate-alist)) - cat))) - ;; More complex category. - ((consp cat) + ((or (symbolp predicate) + (functionp predicate)) + `(,(or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) + ;; More complex predicate. + ((consp predicate) `(,(cond - ((memq (car cat) '(& and)) + ((memq (car predicate) '(& and)) 'and) - ((memq (car cat) '(| or)) + ((memq (car predicate) '(| or)) 'or) - ((memq (car cat) gnus-category-not) + ((memq (car predicate) gnus-category-not) 'not)) - ,@(mapcar 'gnus-category-make-function-1 (cdr cat)))) + ,@(mapcar 'gnus-category-make-function-1 (cdr predicate)))) (t - (error "Unknown category type: %s" cat)))) + (error "Unknown predicate type: %s" predicate)))) (defun gnus-get-predicate (predicate) - "Return the predicate for CATEGORY." + "Return the function implementing PREDICATE." (or (cdr (assoc predicate gnus-category-predicate-cache)) - (cdar (push (cons predicate - (gnus-category-make-function predicate)) - gnus-category-predicate-cache)))) + (let ((func (gnus-category-make-function predicate))) + (setq gnus-category-predicate-cache + (nconc gnus-category-predicate-cache + (list (cons predicate func)))) + func))) + +(defun gnus-predicate-implies-unread (predicate) + "Say whether PREDICATE implies unread articles only. +It is okay to miss some cases, but there must be no false positives. +That is, if this function returns true, then indeed the predicate must +return only unread articles." + (gnus-function-implies-unread-1 (gnus-category-make-function predicate))) + +(defun gnus-function-implies-unread-1 (function) + (cond ((eq function (symbol-function 'gnus-agent-read-p)) + nil) + ((not function) + nil) + ((functionp function) + 'ignore) + ((memq (car function) '(or and not)) + (apply (car function) + (mapcar 'gnus-function-implies-unread-1 (cdr function)))) + (t + (error "Unknown function: %s" function)))) (defun gnus-group-category (group) "Return the category GROUP belongs to." @@ -1506,201 +2449,1043 @@ The following commands are available: (let ((cs gnus-category-alist) groups cat) (while (setq cat (pop cs)) - (setq groups (cadddr cat)) + (setq groups (gnus-agent-cat-groups cat)) (while groups (gnus-sethash (pop groups) cat gnus-category-group-cache))))) (or (gnus-gethash group gnus-category-group-cache) (assq 'default gnus-category-alist))) -(defun gnus-agent-expire () - "Expire all old articles." +(defun gnus-agent-expire-group (group &optional articles force) + "Expire all old articles in GROUP. +If you want to force expiring of certain articles, this function can +take ARTICLES, and FORCE parameters as well. + +The articles on which the expiration process runs are selected as follows: + if ARTICLES is null, all read and unmarked articles. + if ARTICLES is t, all articles. + if ARTICLES is a list, just those articles. +FORCE is equivalent to setting the expiration predicates to true." + (interactive + (list (let ((def (or (gnus-group-group-name) + gnus-newsgroup-name))) + (let ((select (read-string (if def + (concat "Group Name (" + def "): ") + "Group Name: ")))) + (if (and (equal "" select) + def) + def + select))))) + + (if (not group) + (gnus-agent-expire articles group force) + (if (or (not (eq articles t)) + (yes-or-no-p + (concat "Are you sure that you want to " + "expire all articles in " group "."))) + (let ((gnus-command-method (gnus-find-method-for-group group)) + (overview (gnus-get-buffer-create " *expire overview*")) + orig) + (unwind-protect + (let ((active-file (gnus-agent-lib-file "active"))) + (when (file-exists-p active-file) + (with-temp-buffer + (nnheader-insert-file-contents active-file) + (gnus-active-to-gnus-format + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (save-excursion + (gnus-agent-expire-group-1 + group overview (gnus-gethash-safe group orig) + articles force)) + (gnus-agent-write-active active-file orig t))) + (kill-buffer overview)))) + (gnus-message 4 "Expiry...done"))) + +(defun gnus-agent-expire-group-1 (group overview active articles force) + ;; Internal function - requires caller to have set + ;; gnus-command-method, initialized overview buffer, and to have + ;; provided a non-nil active + + (let ((dir (gnus-agent-group-pathname group))) + (when (boundp 'gnus-agent-expire-current-dirs) + (set 'gnus-agent-expire-current-dirs + (cons dir + (symbol-value 'gnus-agent-expire-current-dirs)))) + + (if (eq 'DISABLE (gnus-agent-find-parameter group + 'agent-enable-expiration)) + (gnus-message 5 "Expiry skipping over %s" group) + (gnus-message 5 "Expiring articles in %s" group) + (gnus-agent-load-alist group) + (let* ((info (gnus-get-info group)) + (alist gnus-agent-article-alist) + (day (- (time-to-days (current-time)) + (gnus-agent-find-parameter group 'agent-days-until-old))) + (specials (if (and alist + (not force)) + ;; This could be a bit of a problem. I need to + ;; keep the last article to avoid refetching + ;; headers when using nntp in the backend. At + ;; the same time, if someone uses a backend + ;; that supports article moving then I may have + ;; to remove the last article to complete the + ;; move. Right now, I'm going to assume that + ;; FORCE overrides specials. + (list (caar (last alist))))) + (unreads ;; Articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are marked read by global decree + nil) + ((eq articles t) + ;; All articles are marked read by function + ;; parameter + nil) + ((not articles) + ;; Unread articles are marked protected from + ;; expiration Don't call + ;; gnus-list-of-unread-articles as it returns + ;; articles that have not been fetched into the + ;; agent. + (ignore-errors + (gnus-agent-unread-articles group))) + (t + ;; All articles EXCEPT those named by the caller + ;; are protected from expiration + (gnus-sorted-difference + (gnus-uncompress-range + (cons (caar alist) + (caar (last alist)))) + (sort articles '<))))) + (marked ;; More articles that are exluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are unmarked by global decree + nil) + ((eq articles t) + ;; All articles are unmarked by function + ;; parameter + nil) + (articles + ;; All articles may as well be unmarked as the + ;; unreads list already names the articles we are + ;; going to keep + nil) + (t + ;; Ticked and/or dormant articles are excluded + ;; from expiration + (nconc + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant + (gnus-info-marks info)))))))) + (nov-file (concat dir ".overview")) + (cnt 0) + (completed -1) + dlist + type) + + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse + ;; the process to generate the expired article alist. + + ;; Convert the alist elements to (article# fetch_date nil + ;; nil). + (setq dlist (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) alist)) + + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precidence of the + ;; keep_flag. + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'special nil)) + specials))) + + (set-buffer overview) + (erase-buffer) + (buffer-disable-undo) + (when (file-exists-p nov-file) + (gnus-message 7 "gnus-agent-expire: Loading overview...") + (nnheader-insert-file-contents nov-file) + (goto-char (point-min)) + + (let (p) + (while (< (setq p (point)) (point-max)) + (condition-case nil + ;; If I successfully read an integer (the plus zero + ;; ensures a numeric type), prepend a marker entry + ;; to the list + (push (list (+ 0 (read (current-buffer))) nil nil + (set-marker (make-marker) p)) + dlist) + (error + (gnus-message 1 "gnus-agent-expire: read error \ +occurred when reading expression at %s in %s. Skipping to next \ +line." (point) nov-file))) + ;; Whether I succeeded, or failed, it doesn't matter. + ;; Move to the next line then try again. + (forward-line 1))) + + (gnus-message + 7 "gnus-agent-expire: Loading overview... Done")) + (set-buffer-modified-p nil) + + ;; At this point, all of the information is in dlist. The + ;; only problem is that much of it is spread across multiple + ;; entries. Sort then MERGE!! + (gnus-message 7 "gnus-agent-expire: Sorting entries... ") + ;; If two entries have the same article-number then sort by + ;; ascending keep_flag. + (let ((special 0) + (marked 1) + (unread 2)) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + (let ((a (or (symbol-value (nth 2 a)) + 3)) + (b (or (symbol-value (nth 2 b)) + 3))) + (<= a b)))))))) + (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") + (gnus-message 7 "gnus-agent-expire: Merging entries... ") + (let ((dlist dlist)) + (while (cdr dlist) ; I'm not at the end-of-list + (if (eq (caar dlist) (caadr dlist)) + (let ((first (cdr (car dlist))) + (secnd (cdr (cadr dlist)))) + (setcar first (or (car first) + (car secnd))) ; fetch_date + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; Keep_flag + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; NOV_entry_marker + + (setcdr dlist (cddr dlist))) + (setq dlist (cdr dlist))))) + (gnus-message 7 "gnus-agent-expire: Merging entries... Done") + + (let* ((len (float (length dlist))) + (alist (list nil)) + (tail-alist alist)) + (while dlist + (let ((new-completed (truncate (* 100.0 + (/ (setq cnt (1+ cnt)) + len))))) + (when (> new-completed completed) + (setq completed new-completed) + (gnus-message 7 "%3d%% completed..." completed))) + (let* ((entry (car dlist)) + (article-number (nth 0 entry)) + (fetch-date (nth 1 entry)) + (keep (nth 2 entry)) + (marker (nth 3 entry))) + + (cond + ;; Kept articles are unread, marked, or special. + (keep + (gnus-agent-message 10 + "gnus-agent-expire: Article %d: Kept %s article." + article-number keep) + (when fetch-date + (unless (file-exists-p + (concat dir (number-to-string + article-number))) + (setf (nth 1 entry) nil) + (gnus-agent-message 3 "gnus-agent-expire cleared \ +download flag on article %d as the cached article file is missing." + (caar dlist))) + (unless marker + (gnus-message 1 "gnus-agent-expire detected a \ +missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) + (gnus-agent-append-to-list + tail-alist + (cons article-number fetch-date))) + + ;; The following articles are READ, UNMARKED, and + ;; ORDINARY. See if they can be EXPIRED!!! + ((setq type + (cond + ((not (integerp fetch-date)) + 'read) ;; never fetched article (may expire + ;; right now) + ((not (file-exists-p + (concat dir (number-to-string + article-number)))) + (setf (nth 1 entry) nil) + 'externally-expired) ;; Can't find the cached + ;; article. Handle case + ;; as though this article + ;; was never fetched. + + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + ((< fetch-date day) + 'expired) + (force + 'forced))) + + ;; I found some reason to expire this entry. + + (let ((actions nil)) + (when (memq type '(forced expired)) + (ignore-errors ; Just being paranoid. + (delete-file (concat dir (number-to-string + article-number))) + (push "expired cached article" actions)) + (setf (nth 1 entry) nil) + ) + + (when marker + (push "NOV entry removed" actions) + (goto-char marker) + (gnus-delete-line)) + + ;; If considering all articles is set, I can only + ;; expire article IDs that are no longer in the + ;; active range (That is, articles that preceed the + ;; first article in the new alist). + (if (and gnus-agent-consider-all-articles + (>= article-number (car active))) + ;; I have to keep this ID in the alist + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date)) + (push (format "Removed %s article number from \ +article alist" type) actions)) + + (gnus-agent-message 8 "gnus-agent-expire: Article %d: %s" + article-number + (mapconcat 'identity actions ", ")))) + (t + (gnus-agent-message + 10 "gnus-agent-expire: Article %d: Article kept as \ +expiration tests failed." article-number) + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date))) + ) + + ;; Clean up markers as I want to recycle this buffer + ;; over several groups. + (when marker + (set-marker marker nil)) + + (setq dlist (cdr dlist)))) + + (setq alist (cdr alist)) + + (let ((inhibit-quit t)) + (unless (equal alist gnus-agent-article-alist) + (setq gnus-agent-article-alist alist) + (gnus-agent-save-alist group) + + ;; The active list changed, set the agent's active range + ;; to match the beginning of the list. + (if alist + (setcar active (caar alist)))) + + (when (buffer-modified-p) + (gnus-make-directory dir) + (write-region-as-coding-system gnus-agent-file-coding-system + (point-min) (point-max) nov-file + nil 'silent) + ;; clear the modified flag as that I'm not confused by + ;; its status on the next pass through this routine. + (set-buffer-modified-p nil)) + + (when (eq articles t) + (gnus-summary-update-info)))))))) + +(defun gnus-agent-expire (&optional articles group force) + "Expire all old articles. +If you want to force expiring of certain articles, this function can +take ARTICLES, GROUP and FORCE parameters as well. + +The articles on which the expiration process runs are selected as follows: + if ARTICLES is null, all read and unmarked articles. + if ARTICLES is t, all articles. + if ARTICLES is a list, just those articles. +Setting GROUP will limit expiration to that group. +FORCE is equivalent to setting the expiration predicates to true." (interactive) - (let ((methods gnus-agent-covered-methods) - (day (- (time-to-days (current-time)) gnus-agent-expire-days)) - gnus-command-method sym group articles - history overview file histories elem art nov-file low info - unreads marked article orig lowest highest) - (save-excursion - (setq overview (gnus-get-buffer-create " *expire overview*")) - (while (setq gnus-command-method (pop methods)) - (when (file-exists-p (gnus-agent-lib-file "active")) - (with-temp-buffer - (insert-file-contents-as-coding-system - gnus-agent-file-coding-system (gnus-agent-lib-file "active")) - (gnus-active-to-gnus-format - gnus-command-method - (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) - (let ((expiry-hashtb (gnus-make-hashtable 1023))) - (gnus-agent-open-history) - (set-buffer - (setq gnus-agent-current-history - (setq history (gnus-agent-history-buffer)))) - (goto-char (point-min)) - (when (> (buffer-size) 1) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^\t") - (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) 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))) - (set sym (list (cons (read (current-buffer)) (point))))) - (skip-chars-forward " ")) - (forward-line 1))) - ;; We now have all articles that can possibly be expired. - (mapatoms - (lambda (sym) - (setq group (symbol-name sym) - articles (sort (symbol-value sym) 'car-less-than-car) - low (car (gnus-active group)) - info (gnus-get-info group) - unreads (ignore-errors - (gnus-list-of-unread-articles group)) - marked (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'save (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'reply (gnus-info-marks info))))) - nov-file (gnus-agent-article-name ".overview" group) - lowest nil - highest nil) - (gnus-agent-load-alist group) - (gnus-message 5 "Expiring articles in %s" group) - (set-buffer overview) - (erase-buffer) - (when (file-exists-p nov-file) - (nnheader-insert-file-contents nov-file)) - (goto-char (point-min)) - (setq article 0) - (while (setq elem (pop articles)) - (setq article (car elem)) - (when (or (null low) - (< article low) - gnus-agent-expire-all - (and (not (memq article unreads)) - (not (memq article marked)))) - ;; Find and nuke the NOV line. - (while (and (not (eobp)) - (or (not (numberp - (setq art (read (current-buffer))))) - (< art article))) - (if (and (numberp art) - (file-exists-p - (gnus-agent-article-name - (number-to-string art) group))) - (progn - (unless lowest - (setq lowest art)) - (setq highest art) - (forward-line 1)) - ;; Remove old NOV lines that have no articles. - (gnus-delete-line))) - (if (or (eobp) - (/= art article)) - (beginning-of-line) - (gnus-delete-line)) - ;; Nuke the article. - (when (file-exists-p - (setq file (gnus-agent-article-name - (number-to-string article) - group))) - (delete-file file)) - ;; Schedule the history line for nuking. - (push (cdr elem) histories))) - (gnus-make-directory (file-name-directory nov-file)) - (write-region-as-coding-system - gnus-agent-file-coding-system - (point-min) (point-max) nov-file nil 'silent) - ;; Delete the unwanted entries in the alist. - (setq gnus-agent-article-alist - (sort gnus-agent-article-alist 'car-less-than-car)) - (let* ((alist gnus-agent-article-alist) - (prev (cons nil alist)) - (first prev) - expired) - (while (and alist - (<= (caar alist) article)) - (if (or (not (cdar alist)) - (not (file-exists-p - (gnus-agent-article-name - (number-to-string - (caar alist)) - group)))) - (progn - (push (caar alist) expired) - (setcdr prev (setq alist (cdr alist)))) - (setq prev alist - alist (cdr alist)))) - (setq gnus-agent-article-alist (cdr first)) - (gnus-agent-save-alist group) - ;; Mark all articles up to the first article - ;; in `gnus-article-alist' as read. - (when (and info (caar gnus-agent-article-alist)) - (setcar (nthcdr 2 info) - (gnus-range-add - (nth 2 info) - (cons 1 (- (caar gnus-agent-article-alist) 1))))) - ;; Maybe everything has been expired from `gnus-article-alist' - ;; and so the above marking as read could not be conducted, - ;; or there are expired article within the range of the alist. - (when (and info - expired - (or (not (caar gnus-agent-article-alist)) - (> (car expired) - (caar gnus-agent-article-alist)))) - (setcar (nthcdr 2 info) - (gnus-add-to-range - (nth 2 info) - (nreverse expired)))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string info) - ")"))) - (when lowest - (if (gnus-gethash group orig) - (setcar (gnus-gethash group orig) lowest) - (gnus-sethash group (cons lowest highest) orig)))) - expiry-hashtb) - (set-buffer history) - (setq histories (nreverse (sort histories '<))) - (while histories - (goto-char (pop histories)) - (gnus-delete-line)) - (gnus-agent-save-history) - (gnus-agent-close-history) - (gnus-write-active-file (gnus-agent-lib-file "active") orig)) - (gnus-message 4 "Expiry...done"))))))) + + (if group + (gnus-agent-expire-group group articles force) + (if (or (not (eq articles t)) + (yes-or-no-p "Are you sure that you want to expire all \ +articles in every agentized group.")) + (let ((methods gnus-agent-covered-methods) + ;; Bind gnus-agent-expire-current-dirs to enable tracking + ;; of agent directories. + (gnus-agent-expire-current-dirs nil) + gnus-command-method overview orig) + (setq overview (gnus-get-buffer-create " *expire overview*")) + (unwind-protect + (while (setq gnus-command-method (pop methods)) + (let ((active-file (gnus-agent-lib-file "active"))) + (when (file-exists-p active-file) + (with-temp-buffer + (nnheader-insert-file-contents active-file) + (gnus-active-to-gnus-format + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (dolist (expiring-group (gnus-groups-from-server + gnus-command-method)) + (let* ((active + (gnus-gethash-safe expiring-group orig))) + + (when active + (save-excursion + (gnus-agent-expire-group-1 + expiring-group overview active articles force))))) + (gnus-agent-write-active active-file orig t)))) + (kill-buffer overview)) + (gnus-agent-expire-unagentized-dirs) + (gnus-message 4 "Expiry...done"))))) + +(defun gnus-agent-expire-unagentized-dirs () + (when (and gnus-agent-expire-unagentized-dirs + (boundp 'gnus-agent-expire-current-dirs)) + (let* ((keep (gnus-make-hashtable)) + ;; Formally bind gnus-agent-expire-current-dirs so that the + ;; compiler will not complain about free references. + (gnus-agent-expire-current-dirs + (symbol-value 'gnus-agent-expire-current-dirs)) + dir) + + (gnus-sethash gnus-agent-directory t keep) + (while gnus-agent-expire-current-dirs + (setq dir (pop gnus-agent-expire-current-dirs)) + (when (and (stringp dir) + (file-directory-p dir)) + (while (not (gnus-gethash dir keep)) + (gnus-sethash dir t keep) + (setq dir (file-name-directory (directory-file-name dir)))))) + + (let* (to-remove + checker + (checker + (function + (lambda (d) + "Given a directory, check it and its subdirectories for + membership in the keep hash. If it isn't found, add + it to to-remove." + (let ((files (directory-files d)) + file) + (while (setq file (pop files)) + (cond ((equal file ".") ; Ignore self + nil) + ((equal file "..") ; Ignore parent + nil) + ((equal file ".overview") + ;; Directory must contain .overview to be + ;; agent's cache of a group. + (let ((d (file-name-as-directory d)) + r) + ;; Search ancestor's for last directory NOT + ;; found in keep hash. + (while (not (gnus-gethash + (setq d (file-name-directory d)) keep)) + (setq r d + d (directory-file-name d))) + ;; if ANY ancestor was NOT in keep hash and + ;; it it's already in to-remove, add it to + ;; to-remove. + (if (and r + (not (member r to-remove))) + (push r to-remove)))) + ((file-directory-p (setq file (nnheader-concat d file))) + (funcall checker file))))))))) + (funcall checker (expand-file-name gnus-agent-directory)) + + (when (and to-remove + (or gnus-expert-user + (gnus-y-or-n-p + "gnus-agent-expire has identified local directories that are\ + not currently required by any agentized group. Do you wish to consider\ + deleting them?"))) + (while to-remove + (let ((dir (pop to-remove))) + (if (gnus-y-or-n-p (format "Delete %s?" dir)) + (let* (delete-recursive + (delete-recursive + (function + (lambda (f-or-d) + (ignore-errors + (if (file-directory-p f-or-d) + (condition-case nil + (delete-directory f-or-d) + (file-error + (mapcar (lambda (f) + (or (member f '("." "..")) + (funcall delete-recursive + (nnheader-concat + f-or-d f)))) + (directory-files f-or-d)) + (delete-directory f-or-d))) + (delete-file f-or-d))))))) + (funcall delete-recursive dir)))))))))) ;;;###autoload (defun gnus-agent-batch () + "Start Gnus, send queue and fetch session." (interactive) (let ((init-file-user "") (gnus-always-read-dribble-file t)) (gnus)) - (gnus-group-send-drafts) - (gnus-agent-fetch-session)) + (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation)) + (gnus-group-send-queue) + (gnus-agent-fetch-session))) + +(defun gnus-agent-unread-articles (group) + (let* ((read (gnus-info-read (gnus-get-info group))) + (known (gnus-agent-load-alist group)) + (unread (list nil)) + (tail-unread unread)) + (while (and known read) + (let ((candidate (car (pop known)))) + (while (let* ((range (car read)) + (min (if (numberp range) range (car range))) + (max (if (numberp range) range (cdr range)))) + (cond ((or (not min) + (< candidate min)) + (gnus-agent-append-to-list tail-unread candidate) + nil) + ((> candidate max) + (setq read (cdr read)))))))) + (while known + (gnus-agent-append-to-list tail-unread (car (pop known)))) + (cdr unread))) + +(defun gnus-agent-uncached-articles (articles group &optional cached-header) + "Restrict ARTICLES to numbers already fetched. +Returns a sublist of ARTICLES that excludes thos article ids in GROUP +that have already been fetched. +If CACHED-HEADER is nil, articles are only excluded if the article itself +has been fetched." + + ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar + ;; 'car gnus-agent-article-alist)) + + ;; Functionally, I don't need to construct a temp list using mapcar. + + (if (and (or gnus-agent-cache (not gnus-plugged)) + (gnus-agent-load-alist group)) + (let* ((ref gnus-agent-article-alist) + (arts articles) + (uncached (list nil)) + (tail-uncached uncached)) + (while (and ref arts) + (let ((v1 (car arts)) + (v2 (caar ref))) + (cond ((< v1 v2) ; v1 does not appear in the reference list + (gnus-agent-append-to-list tail-uncached v1) + (setq arts (cdr arts))) + ((= v1 v2) + (unless (or cached-header (cdar ref)) ; v1 is already cached + (gnus-agent-append-to-list tail-uncached v1)) + (setq arts (cdr arts)) + (setq ref (cdr ref))) + (t ; reference article (v2) preceeds the list being filtered + (setq ref (cdr ref)))))) + (while arts + (gnus-agent-append-to-list tail-uncached (pop arts))) + (cdr uncached)) + ;; if gnus-agent-load-alist fails, no articles are cached. + articles)) + +(defun gnus-agent-retrieve-headers (articles group &optional fetch-old) + (save-excursion + (gnus-agent-create-buffer) + (let ((gnus-decode-encoded-word-function 'identity) + (file (gnus-agent-article-name ".overview" group)) + cached-articles uncached-articles) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t)) + + ;; Populate temp buffer with known headers + (when (file-exists-p file) + (with-current-buffer gnus-agent-overview-buffer + (erase-buffer) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-nov-file file (car articles))))) + + (if (setq uncached-articles (gnus-agent-uncached-articles articles group + t)) + (progn + ;; Populate nntp-server-buffer with uncached headers + (set-buffer nntp-server-buffer) + (erase-buffer) + (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent + (gnus-retrieve-headers + uncached-articles group fetch-old)))) + (nnvirtual-convert-headers)) + ((eq 'nntp (car gnus-current-select-method)) + ;; The author of gnus-get-newsgroup-headers-xover + ;; reports that the XOVER command is commonly + ;; unreliable. The problem is that recently + ;; posted articles may not be entered into the + ;; NOV database in time to respond to my XOVER + ;; query. + ;; + ;; I'm going to use his assumption that the NOV + ;; database is updated in order of ascending + ;; article ID. Therefore, a response containing + ;; article ID N implies that all articles from 1 + ;; to N-1 are up-to-date. Therefore, missing + ;; articles in that range have expired. + + (set-buffer nntp-server-buffer) + (let* ((fetched-articles (list nil)) + (tail-fetched-articles fetched-articles) + (min (cond ((numberp fetch-old) + (max 1 (- (car articles) fetch-old))) + (fetch-old + 1) + (t + (car articles)))) + (max (car (last articles)))) + + ;; Get the list of articles that were fetched + (goto-char (point-min)) + (let ((pm (point-max))) + (while (< (point) pm) + (when (looking-at "[0-9]+\t") + (gnus-agent-append-to-list + tail-fetched-articles + (read (current-buffer)))) + (forward-line 1))) + + ;; Clip this list to the headers that will + ;; actually be returned + (setq fetched-articles (gnus-list-range-intersection + (cdr fetched-articles) + (cons min max))) + + ;; Clip the uncached articles list to exclude + ;; IDs after the last FETCHED header. The + ;; excluded IDs may be fetchable using HEAD. + (if (car tail-fetched-articles) + (setq uncached-articles + (gnus-list-range-intersection + uncached-articles + (cons (car uncached-articles) + (car tail-fetched-articles))))) + + ;; Create the list of articles that were + ;; "successfully" fetched. Success, in this + ;; case, means that the ID should not be + ;; fetched again. In the case of an expired + ;; article, the header will not be fetched. + (setq uncached-articles + (gnus-sorted-nunion fetched-articles + uncached-articles)) + ))) + + ;; Erase the temp buffer + (set-buffer gnus-agent-overview-buffer) + (erase-buffer) + + ;; Copy the nntp-server-buffer to the temp buffer + (set-buffer nntp-server-buffer) + (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + + ;; Merge the temp buffer with the known headers (found on + ;; disk in FILE) into the nntp-server-buffer + (when (and uncached-articles (file-exists-p file)) + (gnus-agent-braid-nov group uncached-articles file)) + + ;; Save the new set of known headers to FILE + (set-buffer nntp-server-buffer) + (gnus-agent-check-overview-buffer) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) file nil 'silent) + + ;; Update the group's article alist to include the newly + ;; fetched articles. + (gnus-agent-load-alist group) + (gnus-agent-save-alist group uncached-articles nil) + ) + + ;; Copy the temp buffer to the nntp-server-buffer + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring gnus-agent-overview-buffer))) + + (if (and fetch-old + (not (numberp fetch-old))) + t ; Don't remove anything. + (nnheader-nov-delete-outside-range + (if fetch-old (max 1 (- (car articles) fetch-old)) + (car articles)) + (car (last articles))) + t) + + 'nov)) + +(defun gnus-agent-request-article (article group) + "Retrieve ARTICLE in GROUP from the agent cache." + (when (and gnus-agent + (or gnus-agent-cache + (not gnus-plugged)) + (numberp article)) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (file (gnus-agent-article-name (number-to-string article) group)) + (buffer-read-only nil)) + (when (and (file-exists-p file) + (> (nth 7 (file-attributes file)) 0)) + (erase-buffer) + (gnus-kill-all-overlays) + (insert-file-contents-as-coding-system gnus-cache-coding-system file) + t)))) + +(defun gnus-agent-regenerate-group (group &optional reread) + "Regenerate GROUP. +If REREAD is t, all articles in the .overview are marked as unread. +If REREAD is not nil, downloaded articles are marked as unread." + (interactive + (list (let ((def (or (gnus-group-group-name) + gnus-newsgroup-name))) + (let ((select (read-string (if def + (concat "Group Name (" + def "): ") + "Group Name: ")))) + (if (and (equal "" select) + def) + def + select))) + (intern-soft + (read-string + "Reread (nil)? (t=>all, nil=>none, some=>all downloaded): ")))) + (gnus-message 5 "Regenerating in %s" group) + (let* ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (file (gnus-agent-article-name ".overview" group)) + (dir (file-name-directory file)) + point + (downloaded (if (file-exists-p dir) + (sort (mapcar (lambda (name) (string-to-int name)) + (directory-files dir nil "^[0-9]+$" t)) + '>) + (progn (gnus-make-directory dir) nil))) + dl nov-arts + alist header + regenerated) + + (mm-with-unibyte-buffer + (if (file-exists-p file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))) + (set-buffer-modified-p nil) + + ;; Load the article IDs found in the overview file. As a + ;; side-effect, validate the file contents. + (let ((load t)) + (while load + (setq load nil) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond ((and (looking-at "[0-9]+\t") + (<= (- (match-end 0) (match-beginning 0)) 9)) + (push (read (current-buffer)) nov-arts) + (forward-line 1) + (let ((l1 (car nov-arts)) + (l2 (cadr nov-arts))) + (cond ((not l2) + nil) + ((< l1 l2) + (gnus-message 3 "gnus-agent-regenerate-group: NOV\ + entries are NOT in ascending order.") + ;; Don't sort now as I haven't verified + ;; that every line begins with a number + (setq load t)) + ((= l1 l2) + (forward-line -1) + (gnus-message 4 "gnus-agent-regenerate-group: NOV\ + entries contained duplicate of article %s. Duplicate deleted." l1) + (gnus-delete-line) + (setq nov-arts (cdr nov-arts)))))) + (t + (gnus-message 1 "gnus-agent-regenerate-group: NOV\ + entries contained line that did not begin with an article number. Deleted\ + line.") + (gnus-delete-line)))) + (if load + (progn + (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ + entries into ascending order.") + (sort-numeric-fields 1 (point-min) (point-max)) + (setq nov-arts nil))))) + (gnus-agent-check-overview-buffer) + + ;; Construct a new article alist whose nodes match every header + ;; in the .overview file. As a side-effect, missing headers are + ;; reconstructed from the downloaded article file. + (while (or downloaded nov-arts) + (cond ((and downloaded + (or (not nov-arts) + (> (car downloaded) (car nov-arts)))) + ;; This entry is missing from the overview file + (gnus-message 3 "Regenerating NOV %s %d..." group + (car downloaded)) + (let ((file (concat dir (number-to-string (car downloaded))))) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (nnheader-remove-body) + (setq header (nnheader-parse-naked-head))) + (mail-header-set-number header (car downloaded)) + (if nov-arts + (let ((key (concat "^" (int-to-string (car nov-arts)) + "\t"))) + (or (re-search-backward key nil t) + (re-search-forward key)) + (forward-line 1)) + (goto-char (point-min))) + (nnheader-insert-nov header)) + (setq nov-arts (cons (car downloaded) nov-arts))) + ((eq (car downloaded) (car nov-arts)) + ;; This entry in the overview has been downloaded + (push (cons (car downloaded) + (time-to-days + (nth 5 (file-attributes + (concat dir (number-to-string + (car downloaded))))))) alist) + (setq downloaded (cdr downloaded)) + (setq nov-arts (cdr nov-arts))) + (t + ;; This entry in the overview has not been downloaded + (push (cons (car nov-arts) nil) alist) + (setq nov-arts (cdr nov-arts))))) + + ;; When gnus-agent-consider-all-articles is set, + ;; gnus-agent-regenerate-group should NOT remove article IDs from + ;; the alist. Those IDs serve as markers to indicate that an + ;; attempt has been made to fetch that article's header. + + ;; When gnus-agent-consider-all-articles is NOT set, + ;; gnus-agent-regenerate-group can remove the article ID of every + ;; article (with the exception of the last ID in the list - it's + ;; special) that no longer appears in the overview. In this + ;; situtation, the last article ID in the list implies that it, + ;; and every article ID preceeding it, have been fetched from the + ;; server. + (if gnus-agent-consider-all-articles + ;; Restore all article IDs that were not found in the overview file. + (let* ((n (cons nil alist)) + (merged n) + (o (gnus-agent-load-alist group))) + (while o + (let ((nID (caadr n)) + (oID (caar o))) + (cond ((not nID) + (setq n (setcdr n (list (list oID)))) + (setq o (cdr o))) + ((< oID nID) + (setcdr n (cons (list oID) (cdr n))) + (setq o (cdr o))) + ((= oID nID) + (setq o (cdr o)) + (setq n (cdr n))) + (t + (setq n (cdr n)))))) + (setq alist (cdr merged))) + ;; Restore the last article ID if it is not already in the new alist + (let ((n (last alist)) + (o (last (gnus-agent-load-alist group)))) + (cond ((not o) + nil) + ((not n) + (push (cons (caar o) nil) alist)) + ((< (caar n) (caar o)) + (setcdr n (list (car o))))))) + + (let ((inhibit-quit t)) + (if (setq regenerated (buffer-modified-p)) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) file nil 'silent)) + + (setq regenerated (or regenerated + (and reread gnus-agent-article-alist) + (not (equal alist gnus-agent-article-alist))) + ) + + (setq gnus-agent-article-alist alist) + + (when regenerated + (gnus-agent-save-alist group))) + ) + + (when (and reread gnus-agent-article-alist) + (gnus-make-ascending-articles-unread + group + (delq nil (mapcar (function (lambda (c) + (cond ((eq reread t) + (car c)) + ((cdr c) + (car c))))) + gnus-agent-article-alist))) + + (when (gnus-buffer-live-p gnus-group-buffer) + (gnus-group-update-group group t) + (sit-for 0)) + ) + + (gnus-message 5 nil) + regenerated)) + +;;;###autoload +(defun gnus-agent-regenerate (&optional clean reread) + "Regenerate all agent covered files. +If CLEAN, don't read existing active files." + (interactive "P") + (let (regenerated) + (gnus-message 4 "Regenerating Gnus agent files...") + (dolist (gnus-command-method gnus-agent-covered-methods) + (let ((active-file (gnus-agent-lib-file "active")) + active-hashtb active-changed + point) + (gnus-make-directory (file-name-directory active-file)) + (if clean + (setq active-hashtb (gnus-make-hashtable 1000)) + (mm-with-unibyte-buffer + (if (file-exists-p active-file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents active-file)) + (setq active-changed t)) + (gnus-active-to-gnus-format + nil (setq active-hashtb + (gnus-make-hashtable + (count-lines (point-min) (point-max))))))) + (dolist (group (gnus-groups-from-server gnus-command-method)) + (setq regenerated (or (gnus-agent-regenerate-group group reread) + regenerated)) + (let ((min (or (caar gnus-agent-article-alist) 1)) + (max (or (caar (last gnus-agent-article-alist)) 0)) + (active (gnus-gethash-safe (gnus-group-real-name group) + active-hashtb)) + (read (gnus-info-read (gnus-get-info group)))) + (if (not active) + (progn + (setq active (cons min max) + active-changed t) + (gnus-sethash group active active-hashtb)) + (when (> (car active) min) + (setcar active min) + (setq active-changed t)) + (when (< (cdr active) max) + (setcdr active max) + (setq active-changed t))))) + (when active-changed + (setq regenerated t) + (gnus-message 4 "Regenerate %s" active-file) + (let ((nnmail-active-file-coding-system + gnus-agent-file-coding-system)) + (gnus-write-active-file active-file active-hashtb))))) + (gnus-message 4 "Regenerating Gnus agent files...done") + regenerated)) + +(defun gnus-agent-go-online (&optional force) + "Switch servers into online status." + (interactive (list t)) + (dolist (server gnus-opened-servers) + (when (eq (nth 1 server) 'offline) + (if (if (eq force 'ask) + (gnus-y-or-n-p + (format "Switch %s:%s into online status? " + (caar server) (cadar server))) + force) + (setcar (nthcdr 1 server) 'close))))) + +(defun gnus-agent-toggle-group-plugged (group) + "Toggle the status of the server of the current group." + (interactive (list (gnus-group-group-name))) + (let* ((method (gnus-find-method-for-group group)) + (status (cadr (assoc method gnus-opened-servers)))) + (if (eq status 'offline) + (gnus-server-set-status method 'closed) + (gnus-close-server method) + (gnus-server-set-status method 'offline)) + (message "Turn %s:%s from %s to %s." (car method) (cadr method) + (if (eq status 'offline) 'offline 'online) + (if (eq status 'offline) 'online 'offline)))) + +(defun gnus-agent-group-covered-p (group) + (member (gnus-group-method group) + gnus-agent-covered-methods)) + +(add-hook 'gnus-group-prepare-hook + (lambda () + 'gnus-agent-do-once + + (when (listp gnus-agent-expire-days) + (beep) + (beep) + (gnus-message 1 "WARNING: gnus-agent-expire-days no longer\ + supports being set to a list.")(sleep-for 3) + (gnus-message 1 "Change your configuration to set it to an\ + integer.")(sleep-for 3) + (gnus-message 1 "I am now setting group parameters on each\ + group to match the configuration that the list offered.") + + (save-excursion + (let ((groups (gnus-group-listed-groups))) + (while groups + (let* ((group (pop groups)) + (days gnus-agent-expire-days) + (day (catch 'found + (while days + (when (eq 0 (string-match + (caar days) + group)) + (throw 'found (cadar days))) + (setq days (cdr days))) + nil))) + (when day + (gnus-group-set-parameter group 'agent-days-until-old + day)))))) + + (let ((h gnus-group-prepare-hook)) + (while h + (let ((func (pop h))) + (when (and (listp func) + (eq (cadr (caddr func)) 'gnus-agent-do-once)) + (remove-hook 'gnus-group-prepare-hook func) + (setq h nil))))) + + (gnus-message 1 "I have finished setting group parameters on\ + each group. You may now customize your groups and/or topics to control the\ + agent.")))) (provide 'gnus-agent) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 8e3b3d3..9c5399e 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,6 @@ ;;; gnus-art.el --- article mode commands for Semi-gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -27,14 +28,17 @@ ;;; Code: -(eval-when-compile (require 'cl)) -(eval-when-compile (require 'static)) +(eval-when-compile + (require 'cl) + (require 'static) + (defvar tool-bar-map)) (require 'path-util) (require 'gnus) (require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) +(require 'gnus-win) (require 'alist) (require 'mime-view) (require 'wid-edit) @@ -45,8 +49,13 @@ (require 'mail-parse) (require 'mm-decode) (require 'mm-view) - (require 'mm-uu) - ) + (require 'mm-uu)) + +(require 'message) + +(autoload 'gnus-msg-mail "gnus-msg" nil t) +(autoload 'gnus-button-mailto "gnus-msg") +(autoload 'gnus-button-reply "gnus-msg" nil t) (defgroup gnus-article nil "Article display." @@ -110,33 +119,47 @@ :group 'gnus-article) (defcustom gnus-ignored-headers - '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:" - "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" - "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:" - "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:" - "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:" - "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:" - "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:" - "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:" - "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:" - "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:" - "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:" - "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" - "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:" - "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" - "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:" - "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" - "^MBOX-Line" "^Priority:" "^X-Pgp" "^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:" - "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:" - "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:" - "^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-Received:" "^Content-length:" "X-precedence:") + (mapcar + (lambda (header) + (concat "^" header ":")) + '("Path" "Expires" "Date-Received" "References" "Xref" "Lines" + "Relay-Version" "Message-ID" "Approved" "Sender" "Received" + "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To" + "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature" + "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop" + "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face" + "X-Attribution" "X-Originating-IP" "Delivered-To" + "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace" + "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*" + "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date" + "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache" + "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time" + "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List" + "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt" + "Old-Received" "X-Pgp" "X-Auth" "X-From-Line" + "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender" + "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" + "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT" + "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin" + "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-Received" "Content-length" "X-precedence" + "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info" + "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup" + "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To" + "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post" + "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive" + "X-Content-length" "X-Posting-Agent" "Original-Received" + "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom" + "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" + "X-Local-Origin" "X-Local-Destination" "X-UserInfo1" + "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" + "X-Abuse-and-DMCA-Info" "X-Postfilter")) "*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." @@ -170,17 +193,39 @@ this list." (defcustom gnus-boring-article-headers '(empty followup-to reply-to) "Headers that are only to be displayed if they have interesting data. -Possible values in this list are `empty', `newsgroups', `followup-to', -`reply-to', `date', `long-to', and `many-to'." +Possible values in this list are: + + 'empty Headers with no content. + 'newsgroups Newsgroup identical to Gnus group. + 'to-address To identical to To-address. + 'to-list To identical to To-list. + 'cc-list CC identical to To-list. + 'followup-to Followup-to identical to Newsgroups. + 'reply-to Reply-to identical to From. + 'date Date less than four days old. + 'long-to To and/or Cc longer than 1024 characters. + 'many-to Multiple To and/or Cc." :type '(set (const :tag "Headers with no content." empty) - (const :tag "Newsgroups with only one group." newsgroups) - (const :tag "Followup-to identical to newsgroups." followup-to) - (const :tag "Reply-to identical to from." reply-to) + (const :tag "Newsgroups identical to Gnus group." newsgroups) + (const :tag "To identical to To-address." to-address) + (const :tag "To identical to To-list." to-list) + (const :tag "CC identical to To-list." cc-list) + (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 and/or Cc header." long-to) + (const :tag "To and/or Cc longer than 1024 characters." long-to) (const :tag "Multiple To and/or Cc headers." many-to)) :group 'gnus-article-hiding) +(defcustom gnus-article-skip-boring nil + "Skip over text that is not worth reading. +By default, if you set this t, then Gnus will display citations and +signatures, but will never scroll down to show you a page consisting +only of boring text. Boring text is controlled by +`gnus-article-boring-faces'." + :type 'boolean + :group 'gnus-article-hiding) + (defcustom gnus-signature-separator '("^-- $" "^-- *$") "Regexp matching signature separator. This can also be a list of regexps. In that case, it will be checked @@ -212,28 +257,50 @@ regexp. If it matches, the text in question is not a signature." ;; non-graphical frames in a session. (defcustom gnus-article-x-face-command (cond + (noninteractive + 'ignore) + ((featurep 'xemacs) + (if (or (gnus-image-type-available-p 'xface) + (gnus-image-type-available-p 'pbm)) + 'gnus-display-x-face-in-from + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")) ((and (fboundp 'image-type-available-p) (module-installed-p 'x-face-e21)) 'x-face-decode-message-header) - ((and (fboundp 'image-type-available-p) - (image-type-available-p 'xbm)) - 'gnus-article-display-xface) - ((and (not (featurep 'xemacs)) - window-system + ((gnus-image-type-available-p 'pbm) + 'gnus-display-x-face-in-from) + ((and window-system (module-installed-p 'x-face-mule)) 'x-face-mule-gnus-article-display-x-face) (t - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -")) + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ +display -")) "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." - :type '(choice string - (function-item - :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) + :type `(choice + ,@(let (x-face-e21 x-face-mule) + (if (featurep 'xemacs) + nil + (setq x-face-e21 (module-installed-p 'x-face-e21) + x-face-mule (module-installed-p 'x-face-mule))) + (delq nil + (list + 'string + (if (or (gnus-image-type-available-p 'xface) + (gnus-image-type-available-p 'pbm)) + '(function-item gnus-display-x-face-in-from)) + (if (and x-face-e21 + (fboundp 'image-type-available-p)) + '(function-item + :tag "x-face-decode-message-header (x-face-e21)" + x-face-decode-message-header)) + (if x-face-mule + '(function-item + x-face-mule-gnus-article-display-x-face)) + 'function)))) + ;;:version "21.1" + :group 'gnus-picon :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil @@ -243,30 +310,74 @@ asynchronously. The compressed face will be piped to this command." (defcustom gnus-article-banner-alist nil "Banner alist for stripping. -For example, - ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" +For example, + ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" + :version "21.1" :type '(repeat (cons symbol regexp)) :group 'gnus-article-washing) +(gnus-define-group-parameter + banner + :variable-document + "Alist of regexps (to match group names) and banner." + :variable-group gnus-article-washing + :parameter-type + '(choice :tag "Banner" + :value nil + (const :tag "Remove signature" signature) + (symbol :tag "Item in `gnus-article-banner-alist'" none) + regexp + (const :tag "None" nil)) + :parameter-document + "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.") + +(defcustom gnus-article-address-banner-alist nil + "Alist of mail addresses and banners. +Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp +to match a mail address in the From: header, BANNER is one of a symbol +`signature', an item in `gnus-article-banner-alist', a regexp and nil. +If ADDRESS matches author's mail address, it will remove things like +advertisements. For example: + +\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\")) +" + :type '(repeat + (cons + (regexp :tag "Address") + (choice :tag "Banner" :value nil + (const :tag "Remove signature" signature) + (symbol :tag "Item in `gnus-article-banner-alist'" none) + regexp + (const :tag "None" nil)))) + :group 'gnus-article-washing) + (defcustom gnus-emphasis-alist (let ((format - "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)") + "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") (types - '(("_" "_" underline) + '(("\\*" "\\*" bold) + ("_" "_" underline) ("/" "/" italic) - ("\\*" "\\*" bold) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) ("_\\*/" "/\\*_" underline-bold-italic)))) - `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline) - ,@(mapcar + `(,@(mapcar (lambda (spec) (list (format format (car spec) (car (cdr spec))) 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types))) + types) + ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-strikethru) + ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline))) "*Alist that says how to fontify certain phrases. Each item looks like this: @@ -289,6 +400,7 @@ is the face used for highlighting." 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) @@ -319,7 +431,11 @@ and the latter avoids underlining any whitespace at all." (defface gnus-emphasis-underline-bold-italic '((t (:bold t :italic t :underline t))) "Face used for displaying underlined bold italic emphasized text. -Esample: (_/*word*/_)." +Example: (_/*word*/_)." + :group 'gnus-article-emphasis) + +(defface gnus-emphasis-strikethru '((t (:strikethru t))) + "Face used for displaying strike-through text (-word-)." :group 'gnus-article-emphasis) (defface gnus-emphasis-highlight-words @@ -378,6 +494,7 @@ Gnus provides the following functions: * gnus-summary-save-in-mail (Unix mail format) * gnus-summary-save-in-folder (MH folder) * gnus-summary-save-in-file (article format) +* gnus-summary-save-body-in-file (article body) * gnus-summary-save-in-vm (use VM's folder format) * gnus-summary-write-to-file (article format -- overwrite)." :group 'gnus-article-saving @@ -385,6 +502,7 @@ Gnus provides the following functions: (function-item gnus-summary-save-in-mail) (function-item gnus-summary-save-in-folder) (function-item gnus-summary-save-in-file) + (function-item gnus-summary-save-body-in-file) (function-item gnus-summary-save-in-vm) (function-item gnus-summary-write-to-file))) @@ -477,6 +595,13 @@ The following additional specs are available: :type 'hook :group 'gnus-article-various) +(when (featurep 'xemacs) + ;; Extracted from gnus-xmas-define in order to preserve user settings + (when (fboundp 'turn-off-scroll-in-place) + (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) + ;; Extracted from gnus-xmas-redefine in order to preserve user settings + (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)) + (defcustom gnus-article-menu-hook nil "*Hook run after the creation of the article mode menu." :type 'hook @@ -487,10 +612,8 @@ The following additional specs are available: :type 'hook :group 'gnus-article-various) -(defcustom gnus-article-hide-pgp-hook nil - "*A hook called after successfully hiding a PGP signature." - :type 'hook - :group 'gnus-article-various) +(make-obsolete-variable 'gnus-article-hide-pgp-hook + "This variable is obsolete in Gnus 5.10.") (defcustom gnus-article-button-face 'bold "Face used for highlighting buttons in the article buffer. @@ -582,7 +705,8 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (background light)) (:foreground "indianred4" :italic t)) (t - (:italic t))) "Face used for displaying header content." + (:italic t))) + "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -612,7 +736,8 @@ displayed by the first non-nil matching CONTENT face." (item :tag "skip" nil) (face :value default))))) -(defcustom gnus-article-decode-hook nil +(defcustom gnus-article-decode-hook + '(article-decode-group-name article-decode-idna-rhs) "*Hook run to decode charsets in articles." :group 'gnus-article-headers :type 'hook) @@ -640,6 +765,7 @@ displayed by the first non-nil matching CONTENT face." ("\225" "*") ("\226" "-") ("\227" "--") + ("\230" "~") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -648,14 +774,62 @@ 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." + "List of MIME types that should not be given buttons when rendered inline. +See also `gnus-buttonized-mime-types' which may override this variable. +This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." + :version "21.1" :group 'gnus-article-mime :type '(repeat regexp)) +(defcustom gnus-buttonized-mime-types nil + "List of MIME types that should be given buttons when rendered inline. +If set, this variable overrides `gnus-unbuttonized-mime-types'. +To see e.g. security buttons you could set this to +`(\"multipart/signed\")'. +This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." + :version "21.1" + :group 'gnus-article-mime + :type '(repeat regexp)) + +(defcustom gnus-inhibit-mime-unbuttonizing nil + "If non-nil, all MIME parts get buttons. +When nil (the default value), then some MIME parts do not get buttons, +as described by the variables `gnus-buttonized-mime-types' and +`gnus-unbuttonized-mime-types'." + :version "21.3" + :type 'boolean) + +(defcustom gnus-body-boundary-delimiter "_" + "String used to delimit header and body. +This variable is used by `gnus-article-treat-body-boundary' which can +be controlled by `gnus-treat-body-boundary'." + :group 'gnus-article-various + :type '(choice (item :tag "None" :value nil) + string)) + +(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") + "Defines the location of the faces database. +For information on obtaining this database of pretty pictures, please +see http://www.cs.indiana.edu/picons/ftp/index.html" + :type '(repeat directory) + :link '(url-link :tag "download" + "http://www.cs.indiana.edu/picons/ftp/index.html") + :link '(custom-manual "(gnus)Picons") + :group 'gnus-picon) + +(defun gnus-picons-installed-p () + "Say whether picons are installed on your machine." + (let ((installed nil)) + (dolist (database gnus-picon-databases) + (when (file-exists-p database) + (setq installed t))) + installed)) + (defcustom gnus-article-mime-part-function nil "Function called with a MIME handle as the argument. This is meant for people who want to do something automatic based @@ -665,6 +839,7 @@ on parts -- for instance, adding Vcard info to a database." (defcustom gnus-mime-multipart-functions nil "An alist of MIME types to functions to display them." + :version "21.1" :group 'gnus-article-mime :type 'alist) @@ -673,34 +848,39 @@ on parts -- for instance, adding Vcard info to a database." 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) (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative "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 +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 used." + :version "21.1" :group 'gnus-article-mime - :type '(choice + :type '(choice (item :tag "first" :value nil) (item :tag "undisplayed" :value undisplayed) - (item :tag "undisplayed or alternative" + (item :tag "undisplayed or alternative" :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) + ("delete part" . gnus-mime-delete-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) + ("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)) + ("view internally" . gnus-mime-view-part-internally) + ("view externally" . gnus-mime-view-part-externally)) "An alist of actions that run on the MIME attachment." :group 'gnus-article-mime :type '(repeat (cons (string :tag "name") @@ -733,275 +913,472 @@ used." (defvar gnus-inhibit-treatment nil "Whether to inhibit treatment.") -(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard")) +(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard")) "Highlight the signature. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-highlight-signature 'highlight t) (defcustom gnus-treat-buttonize 100000 "Add buttons. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-buttonize 'highlight t) (defcustom gnus-treat-buttonize-head 'head "Add buttons to the head. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) -(defcustom gnus-treat-emphasize +(defcustom gnus-treat-emphasize (and (or window-system (featurep 'xemacs) (>= (string-to-number emacs-version) 21)) 50000) "Emphasize text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-emphasize 'highlight t) (defcustom gnus-treat-strip-cr nil "Remove carriage returns. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-unsplit-urls nil + "Remove newlines from within URLs. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-leading-whitespace nil + "Remove leading whitespace in headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-hide-headers 'head "Hide headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-boring-headers nil "Hide boring headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-signature nil "Hide the signature. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-fill-article nil "Fill the article. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation nil "Hide cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation-maybe nil "Hide cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-strip-list-identifiers 'head "Strip list identifiers from `gnus-list-identifiers`. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(defcustom gnus-treat-strip-pgp t - "Strip PGP signatures. -Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." - :group 'gnus-article-treat - :type gnus-article-treat-custom) +(make-obsolete-variable 'gnus-treat-strip-pgp + "This option is obsolete in Gnus 5.10.") (defcustom gnus-treat-strip-pem nil "Strip PEM signatures. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-strip-banner t "Strip banners from articles. The banner to be stripped is specified in the `banner' group parameter. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-highlight-headers 'head "Highlight the headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (put 'gnus-treat-highlight-headers 'highlight t) (defcustom gnus-treat-highlight-citation t "Highlight cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-highlight-citation 'highlight t) (defcustom gnus-treat-date-ut nil "Display the Date in UT (GMT). Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-local nil "Display the Date in the local timezone. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-head-custom) + +(defcustom gnus-treat-date-english nil + "Display the Date in a format that can be read aloud in English. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-lapsed nil "Display the Date header in a way that says how much time has elapsed. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-original nil "Display the date in the original timezone. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-iso8601 nil "Display the date in the ISO8601 format. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-user-defined nil "Display the date in a user-defined format. The format is defined by the `gnus-article-time-format' variable. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-strip-headers-in-body t "Strip the X-No-Archive header line from the beginning of the body. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-strip-trailing-blank-lines nil "Strip trailing blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-strip-leading-blank-lines nil "Strip leading blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-strip-multiple-blank-lines nil "Strip multiple blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-unfold-headers 'head + "Unfold folded header lines. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-fold-headers nil + "Fold headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-fold-newsgroups 'head + "Fold the Newsgroups and Followup-To headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-overstrike t "Treat overstrike highlighting. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) (defcustom gnus-treat-display-xface - (if (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 - nil) + (and (not noninteractive) + (or (memq gnus-article-x-face-command + '(x-face-decode-message-header + x-face-mule-gnus-article-display-x-face)) + (and (fboundp 'image-type-available-p) + (image-type-available-p 'xbm) + (string-match "^0x" (shell-command-to-string "uncompface")) + (executable-find "icontopbm")) + (and (featurep 'xemacs) + (featurep 'xface))) + 'head) "Display X-Face headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)X-Face' for details." :group 'gnus-article-treat + ;;:version "21.1" + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)X-Face") :type gnus-article-treat-head-custom) (put 'gnus-treat-display-xface 'highlight t) +(defcustom gnus-article-should-use-smiley-mule + (not (or (featurep 'xemacs) + (gnus-image-type-available-p 'xpm) + (gnus-image-type-available-p 'pbm))) + "If non-nil, gnus uses `smiley-mule' for displaying smileys rather than +`smiley'. It defaults to t when Emacs 20 or earlier is running. +`smiley-mule' is boundled in BITMAP-MULE package. You can set it to t +even if you are using Emacs 21+. It has no effect on XEmacs." + :group 'gnus-article-various + :type 'boolean + :get (lambda (symbol) + (and (not noninteractive) + (default-value symbol) + (not (featurep 'xemacs)) + (module-installed-p 'smiley-mule) + t)) + :set (lambda (symbol value) + (set-default symbol (and (not noninteractive) + value + (not (featurep 'xemacs)) + (module-installed-p 'smiley-mule) + t)))) + +(defvar gnus-article-smiley-mule-loaded-p nil + "Internal variable used to say whether `smiley-mule' is loaded (whether +smiley functions are not overridden by `smiley').") + +(defcustom gnus-treat-display-face + (and (not noninteractive) + ;; x-face-e21 handles both X-Face and Face headers. + (not (and (eq gnus-article-x-face-command 'x-face-decode-message-header) + (module-installed-p 'x-face-e21))) + (or (and (fboundp 'image-type-available-p) + (image-type-available-p 'png)) + (and (featurep 'xemacs) + (featurep 'png))) + 'head) + "Display Face headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)X-Face' for details." + :group 'gnus-article-treat + :version "21.1" + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)X-Face") + :type gnus-article-treat-head-custom) +(put 'gnus-treat-display-face 'highlight t) + (defcustom gnus-treat-display-smileys - (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))) + (if (and (not noninteractive) + (or (and (featurep 'xemacs) + (featurep 'xpm)) + (gnus-image-type-available-p 'xpm) + (gnus-image-type-available-p 'pbm) + (and (not (featurep 'xemacs)) + window-system + (module-installed-p 'smiley-mule)))) t nil) "Display smileys. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Smileys' for details." :group 'gnus-article-treat + ;;:version "21.1" + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Smileys") :type gnus-article-treat-custom) (put 'gnus-treat-display-smileys 'highlight t) -(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil) - "Display picons. +(defcustom gnus-treat-from-picon + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) + 'head nil) + "Display picons in the From header. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." + :group 'gnus-article-treat + :group 'gnus-picon + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Picons") + :type gnus-article-treat-head-custom) +(put 'gnus-treat-from-picon 'highlight t) + +(defcustom gnus-treat-mail-picon + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) + 'head nil) + "Display picons in To and Cc headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." :group 'gnus-article-treat + :group 'gnus-picon + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Picons") :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-picons 'highlight t) +(put 'gnus-treat-mail-picon 'highlight t) + +(defcustom gnus-treat-newsgroups-picon + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) + 'head nil) + "Display picons in the Newsgroups and Followup-To headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." + :group 'gnus-article-treat + :group 'gnus-picon + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Picons") + :type gnus-article-treat-head-custom) +(put 'gnus-treat-newsgroups-picon 'highlight t) + +(defcustom gnus-treat-body-boundary + (if (or gnus-treat-newsgroups-picon + gnus-treat-mail-picon + gnus-treat-from-picon) + 'head nil) + "Draw a boundary at the end of the headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) (defcustom gnus-treat-capitalize-sentences nil "Capitalize sentence-starting words. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-wash-html nil + "Format as HTML. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-fill-long-lines nil "Fill long lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-play-sounds nil "Play sounds. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-decode-article-as-default-mime-charset nil @@ -1017,45 +1394,99 @@ decode the body, '(or header t) for the whole article, etc." (defcustom gnus-treat-translate nil "Translate articles from one language to another. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :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 Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat + :group 'mime-security :type gnus-article-treat-custom) +(defcustom gnus-treat-monafy nil + "Display body part with mona font. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :group 'mime-security + :link '(custom-manual "(gnus)Customizing Articles") + :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) + +(defvar gnus-article-wash-function nil + "Function used for converting HTML into text.") + +(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error)) + (mm-coding-system-p 'utf-8)) + "Whether IDNA decoding of headers is used when viewing messages. +This requires GNU Libidn, and by default only enabled if it is found." + :group 'gnus-article-headers + :type 'boolean) + +(defcustom gnus-article-over-scroll nil + "If non-nil, allow scrolling the article buffer even when there no more text." + :group 'gnus-article + :type 'boolean) + ;;; Internal variables +(defvar gnus-english-month-names + '("January" "February" "March" "April" "May" "June" "July" "August" + "September" "October" "November" "December")) + (defvar article-goto-body-goes-to-point-min-p nil) (defvar gnus-article-wash-types nil) (defvar gnus-article-emphasis-alist nil) +(defvar gnus-article-image-alist nil) (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist - `((gnus-treat-decode-article-as-default-mime-charset + '((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-monafy gnus-article-monafy) (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) (gnus-treat-fill-article gnus-article-fill-cited-article) (gnus-treat-fill-long-lines gnus-article-fill-long-lines) (gnus-treat-strip-cr gnus-article-remove-cr) - (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-unsplit-urls gnus-article-unsplit-urls) + (gnus-treat-date-ut gnus-article-date-ut) + (gnus-treat-date-local gnus-article-date-local) + (gnus-treat-date-english gnus-article-date-english) + (gnus-treat-date-lapsed gnus-article-date-lapsed) + (gnus-treat-date-original gnus-article-date-original) + (gnus-treat-date-user-defined gnus-article-date-user) + (gnus-treat-date-iso8601 gnus-article-date-iso8601) + (gnus-treat-display-face gnus-article-display-face) (gnus-treat-hide-headers gnus-article-maybe-hide-headers) (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) (gnus-treat-hide-signature gnus-article-hide-signature) - (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-leading-whitespace gnus-article-remove-leading-whitespace) (gnus-treat-strip-pem gnus-article-hide-pem) + (gnus-treat-from-picon gnus-treat-from-picon) + (gnus-treat-mail-picon gnus-treat-mail-picon) + (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) (gnus-treat-highlight-headers gnus-article-highlight-headers) - (gnus-treat-emphasize gnus-article-emphasize) - (gnus-treat-highlight-citation gnus-article-highlight-citation) (gnus-treat-highlight-signature gnus-article-highlight-signature) - (gnus-treat-date-ut gnus-article-date-ut) - (gnus-treat-date-local gnus-article-date-local) - (gnus-treat-date-lapsed gnus-article-date-lapsed) - (gnus-treat-date-original gnus-article-date-original) - (gnus-treat-date-user-defined gnus-article-date-user) - (gnus-treat-date-iso8601 gnus-article-date-iso8601) (gnus-treat-strip-trailing-blank-lines gnus-article-remove-trailing-blank-lines) (gnus-treat-strip-leading-blank-lines @@ -1063,13 +1494,21 @@ See the manual for details." (gnus-treat-strip-multiple-blank-lines gnus-article-strip-multiple-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) + (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) + (gnus-treat-fold-headers gnus-article-treat-fold-headers) + ;; Displaying X-Face should be done after unfolding headers + ;; to protect bitmap lines. + (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) - (gnus-treat-display-smileys ,(if (or (featurep 'xemacs) - (>= emacs-major-version 21)) - 'gnus-smiley-display - 'gnus-article-smiley-display)) + (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) - (gnus-treat-display-picons gnus-article-display-picons) + (gnus-treat-wash-html gnus-article-wash-html) + (gnus-treat-emphasize gnus-article-emphasize) + (gnus-treat-hide-citation gnus-article-hide-citation) + (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) + (gnus-treat-highlight-citation gnus-article-highlight-citation) + (gnus-treat-body-boundary gnus-article-treat-body-boundary) (gnus-treat-play-sounds gnus-earcon-display))) (defvar gnus-article-mime-handle-alist nil) @@ -1078,9 +1517,13 @@ 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) - (modify-syntax-entry ?> ")" table) - (modify-syntax-entry ?< "(" table) + ;; This causes the citation match run O(2^n). + ;; (modify-syntax-entry ?- "w" table) + (modify-syntax-entry ?> ")<" table) + (modify-syntax-entry ?< "(>" table) + ;; make M-. in article buffers work for `foo' strings + (modify-syntax-entry ?' " " table) + (modify-syntax-entry ?` " " table) table) "Syntax table used in article mode buffers. Initialized from `text-mode-syntax-table.") @@ -1096,6 +1539,34 @@ Initialized from `text-mode-syntax-table.") (defvar gnus-inhibit-hiding nil) +;;; Macros for dealing with the article buffer. + +(defmacro gnus-with-article-headers (&rest forms) + `(save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (case-fold-search t)) + (article-narrow-to-head) + ,@forms)))) + +(put 'gnus-with-article-headers 'lisp-indent-function 0) +(put 'gnus-with-article-headers 'edebug-form-spec '(body)) + +(defmacro gnus-with-article-buffer (&rest forms) + `(save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + ,@forms))) + +(put 'gnus-with-article-buffer 'lisp-indent-function 0) +(put 'gnus-with-article-buffer 'edebug-form-spec '(body)) + +(defun gnus-article-goto-header (header) + "Go to HEADER, which is a regular expression." + (re-search-forward (concat "^\\(" header "\\):") nil t)) + (defsubst gnus-article-hide-text (b e props) "Set text PROPS on the B to E region, extending `intangible' 1 past B." (gnus-add-text-properties-when 'article-type nil b e props) @@ -1113,14 +1584,13 @@ Initialized from `text-mode-syntax-table.") (defun gnus-article-hide-text-type (b e type) "Hide text of TYPE between B and E." - (push type gnus-article-wash-types) + (gnus-add-wash-type type) (gnus-article-hide-text b e (cons 'article-type (cons type gnus-hidden-properties)))) (defun gnus-article-unhide-text-type (b e type) "Unhide text of TYPE between B and E." - (setq gnus-article-wash-types - (delq type gnus-article-wash-types)) + (gnus-delete-wash-type type) (remove-text-properties b e (cons 'article-type (cons type gnus-hidden-properties))) (when (memq 'intangible gnus-hidden-properties) @@ -1160,13 +1630,13 @@ Initialized from `text-mode-syntax-table.") (defsubst gnus-article-header-rank () "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." (let ((list gnus-sorted-header-list) - (i 0)) + (i 1)) (while list - (when (looking-at (car list)) - (setq list nil)) - (setq list (cdr list)) - (incf i)) - i)) + (if (looking-at (car list)) + (setq list nil) + (setq list (cdr list)) + (incf i))) + i)) (defun article-hide-headers (&optional arg delete) "Hide unwanted headers and possibly sort them as well." @@ -1178,67 +1648,65 @@ Initialized from `text-mode-syntax-table.") (gnus-article-show-hidden-text 'boring-headers) (when (eq 1 (point-min)) (set-window-start (get-buffer-window (current-buffer)) 1))) - (unless gnus-inhibit-hiding - (save-excursion - (save-restriction - (let ((buffer-read-only nil) - (inhibit-read-only t) - (case-fold-search t) - (max (1+ (length gnus-sorted-header-list))) - (ignored (when (not gnus-visible-headers) - (cond ((stringp gnus-ignored-headers) - gnus-ignored-headers) - ((listp gnus-ignored-headers) - (mapconcat 'identity gnus-ignored-headers - "\\|"))))) - (visible - (cond ((stringp gnus-visible-headers) - gnus-visible-headers) - ((and gnus-visible-headers - (listp gnus-visible-headers)) - (mapconcat 'identity gnus-visible-headers "\\|")))) - (inhibit-point-motion-hooks t) - beg) - ;; First we narrow to just the headers. - (article-narrow-to-head) - ;; Hide any "From " lines at the beginning of (mail) articles. - (while (looking-at "From ") - (forward-line 1)) - (unless (bobp) - (if delete - (delete-region (point-min) (point)) - (gnus-article-hide-text (point-min) (point) - (nconc (list 'article-type 'headers) - gnus-hidden-properties)))) - ;; Then treat the rest of the header lines. - ;; Then we use the two regular expressions - ;; `gnus-ignored-headers' and `gnus-visible-headers' to - ;; select which header lines is to remain visible in the - ;; article buffer. - (while (re-search-forward "^[^ \t]*:" nil t) - (beginning-of-line) - ;; Mark the rank of the header. - (put-text-property - (point) (1+ (point)) 'message-rank - (if (or (and visible (looking-at visible)) - (and ignored - (not (looking-at ignored)))) - (gnus-article-header-rank) - (+ 2 max))) - (forward-line 1)) - (message-sort-headers-1) - (when (setq beg (text-property-any - (point-min) (point-max) 'message-rank (+ 2 max))) - ;; We delete or make invisible the unwanted headers. - (push 'headers gnus-article-wash-types) - (if delete - (progn - (add-text-properties - (point-min) (+ 5 (point-min)) - '(article-type headers dummy-invisible t)) - (delete-region beg (point-max))) - (gnus-article-hide-text-type beg (point-max) 'headers)))))))) - ) + (unless gnus-inhibit-hiding + (save-excursion + (save-restriction + (let ((inhibit-read-only t) + (case-fold-search t) + (max (1+ (length gnus-sorted-header-list))) + (ignored (when (not gnus-visible-headers) + (cond ((stringp gnus-ignored-headers) + gnus-ignored-headers) + ((listp gnus-ignored-headers) + (mapconcat 'identity gnus-ignored-headers + "\\|"))))) + (visible + (cond ((stringp gnus-visible-headers) + gnus-visible-headers) + ((and gnus-visible-headers + (listp gnus-visible-headers)) + (mapconcat 'identity gnus-visible-headers "\\|")))) + (inhibit-point-motion-hooks t) + beg) + ;; First we narrow to just the headers. + (article-narrow-to-head) + ;; Hide any "From " lines at the beginning of (mail) articles. + (while (looking-at "From ") + (forward-line 1)) + (unless (bobp) + (if delete + (delete-region (point-min) (point)) + (gnus-article-hide-text (point-min) (point) + (nconc (list 'article-type 'headers) + gnus-hidden-properties)))) + ;; Then treat the rest of the header lines. + ;; Then we use the two regular expressions + ;; `gnus-ignored-headers' and `gnus-visible-headers' to + ;; select which header lines is to remain visible in the + ;; article buffer. + (while (re-search-forward "^[^ \t:]*:" nil t) + (beginning-of-line) + ;; Mark the rank of the header. + (put-text-property + (point) (1+ (point)) 'message-rank + (if (or (and visible (looking-at visible)) + (and ignored + (not (looking-at ignored)))) + (gnus-article-header-rank) + (+ 2 max))) + (forward-line 1)) + (message-sort-headers-1) + (when (setq beg (text-property-any + (point-min) (point-max) 'message-rank (+ 2 max))) + ;; We delete or make invisible the unwanted headers. + (gnus-add-wash-type 'headers) + (if delete + (progn + (add-text-properties + (point-min) (+ 5 (point-min)) + '(article-type headers dummy-invisible t)) + (delete-region beg (point-max))) + (gnus-article-hide-text-type beg (point-max) 'headers))))))))) (defun article-hide-boring-headers (&optional arg) "Toggle hiding of headers that aren't very interesting. @@ -1263,7 +1731,7 @@ always hide." (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) (forward-line -1) (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) + (gnus-point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1272,26 +1740,70 @@ always hide." 'boring-headers))) ;; Hide boring Newsgroups header. ((eq elem 'newsgroups) - (when (equal (gnus-fetch-field "newsgroups") - (gnus-group-real-name - (if (boundp 'gnus-newsgroup-name) - gnus-newsgroup-name - ""))) + (when (gnus-string-equal + (gnus-fetch-field "newsgroups") + (gnus-group-real-name + (if (boundp 'gnus-newsgroup-name) + gnus-newsgroup-name + ""))) (gnus-article-hide-header "newsgroups"))) + ((eq elem 'to-address) + (let ((to (message-fetch-field "to")) + (to-address + (gnus-parameter-to-address + (if (boundp 'gnus-newsgroup-name) + gnus-newsgroup-name "")))) + (when (and to to-address + (ignore-errors + (gnus-string-equal + ;; only one address in To + (nth 1 (mail-extract-address-components to)) + to-address))) + (gnus-article-hide-header "to")))) + ((eq elem 'to-list) + (let ((to (message-fetch-field "to")) + (to-list + (gnus-parameter-to-list + (if (boundp 'gnus-newsgroup-name) + gnus-newsgroup-name "")))) + (when (and to to-list + (ignore-errors + (gnus-string-equal + ;; only one address in To + (nth 1 (mail-extract-address-components to)) + to-list))) + (gnus-article-hide-header "to")))) + ((eq elem 'cc-list) + (let ((cc (message-fetch-field "cc")) + (to-list + (gnus-parameter-to-list + (if (boundp 'gnus-newsgroup-name) + gnus-newsgroup-name "")))) + (when (and cc to-list + (ignore-errors + (gnus-string-equal + ;; only one address in CC + (nth 1 (mail-extract-address-components cc)) + to-list))) + (gnus-article-hide-header "cc")))) ((eq elem 'followup-to) - (when (equal (message-fetch-field "followup-to") - (message-fetch-field "newsgroups")) + (when (gnus-string-equal + (message-fetch-field "followup-to") + (message-fetch-field "newsgroups")) (gnus-article-hide-header "followup-to"))) ((eq elem 'reply-to) - (let ((from (message-fetch-field "from")) - (reply-to (message-fetch-field "reply-to"))) - (when (and - from reply-to - (ignore-errors - (equal - (nth 1 (funcall gnus-extract-address-components from)) - (nth 1 (funcall gnus-extract-address-components reply-to))))) - (gnus-article-hide-header "reply-to")))) + (if (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to) + (gnus-article-hide-header "reply-to") + (let ((from (message-fetch-field "from")) + (reply-to (message-fetch-field "reply-to"))) + (when (and + from reply-to + (ignore-errors + (gnus-string-equal + (nth 1 (mail-extract-address-components from)) + (nth 1 (mail-extract-address-components reply-to))))) + (gnus-article-hide-header "reply-to"))))) ((eq elem 'date) (let ((date (message-fetch-field "date"))) (when (and date @@ -1338,7 +1850,7 @@ always hide." (goto-char (point-min)) (when (re-search-forward (concat "^" header ":") nil t) (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) + (gnus-point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1346,87 +1858,6 @@ always hide." (point-max))) 'boring-headers)))) -(defun article-toggle-headers (&optional arg) - "Toggle hiding of headers. If given a negative prefix, always show; -if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) - (let ((force (when (numberp arg) - (cond ((> arg 0) 'always-hide) - ((< arg 0) 'always-show)))) - (window (get-buffer-window gnus-article-buffer)) - (header-end (point-min)) - header-start field-end field-start - (inhibit-point-motion-hooks t) - (inhibit-read-only t) - buffer-read-only) - (save-restriction - (widen) - (while (and (setq header-start - (text-property-any header-end (point-max) - 'article-treated-header t)) - (setq header-end - (text-property-not-all header-start (point-max) - 'article-treated-header t))) - (setq field-end header-start) - (cond - (;; Hide exposed invisible fields. - (and (not (eq 'always-show force)) - (setq field-start - (text-property-any field-end header-end - 'exposed-invisible-field t))) - (while (and field-start - (setq field-end (text-property-not-all - field-start header-end - 'exposed-invisible-field t))) - (add-text-properties field-start field-end gnus-hidden-properties) - (setq field-start (text-property-any field-end header-end - 'exposed-invisible-field t))) - (put-text-property header-start header-end - 'exposed-invisible-field nil)) - (;; Expose invisible fields. - (and (not (eq 'always-hide force)) - (setq field-start - (text-property-any field-end header-end 'invisible t))) - (while (and field-start - (setq field-end (text-property-not-all - field-start header-end - 'invisible t))) - ;; If the invisible text is not terminated with newline, we - ;; won't expose it. Because it may be created by x-face-mule. - ;; BTW, XEmacs sometimes fail in putting a invisible text - ;; property with `gnus-article-hide-text' (really?). In that - ;; case, the invisible text might be started from the middle of - ;; a line so we will expose the sort of thing. - (when (or (not (or (eq header-start field-start) - (eq ?\n (char-before field-start)))) - (eq ?\n (char-before field-end))) - (remove-text-properties field-start field-end - gnus-hidden-properties) - (put-text-property field-start field-end - 'exposed-invisible-field t)) - (setq field-start (text-property-any field-end header-end - 'invisible t)))) - (;; Hide fields. - (not (eq 'always-show force)) - (narrow-to-region header-start header-end) - (article-hide-headers) - ;; Re-display X-Face image under XEmacs. - (when (and (featurep 'xemacs) - (gnus-functionp gnus-article-x-face-command)) - (let ((func (cadr (assq 'gnus-treat-display-xface - gnus-treatment-function-alist))) - (condition 'head)) - (when (and (not gnus-inhibit-treatment) - func - (gnus-treat-predicate gnus-treat-display-xface)) - (funcall func) - (put-text-property header-start header-end 'read-only nil)))) - (widen)) - )) - (goto-char (point-min)) - (when window - (set-window-start window (point-min)))))) - (defvar gnus-article-normalized-header-length 40 "Length of normalized headers.") @@ -1531,6 +1962,99 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (put-text-property (point) end 'face 'underline))))))))) +(defun gnus-article-treat-unfold-headers () + "Unfold folded message headers. +Only the headers that fit into the current window width will be +unfolded." + (interactive) + (gnus-with-article-headers + (let (length) + (while (not (eobp)) + (save-restriction + (mail-header-narrow-to-field) + (let ((header (buffer-string))) + (with-temp-buffer + (insert header) + (goto-char (point-min)) + (while (re-search-forward "\n[\t ]" nil t) + (replace-match " " t t))) + (setq length (- (point-max) (point-min) 1))) + (when (< length (window-width)) + (while (re-search-forward "\n[\t ]" nil t) + (replace-match " " t t))) + (goto-char (point-max))))))) + +(defun gnus-article-treat-fold-headers () + "Fold message headers." + (interactive) + (gnus-with-article-headers + (while (not (eobp)) + (save-restriction + (mail-header-narrow-to-field) + (mail-header-fold-field) + (goto-char (point-max)))))) + +(defun gnus-treat-smiley () + "Toggle display of textual emoticons (\"smileys\") as small graphical icons." + (interactive) + (unless (featurep 'xemacs) + (when (and (>= emacs-major-version 21) + (not gnus-article-should-use-smiley-mule) + gnus-article-smiley-mule-loaded-p) + (load "smiley" nil t) + (setq gnus-article-smiley-mule-loaded-p nil)) + (when (and gnus-article-should-use-smiley-mule + (not gnus-article-smiley-mule-loaded-p)) + (load "smiley-mule" nil t) + (setq gnus-article-smiley-mule-loaded-p t))) + (gnus-with-article-buffer + (if (memq 'smiley gnus-article-wash-types) + (gnus-delete-images 'smiley) + (article-goto-body) + (let ((images (smiley-region (point) (point-max)))) + (when images + (gnus-add-wash-type 'smiley) + (dolist (image images) + (gnus-add-image 'smiley image))))))) + +(defun gnus-article-remove-images () + "Remove all images from the article buffer." + (interactive) + (gnus-with-article-buffer + (dolist (elem gnus-article-image-alist) + (gnus-delete-images (car elem))))) + +(defun gnus-article-treat-fold-newsgroups () + "Unfold folded message headers. +Only the headers that fit into the current window width will be +unfolded." + (interactive) + (gnus-with-article-headers + (while (gnus-article-goto-header "newsgroups\\|followup-to") + (save-restriction + (mail-header-narrow-to-field) + (while (re-search-forward ", *" nil t) + (replace-match ", " t t)) + (mail-header-fold-field) + (goto-char (point-max)))))) + +(defun gnus-article-treat-body-boundary () + "Place a boundary line at the end of the headers." + (interactive) + (when (and gnus-body-boundary-delimiter + (> (length gnus-body-boundary-delimiter) 0)) + (gnus-with-article-headers + (goto-char (point-max)) + (let ((start (point))) + (insert "X-Boundary: ") + (gnus-add-text-properties start (point) '(invisible t intangible t)) + (insert (let (str) + (while (>= (1- (window-width)) (length str)) + (setq str (concat str gnus-body-boundary-delimiter))) + (substring str 0 (1- (window-width)))) + "\n") + (gnus-put-text-property start (point) 'gnus-decoration 'header))))) + (defun article-fill-long-lines () "Fill lines that are wider than the window width." (interactive) @@ -1539,13 +2063,15 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (width (window-width (get-buffer-window (current-buffer))))) (save-restriction (article-goto-body) - (let ((adaptive-fill-mode nil)) + (let ((adaptive-fill-mode nil)) ;Why? -sm (while (not (eobp)) (end-of-line) (when (>= (current-column) (min fill-column width)) - (narrow-to-region (point) (gnus-point-at-bol)) - (fill-paragraph nil) - (goto-char (point-max)) + (narrow-to-region (min (1+ (point)) (point-max)) + (gnus-point-at-bol)) + (let ((goback (point-marker))) + (fill-paragraph nil) + (goto-char (marker-position goback))) (widen)) (forward-line 1))))))) @@ -1589,56 +2115,84 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (forward-line 1) (point)))))) +(defun article-display-face () + "Display any Face headers in the header." + (interactive) + (gnus-with-article-headers + (let ((face (message-fetch-field "face"))) + (when face + (let ((png (gnus-convert-face-to-png face)) + image) + (when png + (setq image (gnus-create-image png 'png t)) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-wash-type 'face) + (gnus-add-image 'face image) + (gnus-put-image image))))))) + (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." (interactive (list 'force)) - (save-excursion - ;; Delete the old process, if any. - (when (process-status "article-x-face") - (delete-process "article-x-face")) - (let ((inhibit-point-motion-hooks t) - (case-fold-search t) - from last) - (save-restriction - (article-narrow-to-head) - (goto-char (point-min)) - (setq from (message-fetch-field "from")) - (goto-char (point-min)) - (while (and gnus-article-x-face-command - (not last) - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from)))) - ;; Has to be present. - (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 - ;; multiple faces really something to encourage? - (when (stringp gnus-article-x-face-command) - (setq last t)) - ;; We now have the area of the buffer where the X-Face is stored. + (let ((wash-face-p buffer-read-only)) ;; When type `W f' + (gnus-with-article-headers + ;; Delete the old process, if any. + (when (process-status "article-x-face") + (delete-process "article-x-face")) + (if (memq 'xface gnus-article-wash-types) + ;; We have already displayed X-Faces, so we remove them + ;; instead. + (gnus-delete-images 'xface) + ;; Display X-Faces. + (let (x-faces from face) (save-excursion - (let ((beg (point)) - (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command beg end) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (process-send-region "article-x-face" beg end) - (process-send-eof "article-x-face")))))))))) + (when (and wash-face-p + (progn + (goto-char (point-min)) + (not (re-search-forward + "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t))) + (gnus-buffer-live-p gnus-original-article-buffer)) + ;; If type `W f', use gnus-original-article-buffer, + ;; otherwise use the current buffer because displaying + ;; RFC822 parts calls this function too. + (set-buffer gnus-original-article-buffer)) + (save-restriction + (mail-narrow-to-head) + (while (gnus-article-goto-header "X-Face") + (push (mail-header-field-value) x-faces)) + (setq from (message-fetch-field "from")))) + ;; Sending multiple EOFs to xv doesn't work, so we only do a + ;; single external face. + (when (stringp gnus-article-x-face-command) + (setq x-faces (list (car x-faces)))) + (while (and (setq face (pop x-faces)) + gnus-article-x-face-command + (or force + ;; Check whether this face is censored. + (not gnus-article-x-face-too-ugly) + (and gnus-article-x-face-too-ugly from + (not (string-match gnus-article-x-face-too-ugly + from))))) + ;; We display the face. + (if (symbolp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (if (functionp gnus-article-x-face-command) + (funcall gnus-article-x-face-command face) + (error "%s is not a function" gnus-article-x-face-command)) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name shell-command-switch + gnus-article-x-face-command)) + (with-temp-buffer + (insert face) + (process-send-region "article-x-face" + (point-min) (point-max))) + (process-send-eof "article-x-face"))))))))) (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." @@ -1648,7 +2202,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (let ((inhibit-point-motion-hooks t) buffer-read-only (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (mail-decode-encoded-word-region (point-min) (point-max))))) @@ -1660,44 +2214,44 @@ If PROMPT (the prefix), prompt for a coding system to use." (let ((inhibit-point-motion-hooks t) (case-fold-search t) buffer-read-only (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (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) - (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))))))) + (save-excursion + (save-restriction + (article-narrow-to-head) + (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) prompt)))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -1705,14 +2259,77 @@ If PROMPT (the prefix), prompt for a coding system to use." (let ((charset (save-excursion (set-buffer gnus-summary-buffer) default-mime-charset))) - (mime-decode-header-in-buffer charset) - ))) + (mime-decode-header-in-buffer charset)))) -(defun article-de-quoted-unreadable (&optional force) +(defun article-decode-group-name () + "Decode group names in `Newsgroups:'." + (let ((inhibit-point-motion-hooks t) + buffer-read-only + (method (gnus-find-method-for-group gnus-newsgroup-name))) + (when (and (or gnus-group-name-charset-method-alist + gnus-group-name-charset-group-alist) + (gnus-buffer-live-p gnus-original-article-buffer)) + (save-restriction + (article-narrow-to-head) + (with-current-buffer gnus-original-article-buffer + (goto-char (point-min))) + (while (re-search-forward + "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) + (replace-match (save-match-data + (gnus-decode-newsgroups + ;; XXX how to use data in article buffer? + (with-current-buffer gnus-original-article-buffer + (re-search-forward + "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" + nil t) + (match-string 1)) + gnus-newsgroup-name method)) + t t nil 1)) + (goto-char (point-min)) + (with-current-buffer gnus-original-article-buffer + (goto-char (point-min))) + (while (re-search-forward + "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) + (replace-match (save-match-data + (gnus-decode-newsgroups + ;; XXX how to use data in article buffer? + (with-current-buffer gnus-original-article-buffer + (re-search-forward + "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" + nil t) + (match-string 1)) + gnus-newsgroup-name method)) + t t nil 1)))))) + +(autoload 'idna-to-unicode "idna") + +(defun article-decode-idna-rhs () + "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer." + (when gnus-use-idna + (save-restriction + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (article-narrow-to-head) + (goto-char (point-min)) + (while (re-search-forward "\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) + (let (ace unicode) + (when (save-match-data + (and (setq ace (match-string 1)) + (save-excursion + (and (re-search-backward "^[^ \t]" nil t) + (looking-at "From\\|To\\|Cc"))) + (save-excursion (backward-char) + (message-idna-inside-rhs-p)) + (setq unicode (idna-to-unicode ace)))) + (unless (string= ace unicode) + (replace-match unicode nil nil nil 1))))))))) + +(defun article-de-quoted-unreadable (&optional force read-charset) "Translate a quoted-printable-encoded article. If FORCE, decode the article whether it is marked as quoted-printable -or not." - (interactive (list 'force)) +or not. +If READ-CHARSET, ask for a coding system." + (interactive (list 'force current-prefix-arg)) (save-excursion (let ((buffer-read-only nil) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -1720,14 +2337,16 @@ or not." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (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 + (if read-charset + (setq charset (mm-read-coding-system "Charset: " charset))) + (unless charset (setq charset gnus-newsgroup-charset)) (when (or force (and type (let ((case-fold-search t)) @@ -1736,10 +2355,11 @@ or not." (quoted-printable-decode-region (point) (point-max) (mm-charset-to-coding-system charset)))))) -(defun article-de-base64-unreadable (&optional force) +(defun article-de-base64-unreadable (&optional force read-charset) "Translate a base64 article. -If FORCE, decode the article whether it is marked as base64 not." - (interactive (list 'force)) +If FORCE, decode the article whether it is marked as base64 not. +If READ-CHARSET, ask for a coding system." + (interactive (list 'force current-prefix-arg)) (save-excursion (let ((buffer-read-only nil) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -1747,14 +2367,16 @@ If FORCE, decode the article whether it is marked as base64 not." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (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 + (if read-charset + (setq charset (mm-read-coding-system "Charset: " charset))) + (unless charset (setq charset gnus-newsgroup-charset)) (when (or force (and type (let ((case-fold-search t)) @@ -1777,93 +2399,103 @@ If FORCE, decode the article whether it is marked as base64 not." (let ((buffer-read-only nil)) (rfc1843-decode-region (point-min) (point-max))))) -(defun article-wash-html () - "Format an html article." +(defun article-unsplit-urls () + "Remove the newlines that some other mailers insert into URLs." (interactive) (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (re-search-forward + "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) + (replace-match "\\1\\3" t))) + (when (and gnus-display-mime-function (interactive-p)) + (funcall gnus-display-mime-function)))) + + +(defun article-wash-html (&optional read-charset) + "Format an HTML article. +If READ-CHARSET, ask for a coding system." + (interactive "P") + (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 + (when (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))) + (when (stringp charset) + (setq charset (intern (downcase charset))))))) + (when read-charset + (setq charset (mm-read-coding-system "Charset: " 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)))))))) + (let* ((func (or gnus-article-wash-function mm-text-html-renderer)) + (entry (assq func mm-text-html-washer-alist))) + (when entry + (setq func (cdr entry))) + (cond + ((functionp func) + (funcall func)) + (t + (apply (car func) (cdr func)))))))))) + +(defun gnus-article-wash-html-with-w3 () + "Wash the current buffer with w3." + (mm-setup-w3) + (let ((w3-strict-width (window-width)) + (url-standalone-mode t) + (url-gateway-unplugged t) + (w3-honor-stylesheets nil)) + (condition-case () + (w3-region (point-min) (point-max)) + (error)))) + +(defun gnus-article-wash-html-with-w3m () + "Wash the current buffer with emacs-w3m." + (mm-setup-w3m) + (save-restriction + (narrow-to-region (point) (point-max)) + (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images + nil + "\\`cid:")) + w3m-force-redisplay) + (w3m-region (point-min) (point-max))) + (when mm-inline-text-html-with-w3m-keymap + (add-text-properties + (point-min) (point-max) + (nconc (mm-w3m-local-map-property) + '(mm-inline-text-html-with-w3m t)))))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. The `gnus-list-identifiers' variable specifies what to do." (interactive) - (save-excursion - (save-restriction - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (article-narrow-to-head) - (let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers - (mapconcat 'identity gnus-list-identifiers " *\\|")))) - (when regexp - (goto-char (point-min)) - (when (re-search-forward - (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp - " *\\)\\)+\\(Re: +\\)?\\)") - nil t) - (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." - (interactive) - (save-excursion - (save-restriction - (let ((inhibit-point-motion-hooks t) - buffer-read-only beg end) - (article-goto-body) - ;; Hide the "header". - (when (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (push 'pgp gnus-article-wash-types) - (delete-region (match-beginning 0) (match-end 0)) - ;; Remove armor headers (rfc2440 6.2) - (delete-region (point) (or (re-search-forward "^[ \t]*\n" nil t) - (point))) - (setq beg (point)) - ;; Hide the actual signature. - (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) - (setq end (1+ (match-beginning 0))) - (delete-region - end - (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) - (match-end 0) - ;; Perhaps we shouldn't hide to the end of the buffer - ;; if there is no end to the signature? - (point-max)))) - ;; Hide "- " PGP quotation markers. - (when (and beg end) - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (delete-region - (match-beginning 0) (match-end 0))) - (widen)) - (gnus-run-hooks 'gnus-article-hide-pgp-hook)))))) + (let ((inhibit-point-motion-hooks t) + (regexp (if (consp gnus-list-identifiers) + (mapconcat 'identity gnus-list-identifiers " *\\|") + gnus-list-identifiers)) + buffer-read-only) + (when regexp + (save-excursion + (save-restriction + (article-narrow-to-head) + (goto-char (point-min)) + (while (re-search-forward + (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)") + nil t) + (delete-region (match-beginning 2) (match-end 0)) + (beginning-of-line)) + (when (re-search-forward + "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t) + (delete-region (match-beginning 1) (match-end 1)))))))) (defun article-hide-pem (&optional arg) "Toggle hiding of any PEM headers and signatures in the current article. @@ -1879,7 +2511,7 @@ always hide." "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" nil t) (setq end (1+ (match-beginning 0)))) - (push 'pem gnus-article-wash-types) + (gnus-add-wash-type 'pem) (gnus-article-hide-text-type end (if (search-forward "\n\n" nil t) @@ -1893,29 +2525,50 @@ always hide." (match-beginning 0) (match-end 0) 'pem))))))) (defun article-strip-banner () - "Strip the banner specified by the `banner' group parameter." + "Strip the banners specified by the `banner' group parameter and by +`gnus-article-address-banner-alist'." (interactive) (save-excursion (save-restriction + (let ((inhibit-point-motion-hooks t)) + (when (gnus-parameter-banner gnus-newsgroup-name) + (article-really-strip-banner + (gnus-parameter-banner gnus-newsgroup-name))) + (when gnus-article-address-banner-alist + (article-really-strip-banner + (let ((from (save-restriction + (widen) + (article-narrow-to-head) + (mail-fetch-field "from")))) + (when (and from + (setq from + (caar (mail-header-parse-addresses from)))) + (catch 'found + (dolist (pair gnus-article-address-banner-alist) + (when (string-match (car pair) from) + (throw 'found (cdr pair))))))))))))) + +(defun article-really-strip-banner (banner) + "Strip the banner specified by the argument." + (save-excursion + (save-restriction (let ((inhibit-point-motion-hooks t) - (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner)) (gnus-signature-limit nil) - buffer-read-only beg end) - (when banner - (article-goto-body) - (cond - ((eq banner 'signature) - (when (gnus-article-narrow-to-signature) - (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)))))))))) + buffer-read-only) + (article-goto-body) + (cond + ((eq banner 'signature) + (when (gnus-article-narrow-to-signature) + (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))))))))) (defun article-babel () "Translate article using an online translation service." @@ -1928,11 +2581,11 @@ always hide." (start (point)) (end (point-max)) (orig (buffer-substring start end)) - (trans (babel-as-string orig))) + (trans (babel-as-string orig))) (save-restriction (narrow-to-region start end) (delete-region start end) - (insert trans)))))) + (insert trans)))))) (defun article-hide-signature (&optional arg) "Hide the signature in the current article. @@ -1960,7 +2613,8 @@ always hide." (1+ button) (next-single-property-change (1+ button) 'mime-view-entity nil (point-max)) - 'signature)))))))) + 'signature))))))) + (gnus-set-mode-line 'article)) (defun article-strip-headers-in-body () "Strip offensive headers from bodies." @@ -2020,10 +2674,10 @@ Point is left at the beginning of the narrowed-to region." (replace-match "" nil t))) ;; Then replace multiple empty lines with a single empty line. (article-goto-body) - (while (re-search-forward "\n\n\n+" nil t) + (while (re-search-forward "\n\n\\(\n+\\)" nil t) (unless (gnus-annotation-in-region-p (match-beginning 0) (match-end 0)) - (replace-match "\n\n" t t)))))) + (delete-region (match-beginning 1) (match-end 1))))))) (defun article-strip-leading-space () "Remove all white space from the beginning of the lines in the article." @@ -2077,7 +2731,7 @@ Point is left at the beginning of the narrowed-to region." (< (- (point-max) (point)) limit)) (and (floatp limit) (< (count-lines (point) (point-max)) limit)) - (and (gnus-functionp limit) + (and (functionp limit) (funcall limit)) (and (stringp limit) (not (re-search-forward limit nil t)))) @@ -2112,7 +2766,7 @@ Put point at the beginning of the signature separator." (defun gnus-article-check-hidden-text (type arg) "Return nil if hiding is necessary. -Arg can be nil or a number. Nil and positive means hide, negative +Arg can be nil or a number. nil and positive means hide, negative means show, 0 means toggle." (save-excursion (save-restriction @@ -2148,11 +2802,12 @@ means show, 0 means toggle." Originally it is hide instead of DUMMY." (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) - (gnus-remove-text-properties-when + (gnus-remove-text-properties-when 'article-type type - (point-min) (point-max) + (point-min) (point-max) (cons 'article-type (cons type - gnus-hidden-properties))))) + gnus-hidden-properties))) + (gnus-delete-wash-type type))) (defconst article-time-units `((year . ,(* 365.25 24 60 60)) @@ -2163,6 +2818,17 @@ Originally it is hide instead of DUMMY." (second . 1)) "Mapping from time units to seconds.") +(defun gnus-article-forward-header () + "Move point to the start of the next header. +If the current header is a continuation header, this can be several +lines forward." + (let ((ended nil)) + (while (not ended) + (forward-line 1) + (if (looking-at "[ \t]+[^ \t]") + (forward-line 1) + (setq ended t))))) + (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 @@ -2194,8 +2860,8 @@ should replace the \"Date:\" one, or should be added below it." (re-search-forward "^X-Sent:[ \t]" nil t)) (setq bface (get-text-property (gnus-point-at-bol) 'face) date (or (get-text-property (gnus-point-at-bol) - 'original-date) - date) + 'original-date) + date) eface (get-text-property (1- (gnus-point-at-eol)) 'face))) (let ((buffer-read-only nil)) @@ -2243,103 +2909,130 @@ should replace the \"Date:\" one, or should be added below it." (defun article-make-date-line (date type) "Return a DATE line of TYPE." - (let ((time (condition-case () - (date-to-time date) - (error '(0 0))))) - (cond - ;; Convert to the local timezone. We have to slap a - ;; `condition-case' round the calls to the timezone - ;; functions since they aren't particularly resistant to - ;; buggy dates. - ((eq type 'local) - (let ((tz (car (current-time-zone time)))) - (format "Date: %s %s%02d%02d" (current-time-string time) - (if (> tz 0) "+" "-") (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60)))) - ;; Convert to Universal Time. - ((eq type 'ut) - (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))))) - (cond ((< ls 0) (list (1- ms) (+ ls 65536))) - ((> ls 65535) (list (1+ ms) (- ls 65536))) - (t (list ms ls))))) - " UT")) - ;; Get the original date from the article. - ((eq type 'original) - (concat "Date: " (if (string-match "\n+$" date) - (substring date 0 (match-beginning 0)) - date))) - ;; Let the user define the format. - ((eq type 'user) - (if (gnus-functionp gnus-article-time-format) - (funcall gnus-article-time-format time) - (concat - "Date: " - (format-time-string gnus-article-time-format time)))) - ;; ISO 8601. - ((eq type 'iso8601) - (let ((tz (car (current-time-zone time)))) - (concat - "Date: " - (format-time-string "%Y%m%dT%H%M%S" time) - (format "%s%02d%02d" - (if (> tz 0) "+" "-") (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60))))) - ;; Do an X-Sent lapsed format. - ((eq type 'lapsed) - ;; If the date is seriously mangled, the timezone functions are - ;; liable to bug out, so we ignore all errors. - (let* ((now (current-time)) - (real-time (subtract-time now time)) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) - num prev) + (unless (memq type '(local ut original user iso8601 lapsed english)) + (error "Unknown conversion type: %s" type)) + (condition-case () + (let ((time (date-to-time date))) (cond - ((null real-time) - "X-Sent: Unknown") - ((zerop sec) - "X-Sent: Now") - (t - (concat - "X-Sent: " - ;; This is a bit convoluted, but basically we go - ;; through the time units for years, weeks, etc, - ;; and divide things to see whether that results - ;; in positive answers. - (mapconcat - (lambda (unit) - (if (zerop (setq num (ffloor (/ sec (cdr unit))))) - ;; The (remaining) seconds are too few to - ;; be divided into this time unit. - "" - ;; It's big enough, so we output it. - (setq sec (- sec (* num (cdr unit)))) - (prog1 - (concat (if prev ", " "") (int-to-string - (floor num)) - " " (symbol-name (car unit)) - (if (> num 1) "s" "")) - (setq prev t)))) - article-time-units "") - ;; If dates are odd, then it might appear like the - ;; article was sent in the future. - (if (> real-sec 0) - " ago" - " in the future")))))) - (t - (error "Unknown conversion type: %s" type))))) + ;; Convert to the local timezone. + ((eq type 'local) + (let ((tz (car (current-time-zone time)))) + (format "Date: %s %s%02d%02d" (current-time-string time) + (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (/ (% (abs tz) 3600) 60)))) + ;; Convert to Universal Time. + ((eq type 'ut) + (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))))) + (cond ((< ls 0) (list (1- ms) (+ ls 65536))) + ((> ls 65535) (list (1+ ms) (- ls 65536))) + (t (list ms ls))))) + " UT")) + ;; Get the original date from the article. + ((eq type 'original) + (concat "Date: " (if (string-match "\n+$" date) + (substring date 0 (match-beginning 0)) + date))) + ;; Let the user define the format. + ((eq type 'user) + (let ((format (or (condition-case nil + (with-current-buffer gnus-summary-buffer + gnus-article-time-format) + (error nil)) + gnus-article-time-format))) + (if (functionp format) + (funcall format time) + (concat "Date: " (format-time-string format time))))) + ;; ISO 8601. + ((eq type 'iso8601) + (let ((tz (car (current-time-zone time)))) + (concat + "Date: " + (format-time-string "%Y%m%dT%H%M%S" time) + (format "%s%02d%02d" + (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (/ (% (abs tz) 3600) 60))))) + ;; Do an X-Sent lapsed format. + ((eq type 'lapsed) + ;; If the date is seriously mangled, the timezone functions are + ;; liable to bug out, so we ignore all errors. + (let* ((now (current-time)) + (real-time (subtract-time now time)) + (real-sec (and real-time + (+ (* (float (car real-time)) 65536) + (cadr real-time)))) + (sec (and real-time (abs real-sec))) + num prev) + (cond + ((null real-time) + "X-Sent: Unknown") + ((zerop sec) + "X-Sent: Now") + (t + (concat + "X-Sent: " + ;; This is a bit convoluted, but basically we go + ;; through the time units for years, weeks, etc, + ;; and divide things to see whether that results + ;; in positive answers. + (mapconcat + (lambda (unit) + (if (zerop (setq num (ffloor (/ sec (cdr unit))))) + ;; The (remaining) seconds are too few to + ;; be divided into this time unit. + "" + ;; It's big enough, so we output it. + (setq sec (- sec (* num (cdr unit)))) + (prog1 + (concat (if prev ", " "") (int-to-string + (floor num)) + " " (symbol-name (car unit)) + (if (> num 1) "s" "")) + (setq prev t)))) + article-time-units "") + ;; If dates are odd, then it might appear like the + ;; article was sent in the future. + (if (> real-sec 0) + " ago" + " in the future")))))) + ;; Display the date in proper English + ((eq type 'english) + (let ((dtime (decode-time time))) + (concat + "Date: the " + (number-to-string (nth 3 dtime)) + (let ((digit (% (nth 3 dtime) 10))) + (cond + ((memq (nth 3 dtime) '(11 12 13)) "th") + ((= digit 1) "st") + ((= digit 2) "nd") + ((= digit 3) "rd") + (t "th"))) + " of " + (nth (1- (nth 4 dtime)) gnus-english-month-names) + " " + (number-to-string (nth 5 dtime)) + " at " + (format "%02d" (nth 2 dtime)) + ":" + (format "%02d" (nth 1 dtime))))))) + (error + (format "Date: %s (from T-gnus)" date)))) (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." (interactive (list t)) (article-date-ut 'local highlight)) +(defun article-date-english (&optional highlight) + "Convert the current article date to something that is proper English." + (interactive (list t)) + (article-date-ut 'english highlight)) + (defun article-date-original (&optional highlight) "Convert the current article date to what it was originally. This is only useful if you have used some other date conversion @@ -2395,15 +3088,15 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (list t)) (article-date-ut 'iso8601 highlight)) -(defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (widen) - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next)))) +;; (defun article-show-all () +;; "Show all hidden text in the article buffer." +;; (interactive) +;; (save-excursion +;; (widen) +;; (let ((buffer-read-only nil)) +;; (gnus-article-unhide-text (point-min) (point-max)) +;; (gnus-remove-text-with-property 'gnus-prev) +;; (gnus-remove-text-with-property 'gnus-next)))) (defun article-show-all-headers () "Show all hidden headers in the article buffer." @@ -2415,15 +3108,26 @@ This format is defined by the `gnus-article-time-format' variable." (let ((buffer-read-only nil)) (gnus-article-unhide-text (point-min) (point-max)))))) +(defun article-remove-leading-whitespace () + "Remove excessive whitespace from all headers." + (interactive) + (save-excursion + (save-restriction + (let ((buffer-read-only nil)) + (article-narrow-to-head) + (goto-char (point-min)) + (while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t) + (delete-region (match-beginning 1) (match-end 1))))))) + (defun article-emphasize (&optional arg) "Emphasize text according to `gnus-emphasis-alist'." (interactive (gnus-article-hidden-arg)) (unless (gnus-article-check-hidden-text 'emphasis arg) (save-excursion - (let ((alist (or + (let ((alist (or (condition-case nil - (with-current-buffer gnus-summary-buffer - gnus-article-emphasis-alist) + (with-current-buffer gnus-summary-buffer + gnus-article-emphasis-alist) (error)) gnus-emphasis-alist)) (buffer-read-only nil) @@ -2439,15 +3143,15 @@ This format is defined by the `gnus-article-time-format' variable." visible (nth 2 elem) face (nth 3 elem)) (while (re-search-forward regexp nil t) - (when (and (match-beginning visible) (match-beginning invisible)) - (push 'emphasis gnus-article-wash-types) - (gnus-article-hide-text - (match-beginning invisible) (match-end invisible) props) - (gnus-article-unhide-text-type - (match-beginning visible) (match-end visible) 'emphasis) - (gnus-put-text-property-excluding-newlines - (match-beginning visible) (match-end visible) 'face face) - (goto-char (match-end invisible))))))))) + (when (and (match-beginning visible) (match-beginning invisible)) + (gnus-article-hide-text + (match-beginning invisible) (match-end invisible) props) + (gnus-article-unhide-text-type + (match-beginning visible) (match-end visible) 'emphasis) + (gnus-put-overlay-excluding-newlines + (match-beginning visible) (match-end visible) 'face face) + (gnus-add-wash-type 'emphasis) + (goto-char (match-end invisible))))))))) (defun gnus-article-setup-highlight-words (&optional highlight-words) "Setup newsgroup emphasis alist." @@ -2469,8 +3173,9 @@ This format is defined by the `gnus-article-time-format' variable." gnus-newsgroup-name 'highlight-words t))) gnus-emphasis-alist))))) -(defvar gnus-summary-article-menu) -(defvar gnus-summary-post-menu) +(eval-when-compile + (defvar gnus-summary-article-menu) + (defvar gnus-summary-post-menu)) ;;; Saving functions. @@ -2573,7 +3278,7 @@ This format is defined by the `gnus-article-time-format' variable." (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. + ;; 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) @@ -2623,6 +3328,7 @@ Directory to save to is default to `gnus-article-save-directory'." (save-restriction (widen) (if (and (file-readable-p filename) + (file-regular-p filename) (mail-file-babyl-p filename)) (rmail-output-to-rmail-file filename t) (gnus-output-to-mail filename))))) @@ -2647,7 +3353,7 @@ Directory to save to is default to `gnus-article-save-directory'." filename) (defun gnus-summary-write-to-file (&optional filename) - "Write this article to a file. + "Write this article to a file, overwriting it if the file exists. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." (gnus-summary-save-in-file nil t)) @@ -2675,7 +3381,8 @@ The directory to save in defaults to `gnus-article-save-directory'." (cond ((and (eq command 'default) gnus-last-shell-command) gnus-last-shell-command) - (command command) + ((stringp command) + command) (t (read-string (format "Shell command on %s: " @@ -2686,13 +3393,30 @@ The directory to save in defaults to `gnus-article-save-directory'." "this article")) gnus-last-shell-command)))) (when (string-equal command "") - (setq command gnus-last-shell-command)) + (if gnus-last-shell-command + (setq command gnus-last-shell-command) + (error "A command is required"))) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) (shell-command-on-region (point-min) (point-max) command nil))) (setq gnus-last-shell-command command)) +(defmacro gnus-read-string (prompt &optional initial-contents history + default-value) + "Like `read-string' but allow for older XEmacsen that don't have the 5th arg." + (if (and (featurep 'xemacs) + (< emacs-minor-version 2)) + `(read-string ,prompt ,initial-contents ,history) + `(read-string ,prompt ,initial-contents ,history ,default-value))) + +(defun gnus-summary-pipe-to-muttprint (&optional command) + "Pipe this article to muttprint." + (setq command (gnus-read-string + "Print using command: " gnus-summary-muttprint-program + nil gnus-summary-muttprint-program)) + (gnus-summary-save-in-pipe command)) + ;;; Article file names when saving. (defun gnus-capitalize-newsgroup (newsgroup) @@ -2745,9 +3469,115 @@ If variable `gnus-use-long-file-name' is non-nil, it is (expand-file-name (if (gnus-use-long-file-name 'not-save) newsgroup - (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))) + (file-relative-name + (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)) + default-directory)) gnus-article-save-directory))) +(defun gnus-sender-save-name (newsgroup headers &optional last-file) + "Generate file name from sender." + (let ((from (mail-header-from headers))) + (expand-file-name + (if (and from (string-match "\\([^ <]+\\)@" from)) + (match-string 1 from) + "nobody") + 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-substring 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))))))))) + +(defun article-verify-cancel-lock () + "Verify Cancel-Lock header." + (interactive) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (canlock-verify gnus-original-article-buffer))) + +(defun article-monafy () + "Display body part with mona font." + (interactive) + (unless (if (featurep 'xemacs) + (find-face 'gnus-mona-face) + (facep 'gnus-mona-face)) + (require 'navi2ch-mona) + (set-face-font (make-face 'gnus-mona-face) navi2ch-mona-font)) + (save-excursion + (let ((buffer-read-only nil)) + (article-goto-body) + (gnus-overlay-put + (gnus-make-overlay (point) (point-max)) + 'face 'gnus-mona-face)))) + (eval-and-compile (mapcar (lambda (func) @@ -2758,7 +3588,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (setq afunc func gfunc (intern (format "gnus-%s" func)))) (defalias gfunc - (if (fboundp afunc) + (when (fboundp afunc) `(lambda (&optional interactive &rest args) ,(documentation afunc t) (interactive (list t)) @@ -2768,19 +3598,23 @@ If variable `gnus-use-long-file-name' is non-nil, it is (call-interactively ',afunc) (apply ',afunc args)))))))) '(article-hide-headers + article-verify-x-pgp-sig + article-verify-cancel-lock + article-monafy article-hide-boring-headers - article-toggle-headers article-treat-overstrike article-fill-long-lines article-capitalize-sentences article-remove-cr + article-remove-leading-whitespace article-display-x-face + article-display-face article-de-quoted-unreadable article-de-base64-unreadable article-decode-HZ article-wash-html + article-unsplit-urls article-hide-list-identifiers - article-hide-pgp article-strip-banner article-babel article-hide-pem @@ -2794,6 +3628,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-strip-blank-lines article-strip-all-blank-lines article-date-local + article-date-english article-date-iso8601 article-date-original article-date-ut @@ -2806,7 +3641,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-treat-dumbquotes article-normalize-headers (article-show-all-headers . gnus-article-show-all-headers) - (article-show-all . gnus-article-show-all)))) +;; (article-show-all . gnus-article-show-all) + ))) ;;; ;;; Gnus article mode @@ -2829,6 +3665,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ">" end-of-buffer "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug + "R" gnus-article-reply-with-original + "F" gnus-article-followup-with-original "\C-hk" gnus-article-describe-key "\C-hc" gnus-article-describe-key-briefly @@ -2854,10 +3692,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is (unless (lookup-key gnus-article-mode-map key) (define-key gnus-article-mode-map key 'gnus-article-read-summary-keys)))) -(eval-when-compile - (defvar gnus-article-commands-menu)) - (defun gnus-article-make-menu-bar () + (unless (boundp 'gnus-article-commands-menu) + (gnus-summary-make-menu-bar)) (gnus-turn-off-edit-menu 'article) (unless (boundp 'gnus-article-article-menu) (easy-menu-define @@ -2872,26 +3709,23 @@ 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 headers" gnus-article-hide-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 leading whitespace" gnus-article-remove-leading-whitespace t] + ["Treat html" gnus-article-wash-html t] + ["Remove newlines from within URLs" gnus-article-unsplit-urls t] ["Decode HZ" gnus-article-decode-HZ t])) ;; Note "Commands" menu is defined in gnus-sum.el for consistency - (when (boundp 'gnus-summary-post-menu) - (define-key gnus-article-mode-map [menu-bar post] - (cons "Post" gnus-summary-post-menu))) + ;; Note "Post" menu is defined in gnus-sum.el for consistency - (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))) + (gnus-run-hooks 'gnus-article-menu-hook))) (defun gnus-article-mode () "Major mode for displaying an article. @@ -2909,8 +3743,6 @@ commands: \\[gnus-article-describe-briefly]\t Describe the current mode briefly \\[gnus-info-find-node]\t Go to the Gnus info node" (interactive) - (when (gnus-visual-p 'article-menu 'menu) - (gnus-article-make-menu-bar)) (gnus-simplify-mode-line) (setq mode-name "Article") (setq major-mode 'gnus-article-mode) @@ -2918,6 +3750,10 @@ commands: (unless (assq 'gnus-show-mime minor-mode-alist) (push (list 'gnus-show-mime " MIME") minor-mode-alist)) (use-local-map gnus-article-mode-map) + (when (gnus-visual-p 'article-menu 'menu) + (gnus-article-make-menu-bar) + (when gnus-summary-tool-bar-map + (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) (make-local-variable 'gnus-page-broken) @@ -2927,6 +3763,9 @@ commands: (make-local-variable 'gnus-article-decoded-p) (make-local-variable 'gnus-article-mime-handle-alist) (make-local-variable 'gnus-article-wash-types) + (make-local-variable 'gnus-article-image-alist) + (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) @@ -2955,14 +3794,22 @@ commands: ;; Init original article buffer. (save-excursion (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) - (set-buffer-multibyte nil) + (set-buffer-multibyte t) (setq major-mode 'gnus-original-article-mode) (make-local-variable 'gnus-original-article)) (if (get-buffer name) (save-excursion (set-buffer name) + (when (and gnus-article-edit-mode + (buffer-modified-p) + (not + (y-or-n-p "Article mode edit in progress; discard? "))) + (error "Action aborted")) + (set (make-local-variable 'gnus-article-edit-mode) nil) (buffer-disable-undo) (setq buffer-read-only t) + ;; This list just keeps growing if we don't reset it. + (setq gnus-button-marker-list nil) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (current-buffer)) @@ -2977,7 +3824,7 @@ commands: ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) (set-window-start - (get-buffer-window gnus-article-buffer t) + (gnus-get-buffer-window gnus-article-buffer t) (save-excursion (set-buffer gnus-article-buffer) (goto-char (point-min)) @@ -3065,7 +3912,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." result) (save-excursion (gnus-article-setup-buffer) - (set-buffer gnus-original-article-buffer) + (set-buffer gnus-article-buffer) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) @@ -3081,7 +3928,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) - (if (eq (gnus-article-mark article) gnus-undownloaded-mark) + (if (and (memq article gnus-newsgroup-undownloaded) + (not (gnus-online (gnus-find-method-for-group + gnus-newsgroup-name)))) (progn (gnus-summary-set-agent-mark article) (message "Message marked for downloading")) @@ -3153,6 +4002,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)) (article-goto-body) + (unless (bobp) + (forward-line -1)) (set-window-point (get-buffer-window (current-buffer)) (point)) (gnus-configure-windows 'article) t)))))) @@ -3227,28 +4078,43 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;;;###autoload (defun gnus-article-prepare-display () "Make the current buffer look like a nice article." - (setq gnus-article-wash-types nil) - (gnus-run-hooks 'gnus-tmp-internal-hook) - ;; Display message. - (setq mime-message-structure gnus-current-headers) - (mime-buffer-entity-set-buffer-internal mime-message-structure - gnus-original-article-buffer) - (mime-entity-set-representation-type-internal mime-message-structure - 'mime-buffer-entity) - (luna-send mime-message-structure 'initialize-instance - mime-message-structure) - (if gnus-show-mime - (let (mime-display-header-hook mime-display-text/plain-hook) - (funcall gnus-article-display-method-for-mime)) - (funcall gnus-article-display-method-for-traditional)) - ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary gnus-summary-buffer) - ;; Call the treatment functions. - (let ((inhibit-read-only t) + (let ((gnus-article-buffer (current-buffer)) buffer-read-only) + (unless (eq major-mode 'gnus-article-mode) + (gnus-article-mode)) + (setq buffer-read-only nil + gnus-button-marker-list nil + gnus-article-wash-types nil + gnus-article-image-alist nil) (save-restriction (widen) - (if gnus-show-mime + (static-if (featurep 'xemacs) + (map-extents (lambda (extent maparg) (delete-extent extent))) + (let ((lists (overlay-lists))) + (dolist (overlay (nconc (car lists) (cdr lists))) + (delete-overlay overlay))))) + (gnus-run-hooks 'gnus-tmp-internal-hook)) + (let ((show-mime (unless (member gnus-newsgroup-name '("nndraft:delayed" + "nndraft:drafts")) + gnus-show-mime)) + (inhibit-read-only t)) + (set-buffer gnus-original-article-buffer) + ;; Display message. + (setq mime-message-structure gnus-current-headers) + (mime-buffer-entity-set-buffer-internal mime-message-structure + gnus-original-article-buffer) + (mime-entity-set-representation-type-internal mime-message-structure + 'mime-buffer-entity) + (luna-send mime-message-structure 'initialize-instance + mime-message-structure) + (if show-mime + (let (mime-display-header-hook mime-display-text/plain-hook) + (funcall gnus-article-display-method-for-mime)) + (funcall gnus-article-display-method-for-traditional)) + ;; Call the treatment functions. + (save-restriction + (widen) + (if show-mime (gnus-article-prepare-mime-display) (narrow-to-region (goto-char (point-min)) (if (search-forward "\n\n" nil t) @@ -3266,7 +4132,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-article-decode-article-as-default-mime-charset () "Decode an article as `default-mime-charset'. It won't work if the value of the variable `gnus-show-mime' is non-nil." - (unless gnus-show-mime + (unless (or gnus-show-mime + (member gnus-newsgroup-name '("nndraft:delayed" + "nndraft:drafts"))) (set (make-local-variable 'default-mime-charset) (with-current-buffer gnus-summary-buffer default-mime-charset)) @@ -3278,14 +4146,19 @@ value of the variable `gnus-show-mime' is non-nil." ;;; (defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" - "The following specs can be used: + "Format of the MIME buttons. + +Valid specifiers include: %t The MIME type %T MIME type, along with additional info %n The `name' parameter %d The description, if any %l The length of the encoded part %p The part identifier number -%e Dots if the part isn't displayed") +%e Dots if the part isn't displayed + +General format specifiers can also be used. See Info node +`(gnus)Formatting Variables'.") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) @@ -3300,43 +4173,73 @@ 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-delete-part "d" "Delete part") (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-view-part-internally "E" "View Internally") + (gnus-mime-view-part-externally "e" "View Externally") + (gnus-mime-print-part "p" "Print") (gnus-mime-pipe-part "|" "Pipe To Command...") - (gnus-mime-action-on-part "." "Take action on the part"))) + (gnus-mime-action-on-part "." "Take action on the part..."))) (defun gnus-article-mime-part-status () - (if gnus-article-mime-handle-alist-1 - (format " (%d parts)" (length gnus-article-mime-handle-alist-1)) - "")) + (with-current-buffer gnus-article-buffer + (let ((entity (get-text-property (point-min) 'mime-view-entity)) + children) + (if (and entity + (setq children (mime-entity-children entity)) + (setq children (length children))) + (if (eq 1 children) + " (1 part)" + (format " (%d parts)" children)) + "")))) (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map gnus-article-mode-map) + (unless (>= (string-to-number emacs-version) 21) + ;; XEmacs doesn't care. + (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-window-excursion - (let ((pos (event-start event))) - (select-window (posn-window pos)) - (goto-char (posn-point pos)) - (gnus-article-check-buffer) - (let ((response (x-popup-menu - t `("MIME Part" - ("" ,@(mapcar (lambda (c) - (cons (caddr c) (car c))) - gnus-mime-button-commands)))))) - (if response - (call-interactively response)))))) +(easy-menu-define + gnus-mime-button-menu gnus-mime-button-map "MIME button menu." + `("MIME Part" + ,@(mapcar (lambda (c) + (vector (caddr c) (car c) :enable t)) + gnus-mime-button-commands))) + +(eval-when-compile + (define-compiler-macro popup-menu (&whole form + menu &optional position prefix) + (if (and (fboundp 'popup-menu) + (not (memq 'popup-menu (assoc "lmenu" load-history)))) + form + ;; Gnus is probably running under Emacs 20. + `(let* ((menu (cdr ,menu)) + (response (x-popup-menu + t (list (car menu) + (cons "" (mapcar (lambda (c) + (cons (caddr c) (car c))) + (cdr menu))))))) + (if response + (call-interactively (nth 3 (assq response menu)))))))) + +(defun gnus-mime-button-menu (event prefix) + "Construct a context-sensitive menu of MIME commands." + (interactive "e\nP") + (save-window-excursion + (let ((pos (event-start event))) + (select-window (posn-window pos)) + (goto-char (posn-point pos)) + (gnus-article-check-buffer) + (popup-menu gnus-mime-button-menu nil prefix)))) (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." @@ -3345,12 +4248,160 @@ value of the variable `gnus-show-mime' is non-nil." (set-buffer gnus-article-buffer) (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))))) + (mail-parse-ignored-charsets + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) + (when handles + (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 param + (handles gnus-article-mime-handles)) + (if (mm-multiple-handles gnus-article-mime-handles) + (error "This function is not implemented")) + (setq file (and data (mm-save-part data))) + (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 ',handles) + (setq gnus-article-mime-handles nil) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + (gnus-make-local-hook 'kill-buffer-hook) + (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-delete-part () + "Delete the MIME part under point. +Replace it with some information about the removed part." + (interactive) + (gnus-article-check-buffer) + (unless (and gnus-novice-user + (not (gnus-yes-or-no-p + "Really delete attachment forever? "))) + (let* ((data (get-text-property (point) 'gnus-data)) + (handles gnus-article-mime-handles) + (none "(none)") + (description + (or + (mail-decode-encoded-word-string (or (mm-handle-description data) + none)))) + (filename + (or (mail-content-type-get (mm-handle-disposition data) 'filename) + none)) + (type (mm-handle-media-type data))) + (if (mm-multiple-handles gnus-article-mime-handles) + (error "This function is not implemented")) + (with-current-buffer (mm-handle-buffer data) + (let ((bsize (format "%s" (buffer-size)))) + (erase-buffer) + (insert + (concat + "<#part type=text/plain nofile=yes disposition=attachment" + " description=\"Deleted attachment (" bsize " Byte)\">" + ",----\n" + "| The following attachment has been deleted:\n" + "|\n" + "| Type: " type "\n" + "| Filename: " filename "\n" + "| Size (encoded): " bsize " Byte\n" + "| Description: " description "\n" + "`----\n" + "<#/part>")) + (setcdr data + (cdr (mm-make-handle nil `("text/plain")))))) + (set-buffer gnus-summary-buffer) + ;; FIXME: maybe some of the following code (borrowed from + ;; `gnus-mime-save-part-and-strip') isn't necessary? + (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 ',handles) + (setq gnus-article-mime-handles nil) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + (gnus-make-local-hook 'kill-buffer-hook) + (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))))) + ;; Not in `gnus-mime-save-part-and-strip': + (gnus-article-edit-done) + (gnus-summary-expand-window) + (gnus-summary-show-article)) (defun gnus-mime-save-part () "Save the MIME part under point." @@ -3374,6 +4425,9 @@ value of the variable `gnus-show-mime' is non-nil." (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data + (setq gnus-article-mime-handles + (mm-merge-handles + gnus-article-mime-handles (setq data (copy-sequence data)))) (mm-interactively-view-part data)))) (defun gnus-mime-view-part-as-type-internal () @@ -3384,38 +4438,74 @@ value of the variable `gnus-show-mime' is non-nil." (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) +(defun gnus-mime-view-part-as-type (&optional mime-type) "Choose a MIME media type, and view the part as such." - (interactive - (list (completing-read - "View as MIME type: " - (mapcar #'list (mailcap-mime-types)) - nil nil - (gnus-mime-view-part-as-type-internal)))) + (interactive) + (unless mime-type + (setq mime-type (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))) (when 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)))))) + (setq handle + (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) + nil + (mm-handle-id handle))) + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handle)) + (gnus-mm-display-part handle)))) + +(eval-when-compile + (require 'jka-compr)) + +;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days +;; emacs can do that itself. +;; +(defun gnus-mime-jka-compr-maybe-uncompress () + "Uncompress the current buffer if `auto-compression-mode' is enabled. +The uncompress method used is derived from `buffer-file-name'." + (when (and (fboundp 'jka-compr-installed-p) + (jka-compr-installed-p)) + (let ((info (jka-compr-get-compression-info buffer-file-name))) + (when info + (let ((basename (file-name-nondirectory buffer-file-name)) + (args (jka-compr-info-uncompress-args info)) + (prog (jka-compr-info-uncompress-program info)) + (message (jka-compr-info-uncompress-message info)) + (err-file (jka-compr-make-temp-name))) + (if message + (message "%s %s..." message basename)) + (unwind-protect + (unless (memq (apply 'call-process-region + (point-min) (point-max) + prog + t (list t err-file) nil + args) + jka-compr-acceptable-retval-list) + (jka-compr-error prog args basename message err-file)) + (jka-compr-delete-temp-file err-file))))))) (defun gnus-mime-copy-part (&optional handle) - "Put the the MIME part under point into a new buffer." + "Put the MIME part under point into a new buffer. +If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 +are decompressed." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (base (and handle + (base (and handle (file-name-nondirectory (or (mail-content-type-get (mm-handle-type handle) 'name) - (mail-content-type-get (mm-handle-type handle) + (mail-content-type-get (mm-handle-disposition handle) 'filename) "*decoded*")))) (buffer (and base (generate-new-buffer base)))) @@ -3426,10 +4516,36 @@ value of the variable `gnus-show-mime' is non-nil." (unwind-protect (progn (setq buffer-file-name (expand-file-name base)) + (gnus-mime-jka-compr-maybe-uncompress) (normal-mode)) (setq buffer-file-name nil)) (goto-char (point-min))))) +(defun gnus-mime-print-part (&optional handle filename) + "Print the MIME part under point." + (interactive (list nil (ps-print-preprint current-prefix-arg))) + (gnus-article-check-buffer) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + (contents (and handle (mm-get-part handle))) + (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) + (printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) + (when contents + (if printer + (unwind-protect + (progn + (mm-save-part-to-file handle file) + (call-process shell-file-name nil + (generate-new-buffer " *mm*") + nil + shell-command-switch + (mm-mailcap-command + printer file (mm-handle-type handle)))) + (delete-file file)) + (with-temp-buffer + (insert contents) + (gnus-print-buffer)) + (ps-despool filename))))) + (defun gnus-mime-inline-part (&optional handle arg) "Insert the MIME part under point into the current buffer." (interactive (list nil current-prefix-arg)) @@ -3451,13 +4567,13 @@ value of the variable `gnus-show-mime' is non-nil." (if (mm-handle-undisplayer handle) (mm-remove-part handle)) (setq charset - (or (cdr (assq arg + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (read-coding-system "Charset: "))))) + (mm-read-coding-system "Charset: "))))) (forward-line 2) (mm-insert-inline handle - (if (and charset - (setq charset (mm-charset-to-coding-system + (if (and charset + (setq charset (mm-charset-to-coding-system charset)) (not (eq charset 'ascii))) (mm-decode-coding-string contents charset) @@ -3465,7 +4581,8 @@ value of the variable `gnus-show-mime' is non-nil." (goto-char b))))) (defun gnus-mime-view-part-as-charset (&optional handle arg) - "Insert the MIME part under point into the current buffer." + "Insert the MIME part under point into the current buffer using the +specified charset." (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) @@ -3476,13 +4593,13 @@ value of the variable `gnus-show-mime' is non-nil." (if (mm-handle-undisplayer handle) (mm-remove-part handle)) (let ((gnus-newsgroup-charset - (or (cdr (assq arg + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (read-coding-system "Charset: "))) - (gnus-newsgroup-ignored-charsets 'gnus-all)) + (mm-read-coding-system "Charset: "))) + (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-article-press-button))))) -(defun gnus-mime-externalize-part (&optional handle) +(defun gnus-mime-view-part-externally (&optional handle) "View the MIME part under point with an external viewer." (interactive) (gnus-article-check-buffer) @@ -3490,7 +4607,7 @@ value of the variable `gnus-show-mime' is non-nil." (mm-user-display-methods nil) (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (when handle @@ -3498,18 +4615,19 @@ value of the variable `gnus-show-mime' is non-nil." (mm-remove-part handle) (mm-display-part handle))))) -(defun gnus-mime-internalize-part (&optional handle) +(defun gnus-mime-view-part-internally (&optional handle) "View the MIME part under point with an internal viewer. -In no internal viewer is available, use an external viewer." +If no internal viewer is available, use an external viewer." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (mm-inlined-types '(".*")) (mm-inline-large-images t) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + gnus-newsgroup-ignored-charsets)) + buffer-read-only) (when handle (if (mm-handle-undisplayer handle) (mm-remove-part handle) @@ -3518,7 +4636,7 @@ In no internal viewer is available, use an external viewer." (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))) + (list (completing-read "Action: " gnus-mime-action-alist nil t))) (gnus-article-check-buffer) (let ((action-pair (assoc action gnus-mime-action-alist))) (if action-pair @@ -3553,10 +4671,15 @@ In no internal viewer is available, use an external viewer." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-copy-part)) -(defun gnus-article-externalize-part (n) +(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-view-part-externally (n) "View MIME part N externally, which is the numerical prefix." (interactive "p") - (gnus-article-part-wrapper n 'gnus-mime-externalize-part)) + (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) (defun gnus-article-inline-part (n) "Inline MIME part N, which is the numerical prefix." @@ -3567,10 +4690,10 @@ In no internal viewer is available, use an external viewer." (if condition (let ((alist gnus-article-mime-handle-alist) ihandle n) (while (setq ihandle (pop alist)) - (if (and (cond + (if (and (cond ((functionp condition) (funcall condition (cdr ihandle))) - ((eq condition 'undisplayed) + ((eq condition 'undisplayed) (not (or (mm-handle-undisplayer (cdr ihandle)) (equal (mm-handle-media-type (cdr ihandle)) "multipart/alternative")))) @@ -3588,7 +4711,7 @@ In no internal viewer is available, use an external viewer." (interactive "P") (save-current-buffer (set-buffer gnus-article-buffer) - (or (numberp n) (setq n (gnus-article-mime-match-handle-first + (or (numberp n) (setq n (gnus-article-mime-match-handle-first gnus-article-mime-match-handle-function))) (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) @@ -3613,12 +4736,15 @@ In no internal viewer is available, use an external viewer." (prog1 (let ((window (selected-window)) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (mail-parse-ignored-charsets + (if (gnus-buffer-live-p gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-ignored-charsets) + nil))) (save-excursion (unwind-protect - (let ((win (get-buffer-window (current-buffer) t)) + (let ((win (gnus-get-buffer-window (current-buffer) t)) (beg (point))) (when win (select-window win)) @@ -3628,7 +4754,8 @@ In no internal viewer is available, use an external viewer." ;; This will remove the part. (mm-display-part handle) (save-restriction - (narrow-to-region (point) (1+ (point))) + (narrow-to-region (point) + (if (eobp) (point) (1+ (point)))) (mm-display-part handle) ;; We narrow to the part itself and ;; then call the treatment functions. @@ -3639,25 +4766,23 @@ In no internal viewer is available, use an external viewer." nil id (gnus-article-mime-total-parts) (mm-handle-media-type handle))))) - (select-window window)))) + (if (window-live-p window) + (select-window window))))) (goto-char point) - (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) + (gnus-delete-line) (gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle))) (goto-char point)))) (defun gnus-article-goto-part (n) "Go to MIME part N." - (let ((point (text-property-any (point-min) (point-max) 'gnus-part n))) - (when point - (goto-char point)))) + (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name - (or (mail-content-type-get (mm-handle-type handle) - 'name) - (mail-content-type-get (mm-handle-disposition handle) - 'filename) + (or (mail-content-type-get (mm-handle-type handle) '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 @@ -3675,20 +4800,22 @@ In no internal viewer is available, use an external viewer." (setq gnus-tmp-type-long (concat gnus-tmp-type (and (not (equal gnus-tmp-name "")) (concat "; " gnus-tmp-name)))) - (or (equal gnus-tmp-description "") - (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) + (unless (equal gnus-tmp-description "") + (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) (unless (bolp) (insert "\n")) (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)) - (setq e (point)) + `(,@(gnus-local-map-property gnus-mime-button-map) + gnus-callback gnus-mm-display-part + gnus-part ,gnus-tmp-id + article-type annotation + gnus-data ,handle)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) (widget-convert-button 'link b e :mime-handle handle @@ -3731,7 +4858,10 @@ In no internal viewer is available, use an external viewer." ;; We have to do this since selecting the window ;; may change the point. So we set the window point. (set-window-point window point))) - (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) + (let* ((handles (or ihandles + (mm-dissect-buffer nil gnus-article-loose-mime) + (and gnus-article-emulate-mime + (mm-uu-dissect)))) buffer-read-only handle name type b e display) (when (and (not ihandles) (not gnus-displaying-mime)) @@ -3767,7 +4897,28 @@ In no internal viewer is available, use an external viewer." (narrow-to-region (point-min) (point)) (gnus-treat-article 'head)))))))) -(defvar gnus-mime-display-multipart-as-mixed nil) +(defcustom gnus-mime-display-multipart-as-mixed nil + "Display \"multipart\" parts as \"multipart/mixed\". + +If `t', it overrides `nil' values of +`gnus-mime-display-multipart-alternative-as-mixed' and +`gnus-mime-display-multipart-related-as-mixed'." + :group 'gnus-article-mime + :type 'boolean) + +(defcustom gnus-mime-display-multipart-alternative-as-mixed nil + "Display \"multipart/alternative\" parts as \"multipart/mixed\"." + :group 'gnus-article-mime + :type 'boolean) + +(defcustom gnus-mime-display-multipart-related-as-mixed nil + "Display \"multipart/related\" parts as \"multipart/mixed\". + +If displaying \"text/html\" is discouraged \(see +`mm-discouraged-alternatives'\) images or other material inside a +\"multipart/related\" part might be overlooked when this variable is `nil'." + :group 'gnus-article-mime + :type 'boolean) (defun gnus-mime-display-part (handle) (cond @@ -3780,16 +4931,30 @@ In no internal viewer is available, use an external viewer." handle)) ;; multipart/alternative ((and (equal (car handle) "multipart/alternative") - (not gnus-mime-display-multipart-as-mixed)) + (not (or gnus-mime-display-multipart-as-mixed + gnus-mime-display-multipart-alternative-as-mixed))) (let ((id (1+ (length gnus-article-mime-handle-alist)))) (push (cons id handle) gnus-article-mime-handle-alist) (gnus-mime-display-alternative (cdr handle) nil nil id))) ;; multipart/related ((and (equal (car handle) "multipart/related") - (not gnus-mime-display-multipart-as-mixed)) + (not (or gnus-mime-display-multipart-as-mixed + gnus-mime-display-multipart-related-as-mixed))) ;;;!!!We should find the start part, but we just default ;;;!!!to the first part. + ;;(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)) + ;;;!!! No, w3 can display everything just fine. (gnus-mime-display-part (cadr handle))) + ((equal (car handle) "multipart/signed") + (gnus-add-wash-type 'signed) + (gnus-mime-display-security handle)) + ((equal (car handle) "multipart/encrypted") + (gnus-add-wash-type 'encrypted) + (gnus-mime-display-security handle)) ;; Other multiparts are handled like multipart/mixed. (t (gnus-mime-display-mixed (cdr handle))))) @@ -3820,7 +4985,9 @@ In no internal viewer is available, use an external viewer." "inline") (mm-attachment-override-p handle)))) (mm-automatic-display-p handle) - (or (mm-inlined-p handle) + (or (and + (mm-inlinable-p handle) + (mm-inlined-p handle)) (mm-automatic-external-display-p type))) (setq display t) (when (equal (mm-handle-media-supertype handle) "text") @@ -3833,8 +5000,8 @@ In no internal viewer is available, use an external viewer." ;(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) + (gnus-article-insert-newline) + ;(gnus-article-insert-newline) ;; Remember modify the number of forward lines. (setq move t)) (setq beg (point)) @@ -3844,7 +5011,7 @@ In no internal viewer is available, use an external viewer." (forward-line -1) (setq beg (point))) (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case () (set-buffer gnus-summary-buffer) (error)) @@ -3863,18 +5030,23 @@ In no internal viewer is available, use an external viewer." (save-restriction (narrow-to-region beg (point)) (gnus-treat-article - nil id + nil id (gnus-article-mime-total-parts) (mm-handle-media-type handle))))))))) (defun gnus-unbuttonized-mime-type-p (type) "Say whether TYPE is to be unbuttonized." (unless gnus-inhibit-mime-unbuttonizing - (catch 'found - (let ((types gnus-unbuttonized-mime-types)) - (while types - (when (string-match (pop types) type) - (throw 'found t))))))) + (when (catch 'found + (let ((types gnus-unbuttonized-mime-types)) + (while types + (when (string-match (pop types) type) + (throw 'found t))))) + (not (catch 'found + (let ((types gnus-buttonized-mime-types)) + (while types + (when (string-match (pop types) type) + (throw 'found t))))))))) (defun gnus-article-insert-newline () "Insert a newline, but mark it as undeletable." @@ -3917,10 +5089,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 + ,@(gnus-local-map-property gnus-mime-button-map) ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face - keymap ,gnus-mime-button-map gnus-part ,id gnus-data ,handle)) (widget-convert-button 'link from (point) @@ -3942,10 +5113,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 + ,@(gnus-local-map-property gnus-mime-button-map) ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face - keymap ,gnus-mime-button-map gnus-part ,id gnus-data ,handle)) (widget-convert-button 'link from (point) @@ -3957,7 +5127,7 @@ In no internal viewer is available, use an external viewer." (if (stringp (car preferred)) (gnus-display-mime preferred) (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (mm-display-part preferred) @@ -3974,6 +5144,41 @@ In no internal viewer is available, use an external viewer." (when ibegend (goto-char point)))) +(defconst gnus-article-wash-status-strings + (let ((alist '((cite "c" "Possible hidden citation text" + " " "All citation text visible") + (headers "h" "Hidden headers" + " " "All headers visible.") + (pgp "p" "Encrypted or signed message status hidden" + " " "No hidden encryption nor digital signature status") + (signature "s" "Signature has been hidden" + " " "Signature is visible") + (overstrike "o" "Overstrike (^H) characters applied" + " " "No overstrike characters applied") + (gnus-show-mime "m" "Mime processing is activated" + " " "Mime processing is not activated") + (emphasis "e" "/*_Emphasis_*/ characters applied" + " " "No /*_emphasis_*/ characters applied"))) + result) + (dolist (entry alist result) + (let ((key (nth 0 entry)) + (on (copy-sequence (nth 1 entry))) + (on-help (nth 2 entry)) + (off (copy-sequence (nth 3 entry))) + (off-help (nth 4 entry))) + (put-text-property 0 1 'help-echo on-help on) + (put-text-property 0 1 'help-echo off-help off) + (push (list key on off) result)))) + "Alist of strings describing wash status in the mode line. +Each entry has the form (KEY ON OF), where the KEY is a symbol +representing the particular washing function, ON is the string to use +in the article mode line when the washing function is active, and OFF +is the string to use when it is inactive.") + +(defun gnus-article-wash-status-entry (key value) + (let ((entry (assoc key gnus-article-wash-status-strings))) + (if value (nth 1 entry) (nth 2 entry)))) + (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion @@ -3983,17 +5188,43 @@ 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 signature ?s ? ) - (if overstrike ?o ? ) - (if gnus-show-mime ?m ? ) - (if emphasis ?e ? ))))) + (concat + (gnus-article-wash-status-entry 'cite cite) + (gnus-article-wash-status-entry 'headers (or headers boring)) + (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted)) + (gnus-article-wash-status-entry 'signature signature) + (gnus-article-wash-status-entry 'overstrike overstrike) + (gnus-article-wash-status-entry 'gnus-show-mime gnus-show-mime) + (gnus-article-wash-status-entry 'emphasis emphasis))))) + +(defun gnus-add-wash-type (type) + "Add a washing of TYPE to the current status." + (add-to-list 'gnus-article-wash-types type)) + +(defun gnus-delete-wash-type (type) + "Add a washing of TYPE to the current status." + (setq gnus-article-wash-types (delq type gnus-article-wash-types))) + +(defun gnus-add-image (category image) + "Add IMAGE of CATEGORY to the list of displayed images." + (let ((entry (assq category gnus-article-image-alist))) + (unless entry + (setq entry (list category)) + (push entry gnus-article-image-alist)) + (nconc entry (list image)))) + +(defun gnus-delete-images (category) + "Delete all images in CATEGORY." + (let ((entry (assq category gnus-article-image-alist))) + (dolist (image (cdr entry)) + (gnus-remove-image image)) + (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) + (gnus-delete-wash-type category))) (defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) @@ -4017,7 +5248,9 @@ Provided for backwards compatibility." ;; save it to file. (goto-char (point-max)) (insert "\n") - (write-region-as-binary (point-min) (point-max) file-name 'append) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (write-region-as-binary (point-min) (point-max) file-name 'append)) t))) (defun gnus-narrow-to-page (&optional arg) @@ -4065,79 +5298,109 @@ If given a numerical ARG, move forward ARG pages." (goto-char (point-min)) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) + (defun gnus-article-goto-prev-page () "Show the next page of the article." (interactive) - (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) + (if (bobp) + (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) (gnus-article-prev-page nil))) +;; This is cleaner but currently breaks `gnus-pick-mode': +;; +;; (defun gnus-article-goto-next-page () +;; "Show the next page of the article." +;; (interactive) +;; (gnus-eval-in-buffer-window gnus-summary-buffer +;; (gnus-summary-next-page))) +;; +;; (defun gnus-article-goto-prev-page () +;; "Show the next page of the article." +;; (interactive) +;; (gnus-eval-in-buffer-window gnus-summary-buffer +;; (gnus-summary-prev-page))) + (defun gnus-article-next-page (&optional lines) "Show the next page of the current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." (interactive "p") - (let ((start (window-start)) - end-of-buffer end-of-page) - (save-excursion - (move-to-window-line -1) - (if (<= (point) start) + (move-to-window-line -1) + (if (save-excursion + (end-of-line) + (and (pos-visible-in-window-p) ;Not continuation line. + (>= (1+ (point)) (point-max)))) ;Allow for trailing newline. + ;; Nothing in this page. + (if (or (not gnus-page-broken) + (save-excursion + (save-restriction + (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? (progn - (forward-line 2) - (setq start (point))) - (forward-line 1) - (setq start nil)) - (unless (or (cond ((eq (1+ (buffer-size)) (point)) - (and (pos-visible-in-window-p) - (setq end-of-buffer t))) - ((eobp) - (setq end-of-page t))) - (not lines)) - (move-to-window-line lines) - (unless (search-backward "\n\n" nil t) - (setq start (point))))) - (cond (end-of-buffer t) - (end-of-page - (gnus-narrow-to-page 1) - nil) - (t - (if start - (set-window-start (selected-window) start) - (let (window-pixel-scroll-increment) - (scroll-up lines))) - nil)))) + (when gnus-article-over-scroll + (gnus-article-next-page-1 lines)) + t) ;Nothing more. + (gnus-narrow-to-page 1) ;Go to next page. + nil) + ;; More in this page. + (gnus-article-next-page-1 lines) + nil)) + +(defun gnus-article-next-page-1 (lines) + (let ((scroll-in-place nil)) + (condition-case () + (scroll-up lines) + (end-of-buffer + ;; Long lines may cause an end-of-buffer error. + (goto-char (point-max))))) + (move-to-window-line 0)) (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. Argument LINES specifies lines to be scrolled down." (interactive "p") - (let (beginning-of-buffer beginning-of-page) + (move-to-window-line 0) + (if (and gnus-page-broken + (bobp) + (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? + (progn + (gnus-narrow-to-page -1) ;Go to previous page. + (goto-char (point-max)) + (recenter -1)) + (let ((scroll-in-place nil)) + (prog1 + (condition-case () + (scroll-down lines) + (beginning-of-buffer + (goto-char (point-min)))) + (move-to-window-line 0))))) + +(defun gnus-article-only-boring-p () + "Decide whether there is only boring text remaining in the article. +Something \"interesting\" is a word of at least two letters that does +not have a face in `gnus-article-boring-faces'." + (when (and gnus-article-skip-boring + (boundp 'gnus-article-boring-faces) + (symbol-value 'gnus-article-boring-faces)) (save-excursion - (move-to-window-line 0) - (cond ((eq 1 (point)) - (setq beginning-of-buffer t)) - ((bobp) - (setq beginning-of-page t)))) - (cond (beginning-of-buffer) - (beginning-of-page - (gnus-narrow-to-page -1)) - (t - (condition-case nil - (let (window-pixel-scroll-increment) - (scroll-down lines)) - (beginning-of-buffer - (goto-char (point-min)))))))) + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (gnus-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces))) + (throw 'only-boring nil))) + (throw 'only-boring t))))) (defun gnus-article-refer-article () "Read article specified by message-id around point." (interactive) - (let ((point (point))) - (search-forward ">" nil t) ;Move point to end of "<....>". - (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) - (let ((message-id (match-string 1))) - (goto-char point) + (save-excursion + (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t) + (re-search-forward "]+" (gnus-point-at-eol) t) + (let ((msg-id (concat "<" (match-string 0) ">"))) (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id)) - (goto-char (point)) + (gnus-summary-refer-article msg-id)) (error "No references around point")))) (defun gnus-article-show-summary () @@ -4186,60 +5449,60 @@ Argument LINES specifies lines to be scrolled down." (interactive "P") (gnus-article-check-buffer) (let ((nosaves - '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" - "Zc" "ZC" "ZE" "ZJ" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" - "=" "^" "\M-^" "|")) - (nosave-but-article - '("A\r")) - (nosave-in-article - '("\C-d")) - (up-to-top - '("n" "Gn" "p" "Gp")) - keys new-sum-point) + '("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f" + "Zc" "ZC" "ZE" "ZJ" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" + "=" "^" "\M-^" "|")) + (nosave-but-article + '("A\r")) + (nosave-in-article + '("\C-d")) + (up-to-top + '("n" "Gn" "p" "Gp")) + keys new-sum-point) (save-excursion (set-buffer gnus-article-current-summary) (let (gnus-pick-mode) - (push (or key last-command-event) unread-command-events) + (push (or key last-command-event) unread-command-events) (setq keys (static-if (featurep 'xemacs) (events-to-keys (read-key-sequence nil)) (read-key-sequence nil))))) (message "") (if (or (member keys nosaves) - (member keys nosave-but-article) - (member keys nosave-in-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-article-current-summary 'norecord) - ;; We disable the pick minor mode commands. - (let (gnus-pick-mode) - (setq func (lookup-key (current-local-map) keys)))) - (if (or (not func) + (member keys nosave-but-article) + (member keys nosave-in-article)) + (let (func) + (save-window-excursion + (pop-to-buffer gnus-article-current-summary 'norecord) + ;; We disable the pick minor mode commands. + (let (gnus-pick-mode) + (setq func (lookup-key (current-local-map) keys)))) + (if (or (not func) (numberp func)) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-article-current-summary)) - (call-interactively func) - (setq new-sum-point (point))) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer 'norecord))) + (ding) + (unless (member keys nosave-in-article) + (set-buffer gnus-article-current-summary)) + (call-interactively func) + (setq new-sum-point (point))) + (when (member keys nosave-but-article) + (pop-to-buffer gnus-article-buffer 'norecord))) ;; These commands should restore window configuration. (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - (opoint (point)) - (summary gnus-article-current-summary) - func in-buffer selected) - (if not-restore-window - (pop-to-buffer summary 'norecord) - (switch-to-buffer summary 'norecord)) - (setq in-buffer (current-buffer)) - ;; We disable the pick minor mode commands. - (if (and (setq func (let (gnus-pick-mode) + (owin (current-window-configuration)) + (opoint (point)) + (summary gnus-article-current-summary) + func in-buffer selected) + (if not-restore-window + (pop-to-buffer summary 'norecord) + (switch-to-buffer summary 'norecord)) + (setq in-buffer (current-buffer)) + ;; We disable the pick minor mode commands. + (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)) + (progn + (call-interactively func) + (setq new-sum-point (point)) (when (eq in-buffer (current-buffer)) (setq selected (gnus-summary-select-article)) (set-buffer obuf) @@ -4255,7 +5518,7 @@ Argument LINES specifies lines to be scrolled down." (when win (set-window-point win new-sum-point)))) ) (switch-to-buffer gnus-article-buffer) - (ding)))))) + (ding)))))) (defun gnus-article-describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string." @@ -4265,10 +5528,16 @@ Argument LINES specifies lines to be scrolled down." (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: ")))) + (if (featurep 'xemacs) + (progn + (push (elt key 0) unread-command-events) + (setq key (events-to-keys + (read-key-sequence "Describe key: ")))) + (setq unread-command-events + (mapcar + (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) + key)) + (setq key (read-key-sequence "Describe key: ")))) (describe-key key)) (describe-key key))) @@ -4280,22 +5549,65 @@ Argument LINES specifies lines to be scrolled down." (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: ")))) + (if (featurep 'xemacs) + (progn + (push (elt key 0) unread-command-events) + (setq key (events-to-keys + (read-key-sequence "Describe key: ")))) + (setq unread-command-events + (mapcar + (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) + key)) + (setq key (read-key-sequence "Describe key: ")))) (describe-key-briefly key insert)) (describe-key-briefly key insert))) +(defun gnus-article-reply-with-original (&optional wide) + "Start composing a reply mail to the current message. +The text in the region will be yanked. If the region isn't active, +the entire article will be yanked." + (interactive "P") + (let ((article (cdr gnus-article-current)) + contents) + (if (not (gnus-mark-active-p)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply (list (list article)) wide)) + (setq contents (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply + (list (list article contents)) wide))))) + +(defun gnus-article-followup-with-original () + "Compose a followup to the current article. +The text in the region will be yanked. If the region isn't active, +the entire article will be yanked." + (interactive) + (let ((article (cdr gnus-article-current)) + contents) + (if (not (gnus-mark-active-p)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup (list (list article)))) + (setq contents (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup + (list (list article contents))))))) + (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. -This means that PGP stuff, signatures, cited text and (some) -headers will be hidden. +This means that signatures, cited text and (some) headers will be +hidden. If given a prefix, show the hidden text instead." (interactive (append (gnus-article-hidden-arg) (list 'force))) (gnus-article-hide-headers arg) (gnus-article-hide-list-identifiers arg) - (gnus-article-hide-pgp arg) (gnus-article-hide-citation-maybe arg force) (gnus-article-hide-signature arg)) @@ -4311,6 +5623,9 @@ If given a prefix, show the hidden text instead." (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) +(eval-when-compile + (autoload 'nneething-get-file-name "nneething")) + (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." (let (do-update-line sparse-header) @@ -4360,12 +5675,10 @@ If given a prefix, show the hidden text instead." gnus-newsgroup-name))) (when (and (eq (car method) 'nneething) (vectorp header)) - (let ((dir (expand-file-name - (mail-header-subject header) - (file-name-as-directory - (or (cadr (assq 'nneething-address method)) - (nth 1 method)))))) - (when (file-directory-p dir) + (let ((dir (nneething-get-file-name + (mail-header-id header)))) + (when (and (stringp dir) + (file-directory-p dir)) (setq article 'nneething) (gnus-group-enter-directory dir)))))))) @@ -4380,6 +5693,15 @@ If given a prefix, show the hidden text instead." (assq article gnus-newsgroup-reads))) gnus-canceled-mark)) nil) + ;; We first check `gnus-original-article-buffer'. + ((and (get-buffer gnus-original-article-buffer) + (numberp article) + (save-excursion + (set-buffer gnus-original-article-buffer) + (and (equal (car gnus-original-article) group) + (eq (cdr gnus-original-article) article)))) + (insert-buffer-substring gnus-original-article-buffer) + 'article) ;; Check the backlog. ((and gnus-keep-backlog (gnus-backlog-request-article group article (current-buffer))) @@ -4395,12 +5717,17 @@ If given a prefix, show the hidden text instead." (numberp article) (gnus-cache-request-article article group)) 'article) + ;; Check the agent cache. + ((gnus-agent-request-article article group) + 'article) ;; Get the article and put into the article buffer. ((or (stringp article) (numberp article)) (let ((gnus-override-method gnus-override-method) - (methods (and (stringp article) + (methods (and (stringp article) gnus-refer-article-method)) + (backend (car (gnus-find-method-for-group + gnus-newsgroup-name))) result (buffer-read-only nil)) (if (or (not (listp methods)) @@ -4412,23 +5739,29 @@ If given a prefix, show the hidden text instead." (setq gnus-override-method (pop methods))) (while (not result) (when (eq gnus-override-method 'current) - (setq gnus-override-method gnus-current-select-method)) + (setq gnus-override-method + (with-current-buffer gnus-summary-buffer + 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)) + (cond + ((gnus-request-article article group (current-buffer)) (when (numberp article) - (gnus-async-prefetch-next group 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)))) + (methods + (setq gnus-override-method (pop methods))) + ((not (string-match "^400 " + (nnheader-get-report backend))) + ;; If we get 400 server disconnect, reconnect and + ;; retry; otherwise, assume the article has expired. + (setq result 'done)))) (and (eq result 'article) 'article))) ;; It was a pseudo. (t article))) @@ -4445,7 +5778,6 @@ 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)) @@ -4467,7 +5799,7 @@ If given a prefix, show the hidden text instead." (set-buffer gnus-summary-buffer) (gnus-summary-update-article do-update-line sparse-header) (gnus-summary-goto-subject do-update-line nil t) - (set-window-point (get-buffer-window (current-buffer) t) + (set-window-point (gnus-get-buffer-window (current-buffer) t) (point)) (set-buffer buf)))))) @@ -4489,35 +5821,86 @@ If given a prefix, show the hidden text instead." (defvar gnus-article-edit-done-function nil) (defvar gnus-article-edit-mode-map nil) +(defvar gnus-article-edit-mode nil) ;; Should we be using derived.el for this? (unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (make-sparse-keymap)) + (setq gnus-article-edit-mode-map (make-keymap)) (set-keymap-parent gnus-article-edit-mode-map text-mode-map) (gnus-define-keys gnus-article-edit-mode-map + "\C-c?" describe-mode "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit) + "\C-c\C-k" gnus-article-edit-exit + "\C-c\C-f\C-t" message-goto-to + "\C-c\C-f\C-o" message-goto-from + "\C-c\C-f\C-b" message-goto-bcc + ;;"\C-c\C-f\C-w" message-goto-fcc + "\C-c\C-f\C-c" message-goto-cc + "\C-c\C-f\C-s" message-goto-subject + "\C-c\C-f\C-r" message-goto-reply-to + "\C-c\C-f\C-n" message-goto-newsgroups + "\C-c\C-f\C-d" message-goto-distribution + "\C-c\C-f\C-f" message-goto-followup-to + "\C-c\C-f\C-m" message-goto-mail-followup-to + "\C-c\C-f\C-k" message-goto-keywords + "\C-c\C-f\C-u" message-goto-summary + "\C-c\C-f\C-i" message-insert-or-toggle-importance + "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to + "\C-c\C-b" message-goto-body + "\C-c\C-i" message-goto-signature + + "\C-c\C-t" message-insert-to + "\C-c\C-n" message-insert-newsgroups + "\C-c\C-o" message-sort-headers + "\C-c\C-e" message-elide-region + "\C-c\C-v" message-delete-not-region + "\C-c\C-z" message-kill-to-signature + "\M-\r" message-newline-and-reformat + "\C-c\C-a" mml-attach-file + "\C-a" message-beginning-of-line + "\t" message-tab + "\M-;" comment-region) (gnus-define-keys (gnus-article-edit-wash-map "\C-c\C-w" gnus-article-edit-mode-map) "f" gnus-article-edit-full-stops)) -(defun gnus-article-edit-mode () +(easy-menu-define + gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" + '("Field" + ["Fetch To" message-insert-to t] + ["Fetch Newsgroups" message-insert-newsgroups t] + "----" + ["To" message-goto-to t] + ["From" message-goto-from t] + ["Subject" message-goto-subject t] + ["Cc" message-goto-cc t] + ["Reply-To" message-goto-reply-to t] + ["Summary" message-goto-summary t] + ["Keywords" message-goto-keywords t] + ["Newsgroups" message-goto-newsgroups t] + ["Followup-To" message-goto-followup-to t] + ["Mail-Followup-To" message-goto-mail-followup-to t] + ["Distribution" message-goto-distribution t] + ["Body" message-goto-body t] + ["Signature" message-goto-signature t])) + +(define-derived-mode gnus-article-edit-mode text-mode "Article Edit" "Major mode for editing articles. This is an extended text-mode. \\{gnus-article-edit-mode-map}" - (interactive) - (setq major-mode 'gnus-article-edit-mode) - (setq mode-name "Article Edit") - (use-local-map gnus-article-edit-mode-map) (make-local-variable 'gnus-article-edit-done-function) (make-local-variable 'gnus-prev-winconf) + (set (make-local-variable 'font-lock-defaults) + '(message-font-lock-keywords t)) + (set (make-local-variable 'mail-header-separator) "") + (set (make-local-variable 'gnus-article-edit-mode) t) + (easy-menu-add message-mode-field-menu message-mode-map) (setq buffer-read-only nil) (buffer-enable-undo) - (widen) - (gnus-run-hooks 'text-mode-hook 'gnus-article-edit-mode-hook)) + (widen)) (defun gnus-article-edit (&optional force) "Edit the current article. @@ -4543,6 +5926,7 @@ groups." (set-buffer gnus-article-buffer) (gnus-article-edit-mode) (funcall start-func) + (set-buffer-modified-p nil) (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) @@ -4555,26 +5939,31 @@ groups." (interactive "P") (let ((func gnus-article-edit-done-function) (buf (current-buffer)) - (start (window-start))) + (start (window-start)) + (p (point)) + (winconf gnus-prev-winconf)) (remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) - (gnus-article-edit-exit) + (widen) ;; Widen it in case that users narrowed the buffer. + (funcall func arg) + (set-buffer buf) + ;; 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))) + ;; Flush original article as well. (save-excursion - (set-buffer buf) - (let ((buffer-read-only nil)) - (funcall func arg)) - ;; 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))) - ;; Flush original article as well. - (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)))) + (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))) + ;; We remove all text props from the article buffer. + (kill-all-local-variables) + (gnus-set-text-properties (point-min) (point-max) nil) + (gnus-article-mode) + (set-window-configuration winconf) (set-buffer buf) (set-window-start (get-buffer-window buf) start) (set-window-point (get-buffer-window buf) (point)))) @@ -4582,21 +5971,23 @@ groups." (defun gnus-article-edit-exit () "Exit the article editing without updating." (interactive) - ;; We remove all text props from the article buffer. - (let ((buf (buffer-substring-no-properties (point-min) (point-max))) - (curbuf (current-buffer)) - (p (point)) - (window-start (window-start))) - (erase-buffer) - (insert buf) - (let ((winconf gnus-prev-winconf)) - (gnus-article-mode) - (set-window-configuration winconf) - ;; Tippy-toe some to make sure that point remains where it was. - (save-current-buffer - (set-buffer curbuf) - (set-window-start (get-buffer-window (current-buffer)) window-start) - (goto-char p))))) + (when (or (not (buffer-modified-p)) + (yes-or-no-p "Article modified; kill anyway? ")) + (let ((curbuf (current-buffer)) + (p (point)) + (window-start (window-start))) + (erase-buffer) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (insert-buffer-substring gnus-original-article-buffer)) + (let ((winconf gnus-prev-winconf)) + (kill-all-local-variables) + (gnus-article-mode) + (set-window-configuration winconf) + ;; Tippy-toe some to make sure that point remains where it was. + (save-current-buffer + (set-buffer curbuf) + (set-window-start (get-buffer-window (current-buffer)) window-start) + (goto-char p)))))) (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." @@ -4643,10 +6034,13 @@ after replacing with the original article." nil t) (replace-match ""))) (apply ,gnus-article-edit-done-function args) - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (erase-buffer) - (insert-buffer gnus-article-buffer) + (insert + (prog1 + (buffer-substring-no-properties (point-min) (point-max)) + (set-buffer (get-buffer-create gnus-original-article-buffer)) + (erase-buffer))) (setq gnus-current-headers (gnus-article-make-full-mail-header)) + (set-buffer gnus-article-buffer) (gnus-article-prepare-display))) (substitute-key-definition 'gnus-article-edit-done 'gnus-article-mime-edit-done @@ -4655,19 +6049,23 @@ after replacing with the original article." 'gnus-article-mime-edit-exit gnus-article-edit-mode-map) (erase-buffer) - (insert-buffer gnus-original-article-buffer) - (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer))) - (fset 'mime-edit-decode-single-part-in-buffer - (lambda (&rest args) - (if (let ((content-type (car args))) - (and (eq 'message (mime-content-type-primary-type - content-type)) - (eq 'rfc822 (mime-content-type-subtype content-type)))) - (setcar (cdr args) 'not-decode-text)) - (apply ofn args))) - (unwind-protect - (mime-edit-again) - (fset 'mime-edit-decode-single-part-in-buffer ofn))) + (insert-buffer-substring gnus-original-article-buffer) + (unless (member (with-current-buffer gnus-summary-buffer + gnus-newsgroup-name) + '("nndraft:delayed" "nndraft:drafts")) + (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer))) + (fset 'mime-edit-decode-single-part-in-buffer + (lambda (&rest args) + (if (let ((content-type (car args))) + (and (eq 'message (mime-content-type-primary-type + content-type)) + (eq 'rfc822 (mime-content-type-subtype + content-type)))) + (setcar (cdr args) 'not-decode-text)) + (apply ofn args))) + (unwind-protect + (mime-edit-again) + (fset 'mime-edit-decode-single-part-in-buffer ofn)))) (when (featurep 'font-lock) (set (make-local-variable 'font-lock-defaults) '(message-font-lock-keywords t)) @@ -4684,7 +6082,8 @@ after replacing with the original article." (when (featurep 'font-lock) (setq font-lock-defaults nil) (font-lock-mode -1)) - (gnus-article-edit-done arg)) + (let ((inhibit-read-only t)) + (gnus-article-edit-done arg))) (defun gnus-article-mime-edit-exit () "Exit the article MIME editing without updating." @@ -4709,6 +6108,7 @@ after replacing with the original article." (set-buffer (get-buffer-create gnus-original-article-buffer)) (erase-buffer))) (setq gnus-current-headers (gnus-article-make-full-mail-header)) + (set-buffer gnus-article-buffer) (gnus-article-prepare-display) (set-window-configuration winconf)))) @@ -4720,32 +6120,472 @@ after replacing with the original article." ;;; Internal Variables: -(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\\)\\)" +(defcustom gnus-button-url-regexp + (if (string-match "[[:digit:]]" "1") ;; support POSIX? + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) +(defcustom gnus-button-valid-fqdn-regexp + message-valid-fqdn-regexp + "Regular expression that matches a valid FQDN." + :group 'gnus-article-buttons + :type 'regexp) + +(defcustom gnus-button-man-handler 'manual-entry + "Function to use for displaying man pages. +The function must take at least one argument with a string naming the +man page." + :type '(choice (function-item :tag "Man" manual-entry) + (function-item :tag "Woman" woman) + (function :tag "Other")) + :group 'gnus-article-buttons) + +(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/" + "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive. +If the default site is too slow, try to find a CTAN mirror, see +. See also +the variable `gnus-button-handle-ctan'." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type '(choice (const "http://www.tex.ac.uk/tex-archive/") + (const "http://tug.ctan.org/tex-archive/") + (const "http://www.dante.de/CTAN/") + (string :tag "Other"))) + +(defcustom gnus-button-ctan-handler 'browse-url + "Function to use for displaying CTAN links. +The function must take one argument, the string naming the URL." + :type '(choice (function-item :tag "Browse Url" browse-url) + (function :tag "Other")) + :group 'gnus-article-buttons) + +(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" + "Bogus strings removed from CTAN URLs." + :group 'gnus-article-buttons + :type '(choice (const "^/?tex-archive/\\|/") + (regexp :tag "Other"))) + +(defcustom gnus-button-ctan-directory-regexp + (concat + "\\("; Cannot use `\(?: ... \)' (compatibility with Emacs 20). + "biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|" + "indexing\\|info\\|language\\|macros\\|support\\|systems\\|" + "tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete" + "\\)") + "Regular expression for ctan directories. +It should match all directories in the top level of `gnus-ctan-url'." + :group 'gnus-article-buttons + :type 'regexp) + +(defcustom gnus-button-mid-or-mail-regexp + (concat "\\b\\(\")!;:,{}\n\t ]*@" + gnus-button-valid-fqdn-regexp + ">?\\)\\b") + "Regular expression that matches a message ID or a mail address." + :group 'gnus-article-buttons + :type 'regexp) + +(defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic + "What to do when the button on a string as \"foo123@bar.invalid\" is pushed. +Strings like this can be either a message ID or a mail address. If it is one +of the symbols `mid' or `mail', Gnus will always assume that the string is a +message ID or a mail address, respectively. If this variable is set to the +symbol `ask', always query the user what do do. If it is a function, this +function will be called with the string as it's only argument. The function +must return `mid', `mail', `invalid' or `ask'." + :group 'gnus-article-buttons + :type '(choice (function-item :tag "Heuristic function" + gnus-button-mid-or-mail-heuristic) + (const ask) + (const mid) + (const mail))) + +(defcustom gnus-button-mid-or-mail-heuristic-alist + '((-10.0 . ".+\\$.+@") + (-10.0 . "#") + (-10.0 . "\\*") + (-5.0 . "\\+[^+]*\\+.*@") ;; # two plus signs + (-5.0 . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i + (-5.0 . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i; + (-1.0 . "^[^a-z]+@") + ;; + (-5.0 . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@" + (-5.0 . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@" + (-3.0 . "[A-Z][A-Z][a-z][a-z].*@") + (-5.0 . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@") + ;; + (-2.0 . "^[0-9]") + (-1.0 . "^[0-9][0-9]") + ;; + ;; -3.0 /^[0-9][0-9a-fA-F]{2,2}/; + (-3.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") + ;; -5.0 /^[0-9][0-9a-fA-F]{3,3}/; + (-5.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") + ;; + (-3.0 . "[0-9][0-9][0-9][0-9][0-9][^0-9].*@") ;; "[0-9]{5,}.*\@" + (-3.0 . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][^0-9].*@") + ;; "[0-9]{8,}.*\@" + (-3.0 + . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@") + ;; "[0-9]{12,}.*\@" + ;; compensation for TDMA dated mail addresses: + (25.0 . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@") + ;; + (-20.0 . "\\.fsf@") ;; Gnus + (-20.0 . "^slrn") + (-20.0 . "^Pine") + (-20.0 . "_-_") ;; Subject change in thread + ;; + (-20.0 . "\\.ln@") ;; leafnode + (-30.0 . "@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de") + (-30.0 . "@4[Aa][Xx]\\.com") ;; Forte Agent + ;; + ;; (5.0 . "") ;; $local_part_len <= 7 + (10.0 . "^[^0-9]+@") + (3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@") + ;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part + (3.0 . "\@stud") + ;; + (2.0 . "[a-z][a-z][._-][A-Z][a-z].*@") + ;; + (0.5 . "^[A-Z][a-z]") + (0.5 . "^[A-Z][a-z][a-z]") + (1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3} + (2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4} + "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'. + +A negative RATE indicates a message IDs, whereas a positive indicates a mail +address. The REGEXP is processed with `case-fold-search' set to `nil'." + :group 'gnus-article-buttons + :type '(repeat (cons (number :tag "Rate") + (regexp :tag "Regexp")))) + +(defun gnus-button-mid-or-mail-heuristic (mid-or-mail) + "Guess whether MID-OR-MAIL is a message ID or a mail address. +Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail +address, `ask' if unsure and `invalid' if the string is invalid." + (let ((case-fold-search nil) + (list gnus-button-mid-or-mail-heuristic-alist) + (result 0) rate regexp lpartlen elem) + (setq lpartlen + (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) + (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen) + ;; Certain special cases... + (when (string-match + (concat + "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$" "\\|" + "^[0-9]+\.[0-9]+\@compuserve") + mid-or-mail) + (gnus-message 8 "`%s' is a known mail address.") + (setq result 'mail)) + (when (string-match "@.*@\\| " mid-or-mail) + (gnus-message 8 "`%s' is invalid.") + (setq result 'invalid)) + ;; Nothing more to do, if result is not a number here... + (when (numberp result) + (while list + (setq elem (car list) + rate (car elem) + regexp (cdr elem) + list (cdr list)) + (when (string-match regexp mid-or-mail) + (setq result (+ result rate)) + (gnus-message + 9 "`%s' matched `%s', rate `%s', result `%s'." + mid-or-mail regexp rate result))) + (when (<= lpartlen 7) + (setq result (+ result 5.0)) + (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'." + mid-or-mail result)) + (when (>= lpartlen 12) + (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail) + (cond + ((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail) + ;; Long local part should contain realname if e-mail address, + ;; too many digits: message-id. + ;; $score -= 5.0 + 0.1 * $local_part_len; + (setq rate (* -1.0 (+ 5.0 (* 0.1 lpartlen)))) + (setq result (+ result rate)) + (gnus-message + 9 "Many digits in `%s', rate `%s', result `%s'." + mid-or-mail rate result)) + ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@" + mid-or-mail) + ;; Too few vowels [^aeiouy]{4,}.*\@ + (setq result (+ result -5.0)) + (gnus-message + 9 "Few vowels in `%s', rate `%s', result `%s'." + mid-or-mail -5.0 result)) + (t + (setq result (+ result 5.0)) + (gnus-message + 9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result))))) + (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result) + (cond + ;; Maybe we should make this a customizable alist: (condition . 'result) + ((< result -10.0) 'mid) + ((> result 10.0) 'mail) + (t 'ask)))) + +(defun gnus-button-handle-mid-or-mail (mid-or-mail) + (let* ((pref gnus-button-prefer-mid-or-mail) guessed + (url-mid (concat "news" ":" mid-or-mail)) + (url-mailto (concat "mailto" ":" mid-or-mail))) + (gnus-message 9 "mid-or-mail=%s" mid-or-mail) + (when (fboundp pref) + (setq guessed + ;; get rid of surrounding angles... + (funcall pref + (gnus-replace-in-string mid-or-mail "^<\\|>$" ""))) + (if (or (eq 'mid guessed) (eq 'mail guessed)) + (setq pref guessed) + (setq pref 'ask))) + (if (eq pref 'ask) + (save-window-excursion + (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? ")) + (setq pref 'mail) + (setq pref 'mid)))) + (cond ((eq pref 'mid) + (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid) + (gnus-button-handle-news url-mid)) + ((eq pref 'mail) + (gnus-message 8 "calling `gnus-url-mailto' %s" url-mailto) + (gnus-url-mailto url-mailto)) + (t (gnus-message 3 "Invalid string."))))) + +(defun gnus-button-handle-custom (url) + "Follow a Custom URL." + (customize-apropos (gnus-url-unhex-string url))) + +(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|?\\)") + +;; FIXME: Maybe we should merge some of the functions that do quite similar +;; stuff? + +(defun gnus-button-handle-describe-function (url) + "Call `describe-function' when pushing the corresponding URL button." + (describe-function + (intern + (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + +(defun gnus-button-handle-describe-variable (url) + "Call `describe-variable' when pushing the corresponding URL button." + (describe-variable + (intern + (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + +(defun gnus-button-handle-symbol (url) +"Display help on variable or function. +Calls `describe-variable' or `describe-function'." + (let ((sym (intern url))) + (cond + ((fboundp sym) (describe-function sym)) + ((boundp sym) (describe-variable sym)) + (t (gnus-message 3 "`%s' is not a known function of variable." url))))) + +(defun gnus-button-handle-describe-key (url) + "Call `describe-key' when pushing the corresponding URL button." + (let* ((key-string + (gnus-replace-in-string url gnus-button-handle-describe-prefix "")) + (keys (ignore-errors (eval `(kbd ,key-string))))) + (if keys + (describe-key keys) + (gnus-message 3 "Invalid key sequence in button: %s" key-string)))) + +(defun gnus-button-handle-apropos (url) + "Call `apropos' when pushing the corresponding URL button." + (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-apropos-command (url) + "Call `apropos' when pushing the corresponding URL button." + (apropos-command + (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-apropos-variable (url) + "Call `apropos' when pushing the corresponding URL button." + (funcall + (if (fboundp 'apropos-variable) 'apropos-variable 'apropos) + (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-apropos-documentation (url) + "Call `apropos' when pushing the corresponding URL button." + (funcall + (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) + (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-library (url) + "Call `locate-library' when pushing the corresponding URL button." + (gnus-message 9 "url=`%s'" url) + (let* ((lib (locate-library url)) + (file (gnus-replace-in-string (or lib "") "\.elc" ".el"))) + (if (not lib) + (gnus-message 1 "Cannot locale library `%s'." url) + (find-file-read-only file)))) + +(defun gnus-button-handle-ctan (url) + "Call `browse-url' when pushing a CTAN URL button." + (funcall + gnus-button-ctan-handler + (concat + gnus-ctan-url + (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp "")))) + +(defcustom gnus-button-tex-level 5 + "*Integer that says how many TeX-related buttons Gnus will show. +The higher the number, the more buttons will appear and the more false +positives are possible. Note that you can set this variable local to +specifific groups. Setting it higher in TeX groups is probably a good idea. +See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on +how to set variables in specific groups." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type 'integer) + +(defcustom gnus-button-man-level 5 + "*Integer that says how many man-related buttons Gnus will show. +The higher the number, the more buttons will appear and the more false +positives are possible. Note that you can set this variable local to +specifific groups. Setting it higher in Unix groups is probably a good idea. +See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on +how to set variables in specific groups." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type 'integer) + +(defcustom gnus-button-emacs-level 5 + "*Integer that says how many emacs-related buttons Gnus will show. +The higher the number, the more buttons will appear and the more false +positives are possible. Note that you can set this variable local to +specifific groups. Setting it higher in Emacs or Gnus related groups is +probably a good idea. See Info node `(gnus)Group Parameters' and the variable +`gnus-parameters' on how to set variables in specific groups." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type 'integer) + +(defcustom gnus-button-message-level 5 + "*Integer that says how many buttons for news or mail messages will appear. +The higher the number, the more buttons will appear and the more false +positives are possible." + ;; mail addresses, MIDs, URLs for news, ... + :group 'gnus-article-buttons + :type 'integer) + +(defcustom gnus-button-browse-level 5 + "*Integer that says how many buttons for browsing will appear. +The higher the number, the more buttons will appear and the more false +positives are possible." + ;; stuff handled by `browse-url' or `gnus-button-embedded-url' + :group 'gnus-article-buttons + :type 'integer) + (defcustom gnus-button-alist - `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" - 0 t gnus-button-message-id 2) - ("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1) - ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" - 1 t - gnus-button-fetch-group 4) - ("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2) - ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 - t gnus-button-message-id 3) - ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) - ("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) + '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" + 0 (>= gnus-button-message-level 0) gnus-button-handle-news 3) + ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t + gnus-button-handle-news 2) + ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" + 1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5) + ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)" + 0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3) + ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" + 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) + ("\\( \n\t]+\\)>" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) + ("mailto:\\([-a-z.@_+0-9%=?]+\\)" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) + ("\\bmailto:\\([^ \n\t]+\\)" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) + ;; CTAN + ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\(" + gnus-button-ctan-directory-regexp + "[^][>)!;:,'\n\t ]+\\)") + 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1) + ((concat "\\btex-archive/\\(" + gnus-button-ctan-directory-regexp + "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)") + 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1) + ((concat + "\\b\\(" + gnus-button-ctan-directory-regexp + "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") + 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) + ;; This is info + ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) + ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0 + (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) + ("\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" + ;; Info links like `C-h i d m CC Mode RET' + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2) + ;; This is custom + ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" + 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) + ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 + (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1) + ;; Emacs help commands + ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ;; regexp doesn't match arguments containing ` '. + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1) + ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1) + ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1) + ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) + ;; The following entries may lead to many false positives so don't enable + ;; them by default (use a high button level): + ("/\\([a-z][-a-z0-9]+\\.el\\)\\>" + 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) + ("`\\([a-z][-a-z0-9]+\\.el\\)'" + 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) + ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'" + 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1) + ("`\\([a-z][a-z0-9]+-[a-z]+\\)'" + 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) + ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)" + 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1) + ("\\b\\(C-h\\|?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) + ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) + ("`\\(\\b\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" + ;; Unlike the other regexps we really have to require quoting + ;; here to determine where it ends. + 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) + ;; This is how URLs _should_ be embedded in text (RFC 1738)... + ("]*\\)>" + 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) ;; Raw URLs. - (,gnus-button-url-regexp 0 t browse-url 0)) + (gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) + ;; man pages + ("\\b\\([a-z][a-z]+\\)([1-9])\\W" + 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) + gnus-button-handle-man 1) + ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) + ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W" + 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) + gnus-button-handle-man 1) + ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), + ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) + ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W" + 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) + ;; MID or mail: To avoid too many false positives we don't try to catch + ;; all kind of allowed MIDs or mail addresses. Domain part must contain + ;; at least one dot. TLD must contain two or three chars or be a know TLD + ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist' + ;; so that non-ambiguous entries (see above) match first. + (gnus-button-mid-or-mail-regexp + 0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1)) "*Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where -REGEXP: is the string matching text around the button, +REGEXP: is the string (case insensitive) matching text around the button (can +also be lisp expression evaluating to a string), BUTTON: is the number of the regexp grouping actually matching the button, FORM: is a lisp expression which must eval to true for the button to be added, @@ -4755,7 +6595,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function." :group 'gnus-article-buttons - :type '(repeat (list regexp + :type '(repeat (list (choice regexp variable) (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -4764,16 +6604,22 @@ variable it the real callback function." (integer :tag "Regexp group"))))) (defcustom gnus-header-button-alist - `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" - 0 t gnus-button-message-id 0) - ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) + '(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>" + 0 (>= gnus-button-message-level 0) gnus-button-message-id 0) + ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" + 1 (>= gnus-button-message-level 0) gnus-button-reply 1) ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" - 0 t gnus-button-mailto 0) - ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0) - ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0) - ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0) - ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t - gnus-button-message-id 3)) + 0 (>= gnus-button-message-level 0) gnus-button-mailto 0) + ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^Subject:" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^[^:]+:" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) + ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" + 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) "*Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each @@ -4810,7 +6656,7 @@ call it with the value of the `gnus-data' text property." (interactive "e") (set-buffer (window-buffer (posn-window (event-start event)))) (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'gnus-data)) + (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) (goto-char pos) (when fun @@ -4821,8 +6667,8 @@ call it with the value of the `gnus-data' text property." If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." (interactive) - (let* ((data (get-text-property (point) 'gnus-data)) - (fun (get-text-property (point) 'gnus-callback))) + (let ((data (get-text-property (point) 'gnus-data)) + (fun (get-text-property (point) 'gnus-callback))) (when fun (funcall fun data)))) @@ -4982,7 +6828,7 @@ specified by `gnus-button-alist'." (article-goto-body) (setq beg (point)) (while (setq entry (pop alist)) - (setq regexp (car entry)) + (setq regexp (eval (car entry))) (goto-char beg) (while (re-search-forward regexp nil t) (let* ((start (and entry (match-beginning (nth 1 entry)))) @@ -5024,7 +6870,7 @@ specified by `gnus-button-alist'." (match-beginning 0)) (point-max))) (goto-char beg) - (while (re-search-forward (nth 1 entry) end t) + (while (re-search-forward (eval (nth 1 entry)) end t) ;; Each match within a header. (let* ((entry (cdr entry)) (start (match-beginning (nth 1 entry))) @@ -5071,14 +6917,19 @@ specified by `gnus-button-alist'." (limit (next-single-property-change end 'mime-view-entity nil (point-max)))) (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))) + (progn + (gnus-delete-wash-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end limit + (cons 'article-type (cons 'signature + gnus-hidden-properties)))) + (gnus-add-wash-type 'signature) (gnus-add-text-properties-when 'article-type nil end limit (cons 'article-type (cons 'signature - gnus-hidden-properties))))))) + gnus-hidden-properties))))) + (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. @@ -5086,7 +6937,7 @@ specified by `gnus-button-alist'." (entry nil)) (while alist (setq entry (pop alist)) - (if (looking-at (car entry)) + (if (looking-at (eval (car entry))) (setq alist nil) (setq entry nil))) entry)) @@ -5114,6 +6965,71 @@ specified by `gnus-button-alist'." (gnus-message 1 "You must define `%S' to use this button" (cons fun args))))))) +(defun gnus-parse-news-url (url) + (let (scheme server group message-id articles) + (with-temp-buffer + (insert url) + (goto-char (point-min)) + (when (looking-at "\\([A-Za-z]+\\):") + (setq scheme (match-string 1)) + (goto-char (match-end 0))) + (when (looking-at "//\\([^/]+\\)/") + (setq server (match-string 1)) + (goto-char (match-end 0))) + + (cond + ((looking-at "\\(.*@.*\\)") + (setq message-id (match-string 1))) + ((looking-at "\\([^/]+\\)/\\([-0-9]+\\)") + (setq group (match-string 1) + articles (split-string (match-string 2) "-"))) + ((looking-at "\\([^/]+\\)/?") + (setq group (match-string 1))) + (t + (error "Unknown news URL syntax")))) + (list scheme server group message-id articles))) + +(defun gnus-button-handle-news (url) + "Fetch a news URL." + (destructuring-bind (scheme server group message-id articles) + (gnus-parse-news-url url) + (cond + (message-id + (save-excursion + (set-buffer gnus-summary-buffer) + (if server + (let ((gnus-refer-article-method (list (list 'nntp server)))) + (gnus-summary-refer-article message-id)) + (gnus-summary-refer-article message-id)))) + (group + (gnus-button-fetch-group url))))) + +(defun gnus-button-handle-man (url) + "Fetch a man page." + (funcall gnus-button-man-handler url)) + +(defun gnus-button-handle-info-url (url) + "Fetch an info URL." + (cond + ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) + (gnus-info-find-node + (concat "(" (or (gnus-url-unhex-string (match-string 1 url)) + "Gnus") + ")" (gnus-url-unhex-string (match-string 2 url))))) + ((string-match "([^)\"]+)[^\"]+" url) + (setq url + (gnus-replace-in-string + (gnus-replace-in-string url "[\n\t ]+" " ") "\"" "")) + (gnus-info-find-node url)) + (t (error "Can't parse %s" url)))) + +(defun gnus-button-handle-info-keystrokes (url) + "Call `info' when pushing the corresponding URL button." + ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'. + (info) + (Info-directory) + (Info-menu url)) + (defun gnus-button-message-id (message-id) "Fetch MESSAGE-ID." (save-excursion @@ -5125,8 +7041,10 @@ specified by `gnus-button-alist'." (if (not (string-match "[:/]" address)) ;; This is just a simple group url. (gnus-group-read-ephemeral-group address gnus-select-method) - (if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$" - address)) + (if (not + (string-match + "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?" + address)) (error "Can't parse %s" address) (gnus-group-read-ephemeral-group (match-string 4 address) @@ -5134,179 +7052,137 @@ specified by `gnus-button-alist'." (nntp-address ,(match-string 1 address)) (nntp-port-number ,(if (match-end 3) (match-string 3 address) - "nntp"))))))) + "nntp"))) + nil nil nil + (and (match-end 6) (list (string-to-int (match-string 6 address)))))))) (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) (setq pairs (split-string query "&")) (while pairs (setq cur (car pairs) - pairs (cdr pairs)) + pairs (cdr pairs)) (if (not (string-match "=" cur)) - nil ; Grace - (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) - val (gnus-url-unhex-string (substring cur (match-end 0) nil))) - (if downcase - (setq key (downcase key))) - (setq cur (assoc key retval)) - (if cur - (setcdr cur (cons val (cdr cur))) - (setq retval (cons (list key val) retval))))) + nil ; Grace + (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) + val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) + (if downcase + (setq key (downcase key))) + (setq cur (assoc key retval)) + (if cur + (setcdr cur (cons val (cdr cur))) + (setq retval (cons (list key val) retval))))) retval)) -(defun gnus-url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun gnus-url-unhex-string (str &optional allow-newlines) - "Remove %XXX embedded spaces, etc in a url. -If optional second argument ALLOW-NEWLINES is non-nil, then allow the -decoding of carriage returns and line feeds in the string, which is normally -forbidden in URL encoding." - (setq str (or str "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "%[0-9a-f][0-9a-f]" str) - (let* ((start (match-beginning 0)) - (ch1 (gnus-url-unhex (elt str (+ start 1)))) - (code (+ (* 16 ch1) - (gnus-url-unhex (elt str (+ start 2)))))) - (setq tmp (concat - tmp (substring str 0 start) - (cond - (allow-newlines - (char-to-string code)) - ((or (= code ?\n) (= code ?\r)) - " ") - (t (char-to-string code)))) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - (defun gnus-url-mailto (url) ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) (let (to args subject func) (if (string-match (regexp-quote "?") url) - (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) - args (gnus-url-parse-query-string - (substring url (match-end 0) nil) t)) + (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) + args (gnus-url-parse-query-string + (substring url (match-end 0) nil) t)) (setq to (gnus-url-unhex-string url))) (setq args (cons (list "to" to) args) - subject (cdr-safe (assoc "subject" args))) - (gnus-setup-message 'reply - (message-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (mapconcat 'identity (cdar args) ", ")) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject))))) - -(defun gnus-button-mailto (address) - "Mail to ADDRESS." - (set-buffer (gnus-copy-article-buffer)) - (message-reply address)) - -(defalias 'gnus-button-reply 'message-reply) + subject (cdr-safe (assoc "subject" args))) + (gnus-msg-mail) + (while args + (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) + (if (fboundp func) + (funcall func) + (message-position-on-field (caar args))) + (insert (mapconcat 'identity (cdar args) ", ")) + (setq args (cdr args))) + (if subject + (message-goto-body) + (message-goto-subject)))) (defun gnus-button-embedded-url (address) "Activate ADDRESS with `browse-url'." (browse-url (gnus-strip-whitespace address))) -(eval-when-compile - ;; Silence the byte-compiler. - (autoload 'smiley-toggle-buffer "gnus-bitmap")) -(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. (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") -(defvar gnus-prev-page-map nil) -(unless gnus-prev-page-map - (setq gnus-prev-page-map (make-sparse-keymap)) - (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) - (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) +(defvar gnus-prev-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-prev-page) + (define-key map "\r" 'gnus-button-prev-page) + map)) + +(defun gnus-insert-prev-page-button () + (let ((b (point)) + (buffer-read-only nil) + (situation (get-text-property (point-min) 'mime-view-situation))) + (gnus-eval-format + gnus-prev-page-line-format nil + `(,@(gnus-local-map-property gnus-prev-page-map) + gnus-prev t + gnus-callback gnus-article-button-prev-page + article-type annotation + mime-view-situation ,situation)) + (widget-convert-button + 'link b (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point)) + :action 'gnus-button-prev-page + :button-keymap gnus-prev-page-map))) -(static-if (featurep 'xemacs) - (defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil)) - (gnus-eval-format - gnus-prev-page-line-format nil - `(gnus-prev t local-map ,gnus-prev-page-map - gnus-callback gnus-article-button-prev-page - article-type annotation)))) - (defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil) - (situation (get-text-property (point-min) 'mime-view-situation))) - (set-keymap-parent gnus-prev-page-map (current-local-map)) - (gnus-eval-format - gnus-prev-page-line-format nil - `(gnus-prev t local-map ,gnus-prev-page-map - gnus-callback gnus-article-button-prev-page - article-type annotation - mime-view-situation ,situation)))) - ) - -(defvar gnus-next-page-map nil) -(unless gnus-next-page-map - (setq gnus-next-page-map (make-sparse-keymap)) - (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) - (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) - -(defun gnus-button-next-page () +(defvar gnus-next-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-next-page) + (define-key map "\r" 'gnus-button-next-page) + map)) + +(defun gnus-button-next-page (&optional args more-args) "Go to the next page." (interactive) (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-next-page) (select-window win))) -(defun gnus-button-prev-page () +(defun gnus-button-prev-page (&optional args more-args) "Go to the prev page." (interactive) (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) (select-window win))) -(static-if (featurep 'xemacs) - (defun gnus-insert-next-page-button () - (let ((buffer-read-only nil)) - (gnus-eval-format gnus-next-page-line-format nil - `(gnus-next - t local-map ,gnus-next-page-map - gnus-callback gnus-article-button-next-page - article-type annotation)))) - (defun gnus-insert-next-page-button () - (let ((buffer-read-only nil) - (situation (get-text-property (point-min) 'mime-view-situation))) - (set-keymap-parent gnus-next-page-map (current-local-map)) - (gnus-eval-format gnus-next-page-line-format nil - `(gnus-next - t local-map ,gnus-next-page-map +(defun gnus-insert-next-page-button () + (let ((b (point)) + (buffer-read-only nil) + (situation (get-text-property (point-min) 'mime-view-situation))) + (gnus-eval-format gnus-next-page-line-format nil + `(,@(gnus-local-map-property gnus-next-page-map) + gnus-next t gnus-callback gnus-article-button-next-page article-type annotation - mime-view-situation ,situation)))) - ) + mime-view-situation ,situation)) + (widget-convert-button + 'link b (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point)) + :action 'gnus-button-next-page + :button-keymap gnus-next-page-map))) (defun gnus-article-button-next-page (arg) "Go to the next page." (interactive "P") (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-next-page) (select-window win))) @@ -5314,7 +7190,7 @@ forbidden in URL encoding." "Go to the prev page." (interactive "P") (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) (select-window win))) @@ -5324,11 +7200,11 @@ forbidden in URL encoding." 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 +\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups whose names match REGEXP. For example: -((\"chinese\" . gnus-decode-encoded-word-region-by-guess) +\((\"chinese\" . gnus-decode-encoded-word-region-by-guess) mail-decode-encoded-word-region (\"chinese\" . rfc1843-decode-region)) ") @@ -5348,7 +7224,7 @@ For example: (string-match (car x) gnus-newsgroup-name)) (nconc gnus-decode-header-methods-cache (list (cdr x)))))) - gnus-decode-header-methods)) + gnus-decode-header-methods)) (let ((xlist gnus-decode-header-methods-cache)) (pop xlist) (save-restriction @@ -5378,11 +7254,11 @@ For example: val elem buttonized) (gnus-run-hooks 'gnus-part-display-hook) (unless gnus-inhibit-treatment - (while (setq elem (pop alist)) + (dolist (elem alist) (setq val (save-excursion - (if (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-summary-buffer)) + (when (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-summary-buffer)) (symbol-value (car elem)))) (when (and (or (consp val) treated-type) @@ -5449,12 +7325,258 @@ 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 (member gnus-newsgroup-name '("nndraft:delayed" + "nndraft:drafts" + "nndraft:queue")) + (error "Can't encrypt the article in group %s" + gnus-newsgroup-name)) + (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-string) + (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))) + (unless (>= (string-to-number emacs-version) 21) + (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)) + point buffer-read-only) + (if region + (goto-char (car region))) + (save-restriction + (narrow-to-region (point) (point)) + (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)))) + (setq point (point)) + (gnus-mime-display-security handle) + (goto-char (point-max))) + (when region + (delete-region (point) (cdr region)) + (set-marker (car region) nil) + (set-marker (cdr region) nil)) + (goto-char point))) + +(defun gnus-mime-security-show-details (handle) + (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) + (if (not details) + (gnus-message 5 "No details.") + (if gnus-mime-security-show-details-inline + (let ((gnus-mime-security-button-pressed + (not (get-text-property (point) 'gnus-mime-details))) + (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) + (save-restriction + (narrow-to-region (point) (point)) + (gnus-insert-mime-security-button handle)) + (delete-region (point) + (or (text-property-not-all + (point) (point-max) + 'gnus-line-format + gnus-mime-security-button-line-format) + (point-max)))) + ;; Not inlined. + (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))))) + +(defun gnus-mime-security-press-button (handle) + (save-excursion + (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 + `(,@(gnus-local-map-property gnus-mime-security-button-map) + gnus-callback gnus-mime-security-press-button + gnus-line-format ,gnus-mime-security-button-line-format + gnus-mime-details ,gnus-mime-security-button-pressed + article-type annotation + gnus-data ,handle)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (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). + (when (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)) + (unless (gnus-unbuttonized-mime-type-p (car handle)) + (gnus-insert-mime-security-button handle)) + (gnus-mime-display-mixed (cdr handle)) + (unless (bolp) + (insert "\n")) + (unless (gnus-unbuttonized-mime-type-p (car handle)) + (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 ;;; (defun gnus-article-header-presentation-method (entity situation) (mime-insert-header entity) - ) + (article-decode-group-name)) (set-alist 'mime-header-presentation-method-alist 'gnus-original-article-mode diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index e661658..f3a43c9 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -1,5 +1,6 @@ ;;; gnus-async.el --- asynchronous support for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -35,12 +36,6 @@ "Support for asynchronous operations." :group 'gnus) -(defcustom gnus-asynchronous nil - "*If nil, inhibit all Gnus asynchronicity. -If non-nil, let the other asynch variables be heeded." - :group 'gnus-asynchronous - :type 'boolean) - (defcustom gnus-use-article-prefetch 30 "*If non-nil, prefetch articles in groups that allow this. If a number, prefetch only that many articles forward; @@ -50,6 +45,12 @@ if t, prefetch as many articles as possible." (const :tag "all" t) (integer :tag "some" 0))) +(defcustom gnus-asynchronous nil + "*If nil, inhibit all Gnus asynchronicity. +If non-nil, let the other asynch variables be heeded." + :group 'gnus-asynchronous + :type 'boolean) + (defcustom gnus-prefetched-article-deletion-strategy '(read exit) "List of symbols that say when to remove articles from the prefetch buffer. Possible values in this list are `read', which means that @@ -276,15 +277,16 @@ It should return non-nil if the article is to be prefetched." ;; needs to be done in nntp.el. (while (eq article gnus-async-current-prefetch-article) (incf tries) - (when (nntp-accept-process-output proc 1) + (when (nntp-accept-process-output proc) (setq tries 0)) - (when (and (not nntp-have-messaged) (eq 3 tries)) + (when (and (not nntp-have-messaged) + (= tries 3)) (gnus-message 5 "Waiting for async article...") (setq nntp-have-messaged t))) (quit ;; if the user interrupted on a slow/hung connection, ;; do something friendly. - (when (< 3 tries) + (when (> tries 3) (setq gnus-async-current-prefetch-article nil)) (signal 'quit nil))) (when nntp-have-messaged diff --git a/lisp/gnus-audio.el b/lisp/gnus-audio.el index ac959e7..62a6b86 100644 --- a/lisp/gnus-audio.el +++ b/lisp/gnus-audio.el @@ -1,5 +1,5 @@ ;;; gnus-audio.el --- Sound effects for Gnus -;; Copyright (C) 1996, 2000 Free Software Foundation +;; Copyright (C) 1996, 2000, 2003 Free Software Foundation ;; Author: Steven L. Baur ;; Keywords: news, mail, multimedia @@ -30,8 +30,11 @@ (require 'nnheader) +(require 'path-util) + (defgroup gnus-audio nil "Playing sound in Gnus." + :version "21.1" :group 'gnus-visual :group 'multimedia) @@ -46,15 +49,15 @@ :type '(choice directory (const nil)) :group 'gnus-audio) -(defcustom gnus-audio-au-player "/usr/bin/showaudio" +(defcustom gnus-audio-au-player (exec-installed-p "play") "Executable program for playing sun AU format sound files." :group 'gnus-audio - :type 'string) + :type '(choice file (const nil))) -(defcustom gnus-audio-wav-player "/usr/local/bin/play" +(defcustom gnus-audio-wav-player (exec-installed-p "play") "Executable program for playing WAV files." :group 'gnus-audio - :type 'string) + :type '(choice file (const nil))) ;;; The following isn't implemented yet. Wait for Millennium Gnus. ;;(defvar gnus-audio-effects-enabled t @@ -92,18 +95,18 @@ ;;;###autoload (defun gnus-audio-play (file) "Play a sound FILE through the speaker." - (interactive) + (interactive "fSound file name: ") (let ((sound-file (if (file-exists-p file) file (expand-file-name file gnus-audio-directory)))) (when (file-exists-p 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)))) + (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)) diff --git a/lisp/gnus-bbdb.el b/lisp/gnus-bbdb.el index dd14068..35dd546 100644 --- a/lisp/gnus-bbdb.el +++ b/lisp/gnus-bbdb.el @@ -46,38 +46,59 @@ ,field-body ,field-name)) ,field-body)) +(defvar gnus-bbdb/extract-message-sender-function + 'gnus-bbdb/extract-message-sender) + +(defun gnus-bbdb/extract-message-sender () + (let ((from (mime-entity-fetch-field gnus-current-headers "from")) + to) + (when from + (setq from (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body from 'From))) + (if (and (car (cdr from)) + (string-match (bbdb-user-mail-names) (car (cdr from))) + ;; if logged-in user sent this, use recipients. + (setq to (mime-entity-fetch-field gnus-current-headers "to"))) + (gnus-bbdb/extract-address-components + (gnus-bbdb/decode-field-body to 'To)) + from)))) + ;;;###autoload (defun gnus-bbdb/update-record (&optional offer-to-create) - "returns the record corresponding to the current GNUS message, creating + "Return the record corresponding to the current GNUS message, creating or modifying it as necessary. A record will be created if bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and the user confirms the creation." (if bbdb-use-pop-up (gnus-bbdb/pop-up-bbdb-buffer offer-to-create) - (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 - (save-excursion - (bbdb-annotate-message-sender from t - (or (bbdb-invoke-hook-for-value - bbdb/news-auto-create-p) - offer-to-create) - offer-to-create)))))) + (let ((message-key + (intern (mail-header-id gnus-current-headers))) + record sender) + (or (and (setq record (bbdb-message-cache-lookup message-key)) + (if (listp record) + (nth 1 record) + record)) + (when (setq sender + (funcall gnus-bbdb/extract-message-sender-function)) + (save-excursion + (setq record (bbdb-annotate-message-sender + sender t + (or (bbdb-invoke-hook-for-value + bbdb/news-auto-create-p) + offer-to-create) + offer-to-create))) + (when record + ;; XXX: BBDB 2.3x not only redefines + ;; `bbdb-encache-message' as a macro but also the inherent + ;; semantics of message caching functions is changed, so + ;; the following calls are much the same here. + (if (functionp 'bbdb-encache-message) + (car (bbdb-encache-message message-key (list record))) + (bbdb-encache-message message-key record)))))))) ;;;###autoload (defun gnus-bbdb/annotate-sender (string &optional replace) - "Add a line to the end of the Notes field of the BBDB record + "Add a line to the end of the Notes field of the BBDB record corresponding to the sender of this message. If REPLACE is non-nil, replace the existing notes entry (if any)." (interactive (list (if bbdb-readonly-p @@ -103,7 +124,7 @@ This buffer will be in bbdb-mode, with associated keybindings." (let ((record (gnus-bbdb/update-record t))) (if record (bbdb-display-records (list record)) - (error "unperson")))) + (error "unperson")))) (defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create) @@ -114,7 +135,12 @@ displaying the record corresponding to the sender of the current message." (record (let (bbdb-use-pop-up) (gnus-bbdb/update-record offer-to-create))) - (bbdb-elided-display (bbdb-pop-up-elided-display))) + (bbdb-display-layout + (cond ((boundp 'bbdb-pop-up-display-layout) + (symbol-value 'bbdb-pop-up-display-layout)) + ((boundp 'bbdb-pop-up-elided-display) + (symbol-value 'bbdb-pop-up-elided-display)))) + (bbdb-elided-display bbdb-display-layout)) (save-current-buffer ;; display the bbdb buffer iff there is a record for this article. (cond @@ -191,10 +217,10 @@ BBDB-FIELD values is returned. Otherwise, GROUP is returned." (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)))))))) + (insert (regexp-quote (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)) @@ -212,7 +238,7 @@ BBDB-FIELD values is returned. Otherwise, GROUP is returned." (throw 'done (when rest (cons '& rest)))) (t (while records - (when (or (null bbdb-field) + (when (or (null bbdb-field) (and (setq prop (bbdb-record-getprop (car records) bbdb-field)) (string-match regexp prop))) @@ -335,8 +361,9 @@ strings. In the future this should change." (error nil)))) (name (car data)) (net (car (cdr data))) - (record (and data - (bbdb-search-simple name + (record (and data + (bbdb-search-simple + name (if (and net bbdb-canonicalize-net-hook) (bbdb-canonicalize-address net) net)))) @@ -346,7 +373,7 @@ strings. In the future this should change." ;; bogon! (setq record nil)) - (setq name + (setq name (or (and gnus-bbdb/summary-prefer-bbdb-data (or (and gnus-bbdb/summary-prefer-real-names (and record (bbdb-record-name record))) @@ -357,22 +384,22 @@ strings. In the future this should change." net) name)) net from "**UNKNOWN**")) - ;; GNUS can't cope with extra square-brackets appearing in the summary. - (if (and name (string-match "[][]" name)) - (progn (setq name (copy-sequence name)) - (while (string-match "[][]" name) - (aset name (match-beginning 0) ? )))) - (setq string (format "%s%3d:%s" - (if (and record gnus-bbdb/summary-mark-known-posters) - (or (bbdb-record-getprop - record bbdb-message-marker-field) - "*") - " ") - lines (or name from)) - L (length string)) - (cond ((> L length) (substring string 0 length)) - ((< L length) (concat string (make-string (- length L) ? ))) - (t string)))) + ;; GNUS can't cope with extra square-brackets appearing in the summary. + (if (and name (string-match "[][]" name)) + (progn (setq name (copy-sequence name)) + (while (string-match "[][]" name) + (aset name (match-beginning 0) ? )))) + (setq string (format "%s%3d:%s" + (if (and record gnus-bbdb/summary-mark-known-posters) + (or (bbdb-record-getprop + record bbdb-message-marker-field) + "*") + " ") + lines (or name from)) + L (length string)) + (cond ((> L length) (substring string 0 length)) + ((< L length) (concat string (make-string (- length L) ? ))) + (t string)))) (defun gnus-bbdb/summary-get-author (header) "Given a Gnus message header, returns the appropriate piece of @@ -392,15 +419,16 @@ This function is meant to be used with the user function defined in (error nil)))) (name (car data)) (net (car (cdr data))) - (record (and data - (bbdb-search-simple name + (record (and data + (bbdb-search-simple + name (if (and net bbdb-canonicalize-net-hook) (bbdb-canonicalize-address net) net))))) (if (and record name (member (downcase name) (bbdb-record-net record))) ;; bogon! (setq record nil)) - (setq name + (setq name (or (and gnus-bbdb/summary-prefer-bbdb-data (or (and gnus-bbdb/summary-prefer-real-names (and record (bbdb-record-name record))) @@ -486,12 +514,12 @@ field. This allows the BBDB to serve as a supplemental global score file, with the advantage that it can keep up with multiple and changing addresses better than the traditionally static global scorefile." (list (list - (condition-case nil - (read (gnus-bbdb/score-as-text group)) - (error (setq gnus-bbdb/score-rebuild-alist t) - (message "Problem building BBDB score table.") - (ding) (sit-for 2) - nil))))) + (condition-case nil + (read (gnus-bbdb/score-as-text group)) + (error (setq gnus-bbdb/score-rebuild-alist t) + (message "Problem building BBDB score table.") + (ding) (sit-for 2) + nil))))) (defun gnus-bbdb/score-as-text (group) "Returns a SCORE file format string built from the BBDB." @@ -500,24 +528,25 @@ addresses better than the traditionally static global scorefile." (setq gnus-bbdb/score-default-internal gnus-bbdb/score-default) t)) - (not gnus-bbdb/score-alist) - gnus-bbdb/score-rebuild-alist) - (setq gnus-bbdb/score-rebuild-alist nil) - (setq gnus-bbdb/score-alist - (concat "((touched nil) (\"from\"\n" - (mapconcat - (lambda (rec) - (let ((score (or (bbdb-record-getprop rec - gnus-bbdb/score-field) - gnus-bbdb/score-default)) - (net (bbdb-record-net rec))) - (if (not (and score net)) nil - (mapconcat - (lambda (addr) - (concat "(\"" addr "\" " score ")\n")) - net "")))) - (bbdb-records) "") - "))")))) + (not gnus-bbdb/score-alist) + gnus-bbdb/score-rebuild-alist) + (setq gnus-bbdb/score-rebuild-alist nil) + (setq gnus-bbdb/score-alist + (concat "((touched nil) (\"from\"\n" + (mapconcat + (lambda (rec) + (let ((score (or (bbdb-record-getprop + rec + gnus-bbdb/score-field) + gnus-bbdb/score-default)) + (net (bbdb-record-net rec))) + (if (not (and score net)) nil + (mapconcat + (lambda (addr) + (concat "(\"" addr "\" " score ")\n")) + net "")))) + (bbdb-records) "") + "))")))) gnus-bbdb/score-alist) (defun gnus-bbdb/extract-field-value-init () @@ -547,12 +576,12 @@ beginning of the message headers." (defun gnus-bbdb/extract-address-components (str) (let* ((ret (std11-extract-address-components str)) - (phrase (car ret)) - (address (car (cdr ret))) - (methods gnus-bbdb/canonicalize-full-name-methods)) + (phrase (car ret)) + (address (car (cdr ret))) + (methods gnus-bbdb/canonicalize-full-name-methods)) (while (and phrase methods) (setq phrase (funcall (car methods) phrase) - methods (cdr methods))) + methods (cdr methods))) (if (string= address "") (setq address nil)) (if (string= phrase "") (setq phrase nil)) (when (or phrase address) @@ -567,7 +596,7 @@ beginning of the message headers." (setq dest (cons (substring str 0 (match-beginning 0)) dest)) (setq str (substring str (match-end 0)))) (or (string= str "") - (setq dest (cons str dest))) + (setq dest (cons str dest))) (setq dest (nreverse dest)) (mapconcat 'identity dest " "))) @@ -577,7 +606,7 @@ beginning of the message headers." (setq dest (cons (substring str 0 (match-end 0)) dest)) (setq str (substring str (match-end 0)))) (or (string= str "") - (setq dest (cons str dest))) + (setq dest (cons str dest))) (setq dest (nreverse dest)) (mapconcat 'identity dest " "))) @@ -593,6 +622,7 @@ beginning of the message headers." (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-summary-exit-hook 'bbdb-flush-all-caches) (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) @@ -614,7 +644,7 @@ beginning of the message headers." Please redefine `gnus-bbdb/summary-user-format-letter' to a different letter." gnus-bbdb/summary-user-format-letter)) (fset get-author-user-fun 'gnus-bbdb/summary-get-author)))) - + ; One tick. One tick only, please (cond (gnus-bbdb/summary-in-bbdb-format-letter (if (and (fboundp in-bbdb-user-fun) @@ -625,7 +655,7 @@ Please redefine `gnus-bbdb/summary-user-format-letter' to a different letter." Redefine `gnus-bbdb/summary-in-bbdb-format-letter' to a different letter." gnus-bbdb/summary-in-bbdb-format-letter)) (fset in-bbdb-user-fun 'gnus-bbdb/summary-author-in-bbdb))))) - + ;; Scoring (add-hook 'bbdb-after-change-hook 'gnus-bbdb/score-invalidate-alist) ; (setq gnus-score-find-score-files-function diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index 3fca805..c2b0cc3 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -1,5 +1,6 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -55,8 +56,9 @@ (defun gnus-backlog-shutdown () "Clear all backlog variables and buffers." + (interactive) (when (get-buffer gnus-backlog-buffer) - (kill-buffer gnus-backlog-buffer)) + (gnus-kill-buffer gnus-backlog-buffer)) (setq gnus-backlog-hashtb nil gnus-backlog-articles nil)) @@ -69,10 +71,10 @@ b) (if (memq ident gnus-backlog-articles) () ; It's already kept. - ;; Remove the oldest article, if necessary. + ;; Remove the oldest article, if necessary. (and (numberp gnus-keep-backlog) (>= (length gnus-backlog-articles) gnus-keep-backlog) - (gnus-backlog-remove-oldest-article)) + (gnus-backlog-remove-oldest-article)) (push ident gnus-backlog-articles) ;; Insert the new article. (save-excursion @@ -85,7 +87,7 @@ (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-put-text-property b (1+ b) 'gnus-backlog ident) (gnus-error 3 "Article %d is blank" number)))))))) (defun gnus-backlog-remove-oldest-article () diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 734e8eb..8fc0e93 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,5 +1,5 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,10 +36,12 @@ (require 'gnus-range) (require 'gnus-start) (eval-when-compile + (if (not (fboundp 'gnus-agent-load-alist)) + (defun gnus-agent-load-alist (group))) (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) @@ -152,8 +154,8 @@ it's not cached." (group article headers ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) (numberp article) - (> article 0) - (vectorp headers)) ; This might be a dummy article. + (> article 0) ; This might be a dummy article. + (vectorp headers)) (let ((number article) file) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) @@ -164,11 +166,7 @@ it's not cached." (when (and number (> number 0) ; Reffed article. (or force - (and (or (not gnus-cacheable-groups) - (string-match gnus-cacheable-groups group)) - (or (not gnus-uncacheable-groups) - (not (string-match - gnus-uncacheable-groups group))) + (and (gnus-cache-fully-p group) (gnus-cache-member-of-class gnus-cache-enter-articles ticked dormant unread))) (not (file-exists-p (setq file (gnus-cache-file-name @@ -187,7 +185,8 @@ it's not cached." (when (> (buffer-size) 0) (gnus-write-buffer-as-coding-system gnus-cache-write-file-coding-system file) - (setq headers (nnheader-parse-head t)) + (nnheader-remove-body) + (setq headers (nnheader-parse-naked-head)) (mail-header-set-number headers number) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) @@ -213,8 +212,9 @@ it's not cached." (nnheader-insert-nov headers) ;; Update the active info. (set-buffer gnus-summary-buffer) - (gnus-cache-update-active group number) - (push article gnus-newsgroup-cached) + (gnus-cache-possibly-update-active group (cons number number)) + (setq gnus-newsgroup-cached + (gnus-add-to-sorted-list gnus-newsgroup-cached article)) (gnus-summary-update-secondary-mark article)) t)))))) @@ -239,7 +239,7 @@ it's not cached." (defun gnus-cache-possibly-remove-articles-1 () "Possibly remove some of the removable articles." - (unless (eq gnus-use-cache 'passive) + (when (gnus-cache-fully-p gnus-newsgroup-name) (let ((articles gnus-cache-removable-articles) (cache-articles gnus-newsgroup-cached) article) @@ -287,9 +287,7 @@ it's not cached." ;; the normal way. (let ((gnus-use-cache nil)) (gnus-retrieve-headers articles group fetch-old)) - (let ((uncached-articles (gnus-sorted-intersection - (gnus-sorted-complement articles cached) - articles)) + (let ((uncached-articles (gnus-sorted-difference articles cached)) (cache-file (gnus-cache-file-name group ".overview")) type) ;; We first retrieve all the headers that we don't have in @@ -326,65 +324,6 @@ it's not cached." cached articles)) type))))))) -(defun gnus-cache-retrieve-parsed-headers (articles group &optional fetch-old - dependencies force-new) - "Retrieve the parsed-headers for ARTICLES in GROUP." - (let ((cached - (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) - (if (not cached) - ;; No cached articles here, so we just retrieve them - ;; the normal way. - (let ((gnus-use-cache nil)) - (gnus-retrieve-parsed-headers articles group fetch-old - dependencies force-new)) - (let ((uncached-articles (gnus-sorted-intersection - (gnus-sorted-complement articles cached) - articles)) - (cache-file (gnus-cache-file-name group ".overview"))) - (gnus-cache-braid-headers - ;; We first retrieve all the headers that we don't have in - ;; the cache. - (prog1 - (let ((gnus-use-cache nil)) - (when uncached-articles - (and articles - (gnus-retrieve-parsed-headers - uncached-articles group fetch-old - dependencies)) - )) - (gnus-cache-save-buffers)) - ;; Then we insert the cached headers. - (cond ((not (file-exists-p cache-file)) - ;; There are no cached headers. - ) - ((eq gnus-headers-retrieved-by 'nov) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (nnheader-insert-file-contents cache-file) - (nnheader-get-newsgroup-headers-xover* - articles nil dependencies group) - )) - (t - ;; We braid HEADs. - (nnheader-retrieve-headers-from-directory* - cached - (expand-file-name - (file-name-as-directory - (nnheader-translate-file-chars - (if (gnus-use-long-file-name 'not-cache) - group - (let ((group - (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) - dependencies) - ))) - )))) - (defun gnus-cache-enter-article (&optional n) "Enter the next N articles into the cache. If not given a prefix, use the process marked articles instead. @@ -399,14 +338,16 @@ Returns the list of articles entered." gnus-newsgroup-name article (gnus-summary-article-header article) nil nil nil t) + (setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded)) (push article out)) (gnus-message 2 "Can't cache article %d" article)) + (gnus-summary-update-download-mark article) (gnus-summary-update-secondary-mark article)) (gnus-summary-next-subject 1) (gnus-summary-position-point) (nreverse out))) -(defun gnus-cache-remove-article (n) +(defun gnus-cache-remove-article (&optional n) "Remove the next N articles from the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles removed." @@ -418,7 +359,14 @@ Returns the list of articles removed." (setq article (pop articles)) (gnus-summary-remove-process-mark article) (when (gnus-cache-possibly-remove-article article nil nil nil t) + (when gnus-newsgroup-agentized + (let ((alist (gnus-agent-load-alist gnus-newsgroup-name))) + (unless (cdr (assoc article alist)) + (setq gnus-newsgroup-undownloaded + (gnus-add-to-sorted-list + gnus-newsgroup-undownloaded article))))) (push article out)) + (gnus-summary-update-download-mark article) (gnus-summary-update-secondary-mark article)) (gnus-summary-next-subject 1) (gnus-summary-position-point) @@ -431,15 +379,20 @@ 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) '>)) - (gnus-verbose (max 6 gnus-verbose))) - (unless cached - (gnus-message 3 "No cached articles for this group")) - (while cached - (gnus-summary-goto-subject (pop cached) t)))) + (let ((gnus-verbose (max 6 gnus-verbose))) + (if (not gnus-newsgroup-cached) + (gnus-message 3 "No cached articles for this group") + (gnus-summary-goto-subjects gnus-newsgroup-cached)))) -(defalias 'gnus-summary-limit-include-cached - 'gnus-summary-insert-cached-articles) +(defun gnus-summary-limit-include-cached () + "Limit the summary buffer to articles that are cached." + (interactive) + (let ((gnus-verbose (max 6 gnus-verbose))) + (if gnus-newsgroup-cached + (progn + (gnus-summary-limit gnus-newsgroup-cached) + (gnus-summary-position-point)) + (gnus-message 3 "No cached articles for this group")))) ;;; Internal functions. @@ -474,20 +427,23 @@ 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) + (setq group (concat (substring group 0 (match-beginning 0)) + "/" (substring group (match-end 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." @@ -522,10 +478,11 @@ Returns the list of articles removed." (when (or (looking-at (concat (int-to-string number) "\t")) (search-forward (concat "\n" (int-to-string number) "\t") (point-max) t)) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) - (setq gnus-newsgroup-cached - (delq article gnus-newsgroup-cached)) + (gnus-delete-line))) + (unless (setq gnus-newsgroup-cached + (delq article gnus-newsgroup-cached)) + (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) + (setq gnus-cache-active-altered t)) (gnus-summary-update-secondary-mark article) t))) @@ -539,9 +496,13 @@ Returns the list of articles removed." (directory-files dir nil "^[0-9]+$" t)) '<)) ;; Update the cache active file, just to synch more. - (when articles - (gnus-cache-update-active group (car articles) t) - (gnus-cache-update-active group (car (last articles)))) + (if articles + (progn + (gnus-cache-update-active group (car articles) t) + (gnus-cache-update-active group (car (last articles)))) + (when (gnus-gethash group gnus-cache-active-hashtb) + (gnus-sethash group nil gnus-cache-active-hashtb) + (setq gnus-cache-active-altered t))) articles))) (defun gnus-cache-braid-nov (group cached &optional file) @@ -564,13 +525,13 @@ Returns the list of articles removed." (< (read (current-buffer)) (car cached))) (forward-line 1)) (beginning-of-line) - (save-excursion - (set-buffer cache-buf) - (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") - nil t) - (setq beg (progn (beginning-of-line) (point)) - end (progn (end-of-line) (point))) - (setq beg nil))) + (set-buffer cache-buf) + (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") + nil t) + (setq beg (gnus-point-at-bol) + end (progn (end-of-line) (point))) + (setq beg nil)) + (set-buffer nntp-server-buffer) (when beg (insert-buffer-substring cache-buf beg end) (insert "\n")) @@ -610,36 +571,6 @@ Returns the list of articles removed." (setq cached (cdr cached))) (kill-buffer cache-buf))) -(defun gnus-cache-braid-headers (headers cached-headers) - (if cached-headers - (if headers - (let (cached-header hrest nhrest) - (nconc (catch 'tag - (while cached-headers - (setq cached-header (car cached-headers)) - (if (< (mail-header-number cached-header) - (mail-header-number (car headers))) - (throw 'tag (nreverse cached-headers)) - (setq hrest headers - nhrest (cdr hrest)) - (while (and nhrest - (> (mail-header-number cached-header) - (mail-header-number (car nhrest)))) - (setq hrest nhrest - nhrest (cdr nhrest)) - ) - ;;(if nhrest - (setcdr hrest (cons cached-header nhrest)) - ;; (setq headers - ;; (nconc headers (list cached-header))) - ;; (throw 'tag nil) - ;;) - ) - (setq cached-headers (cdr cached-headers)))) - headers)) - (nreverse cached-headers)) - headers)) - ;;;###autoload (defun gnus-jog-cache () "Go through all groups and put the articles into the cache. @@ -695,6 +626,24 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" ;; Mark the active hashtb as unaltered. (setq gnus-cache-active-altered nil))) +(defun gnus-cache-possibly-update-active (group active) + "Update active info bounds of GROUP with ACTIVE if necessary. +The update is performed if ACTIVE contains a higher or lower bound +than the current." + (let ((lower t) (higher t)) + (if gnus-cache-active-hashtb + (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) + (when cache-active + (unless (< (car active) (car cache-active)) + (setq lower nil)) + (unless (> (cdr active) (cdr cache-active)) + (setq higher nil)))) + (gnus-cache-read-active)) + (when lower + (gnus-cache-update-active group (car active) t)) + (when higher + (gnus-cache-update-active group (cdr active))))) + (defun gnus-cache-update-active (group number &optional low) "Update the upper bound of the active info of GROUP to NUMBER. If LOW, update the lower bound instead." @@ -769,6 +718,19 @@ If LOW, update the lower bound instead." (interactive "FMove the cache tree to: ") (rename-file gnus-cache-directory dir)) +(defun gnus-cache-fully-p (&optional group) + "Returns non-nil if the cache should be fully used. +If GROUP is non-nil, also cater to `gnus-cacheable-groups' and +`gnus-uncacheable-groups'." + (and gnus-use-cache + (not (eq gnus-use-cache 'passive)) + (if (null group) + t + (and (or (not gnus-cacheable-groups) + (string-match gnus-cacheable-groups group)) + (or (not gnus-uncacheable-groups) + (not (string-match gnus-uncacheable-groups group))))))) + (provide 'gnus-cache) ;;; gnus-cache.el ends here diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index a92f635..31ee34a 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,6 +1,6 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus -*- coding: iso-latin-1 -*- +;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Per Abhiddenware @@ -30,8 +30,8 @@ (eval-when-compile (require 'static)) (require 'gnus) -(require 'gnus-art) (require 'gnus-range) +(require 'message) ; for message-cite-prefix-regexp ;;; Customization: @@ -41,19 +41,6 @@ :link '(custom-manual "(gnus)Article Highlighting") :group 'gnus-article) -(defcustom gnus-cite-reply-regexp - "^\\(Subject: Re\\|In-Reply-To\\|References\\):" - "*If headers match this regexp it is reasonable to believe that -article has citations." - :group 'gnus-cite - :type 'string) - -(defcustom gnus-cite-always-check nil - "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))) - (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" "Format of opened cited text buttons." :group 'gnus-cite @@ -80,19 +67,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." @@ -110,19 +91,42 @@ The first regexp group should match the Supercite attribution." :group 'gnus-cite :type 'integer) +;; Some Microsoft products put in a citation that extends to the +;; remainder of the message: +;; +;; -----Original Message----- +;; From: ... +;; To: ... +;; Sent: ... [date, in non-RFC-2822 format] +;; Subject: ... +;; +;; Cited message, with no prefixes +;; +;; The four headers are always the same. But note they are prone to +;; folding without additional indentation. +;; +;; Others use "----- Original Message -----" instead, and properly quote +;; the body using "> ". This style is handled without special cases. + (defcustom gnus-cite-attribution-prefix - "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----" + "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----" "*Regexp matching the beginning of an attribution line." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-attribution-suffix - "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$" + "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$" "*Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite :type 'regexp) +(defcustom gnus-cite-unsightly-citation-regexp + "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" + "Regexp matching Microsoft-type rest-of-message citations." + :group 'gnus-cite + :type 'regexp) + (defface gnus-cite-attribution-face '((t (:italic t))) "Face used for attribution lines.") @@ -265,6 +269,22 @@ This should make it easier to see who wrote what." :group 'gnus-cite :type 'integer) +(defcustom gnus-cite-blank-line-after-header t + "If non-nil, put a blank line between the citation header and the button." + :group 'gnus-cite + :type 'boolean) + +;; This has to go here because its default value depends on +;; gnus-cite-face-list. +(defcustom gnus-article-boring-faces (cons 'gnus-signature-face + gnus-cite-face-list) + "List of faces that are not worth reading. +If an article has more pages below the one you are looking at, but +nothing on those pages is a word of at least three letters that is not +in a boring face, then the pages will be skipped." + :type '(repeat face) + :group 'gnus-article-hiding) + ;;; Internal Variables: (defvar gnus-cite-article nil) @@ -312,7 +332,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." @@ -353,7 +373,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (goto-char (point-min)) (forward-line (1- number)) (when (re-search-forward gnus-cite-attribution-suffix - (save-excursion (end-of-line 1) (point)) + (gnus-point-at-eol) t) (gnus-article-add-button (match-beginning 1) (match-end 1) 'gnus-cite-toggle prefix)) @@ -445,7 +465,10 @@ If WIDTH (the numerical prefix), use that text width when filling." (narrow-to-region (caar marks) (caadr marks)) (let ((adaptive-fill-regexp (concat "^" (regexp-quote (cdar marks)) " *")) - (fill-prefix (cdar marks))) + (fill-prefix + (if (string= (cdar marks) "") "" + (concat (cdar marks) " "))) + use-hard-newlines) (fill-region (point-min) (point-max))) (set-marker (caar marks) nil) (setq marks (cdr marks))) @@ -468,63 +491,65 @@ always hide." (gnus-set-format 'cited-closed-text-button t) (save-excursion (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - marks - (inhibit-point-motion-hooks t) - (props (nconc (list 'article-type 'cite) - gnus-hidden-properties)) - (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 + (let ((buffer-read-only nil) + marks + (inhibit-point-motion-hooks t) + (props (nconc (list 'article-type 'cite) + gnus-hidden-properties)) + (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-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 + (when (and beg end) + (gnus-add-wash-type 'cite) + ;; 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) + (when (and gnus-cite-blank-line-after-header + (not (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) @@ -532,8 +557,8 @@ 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 &optional arg) "Toggle hiding the text in REGION. @@ -552,14 +577,20 @@ means show, nil means toggle." (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))) + (progn + ;; Can't remove 'cite from g-a-wash-types here because + ;; multiple citations may be hidden -jas + (gnus-remove-text-properties-when + 'article-type 'cite beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties)))) + (gnus-add-wash-type 'cite) (gnus-add-text-properties-when - 'article-type nil beg end + 'article-type nil beg end (cons 'article-type (cons 'cite gnus-hidden-properties)))) + (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)) (save-excursion (goto-char start) (gnus-delete-line) @@ -657,11 +688,13 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-delete-overlays () (dolist (overlay gnus-cite-overlay-list) - (when (or (not (gnus-overlay-end overlay)) - (and (>= (gnus-overlay-end overlay) (point-min)) - (<= (gnus-overlay-end overlay) (point-max)))) - (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) - (gnus-delete-overlay overlay)))) + (ignore-errors + (when (or (not (gnus-overlay-end overlay)) + (and (>= (gnus-overlay-end overlay) (point-min)) + (<= (gnus-overlay-end overlay) (point-max)))) + (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) + (ignore-errors + (gnus-delete-overlay overlay)))))) (defun gnus-cite-parse-wrapper () ;; Wrap chopped gnus-cite-parse. @@ -684,14 +717,14 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char (point-max)) (gnus-article-search-signature) (point))) - (prefix-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)")) + (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)) + end (gnus-point-at-bol 2) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. @@ -715,9 +748,19 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char begin)) (goto-char start) (setq line (1+ line))) + ;; Horrible special case for some Microsoft mailers. + (goto-char (point-min)) + (when (re-search-forward gnus-cite-unsightly-citation-regexp max t) + (setq begin (count-lines (point-min) (point))) + (setq end (count-lines (point-min) max)) + (setq entry nil) + (while (< begin end) + (push begin entry) + (setq begin (1+ begin))) + (push (cons "" entry) alist)) ;; We got all the potential prefixes. Now create ;; `gnus-cite-prefix-alist' containing the oldest prefix for each - ;; line that appears at least gnus-cite-minimum-match-count + ;; line that appears at least `gnus-cite-minimum-match-count' ;; times. First sort them by length. Longer is older. (setq alist (sort alist (lambda (a b) (> (length (car a)) (length (car b)))))) @@ -962,14 +1005,20 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char (point-min)) (forward-line (1- number)) (cond ((get-text-property (point) 'invisible) + ;; Can't remove 'cite from g-a-wash-types here because + ;; multiple citations may be hidden -jas (remove-text-properties (point) (progn (forward-line 1) (point)) gnus-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t + (gnus-add-wash-type 'cite) (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) - gnus-hidden-properties)))))))) + gnus-hidden-properties)))) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)))))) (defun gnus-cite-find-prefix (line) ;; Return citation prefix for LINE. @@ -992,6 +1041,17 @@ See also the documentation for `gnus-article-highlight-citation'." (while vars (make-local-variable (pop vars))))) +(defun gnus-cited-line-p () + "Say whether the current line is a cited line." + (save-excursion + (beginning-of-line) + (let ((found nil)) + (dolist (prefix (mapcar 'car gnus-cite-prefix-alist)) + (when (string= (buffer-substring (point) (+ (length prefix) (point))) + prefix) + (setq found t))) + found))) + (gnus-ems-redefine) (provide 'gnus-cite) diff --git a/lisp/gnus-clfns.el b/lisp/gnus-clfns.el index 9b28e89..db33634 100644 --- a/lisp/gnus-clfns.el +++ b/lisp/gnus-clfns.el @@ -1,5 +1,6 @@ ;;; gnus-clfns.el --- compiler macros for emulating cl functions -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. + +;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Kastsumi Yamaoka ;; Keywords: cl, compile @@ -23,17 +24,19 @@ ;;; Commentary: -;; Avoid cl runtime functions for FSF Emacsen. +;; This module is for mainly avoiding cl runtime functions in FSF +;; Emacsen. Function should also be defined as an ordinary function +;; if it will not be provided in cl. ;;; Code: (if (featurep 'xemacs) nil - (require 'cl) + (eval-when-compile (require 'cl)) + (require 'pym) (define-compiler-macro butlast (&whole form x &optional n) - (if (and (fboundp 'butlast) - (subrp (symbol-function 'butlast))) + (if (>= emacs-major-version 21) form (if n `(let ((x ,x) @@ -44,18 +47,51 @@ (or n (setq n 1)) (and (< n m) (progn - (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) + (if (> n 0) + (progn + (setq x (copy-sequence x)) + (setcdr (nthcdr (- (1- m) n) x) nil))) x))))) `(let* ((x ,x) (m (length x))) (and (< 1 m) (progn + (setq x (copy-sequence x)) (setcdr (nthcdr (- m 2) x) nil) x)))))) +;; (define-compiler-macro coerce (&whole form x type) +;; (if (and (fboundp 'coerce) +;; (subrp (symbol-function 'coerce))) +;; form +;; `(let ((x ,x) +;; (type ,type)) +;; (cond ((eq type 'list) (if (listp x) x (append x nil))) +;; ((eq type 'vector) (if (vectorp x) x (vconcat x))) +;; ((eq type 'string) (if (stringp x) x (concat x))) +;; ((eq type 'array) (if (arrayp x) x (vconcat x))) +;; ((and (eq type 'character) (stringp x) (= (length x) 1)) +;; (aref x 0)) +;; ((and (eq type 'character) (symbolp x) +;; (= (length (symbol-name x)) 1)) +;; (aref (symbol-name x) 0)) +;; ((eq type 'float) (float x)) +;; ((typep x type) x) +;; (t (error "Can't coerce %s to type %s" x type)))))) + +;; (define-compiler-macro copy-list (&whole form list) +;; (if (and (fboundp 'copy-list) +;; (subrp (symbol-function 'copy-list))) +;; form +;; `(let ((list ,list)) +;; (if (consp list) +;; (let ((res nil)) +;; (while (consp list) (push (pop list) res)) +;; (prog1 (nreverse res) (setcdr res list))) +;; (car list))))) + (define-compiler-macro last (&whole form x &optional n) - (if (and (fboundp 'last) - (subrp (symbol-function 'last))) + (if (>= emacs-major-version 20) form (if n `(let* ((x ,x) @@ -74,8 +110,323 @@ (while (consp (cdr x)) (pop x)) x)))) + + (define-compiler-macro mapc (&whole form fn seq &rest rest) + (if (>= emacs-major-version 21) + 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)))) + +;; (define-compiler-macro merge (&whole form type seq1 seq2 pred &rest keys) +;; (if (and (fboundp 'merge) +;; (subrp (symbol-function 'merge))) +;; form +;; `(let ((type ,type) +;; (seq1 ,seq1) +;; (seq2 ,seq2) +;; (pred ,pred)) +;; (or (listp seq1) (setq seq1 (append seq1 nil))) +;; (or (listp seq2) (setq seq2 (append seq2 nil))) +;; (let ((res nil)) +;; (while (and seq1 seq2) +;; (if (funcall pred (car seq2) (car seq1)) +;; (push (pop seq2) res) +;; (push (pop seq1) res))) +;; (coerce (nconc (nreverse res) seq1 seq2) type))))) + +;; (define-compiler-macro string (&whole form &rest args) +;; (if (>= emacs-major-version 20) +;; form +;; (list 'concat (cons 'list args)))) + +;; (defun-maybe string (&rest args) +;; "Concatenate all the argument characters and make the result a string." +;; (concat args)) + + (define-compiler-macro string-to-list (&whole form string) + (cond ((fboundp 'string-to-list) + form) + ((fboundp 'string-to-char-list) + (list 'string-to-char-list string)) + (t + `(let* ((str ,string) + (len (length str)) + (idx 0) + c l) + (while (< idx len) + (setq c (sref str idx)) + (setq idx (+ idx (char-bytes c))) + (setq l (cons c l))) + (nreverse l))))) + + ;; 92.7.2 by K.Handa (imported from Mule 2.3) + (defun-maybe string-to-list (str) + (let ((len (length str)) + (idx 0) + c l) + (while (< idx len) + (setq c (sref str idx)) + (setq idx (+ idx (char-bytes c))) + (setq l (cons c l))) + (nreverse l))) + +;; (define-compiler-macro subseq (&whole form seq start &optional end) +;; (if (and (fboundp 'subseq) +;; (subrp (symbol-function 'subseq))) +;; form +;; (if end +;; `(let ((seq ,seq) +;; (start ,start) +;; (end ,end)) +;; (if (stringp seq) +;; (substring seq start end) +;; (let (len) +;; (if (< end 0) +;; (setq end (+ end (setq len (length seq))))) +;; (if (< start 0) +;; (setq start (+ start (or len (setq len (length seq)))))) +;; (cond ((listp seq) +;; (if (> start 0) +;; (setq seq (nthcdr start seq))) +;; (let ((res nil)) +;; (while (>= (setq end (1- end)) start) +;; (push (pop seq) res)) +;; (nreverse res))) +;; (t +;; (let ((res (make-vector (max (- end start) 0) nil)) +;; (i 0)) +;; (while (< start end) +;; (aset res i (aref seq start)) +;; (setq i (1+ i) +;; start (1+ start))) +;; res)))))) +;; `(let ((seq ,seq) +;; (start ,start)) +;; (if (stringp seq) +;; (substring seq start) +;; (let (len) +;; (if (< start 0) +;; (setq start (+ start (or len (setq len (length seq)))))) +;; (cond ((listp seq) +;; (if (> start 0) +;; (setq seq (nthcdr start seq))) +;; (copy-sequence seq)) +;; (t +;; (let* ((end (or len (length seq))) +;; (res (make-vector (max (- end start) 0) nil)) +;; (i 0)) +;; (while (< start end) +;; (aset res i (aref seq start)) +;; (setq i (1+ i) +;; start (1+ start))) +;; res))))))))) ) +;; A tool for the developers. + +(defvar cl-run-time-functions + '(Values + Values-list acons assoc-if assoc-if-not build-klist butlast ceiling* + coerce common-lisp-indent-function compiler-macroexpand concatenate + copy-list count count-if count-if-not delete* delete-duplicates delete-if + delete-if-not duplicate-symbols-p elt-satisfies-test-p equalp evenp every + extract-from-klist fill find find-if find-if-not floatp-safe floor* gcd + gensym gentemp get-setf-method getf hash-table-count hash-table-p + intersection isqrt keyword-argument-supplied-p keyword-of keywordp last + lcm ldiff lisp-indent-259 lisp-indent-do lisp-indent-function-lambda-hack + lisp-indent-report-bad-format lisp-indent-tagbody list-length + make-hash-table make-random-state map mapc mapcan mapcar* mapcon mapl + maplist member-if member-if-not merge mismatch mod* nbutlast nintersection + notany notevery nreconc nset-difference nset-exclusive-or nsublis nsubst + nsubst-if nsubst-if-not nsubstitute nsubstitute-if nsubstitute-if-not + nunion oddp pair-with-newsyms pairlis position position-if position-if-not + proclaim random* random-state-p rassoc* rassoc-if rassoc-if-not + reassemble-argslists reduce rem* remove remove* remove-duplicates + remove-if remove-if-not remq replace revappend round* safe-idiv search + set-difference set-exclusive-or setelt setnth setnthcdr signum some sort* + stable-sort sublis subseq subsetp subst subst-if subst-if-not substitute + substitute-if substitute-if-not tailp tree-equal truncate* union + unzip-lists zip-lists) + "A list of CL run-time functions. Some functions were built-in, nowadays.") + +;;;###autoload +(defun find-cl-run-time-functions (file-or-directory arg) + "Find CL run-time functions in the FILE-OR-DIRECTORY. You can alter +the behavior of this command with the prefix ARG as described below. + +By default, it searches for all the CL run-time functions listed in + the variable `cl-run-time-functions'. +With 1 or 3 \\[universal-argument]'s, the built-in functions in this Emacs\ + will not be + reported. +With 2 or 3 \\[universal-argument]'s, just the symbols will also be reported. + +You can use the `digit-argument' 1, 2 or 3 instead of\ + \\[universal-argument]'s." + (interactive (list (read-file-name "Find CL run-time functions in: " + nil default-directory t) + current-prefix-arg)) + (unless (interactive-p) + (error "You should invoke `M-x find-cl-run-time-functions' interactively")) + (let ((report-symbols (member arg '((16) (64) 2 3))) + files clfns working file lines form forms fns fn newform buffer + window scroll + buffer-file-format format-alist + insert-file-contents-post-hook insert-file-contents-pre-hook) + (cond ((file-directory-p file-or-directory) + (setq files (directory-files file-or-directory t "\\.el$")) + (dolist (file files) + (unless (file-exists-p file) + (setq files (delete file files)))) + (unless files + (message "No files found in: %s" file-or-directory)) + files) + ((file-exists-p file-or-directory) + (setq files (list file-or-directory))) + (t + (message "No such file or directory: %s" file-or-directory))) + (when files + (if (member arg '((4) (64) 1 3)) + (dolist (fn cl-run-time-functions) + (unless (and (fboundp fn) + (subrp (symbol-function fn))) + (push fn clfns))) + (setq clfns cl-run-time-functions)) + (set-buffer (setq working + (get-buffer-create + " *Searching for CL run-time functions*"))) + (let (emacs-lisp-mode-hook) + (emacs-lisp-mode)) + (while files + (setq file (pop files) + lines (list nil nil)) + (message "Searching for CL run-time functions in: %s..." + (file-name-nondirectory file)) + (insert-file-contents file nil nil nil t) + ;; XEmacs moves point to the beginning of the buffer after + ;; inserting a file, FSFmacs doesn't so if the fifth argument + ;; of `insert-file-contents' is specified. + (goto-char (point-min)) + ;; + (while (progn + (while (and (looking-at "[\t\v\f\r ]*\\(;.*\\)?$") + (zerop (forward-line 1)))) + (not (eobp))) + (setcar lines (if (bolp) + (1+ (count-lines (point-min) (point))) + (count-lines (point-min) (point)))) + (when (consp;; Ignore stand-alone symbols, strings, etc. + (setq form (condition-case nil + (read working) + (error nil)))) + (setcdr lines (list (count-lines (point-min) (point)))) + (setq forms (list form) + fns nil) + (while forms + (setq form (pop forms)) + (when (consp form) + (setq fn (pop form)) + (cond ((memq fn '(apply mapatoms mapcar mapconcat + mapextent symbol-function)) + (if (consp (car form)) + (when (memq (caar form) '(\` backquote quote)) + (setcar form (cdar form))) + (setq form (cdr form)))) + ((memq fn '(\` backquote quote)) + (if report-symbols + (progn + (setq form (car form) + newform nil) + (while form + (push (list (or (car-safe form) form)) + newform) + (setq form (cdr-safe form))) + (setq form (nreverse newform))) + (setq form nil))) + ((memq fn '(defadvice + defmacro defsubst defun + defmacro-maybe defmacro-maybe-cond + defsubst-maybe defun-maybe + defun-maybe-cond)) + (setq form (cddr form))) + ((memq fn '(defalias lambda fset)) + (setq form (cdr form))) + ((eq fn 'define-compiler-macro) + (setq form nil)) + ((eq fn 'dolist) + (setcar form (cadar form))) + ((memq fn '(let let*)) + (setq form + (append + (delq nil + (mapcar + (lambda (element) + (when (and (consp element) + (consp (cadr element))) + (cadr element))) + (car form))) + (cdr form)))) + ((eq fn 'sort) + (when (and (consp (cadr form)) + (memq (caadr form) '(\` backquote quote))) + (setcdr form (list (cdadr form))))) + ((and (memq fn clfns) + (listp form)) + (push fn fns))) + (when (listp form) + (setq forms (append form forms))))) + (when fns + (if buffer + (set-buffer buffer) + (display-buffer + (setq buffer (get-buffer-create + (concat "*CL run-time functions in: " + file-or-directory "*")))) + (set-buffer buffer) + (erase-buffer) + (setq window (get-buffer-window buffer t) + scroll (- 2 (window-height window)) + fill-column (max 16 (- (window-width window) 2)) + fill-prefix " ")) + (when file + (insert file "\n") + (setq file nil)) + (narrow-to-region + (point) + (progn + (insert fill-prefix + (mapconcat (lambda (fn) (format "%s" fn)) + (nreverse fns) " ") + "\n") + (point))) + (fill-region (point-min) (point-max)) + (goto-char (point-min)) + (widen) + (delete-char 14) + (insert (format "%5d - %5d:" (car lines) (cadr lines))) + (goto-char (point-max)) + (forward-line scroll) + (set-window-start window (point)) + (goto-char (point-max)) + (sit-for 0) + (set-buffer working))))) + (kill-buffer working) + (if buffer + (message "Done") + (message "No CL run-time functions found in: %s" + file-or-directory))))) + (provide 'gnus-clfns) ;;; gnus-clfns.el ends here diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 6d25e44..f991297 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -1,6 +1,7 @@ ;;; gnus-cus.el --- customization commands for Gnus ;; -;; Copyright (C) 1996,1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: news @@ -27,15 +28,14 @@ ;;; Code: (require 'wid-edit) +(require 'gnus) +(require 'gnus-agent) (require 'gnus-score) (require 'gnus-topic) +(require 'gnus-art) ;;; Widgets: -;; There should be special validation for this. -(define-widget 'gnus-email-address 'string - "An email address") - (defun gnus-custom-mode () "Major mode for editing Gnus customization buffers. @@ -72,36 +72,7 @@ if that value is non-nil." ;;; Group Customization: (defconst gnus-group-parameters - '((to-address (gnus-email-address :tag "To Address") "\ -This will be used when doing followups and posts. - -This is primarily useful in mail groups that represent closed -mailing lists--mailing lists where it's expected that everybody that -writes to the mailing list is subscribed to it. Since using this -parameter ensures that the mail only goes to the mailing list itself, -it means that members won't receive two copies of your followups. - -Using `to-address' will actually work whether the group is foreign or -not. Let's say there's a group on the server that is called -`fa.4ad-l'. This is a real newsgroup, but the server has gotten the -articles from a mail-to-news gateway. Posting directly to this group -is therefore impossible--you have to send mail to the mailing list -address instead. - -The gnus-group-split mail splitting mechanism will behave as if this -address was listed in gnus-group-split Addresses (see below).") - - (to-list (gnus-email-address :tag "To List") "\ -This address will be used when doing a `a' in the group. - -It is totally ignored when doing a followup--except that if it is -present in a news group, you'll get mail group semantics when doing -`f'. - -The gnus-group-split mail splitting mechanism will behave as if this -address was listed in gnus-group-split Addresses (see below).") - - (extra-aliases (choice + '((extra-aliases (choice :tag "Extra Aliases" (list :tag "List" @@ -161,29 +132,13 @@ All posts will be sent to the specified group.") (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', +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 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) - symbol - regexp - (const :tag "None" nil)) "\ -Regular expression matching banners to be removed from articles.") - - (auto-expire (const :tag "Automatic Expire" t) "\ -All articles that are read will be marked as expirable.") - - (total-expire (const :tag "Total Expire" t) "\ -All read articles will be put through the expiry process - -This happens even if they are not marked as expirable. -Use with caution.") - (expiry-wait (choice :tag "Expire Wait" :value never (const never) @@ -198,13 +153,13 @@ 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) "\ + :value delete + (const delete) + (function :format "%v" nnmail-) + string) "\ Where expired messages end up. -Overrides `nnmail-expiry-target', which see.") +Overrides `nnmail-expiry-target'.") (score-file (file :tag "Score File") "\ Make the specified file into the current score file. @@ -225,15 +180,25 @@ you to put the admin address somewhere convenient.") (display (choice :tag "Display" :value default (const all) - (const default)) "\ + (integer) + (const default) + (sexp :tag "Other")) "\ Which articles to display on entering the group. `all' Display all articles, both read and unread. +`integer' + Display the last NUMBER articles in the group. This is the same as + entering the group with C-u NUMBER. + `default' Display the default visible articles, which normally includes - unread and ticked articles.") + unread and ticked articles. + +`Other' + Display the articles that satisfy the S-expression. The S-expression + should be in an array form.") (comment (string :tag "Comment") "\ An arbitrary comment on the group.") @@ -242,28 +207,33 @@ An arbitrary comment on the group.") Always display this group, even when there are no unread articles in it..") - (charset (symbol :tag "Charset") "\ -The default charset to use in the group.") - - (ignored-charsets - (choice :tag "Ignored charsets" - :value nil - (repeat (symbol))) "\ -List of charsets that should be ignored. - -When these charsets are used in the \"charset\" parameter, the -default charset will be used instead.") - - (highlight-words + (highlight-words (choice :tag "Highlight words" :value nil (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)))) "highlight regexps. -See gnus-emphasis-alist.")) +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) + (const import)) + (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 @@ -272,9 +242,15 @@ DOC is a documentation string for the parameter.") (defconst gnus-extra-topic-parameters '((subscribe (regexp :tag "Subscribe") "\ -If `gnus-subscribe-newsgroup-method' is set to +If `gnus-subscribe-newsgroup-method' or +`gnus-subscribe-options-newsgroup-method' is set to `gnus-subscribe-topics', new groups that matches this regexp will -automatically be subscribed to this topic")) +automatically be subscribed to this topic") + (subscribe-level (integer :tag "Subscribe Level" :value 1) "\ +If this topic parameter is set, when new groups are subscribed +automatically under this topic (via the `subscribe' topic parameter) +assign this level to the group, rather than the default level +set in `gnus-level-default-subscribed'")) "Alist of topic parameters that are not also group parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter @@ -289,6 +265,62 @@ Server-assigned value attached to IMAP groups, used to maintain consistency.")) 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.") + +(eval-and-compile + (defconst gnus-agent-parameters + '((agent-predicate + (sexp :tag "Selection Predicate" :value false) + "Predicate used to automatically select articles for downloading." + gnus-agent-cat-predicate) + (agent-score + (choice :tag "Score File" :value nil + (const file :tag "Use group's score files") + (repeat (list (string :format "%v" :tag "File name")))) + "Which score files to use when using score to select articles to fetch. + + `nil' + All articles will be scored to zero (0). + + `file' + The group's score files will be used to score the articles. + + `List' + A list of score file names." + gnus-agent-cat-score-file) + (agent-short-article + (integer :tag "Max Length of Short Article" :value "") + "The SHORT predicate will evaluate to true when the article is +shorter than this length." gnus-agent-cat-length-when-short) + (agent-long-article + (integer :tag "Min Length of Long Article" :value "") + "The LONG predicate will evaluate to true when the article is +longer than this length." gnus-agent-cat-length-when-long) + (agent-low-score + (integer :tag "Low Score Limit" :value "") + "The LOW predicate will evaluate to true when the article scores +lower than this limit." gnus-agent-cat-low-score) + (agent-high-score + (integer :tag "High Score Limit" :value "") + "The HIGH predicate will evaluate to true when the article scores +higher than this limit." gnus-agent-cat-high-score) + (agent-days-until-old + (integer :tag "Days Until Old" :value "") + "The OLD predicate will evaluate to true when the fetched article +has been stored locally for at least this many days." + gnus-agent-cat-days-until-old) + (agent-enable-expiration + (radio :tag "Expire in this Group or Topic" :value nil +; (const :format "Inherit " nil) + (const :format "Enable " ENABLE) + (const :format "Disable " DISABLE)) + "\nEnable, or disable, agent expiration in this group or topic." + gnus-agent-cat-enable-expiration) ) + "Alist of group parameters that are not also topic parameters. + +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.")) + (defvar gnus-custom-params) (defvar gnus-custom-method) (defvar gnus-custom-group) @@ -303,10 +335,29 @@ DOC is a documentation string for the parameter.") :doc ,(nth 2 entry) (const :format "" ,(nth 0 entry)) ,(nth 1 entry))) - (append gnus-group-parameters + (append (reverse gnus-group-parameters-more) + gnus-group-parameters (if group gnus-extra-group-parameters - gnus-extra-topic-parameters))))) + gnus-extra-topic-parameters)))) + (agent (mapcar (lambda (entry) + (let ((type (nth 1 entry)) + vcons) + (if (listp type) + (setq type (copy-sequence type))) + + (setq vcons (cdr (memq :value type))) + + (if (symbolp (car vcons)) + (condition-case nil + (setcar vcons (symbol-value (car vcons))) + (error))) + `(cons :format "%v%h\n" + :doc ,(nth 2 entry) + (const :format "" ,(nth 0 entry)) + ,type))) + (if gnus-agent + gnus-agent-parameters)))) (unless (or group topic) (error "No group on current line")) (when (and group topic) @@ -314,7 +365,7 @@ DOC is a documentation string for the parameter.") (unless (or topic (setq info (gnus-get-info group))) (error "Killed group; can't be edited")) ;; Ready. - (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) + (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) (gnus-custom-mode) (make-local-variable 'gnus-custom-group) @@ -341,44 +392,74 @@ DOC is a documentation string for the parameter.") :action 'gnus-group-customize-done) (widget-insert ".\n\n") (make-local-variable 'gnus-custom-params) - (setq gnus-custom-params - (widget-create 'group - :value (if group - (gnus-info-params info) - (gnus-topic-parameters topic)) - `(set :inline t - :greedy t - :tag "Parameters" - :format "%t:\n%h%v" - :doc "\ + + (let ((values (if group + (gnus-info-params info) + (gnus-topic-parameters topic)))) + + ;; The parameters in values may contain duplicates. This is + ;; normally OK as assq returns the first. However, right here + ;; every duplicate ends up being displayed. So, rather than + ;; display them, remove them from the list. + + (let ((tmp (setq values (gnus-copy-sequence values))) + elem) + (while (cdr tmp) + (while (setq elem (assq (caar tmp) (cdr tmp))) + (delq elem tmp)) + (setq tmp (cdr tmp)))) + + (setq gnus-custom-params + (apply 'widget-create 'group + :value values + (delq nil + (list `(set :inline t + :greedy t + :tag "Parameters" + :format "%t:\n%h%v" + :doc "\ 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) - '(repeat :inline t - :tag "Variables" - :format "%t:\n%h%v%i\n\n" - :doc "\ + ,@types) + (when gnus-agent + `(set :inline t + :greedy t + :tag "Agent Parameters" + :format "%t:\n%h%v" + :doc "\ These agent parameters are +recognized by Gnus. They control article selection and expiration for +use in the unplugged cache. 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. + +For those interested, group parameters override topic parameters while +topic parameters override agent category parameters. Underlying +category parameters are the customizable variables." ,@agent)) + '(repeat :inline t + :tag "Variables" + :format "%t:\n%h%v%i\n\n" + :doc "\ Set variables local to the group you are entering. If you want to turn threading off in `news.answers', you could put `(gnus-show-threads nil)' in the group parameters of that group. `gnus-show-threads' will be made into a local variable in the summary -buffer you enter, and the form `nil' will be `eval'ed there. +buffer you enter, and the form nil will be `eval'ed there. This can also be used as a group-specific hook function, if you'd 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?" - (list :format "%v" :value (nil nil) - (symbol :tag "Variable") - (sexp :tag - "Value"))) - - '(repeat :inline t - :tag "Unknown entries" - sexp))) + (list :format "%v" :value (nil nil) + (symbol :tag "Variable") + (sexp :tag + "Value"))) + + '(repeat :inline t + :tag "Unknown entries" + sexp)))))) (when group (widget-insert "\n\nYou can also edit the ") (widget-create 'info-link @@ -477,15 +558,15 @@ by ordinary scoring rules.") (sexp :format "%v" :hide-front-space t)) "\ This entry controls the adaptive scoring. -If it is `t', the default adaptive scoring rules will be used. If it +If it is t, the default adaptive scoring rules will be used. If it is `ignore', no adaptive scoring will be performed on this group. If it is a list, this list will be used as the adaptive scoring rules. -If it isn't present, or is something other than `t' or `ignore', the +If it isn't present, or is something other than t or `ignore', the default adaptive scoring rules will be used. If you want to use adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring' -to `t', and insert an `(adapt ignore)' in the groups where you do not +to t, and insert an `(adapt ignore)' in the groups where you do not want adaptive scoring. If you only want adaptive scoring in a few -groups, you'd set `gnus-use-adaptive-scoring' to `nil', and insert +groups, you'd set `gnus-use-adaptive-scoring' to nil, and insert `(adapt t)' in the score files of the groups where you want it.") (adapt-file (file :tag "Adapt-file") "\ @@ -678,8 +759,13 @@ eh?"))) (defvar gnus-custom-score-alist) (defun gnus-score-customize (file) - "Customize score file FILE." + "Customize score file FILE. +When called interactively, FILE defaults to the current score file. +This can be changed using the `\\[gnus-score-change-score-file]' command." (interactive (list gnus-current-score-file)) + (unless file + (error (format "No score file for %s" + (gnus-group-decoded-name gnus-newsgroup-name)))) (let ((scores (gnus-score-load file)) (types (mapcar (lambda (entry) `(group :format "%v%h\n" @@ -791,6 +877,163 @@ articles in the thread. (gnus-score-set 'touched '(t) alist)) (bury-buffer)) +(eval-when-compile + (defvar category-fields nil) + (defvar gnus-agent-cat-predicate nil) + (defvar gnus-agent-cat-score-file nil) + (defvar gnus-agent-cat-length-when-short nil) + (defvar gnus-agent-cat-length-when-long nil) + (defvar gnus-agent-cat-low-score nil) + (defvar gnus-agent-cat-high-score nil) + (defvar gnus-agent-cat-groups nil) + (defvar gnus-agent-cat-enable-expiration nil) + (defvar gnus-agent-cat-days-until-old nil) + (defvar gnus-agent-cat-name nil) +) + +(defun gnus-trim-whitespace (s) + (when (string-match "\\`[ \n\t]+" s) + (setq s (substring s (match-end 0)))) + (when (string-match "[ \n\t]+\\'" s) + (setq s (substring s 0 (match-beginning 0)))) + s) + +(defmacro gnus-agent-cat-prepare-category-field (parameter) + (let* ((entry (assq parameter gnus-agent-parameters)) + (field (nth 3 entry))) + `(let* ((type (copy-sequence + (nth 1 (assq ',parameter gnus-agent-parameters)))) + (val (,field info)) + (deflt (if (,field defaults) + (concat " [" (gnus-trim-whitespace + (pp-to-string (,field defaults))) "]")))) + + (if (eq (car type) 'radio) + (let* ((rtype (nreverse type)) + (rt rtype)) + (while (listp (or (cadr rt) 'not-list)) + (setq rt (cdr rt))) + + (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt))) + (setq type (nreverse rtype)))) + + (if deflt + (let ((tag (cdr (memq :tag type)))) + (if (string-match "\n" deflt) + (progn (while (progn (setq deflt (replace-match "\n " t t + deflt)) + (string-match "\n" deflt (match-end 0)))) + (setq deflt (concat "\n" deflt)))) + + (setcar tag (concat (car tag) deflt)))) + + (widget-insert "\n") + + (set (make-local-variable ',field) + (if val + (widget-create type :value val) + (widget-create type))) + (widget-put ,field :default val) + (widget-put ,field :accessor ',field) + (push ,field category-fields)))) + +(defun gnus-agent-customize-category (category) + "Edit the CATEGORY." + (interactive (list (gnus-category-name))) + (let ((info (assq category gnus-category-alist)) + (defaults (list nil '(agent-predicate . false) + (cons 'agent-enable-expiration + gnus-agent-enable-expiration) + '(agent-days-until-old . 7) + (cons 'agent-length-when-short + gnus-agent-short-article) + (cons 'agent-length-when-long gnus-agent-long-article) + (cons 'agent-low-score gnus-agent-low-score) + (cons 'agent-high-score gnus-agent-high-score)))) + + (let ((old (get-buffer "*Gnus Agent Category Customize*"))) + (when old + (gnus-kill-buffer old))) + (switch-to-buffer (gnus-get-buffer-create + "*Gnus Agent Category Customize*")) + + (let ((inhibit-read-only t)) + (gnus-custom-mode) + (buffer-disable-undo) + + (let* ((name (gnus-agent-cat-name info))) + (widget-insert "Customize the Agent Category '") + (widget-insert (symbol-name name)) + (widget-insert "' and press ") + (widget-create + 'push-button + :notify + '(lambda (&rest ignore) + (let* ((info (assq gnus-agent-cat-name gnus-category-alist)) + (widgets category-fields)) + (while widgets + (let* ((widget (pop widgets)) + (value (ignore-errors (widget-value widget)))) + (eval `(setf (,(widget-get widget :accessor) ',info) + ',value))))) + (gnus-category-write) + (gnus-kill-buffer (current-buffer)) + (when (get-buffer gnus-category-buffer) + (switch-to-buffer (get-buffer gnus-category-buffer)) + (gnus-category-list))) + "Done") + (widget-insert + "\n Note: Empty fields default to the customizable global\ + variables.\n\n") + + (set (make-local-variable 'gnus-agent-cat-name) + name)) + + (set (make-local-variable 'category-fields) nil) + (gnus-agent-cat-prepare-category-field agent-predicate) + + (gnus-agent-cat-prepare-category-field agent-score) + (gnus-agent-cat-prepare-category-field agent-short-article) + (gnus-agent-cat-prepare-category-field agent-long-article) + (gnus-agent-cat-prepare-category-field agent-low-score) + (gnus-agent-cat-prepare-category-field agent-high-score) + + ;; The group list is NOT handled with + ;; gnus-agent-cat-prepare-category-field as I don't want the + ;; group list to appear when customizing a topic. + (widget-insert "\n") + (set (make-local-variable 'gnus-agent-cat-groups) + (widget-create + `(choice + :format "%[Select Member Groups%]\n%v" :value ignore + (const :menu-tag "do not change" :tag "" :value ignore) + (checklist :entry-format "%b %v" + :menu-tag "display group selectors" + :greedy t + :value ,(delq nil + (mapcar + (lambda (newsrc) + (car (member + (gnus-info-group newsrc) + (gnus-agent-cat-groups info)))) + (cdr gnus-newsrc-alist))) + ,@(mapcar (lambda (newsrc) + `(const ,(gnus-info-group newsrc))) + (cdr gnus-newsrc-alist)))))) + + (widget-put gnus-agent-cat-groups :default (gnus-agent-cat-groups info)) + (widget-put gnus-agent-cat-groups :accessor 'gnus-agent-cat-groups) + (push gnus-agent-cat-groups category-fields) + + (widget-insert "\nExpiration Settings ") + + (gnus-agent-cat-prepare-category-field agent-enable-expiration) + (gnus-agent-cat-prepare-category-field agent-days-until-old) + + (use-local-map widget-keymap) + (widget-setup) + (buffer-enable-undo)))) + ;;; The End: (provide 'gnus-cus) diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index d647928..3d943b6 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -1,6 +1,6 @@ ;;; gnus-demon.el --- daemonic Gnus behaviour -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -150,32 +150,32 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (if (not (stringp time)) time (let* ((now (current-time)) - ;; obtain NOW as discrete components -- make a vector for speed - (nowParts (decode-time now)) - ;; obtain THEN as discrete components - (thenParts (parse-time-string time)) - (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 - ;; says that this is OK. - (+ (elt nowParts 3) - (if (or (< thenHour (elt nowParts 2)) - (and (= thenHour (elt nowParts 2)) - (<= thenMin (elt nowParts 1)))) - 1 0)) - (elt nowParts 4) - (elt nowParts 5) - (elt nowParts 6) - (elt nowParts 7) - (elt nowParts 8))) - ;; calculate number of seconds between NOW and THEN - (diff (+ (* 65536 (- (car then) (car now))) - (- (cadr then) (cadr now))))) + ;; obtain NOW as discrete components -- make a vector for speed + (nowParts (decode-time now)) + ;; obtain THEN as discrete components + (thenParts (parse-time-string time)) + (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 + ;; says that this is OK. + (+ (elt nowParts 3) + (if (or (< thenHour (elt nowParts 2)) + (and (= thenHour (elt nowParts 2)) + (<= thenMin (elt nowParts 1)))) + 1 0)) + (elt nowParts 4) + (elt nowParts 5) + (elt nowParts 6) + (elt nowParts 7) + (elt nowParts 8))) + ;; calculate number of seconds between NOW and THEN + (diff (+ (* 65536 (- (car then) (car now))) + (- (cadr then) (cadr now))))) ;; return number of timesteps in the number of seconds (round (/ diff gnus-demon-timestep))))) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 849dc9b..4bad775 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,5 +1,5 @@ ;;; gnus-draft.el --- draft message support for Semi-gnus -;; Copyright (C) 1997, 1998, 1999, 2000 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -95,12 +95,18 @@ (defun gnus-draft-edit-message () "Enter a mail/post buffer to edit and send the draft." (interactive) - (let ((article (gnus-summary-article-number))) + (let ((article (gnus-summary-article-number)) + (group gnus-newsgroup-name)) (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup-for-editing article gnus-newsgroup-name) - (message-save-drafts) + (gnus-draft-setup article group t) + (set-buffer-modified-p t) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-remove-header "date"))) + (save-buffer) (let ((gnus-verbose-backends nil)) - (gnus-request-expire-articles (list article) gnus-newsgroup-name t)) + (gnus-request-expire-articles (list article) group t)) (push `((lambda () (when (gnus-buffer-exists-p ,gnus-summary-buffer) @@ -118,30 +124,38 @@ (while (setq article (pop articles)) (gnus-summary-remove-process-mark article) (unless (memq article gnus-newsgroup-unsendable) - (let ((message-sending-message - (format "Sending message %d of %d..." + (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." - (let ((message-syntax-checks (if interactive nil + (let ((message-syntax-checks (if interactive message-syntax-checks 'dont-check-for-anything-just-trust-me)) - (message-inhibit-body-encoding (or (not group) + (message-hidden-headers nil) + (message-inhibit-body-encoding (or (not group) (equal group "nndraft:queue") 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")) + type method move-to) + (gnus-draft-setup article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction (message-narrow-to-head) (when (re-search-forward + (concat "^" (regexp-quote gnus-agent-target-move-group-header) + ":") nil t) + (skip-syntax-forward "-") + (setq move-to (buffer-substring (point) (gnus-point-at-eol))) + (message-remove-header gnus-agent-target-move-group-header)) + (goto-char (point-min)) + (when (re-search-forward (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") nil t) (setq type (ignore-errors (read (current-buffer))) @@ -151,25 +165,20 @@ (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 "")) - (cond ((eq type 'news) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (funcall message-send-news-function method) - ))) - (funcall message-send-news-function method) - ) - ((eq type 'mail) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (funcall message-send-mail-function) - ))) - (funcall message-send-mail-function) - t))) + (when (and (or (null method) + (gnus-server-opened method) + (gnus-open-server method)) + (if type + (let ((message-this-is-news (eq type 'news)) + (message-this-is-mail (eq type 'mail)) + (gnus-post-method method) + (message-post-method method)) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit))) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit)))) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) (or group "nndraft:queue") t))))) @@ -180,7 +189,7 @@ (gnus-uu-mark-buffer) (gnus-draft-send-message)) -(defun gnus-group-send-drafts () +(defun gnus-group-send-queue () "Send all sendable articles from the queue group." (interactive) (gnus-activate-group "nndraft:queue") @@ -190,6 +199,7 @@ (cdr (assq 'unsend (gnus-info-marks (gnus-get-info "nndraft:queue")))))) + (gnus-posting-styles nil) (total (length articles)) article) (while (setq article (pop articles)) @@ -199,6 +209,20 @@ (- total (length articles)) total))) (gnus-draft-send article))))))) +;;;###autoload +(defun gnus-draft-reminder () + "Reminder user if there are unsent drafts." + (interactive) + (if (gnus-alive-p) + (let (active) + (catch 'continue + (dolist (group '("nndraft:drafts" "nndraft:queue")) + (setq active (gnus-activate-group group)) + (if (and active (>= (cdr active) (car active))) + (if (y-or-n-p "There are unsent drafts. Confirm to exit?") + (throw 'continue t) + (error "Stop!")))))))) + ;;; Utility functions (defcustom gnus-draft-decoding-function @@ -212,32 +236,42 @@ ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, ;;;!!!but for the time being, we'll just run this tiny function uncompiled. -(defun gnus-draft-setup-for-editing (narticle group) - (gnus-setup-message 'forward - (let ((article narticle)) - (message-mail) - (erase-buffer) - (if (not (gnus-request-restore-buffer article group)) - (error "Couldn't restore the article") - (funcall gnus-draft-decoding-function) - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (forward-line 1) - (message-set-auto-save-file-name))))) - -(defvar gnus-draft-send-draft-buffer " *send draft*") -(defun gnus-draft-setup-for-sending (narticle group) - (let ((article narticle)) - (if (not (get-buffer gnus-draft-send-draft-buffer)) - (get-buffer-create gnus-draft-send-draft-buffer)) - (set-buffer gnus-draft-send-draft-buffer) - (erase-buffer) - (if (not (gnus-request-restore-buffer article group)) - (error "Couldn't restore the article") - ))) +(defun gnus-draft-setup (narticle group &optional restore) + (let (ga) + (gnus-setup-message 'forward + (let ((article narticle)) + (message-mail) + (erase-buffer) + (if (not (gnus-request-restore-buffer article group)) + (error "Couldn't restore the article") + (when (and restore + (equal group "nndraft:queue")) + (funcall gnus-draft-decoding-function)) + ;; Insert the separator. + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (insert mail-header-separator) + (forward-line 1) + (setq ga (message-fetch-field gnus-draft-meta-information-header)) + (message-set-auto-save-file-name)))) + (gnus-backlog-remove-article group narticle) + (when (and ga + (ignore-errors (setq ga (car (read-from-string ga))))) + (setq gnus-newsgroup-name + (if (equal (car ga) "") nil (car ga))) + (gnus-configure-posting-styles) + (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) + (setq message-post-method + `(lambda (arg) + (gnus-post-method arg ,(car ga)))) + (unless (equal (cadr ga) "") + (message-add-action + `(progn + (gnus-add-mark ,(car ga) 'replied ,(cadr ga)) + (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga)) + 'add '(reply))))) + 'send))))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." diff --git a/lisp/gnus-dup.el b/lisp/gnus-dup.el index e148f45..a2b5544 100644 --- a/lisp/gnus-dup.el +++ b/lisp/gnus-dup.el @@ -113,7 +113,7 @@ seen in the same session." (gnus-dup-open)) (setq gnus-dup-list-dirty t) ; mark list for saving (let ((data gnus-newsgroup-data) - datum msgid) + datum msgid) ;; Enter the Message-IDs of all read articles into the list ;; and hash table. (while (setq datum (pop data)) @@ -121,11 +121,11 @@ seen in the same session." (> (gnus-data-number datum) 0) (not (memq (gnus-data-number datum) gnus-newsgroup-unreads)) (not (= (gnus-data-mark datum) gnus-canceled-mark)) - (setq msgid (mail-header-id (gnus-data-header datum))) - (not (nnheader-fake-message-id-p msgid)) - (not (intern-soft msgid gnus-dup-hashtb))) + (setq msgid (mail-header-id (gnus-data-header datum))) + (not (nnheader-fake-message-id-p msgid)) + (not (intern-soft msgid gnus-dup-hashtb))) (push msgid gnus-dup-list) - (intern msgid gnus-dup-hashtb)))) + (intern msgid gnus-dup-hashtb)))) ;; Chop off excess Message-IDs from the list. (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) (when end diff --git a/lisp/gnus-eform.el b/lisp/gnus-eform.el index 9fe7242..042f8c3 100644 --- a/lisp/gnus-eform.el +++ b/lisp/gnus-eform.el @@ -1,5 +1,5 @@ ;;; gnus-eform.el --- a mode for editing forms for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -114,7 +114,9 @@ of the buffer." "Update changes and kill the current buffer." (interactive) (goto-char (point-min)) - (let ((form (read (current-buffer))) + (let ((form (condition-case nil + (read (current-buffer)) + (end-of-file nil))) (func gnus-edit-form-done-function)) (gnus-edit-form-exit) (funcall func form))) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 3a2fedc..aa535b4 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,5 +1,5 @@ ;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -27,7 +27,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'ring)) ;;; Function aliases later to be redefined for XEmacs usage. @@ -46,9 +48,10 @@ (autoload 'gnus-xmas-redefine "gnus-xmas") (autoload 'appt-select-lowest-window "appt")) -(if (featurep 'xemacs) - (autoload 'gnus-smiley-display "smiley") - (autoload 'gnus-smiley-display "smiley-ems")) ; override XEmacs version +(if (or (featurep 'xemacs) + (>= emacs-major-version 21)) + (autoload 'smiley-region "smiley") + (autoload 'smiley-region "smiley-mule")) (defun gnus-kill-all-overlays () "Delete all overlays in the current buffer." @@ -61,22 +64,17 @@ ;;; Mule functions. (eval-and-compile + (defalias 'gnus-char-width + (if (fboundp 'char-width) + 'char-width + (lambda (ch) 1)))) ;; A simple hack. + +(eval-and-compile (if (featurep 'xemacs) (gnus-xmas-define) (defvar gnus-mouse-face-prop 'mouse-face "Property used for highlighting mouse regions."))) -(eval-and-compile - (let ((case-fold-search t)) - (cond - ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32" - (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) (defvar gnus-tmp-score-char) @@ -86,6 +84,7 @@ (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 @@ -97,18 +96,18 @@ ;; [Note] Now there are three kinds of mule implementations, ;; original MULE, XEmacs/mule and Emacs 20+ including - ;; MULE features. Unfortunately these API are different. In - ;; particular, Emacs (including original MULE) and XEmacs are + ;; MULE features. Unfortunately these APIs are different. In + ;; particular, Emacs (including original Mule) and XEmacs are ;; 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 + ;; (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. + ;; (featurep 'mule) is t when other mule variants are running. ;; It is possible to detect XEmacs/mule by (featurep 'mule) and - ;; checking `emacs-version'. In this case, the implementation for + ;; (featurep 'xemacs). In this case, the implementation for ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. (defvar gnus-summary-display-table nil @@ -162,6 +161,10 @@ (boundp 'mark-active) mark-active)) +(defun gnus-mark-active-p () + "Non-nil means the mark and region are currently active in this buffer." + mark-active) ; aliased to region-exists-p in XEmacs. + (if (fboundp 'add-minor-mode) (defalias 'gnus-add-minor-mode 'add-minor-mode) (defun gnus-add-minor-mode (mode name map &rest rest) @@ -184,11 +187,13 @@ (when (and dir (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)))))) + (let ((coding-system-for-read 'raw-text) + default-enable-multibyte-characters) + (with-temp-buffer + (insert-file-contents-as-binary file) + (goto-char (point-min)) + (ignore-errors + (setq pixmap (read (current-buffer))))))) (when pixmap (make-face 'gnus-splash) (setq height (/ (car pixmap) (frame-char-height)) @@ -207,82 +212,32 @@ (goto-char (point-min)) (sit-for 0)))))) -(defvar gnus-article-xface-ring-internal nil - "Cache for face data.") - -;; Worth customizing? -(defvar gnus-article-xface-ring-size 6 - "Length of the ring used for `gnus-article-xface-ring-internal'.") - -(defvar gnus-article-compface-xbm - (condition-case () - (eq 0 (string-match "#define" - (shell-command-to-string "uncompface -X"))) - (error nil)) - "Non-nil means the compface program supports the -X option. -That produces XBM output.") - -(defun gnus-article-display-xface (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)))))) +;;; Image functions. + +(defun gnus-image-type-available-p (type) + (and (fboundp 'image-type-available-p) + (image-type-available-p type))) + +(defun gnus-create-image (file &optional type data-p &rest props) + (let ((face (plist-get props :face))) + (when face + (setq props (plist-put props :foreground (face-foreground face))) + (setq props (plist-put props :background (face-background face)))) + (apply 'create-image file type data-p props))) + +(defun gnus-put-image (glyph &optional string) + (insert-image glyph (or string " ")) + (unless string + (put-text-property (1- (point)) (point) + 'gnus-image-text-deletable t)) + glyph) + +(defun gnus-remove-image (image) + (dolist (position (message-text-with-property 'display)) + (when (equal (get-text-property position 'display) image) + (put-text-property position (1+ position) 'display nil) + (when (get-text-property position 'gnus-image-text-deletable) + (delete-region position (1+ position)))))) (defun-maybe assoc-ignore-case (key alist) "Like `assoc', but assumes KEY is a string and ignores case when comparing." @@ -329,8 +284,4 @@ for XEmacs." (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 f3d08b3..7a989e6 100644 --- a/lisp/gnus-gl.el +++ b/lisp/gnus-gl.el @@ -1,6 +1,6 @@ ;;; gnus-gl.el --- an interface to GroupLens for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Brad Miller @@ -131,7 +131,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar gnus-summary-grouplens-line-format - "%U\%R\%z%l%I\%(%[%4L: %-20,20n%]%) %s\n" + "%U\%R\%z%l%I\%(%[%4L: %-23,23n%]%) %s\n" "*The line format spec in summary GroupLens mode buffers.") (defvar grouplens-pseudonym "" @@ -343,7 +343,7 @@ If this times out we give up and assume that something has died..." ) (defun bbb-build-mid-scores-alist (groupname) "this function can be called as part of the function to return the list of score files to use. -See the gnus variable gnus-score-find-score-files-function. +See the gnus variable `gnus-score-find-score-files-function'. *Note:* If you want to use grouplens scores along with calculated scores, you should see the offset and scale variables. At this point, I don't @@ -511,11 +511,11 @@ recommend using both scores and grouplens predictions together." ;; Return an empty string "" (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (pred (or (nth 0 hashent) 0)) - (low (nth 1 hashent)) - (high (nth 2 hashent))) + (mid (mail-header-id header)) + (hashent (gnus-gethash mid grouplens-current-hashtable)) + (pred (or (nth 0 hashent) 0)) + (low (nth 1 hashent)) + (high (nth 2 hashent))) ;; Init rate-string (aset rate-string 0 ?|) (aset rate-string 11 ?|) @@ -633,10 +633,10 @@ recommend using both scores and grouplens predictions together." (defun bbb-build-rate-command (rate-alist) (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n" - (mapconcat '(lambda (this) ; form (mid . (score . time)) - (concat (car this) - " :rating=" (cadr this) ".00" - " :time=" (cddr this))) + (mapconcat (lambda (this) ; form (mid . (score . time)) + (concat (car this) + " :rating=" (cadr this) ".00" + " :time=" (cddr this))) rate-alist "\r\n") "\r\n.\r\n")) @@ -811,9 +811,9 @@ If prefix argument ALL is non-nil, all articles are marked as read." (if (null arg) (not gnus-grouplens-mode) (> (prefix-numeric-value arg) 0))) (when gnus-grouplens-mode - (make-local-hook 'gnus-select-article-hook) + (gnus-make-local-hook 'gnus-select-article-hook) (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local) - (make-local-hook 'gnus-exit-group-hook) + (gnus-make-local-hook 'gnus-exit-group-hook) (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) (make-local-variable 'gnus-score-find-score-files-function) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index bb81c1c..a3ca7cf 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,5 +1,5 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -26,7 +26,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (defvar tool-bar-map)) (require 'gnus) (require 'gnus-start) @@ -39,6 +41,8 @@ (require 'time-date) (require 'gnus-ems) +(eval-when-compile (require 'mm-url)) + (defcustom gnus-group-archive-directory "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives." @@ -118,24 +122,30 @@ This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', `gnus-group-sort-by-unread', `gnus-group-sort-by-level', -`gnus-group-sort-by-score', `gnus-group-sort-by-method', and -`gnus-group-sort-by-rank'. +`gnus-group-sort-by-score', `gnus-group-sort-by-method', +`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'. This variable can also be a list of sorting functions. In that case, the most significant sort function should be the last function in the list." :group 'gnus-group-listing :link '(custom-manual "(gnus)Sorting Groups") - :type '(radio (function-item gnus-group-sort-by-alphabet) - (function-item gnus-group-sort-by-real-name) - (function-item gnus-group-sort-by-unread) - (function-item gnus-group-sort-by-level) - (function-item gnus-group-sort-by-score) - (function-item gnus-group-sort-by-method) - (function-item gnus-group-sort-by-rank) - (function :tag "other" nil))) - -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" + :type '(repeat :value-to-internal (lambda (widget value) + (if (listp value) value (list value))) + :match (lambda (widget value) + (or (symbolp value) + (widget-editable-list-match widget value))) + (choice (function-item gnus-group-sort-by-alphabet) + (function-item gnus-group-sort-by-real-name) + (function-item gnus-group-sort-by-unread) + (function-item gnus-group-sort-by-level) + (function-item gnus-group-sort-by-score) + (function-item gnus-group-sort-by-method) + (function-item gnus-group-sort-by-server) + (function-item gnus-group-sort-by-rank) + (function :tag "other" nil)))) + +(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -148,14 +158,18 @@ with some simple extensions. %i Number of ticked and dormant (integer) %T Number of ticked articles (integer) %R Number of read articles (integer) +%U Number of unseen articles (integer) %t Estimated total number of articles (integer) %y Number of unread, unticked articles (integer) %G Group name (string) %g Qualified group name (string) +%c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'. +%C Group comment (string) %D Group description (string) %s Select method (string) %o Moderated group (char, \"m\") %p Process mark (char) +%B Whether a summary buffer for the group is open (char, \"*\") %O Moderated group (string, \"(m)\" or \"\") %P Topic indentation (string) %m Whether there is new(ish) mail in the group (char, \"%\") @@ -167,13 +181,10 @@ with some simple extensions. %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 - current header as argument. The function should return a string, which - will be inserted into the buffer just like information from any other - group specifier. - -Text between %( and %) will be highlighted with `gnus-mouse-face' when -the mouse point move inside the area. There can only be one such area. + where X is the letter following %u. The function will be passed a + single dummy parameter as argument.. The function should return a + string, which will be inserted into the buffer just like information + from any other group specifier. Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification @@ -185,7 +196,11 @@ If you use %o or %O, reading the active file will be slower and quite a bit of extra memory will be used. %D will also worsen performance. Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into -effect." +effect. + +General format specifiers can also be used. +See Info node `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-group-visual :type 'string) @@ -200,11 +215,10 @@ with some simple extensions: :group 'gnus-group-visual :type 'string) -(defcustom gnus-group-mode-hook nil - "Hook for Gnus group mode." - :group 'gnus-group-various - :options '(gnus-topic-mode) - :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) + (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)) (defcustom gnus-group-menu-hook nil "Hook run after the creation of the group mode menu." @@ -290,52 +304,52 @@ variable." (sexp :tag "Method")))) (defcustom gnus-group-highlight - '(;; News. - ((and (= unread 0) (not mailp) (eq level 1)) . + '(;; Mail. + ((and mailp (= unread 0) (eq level 1)) . + gnus-group-mail-1-empty-face) + ((and mailp (eq level 1)) . + gnus-group-mail-1-face) + ((and mailp (= unread 0) (eq level 2)) . + gnus-group-mail-2-empty-face) + ((and mailp (eq level 2)) . + gnus-group-mail-2-face) + ((and mailp (= unread 0) (eq level 3)) . + gnus-group-mail-3-empty-face) + ((and mailp (eq level 3)) . + gnus-group-mail-3-face) + ((and mailp (= unread 0)) . + gnus-group-mail-low-empty-face) + ((and mailp) . + gnus-group-mail-low-face) + ;; News. + ((and (= unread 0) (eq level 1)) . gnus-group-news-1-empty-face) - ((and (not mailp) (eq level 1)) . + ((and (eq level 1)) . gnus-group-news-1-face) - ((and (= unread 0) (not mailp) (eq level 2)) . + ((and (= unread 0) (eq level 2)) . gnus-group-news-2-empty-face) - ((and (not mailp) (eq level 2)) . + ((and (eq level 2)) . gnus-group-news-2-face) - ((and (= unread 0) (not mailp) (eq level 3)) . + ((and (= unread 0) (eq level 3)) . gnus-group-news-3-empty-face) - ((and (not mailp) (eq level 3)) . + ((and (eq level 3)) . gnus-group-news-3-face) - ((and (= unread 0) (not mailp) (eq level 4)) . + ((and (= unread 0) (eq level 4)) . gnus-group-news-4-empty-face) - ((and (not mailp) (eq level 4)) . + ((and (eq level 4)) . gnus-group-news-4-face) - ((and (= unread 0) (not mailp) (eq level 5)) . + ((and (= unread 0) (eq level 5)) . gnus-group-news-5-empty-face) - ((and (not mailp) (eq level 5)) . + ((and (eq level 5)) . gnus-group-news-5-face) - ((and (= unread 0) (not mailp) (eq level 6)) . + ((and (= unread 0) (eq level 6)) . gnus-group-news-6-empty-face) - ((and (not mailp) (eq level 6)) . + ((and (eq level 6)) . gnus-group-news-6-face) - ((and (= unread 0) (not mailp)) . + ((and (= unread 0)) . gnus-group-news-low-empty-face) - ((and (not mailp)) . - gnus-group-news-low-face) - ;; Mail. - ((and (= unread 0) (eq level 1)) . - gnus-group-mail-1-empty-face) - ((eq level 1) . - gnus-group-mail-1-face) - ((and (= unread 0) (eq level 2)) . - gnus-group-mail-2-empty-face) - ((eq level 2) . - gnus-group-mail-2-face) - ((and (= unread 0) (eq level 3)) . - gnus-group-mail-3-empty-face) - ((eq level 3) . - gnus-group-mail-3-face) - ((= unread 0) . - gnus-group-mail-low-empty-face) (t . - gnus-group-mail-low-face)) + gnus-group-news-low-face)) "*Controls the highlighting of group buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a a @@ -377,7 +391,7 @@ 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 +`gnus-group-glyph-directory' or by designating absolute name of the file. It is also possible to change and add form fields, but currently that @@ -397,20 +411,22 @@ ticked: The number of ticked articles." :type '(repeat (cons (sexp :tag "Form") file))) (defcustom gnus-group-name-charset-method-alist nil - "*Alist of method and the charset for group names. + "Alist of method and the charset for group names. For example: - (((nntp \"news.com.cn\") . cn-gb-2312)) -" + (((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. +(defcustom gnus-group-name-charset-group-alist + (if (mm-coding-system-p 'utf-8) + '(("[^\000-\177]" . utf-8)) + nil) + "Alist of group regexp and the charset for group names. For example: - ((\"\\.com\\.cn:\" . cn-gb-2312)) -" + ((\"\\.com\\.cn:\" . cn-gb-2312))" :group 'gnus-charset :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) @@ -421,10 +437,17 @@ 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))) + (const :tag "Empty" nil))) + +(defvar gnus-group-listing-limit 1000 + "*A limit of the number of groups when listing. +If the number of groups is larger than the limit, list them in a +simple manner.") ;;; Internal variables +(defvar gnus-group-is-exiting-p nil) +(defvar gnus-group-is-exiting-without-update-p nil) (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat "Function for sorting the group buffer.") @@ -451,6 +474,7 @@ in the minibuffer prompt." (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) (t number)) ?s) (?R gnus-tmp-number-of-read ?s) + (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d) (?t gnus-tmp-number-total ?d) (?y gnus-tmp-number-of-unread ?s) (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) @@ -460,6 +484,7 @@ in the minibuffer prompt." (?g gnus-tmp-group ?s) (?G gnus-tmp-qualified-group ?s) (?c (gnus-short-group-name gnus-tmp-group) ?s) + (?C gnus-tmp-comment ?s) (?D gnus-tmp-newsgroup-description ?s) (?o gnus-tmp-moderated ?c) (?O gnus-tmp-moderated-string ?s) @@ -468,13 +493,14 @@ in the minibuffer prompt." (?n gnus-tmp-news-method ?s) (?P gnus-group-indentation ?s) (?E gnus-tmp-group-icon ?s) + (?B gnus-tmp-summary-live ?c) (?l gnus-tmp-grouplens ?s) (?z gnus-tmp-news-method-string ?s) (?m (gnus-group-new-mail gnus-tmp-group) ?c) - (?w (if (gnus-news-group-p gnus-tmp-group) + (?w (if (gnus-news-group-p gnus-tmp-group) "" - (int-to-string - (length + (int-to-string + (length (nnmail-new-mail-numbers (gnus-group-real-name gnus-tmp-group)) ))) ?s) @@ -500,6 +526,9 @@ in the minibuffer prompt." (defvar gnus-group-icon-cache nil) +(defvar gnus-group-listed-groups nil) +(defvar gnus-group-list-option nil) + ;;; ;;; Gnus group mode ;;; @@ -534,6 +563,7 @@ in the minibuffer prompt." "l" gnus-group-list-groups "L" gnus-group-list-all-groups "m" gnus-group-mail + "i" gnus-group-news "g" gnus-group-get-new-news "\M-g" gnus-group-get-new-news-this-group "R" gnus-group-restart @@ -568,6 +598,7 @@ in the minibuffer prompt." "<" beginning-of-buffer ">" end-of-buffer "\C-c\C-b" gnus-bug + "\C-c\C-n" gnus-namazu-search "\C-c\C-s" gnus-group-sort-groups "t" gnus-topic-mode "\C-c\M-g" gnus-activate-all-groups @@ -583,6 +614,10 @@ in the minibuffer prompt." "r" gnus-group-mark-regexp "U" gnus-group-unmark-all-groups) + (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) + "u" gnus-sieve-update + "g" gnus-sieve-generate) + (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) "d" gnus-group-make-directory-group "h" gnus-group-make-help-group @@ -591,6 +626,7 @@ in the minibuffer prompt." "k" gnus-group-make-kiboze-group "l" gnus-group-nnimap-edit-acl "m" gnus-group-make-group + "n" gnus-group-make-shimbun-group "E" gnus-group-edit-group "e" gnus-group-edit-group-method "p" gnus-group-edit-group-parameters @@ -598,8 +634,10 @@ in the minibuffer prompt." "V" gnus-group-make-empty-virtual "D" gnus-group-enter-directory "f" gnus-group-make-doc-group + "G" gnus-group-make-nnir-group "w" gnus-group-make-web-group "r" gnus-group-rename-group + "R" gnus-group-make-rss-group "c" gnus-group-customize "x" gnus-group-nnimap-expunge "\177" gnus-group-delete-group @@ -619,7 +657,8 @@ in the minibuffer prompt." "l" gnus-group-sort-groups-by-level "v" gnus-group-sort-groups-by-score "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method) + "m" gnus-group-sort-groups-by-method + "n" gnus-group-sort-groups-by-real-name) (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) "s" gnus-group-sort-selected-groups @@ -628,7 +667,8 @@ in the minibuffer prompt." "l" gnus-group-sort-selected-groups-by-level "v" gnus-group-sort-selected-groups-by-score "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method) + "m" gnus-group-sort-selected-groups-by-method + "n" gnus-group-sort-selected-groups-by-real-name) (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) "k" gnus-group-list-killed @@ -644,10 +684,48 @@ in the minibuffer prompt." "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) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) + "c" gnus-group-fetch-charter + "C" gnus-group-fetch-control "d" gnus-group-describe-group "f" gnus-group-fetch-faq "v" gnus-version) @@ -662,42 +740,88 @@ in the minibuffer prompt." "\C-k" gnus-group-kill-level "z" gnus-group-kill-all-zombies)) +(defun gnus-topic-mode-p () + "Return non-nil in `gnus-topic-mode'." + (and (boundp 'gnus-topic-mode) + (symbol-value 'gnus-topic-mode))) + (defun gnus-group-make-menu-bar () (gnus-turn-off-edit-menu 'group) (unless (boundp 'gnus-group-reading-menu) (easy-menu-define gnus-group-reading-menu gnus-group-mode-map "" - '("Group" - ["Read" gnus-group-read-group (gnus-group-group-name)] - ["Select" gnus-group-select-group (gnus-group-group-name)] + `("Group" + ["Read" gnus-group-read-group + :included (not (gnus-topic-mode-p)) + :active (gnus-group-group-name)] + ["Read " gnus-topic-read-group + :included (gnus-topic-mode-p)] + ["Select" gnus-group-select-group + :included (not (gnus-topic-mode-p)) + :active (gnus-group-group-name)] + ["Select " gnus-topic-select-group + :included (gnus-topic-mode-p)] ["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 + :included (not (gnus-topic-mode-p)) + :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Mark unread articles in the current group as read"))] + ["Catch up " gnus-topic-catchup-articles + :included (gnus-topic-mode-p) + ,@(if (featurep 'xemacs) nil + '(:help "Mark unread articles in the current group or topic 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)] + :included (not (gnus-topic-mode-p)) + :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Check for new messages in current group"))] + ["Check for new articles " gnus-topic-get-new-news-this-topic + :included (gnus-topic-mode-p) + ,@(if (featurep 'xemacs) nil + '(:help "Check for new messages in current group or topic"))] ["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)] + ["Fetch charter" gnus-group-fetch-charter + :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display the charter of the current group"))] + ["Fetch control message" gnus-group-fetch-control + :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display the archived control message for the current group"))] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) - ["Expire articles" gnus-group-expire-articles - (or (and (gnus-group-group-name) - (gnus-check-backend-function - 'request-expire-articles - (gnus-group-group-name))) gnus-group-marked)] - ["Set group level" gnus-group-set-current-level + ["Expire articles" gnus-group-expire-articles + :included (not (gnus-topic-mode-p)) + :active (or (and (gnus-group-group-name) + (gnus-check-backend-function + 'request-expire-articles + (gnus-group-group-name))) gnus-group-marked)] + ["Expire articles " gnus-topic-expire-articles + :included (gnus-topic-mode-p)] + ["Set group level..." gnus-group-set-current-level (gnus-group-group-name)] ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] ["Customize" gnus-group-customize (gnus-group-group-name)] ("Edit" ["Parameters" gnus-group-edit-group-parameters - (gnus-group-group-name)] + :included (not (gnus-topic-mode-p)) + :active (gnus-group-group-name)] + ["Parameters " gnus-topic-edit-parameters + :included (gnus-topic-mode-p)] ["Select method" gnus-group-edit-group-method (gnus-group-group-name)] ["Info" gnus-group-edit-group (gnus-group-group-name)] @@ -728,22 +852,25 @@ in the minibuffer prompt." ["Sort by score" gnus-group-sort-groups-by-score t] ["Sort by level" gnus-group-sort-groups-by-level t] ["Sort by unread" gnus-group-sort-groups-by-unread t] - ["Sort by name" gnus-group-sort-groups-by-alphabet t]) + ["Sort by name" gnus-group-sort-groups-by-alphabet t] + ["Sort by real name" gnus-group-sort-groups-by-real-name t]) ("Sort process/prefixed" ["Default sort" gnus-group-sort-selected-groups - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] + (not (gnus-topic-mode-p))] ["Sort by method" gnus-group-sort-selected-groups-by-method - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] + (not (gnus-topic-mode-p))] ["Sort by rank" gnus-group-sort-selected-groups-by-rank - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] + (not (gnus-topic-mode-p))] ["Sort by score" gnus-group-sort-selected-groups-by-score - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] + (not (gnus-topic-mode-p))] ["Sort by level" gnus-group-sort-selected-groups-by-level - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] + (not (gnus-topic-mode-p))] ["Sort by unread" gnus-group-sort-selected-groups-by-unread - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] + (not (gnus-topic-mode-p))] ["Sort by name" gnus-group-sort-selected-groups-by-alphabet - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) + (not (gnus-topic-mode-p))] + ["Sort by real name" gnus-group-sort-selected-groups-by-real-name + (not (gnus-topic-mode-p))]) ("Mark" ["Mark group" gnus-group-mark-group (and (gnus-group-group-name) @@ -753,27 +880,29 @@ in the minibuffer prompt." (memq (gnus-group-group-name) gnus-group-marked))] ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] ["Mark regexp..." gnus-group-mark-regexp t] - ["Mark region" gnus-group-mark-region t] + ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)] ["Mark buffer" gnus-group-mark-buffer t] ["Execute command" gnus-group-universal-argument (or gnus-group-marked (gnus-group-group-name))]) ("Subscribe" - ["Subscribe to a group" gnus-group-unsubscribe-group t] - ["Kill all newsgroups in region" gnus-group-kill-region t] + ["Subscribe to a group..." gnus-group-unsubscribe-group t] + ["Kill all newsgroups in region" gnus-group-kill-region + :active (gnus-mark-active-p)] ["Kill all zombie groups" gnus-group-kill-all-zombies gnus-zombie-list] ["Kill all groups on level..." gnus-group-kill-level t]) ("Foreign groups" - ["Make a foreign group" gnus-group-make-group t] - ["Add a directory group" gnus-group-make-directory-group t] + ["Make a foreign group..." gnus-group-make-group t] + ["Make a shimbun group..." gnus-group-make-shimbun-group t] + ["Add a directory group..." gnus-group-make-directory-group t] ["Add the help group" gnus-group-make-help-group t] ["Add the archive group" gnus-group-make-archive-group t] - ["Make a doc group" gnus-group-make-doc-group t] - ["Make a web group" gnus-group-make-web-group t] - ["Make a kiboze group" gnus-group-make-kiboze-group t] - ["Make a virtual group" gnus-group-make-empty-virtual t] - ["Add a group to a virtual" gnus-group-add-to-virtual t] - ["Rename group" gnus-group-rename-group + ["Make a doc group..." gnus-group-make-doc-group t] + ["Make a web group..." gnus-group-make-web-group t] + ["Make a kiboze group..." gnus-group-make-kiboze-group t] + ["Make a virtual group..." gnus-group-make-empty-virtual t] + ["Add a group to a virtual..." gnus-group-add-to-virtual t] + ["Rename group..." gnus-group-rename-group (gnus-check-backend-function 'request-rename-group (gnus-group-group-name))] ["Delete group" gnus-group-delete-group @@ -787,9 +916,12 @@ in the minibuffer prompt." ["Next unread same level" gnus-group-next-unread-group-same-level t] ["Previous unread same level" gnus-group-prev-unread-group-same-level t] - ["Jump to group" gnus-group-jump-to-group t] + ["Jump to group..." gnus-group-jump-to-group t] ["First unread group" gnus-group-first-unread-group t] ["Best unread group" gnus-group-best-unread-group t]) + ("Sieve" + ["Generate" gnus-sieve-generate t] + ["Generate and update" gnus-sieve-update t]) ["Delete bogus groups" gnus-group-check-bogus-groups t] ["Find new newsgroups" gnus-group-find-new-groups t] ["Transpose" gnus-group-transpose-groups @@ -798,7 +930,7 @@ in the minibuffer prompt." (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" - '("Misc" + `("Gnus" ("SOUP" ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] ["Send replies" gnus-soup-send-replies @@ -807,12 +939,20 @@ in the minibuffer prompt." ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] ["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] + ["Send a message (mail or news)" gnus-group-post-news t] + ["Create a local message" gnus-group-news t] + ["Check for new news" gnus-group-get-new-news + ,@(if (featurep 'xemacs) '(t) + '(:help "Get newly arrived articles")) + ] + ["Send queued messages" gnus-delay-send-queue + ,@(if (featurep 'xemacs) '(t) + '(:help "Send all messages that are scheduled to be sent now")) + ] ["Activate all groups" gnus-activate-all-groups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] - ["Browse foreign server" gnus-group-browse-foreign-server t] + ["Browse foreign server..." gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ["Expire all expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] @@ -824,11 +964,44 @@ in the minibuffer prompt." ["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) '(t) + '(: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 + (condition-case nil (require 'tool-bar) (error nil)) + (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)) + (load-path (mm-image-load-path))) + (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. @@ -847,9 +1020,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") @@ -871,6 +1045,7 @@ The following commands are available: (defun gnus-update-group-mark-positions () (save-excursion (let ((gnus-process-mark ?\200) + (gnus-group-update-hook nil) (gnus-group-marked '("dummy.group")) (gnus-active-hashtb (make-vector 10 0)) (topic "")) @@ -912,13 +1087,13 @@ The following commands are available: (when gnus-carpal (gnus-carpal-setup-buffer 'group)))) -(defsubst gnus-group-name-charset (method group) +(defun 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 + (if item (cdr item) (while (setq item (pop alist)) (if (string-match (car item) group) @@ -926,7 +1101,8 @@ The following commands are available: result (cdr item)))) result))) -(defsubst gnus-group-name-decode (string charset) +(defun gnus-group-name-decode (string charset) + ;; Fixme: Don't decode in unibyte mode. (if (and string charset (featurep 'mule)) (decode-coding-string string charset) string)) @@ -935,6 +1111,35 @@ The following commands are available: (let ((charset (gnus-group-name-charset nil string))) (gnus-group-name-decode string charset))) +(defun gnus-group-name-encode (string charset) + (if (and string charset (featurep 'mule)) + (encode-coding-string string charset) + string)) + +(defun gnus-group-encoded-name (string) + (let ((charset (gnus-group-name-charset nil string))) + (gnus-group-name-encode string charset))) + +(defun gnus-group-completing-read-group-name + (prompt table &optional predicate require-match initial-contents history) + (if (vectorp table) + (mapatoms + (lambda (group) + (push (list (gnus-group-decoded-name (symbol-name group))) table)) + (prog1 + table + (setq table nil))) + (dolist (entry (prog1 + table + (setq table nil))) + (push (list (gnus-group-decoded-name (car entry))) table))) + (gnus-group-encoded-name + (completing-read + prompt table predicate + require-match + initial-contents + history))) + (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. @@ -1008,18 +1213,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) @@ -1027,41 +1249,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 unchecked - (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)))) + (when not-in-list + (setq not-in-list (delete group not-in-list))) + (when (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)) + (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 not-in-list + (dolist (group gnus-zombie-list) + (setq not-in-list (delete group not-in-list)))) + (when (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)) @@ -1070,35 +1311,38 @@ 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. + (if (> (length groups) gnus-group-listing-limit) (while groups (setq group (pop groups)) - (when (string-match regexp group) + (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)) + (gnus-group-decoded-name 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 (setq group (pop groups)) - (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)))))) + (when (gnus-group-prepare-logic + group + (or (not regexp) + (and (stringp regexp) (string-match regexp group)) + (and (functionp regexp) (funcall regexp group)))) + (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." @@ -1141,14 +1385,26 @@ 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-number-of-unseen-articles-in-group (group) + (let* ((info (nth 2 (gnus-group-entry group))) + (marked (gnus-info-marks info)) + (seen (cdr (assq 'seen marked))) + (active (gnus-active group))) + (if (not active) + 0 + (length (gnus-uncompress-range + (gnus-range-difference + (gnus-range-difference (list active) (gnus-info-read info)) + seen)))))) (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-method - (gnus-server-get-method gnus-tmp-group 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)) @@ -1168,13 +1424,16 @@ 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-tmp-qualified-group (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) group-name-charset)) + (gnus-tmp-comment + (or (gnus-group-get-parameter gnus-tmp-group 'comment t) + gnus-tmp-group)) (gnus-tmp-newsgroup-description (if gnus-description-hashtb (or (gnus-group-name-decode - (gnus-gethash gnus-tmp-group gnus-description-hashtb) + (gnus-gethash gnus-tmp-group gnus-description-hashtb) group-name-charset) "") "")) (gnus-tmp-moderated @@ -1195,6 +1454,11 @@ If REGEXP, only list groups matching REGEXP." (zerop number) (cdr (assq 'tick gnus-tmp-marked))) ?* ? )) + (gnus-tmp-summary-live + (if (and (not gnus-group-is-exiting-p) + (gnus-buffer-live-p (gnus-summary-buffer-name + gnus-tmp-group))) + ?* ? )) (gnus-tmp-process-marked (if (member gnus-tmp-group gnus-group-marked) gnus-process-mark ? )) @@ -1209,7 +1473,9 @@ If REGEXP, only list groups matching REGEXP." (point) (prog1 (1+ (point)) ;; Insert the text. - (eval gnus-group-line-format-spec)) + (let ((gnus-tmp-group (gnus-group-name-decode + gnus-tmp-group group-name-charset))) + (eval gnus-group-line-format-spec))) `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) gnus-unread ,(if (numberp number) (string-to-int gnus-tmp-number-of-unread) @@ -1228,7 +1494,7 @@ If REGEXP, only list groups matching REGEXP." "Highlight the current line according to `gnus-group-highlight'." (let* ((list gnus-group-highlight) (p (point)) - (end (progn (end-of-line) (point))) + (end (gnus-point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point))) (group (gnus-group-group-name)) @@ -1239,9 +1505,13 @@ If REGEXP, only list groups matching REGEXP." (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))) + (mailp (apply 'append + (mapcar + (lambda (x) + (memq x (assoc (symbol-name + (car (or method gnus-select-method))) + gnus-valid-select-methods))) + '(mail post-mail)))) (level (or (gnus-info-level info) gnus-level-killed)) (score (or (gnus-info-score info) 0)) (ticked (gnus-range-length (cdr (assq 'tick marked)))) @@ -1562,7 +1832,7 @@ Take into consideration N (the prefix) and the list of marked groups." (setq n (1- n)) (gnus-group-next-group way))) (nreverse groups))) - ((gnus-region-active-p) + ((and (gnus-region-active-p) (mark)) ;; Work on the region between point and mark. (let ((max (max (point) (mark))) groups) @@ -1647,9 +1917,12 @@ group." (defun gnus-group-select-group (&optional all) "Select this newsgroup. No article is selected automatically. +If the group is opened, just switch the summary buffer. If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles." (interactive "P") + (when (and (eobp) (not (gnus-group-group-name))) + (forward-line -1)) (gnus-group-read-group all t)) (defun gnus-group-quick-select-group (&optional all) @@ -1692,13 +1965,14 @@ be permanent." (gnus-group-prefixed-name group method) method))) ;;;###autoload -(defun gnus-fetch-group (group) +(defun gnus-fetch-group (group &optional articles) "Start Gnus if necessary and enter GROUP. Returns whether the fetching was successful or not." - (interactive (list (completing-read "Group name: " gnus-active-hashtb))) + (interactive (list (gnus-group-completing-read-group-name + "Group name: " gnus-active-hashtb))) (unless (get-buffer gnus-group-buffer) (gnus-no-server)) - (gnus-group-read-group nil nil group)) + (gnus-group-read-group articles nil group)) ;;;###autoload (defun gnus-fetch-group-other-frame (group) @@ -1715,17 +1989,38 @@ Returns whether the fetching was successful or not." (defvar gnus-ephemeral-group-server 0) +(defcustom gnus-large-ephemeral-newsgroup 200 + "The number of articles which indicates a large ephemeral newsgroup. +Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups. + +If the number of articles in a newsgroup is greater than this value, +confirmation is required for selecting the newsgroup. If it is nil, no +confirmation is required." + :group 'gnus-group-select + :type '(choice (const :tag "No limit" nil) + integer)) + +(defcustom gnus-fetch-old-ephemeral-headers nil + "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups." + :group 'gnus-thread + :type '(choice (const :tag "off" nil) + (const some) + number + (sexp :menu-tag "other" t))) + ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only - select-articles) + select-articles + parameters) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. If QUIT-CONFIG, use that window configuration when exiting from the ephemeral group. If REQUEST-ONLY, don't actually read the group; just request it. If SELECT-ARTICLES, only select those articles. +If PARAMETERS, use those as the group parameters. Return the name of the group if selection was successful." ;; Transform the select method into a unique server. @@ -1736,15 +2031,19 @@ Return the name of the group if selection was successful." (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method))) (let ((group (if (gnus-group-foreign-p group) group - (gnus-group-prefixed-name group method)))) + (gnus-group-prefixed-name (gnus-group-real-name group) + method)))) (gnus-sethash group `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method - ((quit-config . - ,(if quit-config quit-config - (cons gnus-summary-buffer - gnus-current-window-configuration)))))) + ,(cons + (if quit-config + (cons 'quit-config quit-config) + (cons 'quit-config + (cons gnus-summary-buffer + gnus-current-window-configuration))) + parameters))) gnus-newsrc-hashtb) (push method gnus-ephemeral-servers) (set-buffer gnus-group-buffer) @@ -1758,7 +2057,10 @@ Return the name of the group if selection was successful." (if request-only group (condition-case () - (when (gnus-group-read-group t t group select-articles) + (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup) + (gnus-fetch-old-headers + gnus-fetch-old-ephemeral-headers)) + (gnus-group-read-group t t group select-articles)) group) ;;(error nil) (quit @@ -1768,7 +2070,7 @@ Return the name of the group if selection was successful." (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." (interactive - (list (completing-read + (list (gnus-group-completing-read-group-name "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) gnus-group-jump-to-group-prompt @@ -1820,11 +2122,11 @@ If TEST-MARKED, the line must be marked." (test-marked (goto-char (point-min)) (let (found) - (while (and (not found) + (while (and (not found) (gnus-goto-char (text-property-any (point) (point-max) - 'gnus-group + 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (if (gnus-group-mark-line-p) (setq found t) @@ -1917,7 +2219,7 @@ If EXCLUDE-GROUP, do not go to that group." (forward-line 1)) (when best-point (goto-char best-point)) - (gnus-summary-position-point) + (gnus-group-position-point) (and best-point (gnus-group-group-name)))) (defun gnus-group-first-unread-group () @@ -1988,7 +2290,9 @@ ADDRESS." (require backend)) (gnus-check-server meth) (when (gnus-check-backend-function 'request-create-group nname) - (gnus-request-create-group nname nil args)) + (unless (gnus-request-create-group nname nil args) + (error "Could not create group on server: %s" + (nnheader-get-report backend)))) t)) (defun gnus-group-delete-groups (&optional arg) @@ -2003,6 +2307,8 @@ ADDRESS." (lambda (group) (gnus-group-delete-group group nil t)))))) +(eval-when-compile (defvar gnus-cache-active-altered)) + (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 @@ -2013,7 +2319,7 @@ doing the deletion." (list (gnus-group-group-name) current-prefix-arg)) (unless group - (error "No group to rename")) + (error "No group to delete")) (unless (gnus-check-backend-function 'request-delete-group group) (error "This backend does not support group deletion")) (prog1 @@ -2030,6 +2336,10 @@ doing the deletion." (gnus-group-goto-group group) (gnus-group-kill-group 1 t) (gnus-sethash group nil gnus-active-hashtb) + (if (boundp 'gnus-cache-active-hashtb) + (when gnus-cache-active-hashtb + (gnus-sethash group nil gnus-cache-active-hashtb) + (setq gnus-cache-active-altered t))) t)) (gnus-group-position-point))) @@ -2112,7 +2422,17 @@ and NEW-NAME will be prompted for." (t "group info")) (gnus-group-decoded-name group)) `(lambda (form) - (gnus-group-edit-group-done ',part ,group form))))) + (gnus-group-edit-group-done ',part ,group form))) + (local-set-key + "\C-c\C-i" + (gnus-create-info-command + (cond + ((eq part 'method) + "(gnus)Select Methods") + ((eq part 'params) + "(gnus)Group Parameters") + (t + "(gnus)Group Info")))))) (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." @@ -2173,20 +2493,33 @@ and NEW-NAME will be prompted for." (setcar entry (eval (cadar entry))))) (gnus-group-make-group group method)) -(defun gnus-group-make-help-group () - "Create the Gnus documentation group." +(defun gnus-group-make-help-group (&optional noerror) + "Create the Gnus documentation group. +Optional argument NOERROR modifies the behavior of this function when the +group already exists: +- if not given, and error is signaled, +- if t, stay silent, +- if anything else, just print a message." (interactive) (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) (file (nnheader-find-etc-directory "gnus-tut.txt" t))) - (when (gnus-gethash name gnus-newsrc-hashtb) - (error "Documentation group already exists")) - (if (not file) - (gnus-message 1 "Couldn't find doc group") - (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc "gnus-help" - (list 'nndoc-address file) - (list 'nndoc-article-type 'mbox))))) + (if (gnus-gethash name gnus-newsrc-hashtb) + (cond ((eq noerror nil) + (error "Documentation group already exists")) + ((eq noerror t) + ;; stay silent + ) + (t + (gnus-message 1 "Documentation group already exists"))) + ;; else: + (if (not file) + (gnus-message 1 "Couldn't find doc group") + (gnus-group-make-group + (gnus-group-real-name name) + (list 'nndoc "gnus-help" + (list 'nndoc-address file) + (list 'nndoc-article-type 'mbox)))) + )) (gnus-group-position-point)) (defun gnus-group-make-doc-group (file type) @@ -2251,12 +2584,40 @@ If SOLID (the prefix), create a solid group." (nnweb-type ,(intern type)) (nnweb-ephemeral-p t)))) (if solid - (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search)) + (progn + (gnus-pull 'nnweb-ephemeral-p method) + (gnus-group-make-group group method)) (gnus-group-read-ephemeral-group group method t (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) +(eval-when-compile (defvar nnrss-group-alist) + (defun nnrss-discover-feed (arg)) + (defun nnrss-save-server-data (arg))) +(defun gnus-group-make-rss-group (&optional url) + "Given a URL, discover if there is an RSS feed. If there is, +use Gnus' to create an nnrss group" + (interactive) + (require 'nnrss) + (if (not url) + (setq url (read-from-minibuffer "URL to Search for RSS: "))) + (let ((feedinfo (nnrss-discover-feed url))) + (if feedinfo + (let ((title (read-from-minibuffer "Title: " + (cdr (assoc 'title + feedinfo)))) + (desc (read-from-minibuffer "Description: " + (cdr (assoc 'description + feedinfo)))) + (href (cdr (assoc 'href feedinfo)))) + (push (list title href desc) + nnrss-group-alist) + (gnus-group-unsubscribe-group + (concat "nnrss:" title)) + (nnrss-save-server-data nil)) + (error "No feeds found for %s" url)))) + (defvar nnwarchive-type-definition) (defvar gnus-group-warchive-type-history nil) (defvar gnus-group-warchive-login-history nil) @@ -2288,35 +2649,11 @@ If SOLID (the prefix), create a solid group." default-login 'gnus-group-warchive-login-history) user-mail-address)) (method - `(nnwarchive ,address + `(nnwarchive ,address (nnwarchive-type ,(intern type)) (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: " - 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 - 'list - (cdr (assq 'groups - (cdr (assoc server nnshimbun-type-definition))))) - nil t nil)) - (nnshimbun-pre-fetch-article nil)) - (gnus-group-make-group group (list '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." @@ -2508,6 +2845,7 @@ If REVERSE (the prefix), reverse the sorting order." (interactive (list gnus-group-sort-function current-prefix-arg)) (funcall gnus-group-sort-alist-function (gnus-make-sort-function func) reverse) + (gnus-group-unmark-all-groups) (gnus-group-list-groups) (gnus-dribble-touch)) @@ -2530,6 +2868,12 @@ If REVERSE, sort in reverse order." (interactive "P") (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) +(defun gnus-group-sort-groups-by-real-name (&optional reverse) + "Sort the group buffer alphabetically by real (unprefixed) group name. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse)) + (defun gnus-group-sort-groups-by-unread (&optional reverse) "Sort the group buffer by number of unread articles. If REVERSE, sort in reverse order." @@ -2560,6 +2904,12 @@ If REVERSE, sort in reverse order." (interactive "P") (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) +(defun gnus-group-sort-groups-by-server (&optional reverse) + "Sort the group buffer alphabetically by server name. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-server reverse)) + ;;; Selected group sorting. (defun gnus-group-sort-selected-groups (n func &optional reverse) @@ -2568,7 +2918,9 @@ If REVERSE, sort in reverse order." (let ((groups (gnus-group-process-prefix n))) (funcall gnus-group-sort-selected-function groups (gnus-make-sort-function func) reverse) - (gnus-group-list-groups))) + (gnus-group-unmark-all-groups) + (gnus-group-list-groups) + (gnus-dribble-touch))) (defun gnus-group-sort-selected-flat (groups func reverse) (let (entries infos) @@ -2600,6 +2952,13 @@ sort in reverse order." (interactive (gnus-interactive "P\ny")) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) +(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse) + "Sort the group buffer alphabetically by real group name. +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse)) + (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) "Sort the group buffer by number of unread articles. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), @@ -2659,14 +3018,23 @@ sort in reverse order." (defun gnus-group-sort-by-method (info1 info2) "Sort alphabetically by backend name." - (string< (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info1) info1))) - (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info2) info2))))) + (string< (car (gnus-find-method-for-group + (gnus-info-group info1) info1)) + (car (gnus-find-method-for-group + (gnus-info-group info2) info2)))) + +(defun gnus-group-sort-by-server (info1 info2) + "Sort alphabetically by server name." + (string< (gnus-method-to-full-server-name + (gnus-find-method-for-group + (gnus-info-group info1) info1)) + (gnus-method-to-full-server-name + (gnus-find-method-for-group + (gnus-info-group info2) info2)))) (defun gnus-group-sort-by-score (info1 info2) "Sort by group score." - (< (gnus-info-score info1) (gnus-info-score info2))) + (> (gnus-info-score info1) (gnus-info-score info2))) (defun gnus-group-sort-by-rank (info1 info2) "Sort by level and score." @@ -2706,13 +3074,22 @@ sort in reverse order." (defun gnus-info-clear-data (info) "Clear all marks and read ranges from INFO." - (let ((group (gnus-info-group info))) + (let ((group (gnus-info-group info)) + action) + (dolist (el (gnus-info-marks info)) + (push `(,(cdr el) add (,(car el))) action)) + (push `(,(gnus-info-read info) add (read)) action) (gnus-undo-register `(progn + (gnus-request-set-mark ,group ',action) (gnus-info-set-marks ',info ',(gnus-info-marks info) t) (gnus-info-set-read ',info ',(gnus-info-read info)) (when (gnus-group-goto-group ,group) + (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t) (gnus-group-update-group-line)))) + (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el))) + action)) + (gnus-request-set-mark group action) (gnus-info-set-read info nil) (when (gnus-info-marks info) (gnus-info-set-marks info nil)))) @@ -2772,34 +3149,38 @@ If ALL is non-nil, all articles are marked as read. 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))) + (num (car entry)) + (marks (nth 3 (nth 2 entry))) + (unread (gnus-list-of-unread-articles group))) ;; 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) + (gnus-update-read-articles group nil) + (when all + ;; Nix out the lists of marks and dormants. + (gnus-request-set-mark group (list (list (cdr (assq 'tick marks)) + 'del '(tick)) + (list (cdr (assq 'dormant marks)) + 'del '(dormant)))) + (setq unread (gnus-uncompress-range + (gnus-range-add (gnus-range-add + unread (cdr (assq 'dormant marks))) + (cdr (assq 'tick marks))))) + (gnus-add-marked-articles group 'tick nil nil 'force) + (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) - (gnus-add-marked-articles - group 'expire (gnus-list-of-unread-articles group)) - (when all - (let ((marks (nth 3 (nth 2 entry)))) - (gnus-add-marked-articles - group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) - (gnus-add-marked-articles - group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) - (when entry - (gnus-update-read-articles group nil) - ;; Also nix out the lists of marks and dormants. - (when all - (gnus-add-marked-articles group 'tick nil nil 'force) - (gnus-add-marked-articles group 'dormant nil nil 'force)) - (let ((gnus-newsgroup-name group)) - (gnus-run-hooks 'gnus-group-catchup-group-hook)) - num)))) + (gnus-add-marked-articles group 'expire unread) + (gnus-request-set-mark group (list (list unread 'add '(expire))))) + (let ((gnus-newsgroup-name group)) + (gnus-run-hooks 'gnus-group-catchup-group-hook)) + num))) (defun gnus-group-expire-articles (&optional n) - "Expire all expirable articles in the current newsgroup." + "Expire all expirable articles in the current newsgroup. +Uses the process/prefix convention." (interactive "P") (let ((groups (gnus-group-process-prefix n)) group) @@ -2921,7 +3302,7 @@ If given numerical prefix, toggle the N next groups." Killed newsgroups are subscribed. If SILENT, don't try to update the group line." (interactive - (list (completing-read + (list (gnus-group-completing-read-group-name "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) nil @@ -3179,9 +3560,7 @@ entail asking the server for the groups." (gnus-add-text-properties (point) (prog1 (1+ (point)) (insert " *: " - (gnus-group-name-decode group - (gnus-group-name-charset - nil group)) + (gnus-group-decoded-name group) "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t @@ -3206,6 +3585,7 @@ re-scanning. If ARG is non-nil and not a number, this will force ;; Binding this variable will inhibit multiple fetchings ;; of the same mail source. (nnmail-fetched-sources (list t))) + (gnus-run-hooks 'gnus-get-top-new-news-hook) (gnus-run-hooks 'gnus-get-new-news-hook) ;; Read any slave files. @@ -3289,7 +3669,7 @@ to use." (gnus-group-group-name) (when current-prefix-arg (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) + "FAQ dir: " (and (listp gnus-group-faq-directory) (mapcar #'list gnus-group-faq-directory)))))) (unless group @@ -3308,6 +3688,60 @@ to use." (find-file file) (setq found t)))))) +(defun gnus-group-fetch-charter (group) + "Fetch the charter for the current group. +If given a prefix argument, prompt for a group." + (interactive + (list (or (when current-prefix-arg + (completing-read "Group: " gnus-active-hashtb)) + (gnus-group-group-name) + gnus-newsgroup-name))) + (unless group + (error "No group name given")) + (require 'mm-url) + (condition-case nil (require 'url-http) (error nil)) + (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group))) + url hierarchy) + (when (string-match "\\(^[^\\.]+\\)\\..*" name) + (setq hierarchy (match-string 1 name)) + (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) + (if (fboundp 'url-http-file-exists-p) + (url-http-file-exists-p (eval url)) + t)) + (browse-url (eval url)) + (setq url (concat "http://" hierarchy + ".news-admin.org/charters/" name)) + (if (and (fboundp 'url-http-file-exists-p) + (url-http-file-exists-p url)) + (browse-url url) + (gnus-group-fetch-control group)))))) + +(defun gnus-group-fetch-control (group) + "Fetch the archived control messages for the current group. +If given a prefix argument, prompt for a group." + (interactive + (list (or (when current-prefix-arg + (completing-read "Group: " gnus-active-hashtb)) + (gnus-group-group-name) + gnus-newsgroup-name))) + (unless group + (error "No group name given")) + (let ((name (gnus-group-real-name group)) + hierarchy) + (when (string-match "\\(^[^\\.]+\\)\\..*" name) + (setq hierarchy (match-string 1 name)) + (if gnus-group-fetch-control-use-browse-url + (browse-url (concat "ftp://ftp.isc.org/usenet/control/" + hierarchy "/" name ".Z")) + (let ((enable-local-variables nil)) + (gnus-group-read-ephemeral-group + group + `(nndoc ,group (nndoc-address + ,(find-file-noselect + (concat "/ftp@ftp.isc.org:/usenet/control/" + hierarchy "/" name ".Z"))) + (nndoc-article-type mbox)) t nil nil)))))) + (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) @@ -3345,7 +3779,7 @@ to use." (lambda (group) (setq b (point)) (let ((charset (gnus-group-name-charset nil (symbol-name group)))) - (insert (format " *: %-20s %s\n" + (insert (format " *: %-20s %s\n" (gnus-group-name-decode (symbol-name group) charset) (gnus-group-name-decode @@ -3424,8 +3858,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)) @@ -3471,7 +3905,7 @@ group." (defun gnus-group-find-new-groups (&optional arg) "Search for new groups and add them. -Each new group will be treated with `gnus-subscribe-newsgroup-method.' +Each new group will be treated with `gnus-subscribe-newsgroup-method'. With 1 C-u, use the `ask-server' method to query the server for new groups. With 2 C-u's, use most complete method possible to query the server @@ -3508,11 +3942,16 @@ In fact, cleanup buffers except for group mode buffer. The hook gnus-suspend-gnus-hook is called before actually suspending." (interactive) (gnus-run-hooks 'gnus-suspend-gnus-hook) + (gnus-offer-save-summaries) ;; Kill Gnus buffers except for group mode buffer. (let ((group-buf (get-buffer gnus-group-buffer))) (mapcar (lambda (buf) - (unless (member buf (list group-buf gnus-dribble-buffer)) - (kill-buffer buf))) + (unless (or (member buf (list group-buf gnus-dribble-buffer)) + (progn + (save-excursion + (set-buffer buf) + (eq major-mode 'message-mode)))) + (gnus-kill-buffer buf))) (gnus-buffers)) (gnus-kill-gnus-frames) (when group-buf @@ -3560,6 +3999,12 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (file-name-nondirectory gnus-current-startup-file)))) (gnus-run-hooks 'gnus-exit-gnus-hook) (gnus-configure-windows 'group t) + (when (and (gnus-buffer-live-p gnus-dribble-buffer) + (not (zerop (save-excursion + (set-buffer gnus-dribble-buffer) + (buffer-size))))) + (gnus-dribble-enter + ";;; Gnus was exited on purpose without saving the .newsrc files.")) (gnus-dribble-save) (gnus-close-backends) (gnus-clear-system) @@ -3649,7 +4094,8 @@ and the second element is the address." (setcar (nthcdr 2 entry) info) (when (and (not (eq (car entry) t)) (gnus-active (gnus-info-group info))) - (setcar entry (length (gnus-list-of-unread-articles (car info)))))) + (setcar entry (length + (gnus-list-of-unread-articles (car info)))))) (error "No such group: %s" (gnus-info-group info)))))) (defun gnus-group-set-method-info (group select-method) @@ -3684,6 +4130,16 @@ and the second element is the address." (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) +(defun gnus-add-mark (group mark article) + "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." + (let ((buffer (gnus-summary-buffer-name group))) + (if (gnus-buffer-live-p buffer) + (save-excursion + (set-buffer (get-buffer buffer)) + (gnus-summary-add-mark article mark)) + (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) + (list article))))) + ;;; ;;; Group timestamps ;;; @@ -3705,7 +4161,7 @@ or `gnus-group-catchup-group-hook'." "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))) - (delta (subtract-time (current-time) time))) + (delta (subtract-time (current-time) time))) (+ (* (nth 0 delta) 65536.0) (nth 1 delta)))) @@ -3716,68 +4172,6 @@ or `gnus-group-catchup-group-hook'." "" (gnus-time-iso8601 time)))) -(defun gnus-group-prepare-flat-list-dead-predicate - (groups level mark predicate) - (let (group) - (if predicate - ;; This loop is used when listing groups that match some - ;; regexp. - (while (setq group (pop groups)) - (when (funcall predicate 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))))))) - -(defun gnus-group-prepare-flat-predicate (level predicate &optional lowest - dead-predicate) - "List all newsgroups with unread articles of level LEVEL or lower. -If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. -If PREDICATE, only list groups which PREDICATE returns non-nil. -If DEAD-PREDICATE, list dead groups which DEAD-PREDICATE returns non-nil." - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) - (newsrc (cdr gnus-newsrc-alist)) - (lowest (or lowest 1)) - info clevel unread group params) - (erase-buffer) - ;; List living groups. - (while newsrc - (setq info (car newsrc) - group (gnus-info-group info) - params (gnus-info-params info) - newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (and unread ; This group might be unchecked - (funcall predicate info) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (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-predicate - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - dead-predicate)) - (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) - (gnus-group-prepare-flat-list-dead-predicate - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K dead-predicate)) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level t)) - (gnus-run-hooks 'gnus-group-prepare-hook) - t)) - (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 @@ -3790,21 +4184,22 @@ This command may read the active file." (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) (gnus-cache-open)) - (gnus-group-prepare-flat-predicate (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)))) + (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)) @@ -3820,14 +4215,90 @@ This command may read the active file." (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) (gnus-cache-open)) - (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) - #'(lambda (info) - (let ((marks (gnus-info-marks info))) - (assq 'dormant marks))) - lowest) + (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))) + +(defun gnus-group-mark-article-read (group article) + "Mark ARTICLE read." + (let ((buffer (gnus-summary-buffer-name group)) + (mark gnus-read-mark) + active n) + (if (get-buffer buffer) + (with-current-buffer buffer + (setq active gnus-newsgroup-active) + (gnus-activate-group group) + (when gnus-newsgroup-prepared + (when (and gnus-newsgroup-auto-expire + (memq mark gnus-auto-expirable-marks)) + (setq mark gnus-expirable-mark)) + (setq mark (gnus-request-update-mark + group article mark)) + (gnus-mark-article-as-read article mark) + (setq gnus-newsgroup-active (gnus-active group)) + (when active + (setq n (1+ (cdr active))) + (while (<= n (cdr gnus-newsgroup-active)) + (unless (eq n article) + (push n gnus-newsgroup-unselected)) + (setq n (1+ n))) + (setq gnus-newsgroup-unselected + (nreverse gnus-newsgroup-unselected))))) + (gnus-activate-group group) + (gnus-group-make-articles-read group (list article)) + (when (gnus-group-auto-expirable-p group) + (gnus-add-marked-articles + group 'expire (list article)))))) + (provide 'gnus-group) ;;; gnus-group.el ends here diff --git a/lisp/gnus-i18n.el b/lisp/gnus-i18n.el index 7e3f2f3..c71b1e2 100644 --- a/lisp/gnus-i18n.el +++ b/lisp/gnus-i18n.el @@ -77,13 +77,13 @@ It is specified by variable `gnus-newsgroup-default-charset-alist' (setq alist (cdr alist))) )))) (if charset - (progn - (save-excursion - (set-buffer gnus-summary-buffer) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset)) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset)) + (progn + (save-excursion + (set-buffer gnus-summary-buffer) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) (kill-local-variable 'default-mime-charset))))) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index abd5737..835cb91 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,5 +1,5 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -30,12 +30,31 @@ (eval-when-compile (require 'cl)) (require 'gnus) +(require 'message) +(require 'gnus-range) + +(eval-when-compile + (defun gnus-agent-expire (&optional a b c))) (defcustom gnus-open-server-hook nil "Hook called just before opening connection to the news server." :group 'gnus-start :type 'hook) +(defcustom gnus-server-unopen-status nil + "The default status if the server is not able to open. +If the server is covered by Gnus agent, the possible values are +`denied', set the server denied; `offline', set the server offline; +nil, ask user. If the server is not covered by Gnus agent, set the +server denied." + :group 'gnus-start + :type '(choice (const :tag "Ask" nil) + (const :tag "Deny server" denied) + (const :tag "Unplug Agent" offline))) + +(defvar gnus-internal-registry-spool-current-method nil + "The current method, for the registry.") + ;;; ;;; Server Communication ;;; @@ -111,7 +130,8 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." "Check whether the connection to METHOD is down. If METHOD is nil, use `gnus-select-method'. If it is down, start it up (again)." - (let ((method (or method gnus-select-method))) + (let ((method (or method gnus-select-method)) + result) ;; Transform virtual server names into select methods. (when (stringp method) (setq method (gnus-server-to-method method))) @@ -125,9 +145,15 @@ If it is down, start it up (again)." (format " on %s" (nth 1 method))))) (gnus-run-hooks 'gnus-open-server-hook) (prog1 - (gnus-open-server method) + (condition-case () + (setq result (gnus-open-server method)) + (quit (message "Quit gnus-check-server") + nil)) (unless silent - (message "")))))) + (gnus-message 5 "Opening %s server%s...%s" (car method) + (if (equal (nth 1 method) "") "" + (format " on %s" (nth 1 method))) + (if result "done" "failed"))))))) (defun gnus-get-function (method function &optional noerror) "Return a function symbol based on METHOD and FUNCTION." @@ -177,17 +203,51 @@ If it is down, start it up (again)." nil) ;; Open the server. (let ((result - (funcall (gnus-get-function gnus-command-method 'open-server) - (nth 1 gnus-command-method) - (nthcdr 2 gnus-command-method)))) + (condition-case err + (funcall (gnus-get-function gnus-command-method 'open-server) + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method)) + (error + (gnus-message 1 (format + "Unable to open server due to: %s" + (error-message-string err))) + nil) + (quit + (gnus-message 1 "Quit trying to open server") + nil)))) ;; If this hasn't been opened before, we add it to the list. (unless elem (setq elem (list gnus-command-method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. - (setcar (cdr elem) (if result 'ok 'denied)) + (setcar (cdr elem) + (if result + (if (eq (cadr elem) 'offline) + 'offline + 'ok) + (if (and gnus-agent + (not (eq (cadr elem) 'offline)) + (gnus-agent-method-p gnus-command-method)) + (or gnus-server-unopen-status + (if (gnus-y-or-n-p + (format "Unable to open %s:%s, go offline? " + (car gnus-command-method) + (cadr gnus-command-method))) + 'offline + 'denied)) + 'denied))) ;; Return the result from the "open" call. - result)))) + (cond ((eq (cadr elem) 'offline) + ;; I'm avoiding infinite recursion by binding unopen + ;; status to denied (The logic of this routine + ;; guarantees that I can't get to this point with + ;; unopen status already bound to denied). + (unless (eq gnus-server-unopen-status 'denied) + (let ((gnus-server-unopen-status 'denied)) + (gnus-open-server gnus-command-method))) + t) + (t + result)))))) (defun gnus-close-server (gnus-command-method) "Close the connection to GNUS-COMMAND-METHOD." @@ -229,7 +289,7 @@ If it is down, start it up (again)." (defun gnus-status-message (gnus-command-method) "Return the status message from GNUS-COMMAND-METHOD. -If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method +If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method this group uses will be queried." (let ((gnus-command-method (if (stringp gnus-command-method) @@ -290,48 +350,16 @@ this group uses will be queried." "Request headers for ARTICLES in GROUP. If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (let ((gnus-command-method (gnus-find-method-for-group group))) - (if (and gnus-use-cache (numberp (car articles))) - (gnus-cache-retrieve-headers articles group fetch-old) + (cond + ((and gnus-use-cache (numberp (car articles))) + (gnus-cache-retrieve-headers articles group fetch-old)) + ((and gnus-agent (gnus-online gnus-command-method) + (gnus-agent-method-p gnus-command-method)) + (gnus-agent-retrieve-headers articles group fetch-old)) + (t (funcall (gnus-get-function gnus-command-method 'retrieve-headers) articles (gnus-group-real-name group) - (nth 1 gnus-command-method) fetch-old)))) - -(defun gnus-retrieve-parsed-headers (articles group &optional fetch-old - dependencies force-new) - "Request parsed-headers for ARTICLES in GROUP. -If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." - (unless dependencies - (setq dependencies - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies))) - (let ((gnus-command-method (gnus-find-method-for-group group)) - headers) - (if (and gnus-use-cache (numberp (car articles))) - (setq headers - (gnus-cache-retrieve-parsed-headers articles group fetch-old - dependencies force-new)) - (let ((func (gnus-get-function gnus-command-method - 'retrieve-parsed-headers 'no-error))) - (if func - (setq headers (funcall func articles dependencies - (gnus-group-real-name group) - (nth 1 gnus-command-method) fetch-old - force-new) - gnus-headers-retrieved-by (car headers) - headers (cdr headers)) - (setq gnus-headers-retrieved-by - (funcall - (gnus-get-function gnus-command-method 'retrieve-headers) - articles (gnus-group-real-name group) - (nth 1 gnus-command-method) fetch-old)) - ))) - (or headers - (if (eq gnus-headers-retrieved-by 'nov) - (gnus-get-newsgroup-headers-xover - articles nil dependencies gnus-newsgroup-name t) - (gnus-get-newsgroup-headers dependencies))) - )) + (nth 1 gnus-command-method) fetch-old))))) (defun gnus-retrieve-articles (articles group) "Request ARTICLES in GROUP." @@ -396,6 +424,10 @@ If BUFFER, insert the article in that group." (gnus-cache-request-article article group)) (setq res (cons group article) clean-up t)) + ;; Check the agent cache. + ((gnus-agent-request-article article group) + (setq res (cons group article) + clean-up t)) ;; Use `head' function. ((fboundp head) (setq res (funcall head article (gnus-group-real-name group) @@ -425,6 +457,10 @@ If BUFFER, insert the article in that group." (gnus-cache-request-article article group)) (setq res (cons group article) clean-up t)) + ;; Check the agent cache. + ((gnus-agent-request-article article group) + (setq res (cons group article) + clean-up t)) ;; Use `head' function. ((fboundp head) (setq res (funcall head article (gnus-group-real-name group) @@ -456,9 +492,11 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (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))))) + (progn + (setq gnus-internal-registry-spool-current-method 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." @@ -466,22 +504,48 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (setq gnus-command-method (gnus-server-to-method gnus-command-method))) (when (gnus-check-backend-function 'request-update-info (car gnus-command-method)) - (funcall (gnus-get-function gnus-command-method 'request-update-info) - (gnus-group-real-name (gnus-info-group info)) - info (nth 1 gnus-command-method)))) + (let ((group (gnus-info-group info))) + (and (funcall (gnus-get-function gnus-command-method + 'request-update-info) + (gnus-group-real-name group) + info (nth 1 gnus-command-method)) + ;; If the minimum article number is greater than 1, then all + ;; smaller article numbers are known not to exist; we'll + ;; artificially add those to the 'read range. + (let* ((active (gnus-active group)) + (min (car active))) + (when (> min 1) + (let* ((range (if (= min 2) 1 (cons 1 (1- min)))) + (read (gnus-info-read info)) + (new-read (gnus-range-add read (list range)))) + (gnus-info-set-read info new-read))) + info))))) (defun gnus-request-expire-articles (articles group &optional force) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-expire-articles) - articles (gnus-group-real-name group) (nth 1 gnus-command-method) - force))) - -(defun gnus-request-move-article - (article group server accept-function &optional last) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-move-article) - article (gnus-group-real-name group) - (nth 1 gnus-command-method) accept-function last))) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (not-deleted + (funcall + (gnus-get-function gnus-command-method 'request-expire-articles) + articles (gnus-group-real-name group) (nth 1 gnus-command-method) + force))) + (when (and gnus-agent + (gnus-agent-method-p gnus-command-method)) + (let ((expired-articles (gnus-sorted-difference articles not-deleted))) + (when expired-articles + (gnus-agent-expire expired-articles group 'force)))) + not-deleted)) + +(defun gnus-request-move-article (article group server accept-function + &optional last) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (result (funcall (gnus-get-function gnus-command-method + 'request-move-article) + article (gnus-group-real-name group) + (nth 1 gnus-command-method) accept-function last))) + (when (and result gnus-agent + (gnus-agent-method-p gnus-command-method)) + (gnus-agent-expire (list article) group 'force)) + result)) (defun gnus-request-accept-article (group &optional gnus-command-method last no-encode) @@ -494,9 +558,9 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (goto-char (point-max)) (unless (bolp) (insert "\n")) - (let ((func (car (or gnus-command-method - (gnus-find-method-for-group group))))) - (funcall (intern (format "%s-request-accept-article" func)) + (let ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group)))) + (funcall (gnus-get-function gnus-command-method 'request-accept-article) (if (stringp group) (gnus-group-real-name group) group) (cadr gnus-command-method) last))) diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index 4372825..cf95f9f 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -1,5 +1,5 @@ ;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -357,16 +357,16 @@ If NEWSGROUP is nil, return the global kill file instead." (defun gnus-apply-kill-file-unless-scored () "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) - ;; Ignores global KILL. - (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) + ;; Ignores global KILL. + (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" gnus-newsgroup-name)) - 0) - ((or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal)) - (t - 0))) + 0) + ((or (file-exists-p (gnus-newsgroup-kill-file nil)) + (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) + (gnus-apply-kill-file-internal)) + (t + 0))) (defun gnus-apply-kill-file-internal () "Apply a kill file to the current newsgroup. @@ -398,7 +398,7 @@ Returns the number of articles marked as read." gnus-newsgroup-kill-headers)) (setq headers (cdr headers)))) (setq files nil)) - (setq files (cdr files))))) + (setq files (cdr files))))) (if (not gnus-newsgroup-kill-headers) () (save-window-excursion @@ -428,16 +428,6 @@ Returns the number of articles marked as read." 0)))) ;; Parse a Gnus killfile. -(defun gnus-score-insert-help (string alist idx) - (save-excursion - (pop-to-buffer "*Score Help*") - (buffer-disable-undo) - (erase-buffer) - (insert string ":\n\n") - (while alist - (insert (format " %c: %s\n" (caar alist) (nth idx (car alist)))) - (setq alist (cdr alist))))) - (defun gnus-kill-parse-gnus-kill-file () (goto-char (point-min)) (gnus-kill-file-mode) @@ -588,7 +578,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (insert "\n t")) (insert ")") (prog1 - (buffer-substring (point-min) (point-max)) + (buffer-string) (kill-buffer (current-buffer)))))) (defun gnus-execute-1 (function regexp form header) @@ -608,7 +598,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (setq did-kill (string-match regexp value))) (cond ((stringp form) ;Keyboard macro. (execute-kbd-macro form)) - ((gnus-functionp form) + ((functionp form) (funcall form)) (t (eval form))))) @@ -627,7 +617,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (setq did-kill (re-search-forward regexp nil t))) (cond ((stringp form) ;Keyboard macro. (execute-kbd-macro form)) - ((gnus-functionp form) + ((functionp form) (funcall form)) (t (eval form))))))) diff --git a/lisp/gnus-load.el b/lisp/gnus-load.el deleted file mode 100644 index 53784fb..0000000 --- a/lisp/gnus-load.el +++ /dev/null @@ -1,102 +0,0 @@ -;;; gnus-load.el --- automatically extracted custom dependencies -;; -;;; Code: - -(put 'nnmail 'custom-loads '("nnmail")) -(put 'gnus-article-emphasis 'custom-loads '("gnus-art")) -(put 'gnus-article-headers 'custom-loads '("gnus-sum" "gnus-art")) -(put 'nnmail-procmail 'custom-loads '("nnmail")) -(put 'gnus-score-kill 'custom-loads '("gnus-kill")) -(put 'gnus-visual 'custom-loads '("smiley" "gnus" "gnus-picon" "gnus-art" "earcon")) -(put 'gnus-score-expire 'custom-loads '("gnus-score" "gnus-kill")) -(put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum")) -(put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int" "gnus-group")) -(put 'gnus-extract-view 'custom-loads '("gnus-uu" "gnus-sum")) -(put 'gnus-various 'custom-loads '("gnus-sum")) -(put 'gnus-article-washing 'custom-loads '("gnus-art")) -(put 'gnus-score-files 'custom-loads '("gnus-score")) -(put 'message-news 'custom-loads '("message")) -(put 'gnus-thread 'custom-loads '("gnus-sum")) -(put 'languages 'custom-loads '("cus-edit")) -(put 'development 'custom-loads '("cus-edit")) -(put 'nnmail-various 'custom-loads '("nnmail")) -(put 'extensions 'custom-loads '("wid-edit")) -(put 'message-various 'custom-loads '("message")) -(put 'gnus-summary-exit 'custom-loads '("gnus-sum")) -(put 'news 'custom-loads '("message" "gnus")) -(put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art")) -(put 'gnus-summary-visual 'custom-loads '("gnus-sum")) -(put 'gnus-group-listing 'custom-loads '("gnus-group")) -(put 'gnus-score 'custom-loads '("gnus" "gnus-nocem")) -(put 'gnus-group-select 'custom-loads '("gnus-sum")) -(put 'message-buffers 'custom-loads '("message")) -(put 'gnus-threading 'custom-loads '("gnus-sum")) -(put 'gnus-score-decay 'custom-loads '("gnus-score")) -(put 'help 'custom-loads '("cus-edit")) -(put 'gnus-nocem 'custom-loads '("gnus-nocem")) -(put 'gnus-cite 'custom-loads '("gnus-cite")) -(put 'gnus-demon 'custom-loads '("gnus-demon")) -(put 'gnus-message 'custom-loads '("message")) -(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")) -(put 'gnus-edit-form 'custom-loads '("gnus-eform")) -(put 'emacs 'custom-loads '("cus-edit")) -(put 'gnus-summary-mail 'custom-loads '("gnus-sum")) -(put 'gnus-topic 'custom-loads '("gnus-topic")) -(put 'wp 'custom-loads '("cus-edit")) -(put 'gnus-summary-choose 'custom-loads '("gnus-sum")) -(put 'widget-browse 'custom-loads '("wid-browse")) -(put 'external 'custom-loads '("cus-edit")) -(put 'message-headers 'custom-loads '("message")) -(put 'message-forwarding 'custom-loads '("message")) -(put 'message-faces 'custom-loads '("message")) -(put 'environment 'custom-loads '("cus-edit")) -(put 'gnus-article-mime 'custom-loads '("gnus-sum" "gnus-art")) -(put 'gnus-duplicate 'custom-loads '("gnus-dup")) -(put 'nnmail-retrieve 'custom-loads '("nnmail")) -(put 'widgets 'custom-loads '("wid-edit" "wid-browse")) -(put 'earcon 'custom-loads '("earcon")) -(put 'hypermedia 'custom-loads '("wid-edit")) -(put 'gnus-group-levels 'custom-loads '("gnus-group")) -(put 'gnus-summary-format 'custom-loads '("gnus-sum")) -(put 'gnus-files 'custom-loads '("nnmail" "gnus")) -(put 'gnus-windows 'custom-loads '("gnus-win")) -(put 'gnus-article-buttons 'custom-loads '("gnus-art")) -(put 'gnus-summary 'custom-loads '("gnus" "gnus-sum")) -(put 'gnus-article-hiding 'custom-loads '("gnus-sum" "gnus-art")) -(put 'gnus-group 'custom-loads '("gnus" "gnus-topic")) -(put 'gnus-article-various 'custom-loads '("gnus-sum" "gnus-art")) -(put 'gnus-summary-marks 'custom-loads '("gnus-sum")) -(put 'gnus-article-saving 'custom-loads '("gnus-art")) -(put 'nnmail-expire 'custom-loads '("nnmail")) -(put 'message-mail 'custom-loads '("message")) -(put 'faces 'custom-loads '("wid-edit" "cus-edit" "message" "gnus")) -(put 'gnus-summary-various 'custom-loads '("gnus-sum")) -(put 'applications 'custom-loads '("cus-edit")) -(put 'gnus-extract-archive 'custom-loads '("gnus-uu")) -(put 'message 'custom-loads '("message")) -(put 'message-sending 'custom-loads '("message")) -(put 'editing 'custom-loads '("cus-edit")) -(put 'gnus-score-adapt 'custom-loads '("gnus-score")) -(put 'message-insertion 'custom-loads '("message")) -(put 'gnus-extract-post 'custom-loads '("gnus-uu")) -(put 'mail 'custom-loads '("message" "gnus")) -(put 'gnus-summary-sort 'custom-loads '("gnus-sum")) -(put 'customize 'custom-loads '("wid-edit" "custom" "cus-face" "cus-edit")) -(put 'nnmail-split 'custom-loads '("nnmail")) -(put 'gnus-asynchronous 'custom-loads '("gnus-async")) -(put 'gnus-article-highlight 'custom-loads '("gnus-art")) -(put 'gnus-extract 'custom-loads '("gnus-uu")) -(put 'gnus-article 'custom-loads '("gnus-cite" "gnus-art")) -(put 'gnus-group-foreign 'custom-loads '("gnus-group")) -(put 'programming 'custom-loads '("cus-edit")) -(put 'nnmail-prepare 'custom-loads '("nnmail")) -(put 'picons 'custom-loads '("gnus-picon")) -(put 'gnus-article-signature 'custom-loads '("gnus-art")) -(put 'gnus-group-various 'custom-loads '("gnus-group")) - -(provide 'gnus-load) - -;;; gnus-load.el ends here diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index 03b1c1c..20fe9e0 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -1,5 +1,5 @@ ;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -41,15 +41,33 @@ (defconst gnus-advanced-index ;; Name to index alist. - '(("number" 0 gnus-advanced-integer) - ("subject" 1 gnus-advanced-string) - ("from" 2 gnus-advanced-string) - ("date" 3 gnus-advanced-date) - ("message-id" 4 gnus-advanced-string) - ("references" 5 gnus-advanced-string) - ("chars" 6 gnus-advanced-integer) - ("lines" 7 gnus-advanced-integer) - ("xref" 8 gnus-advanced-string) + `(("number" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'location) + gnus-advanced-integer) + ("subject" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'subject) + gnus-advanced-string) + ("from" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'from) + gnus-advanced-string) + ("date" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'date) + gnus-advanced-date) + ("message-id" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'id) + gnus-advanced-string) + ("references" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'references) + gnus-advanced-string) + ("chars" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'chars) + gnus-advanced-integer) + ("lines" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'lines) + gnus-advanced-integer) + ("xref" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) 'xref) + gnus-advanced-string) ("head" nil gnus-advanced-body) ("body" nil gnus-advanced-body) ("all" nil gnus-advanced-body))) @@ -59,21 +77,21 @@ (defun gnus-score-advanced (rule &optional trace) "Apply advanced scoring RULE to all the articles in the current group." - (let ((headers gnus-newsgroup-headers) - gnus-advanced-headers score) - (while (setq gnus-advanced-headers (pop headers)) - (when (gnus-advanced-score-rule (car rule)) - ;; This rule was successful, so we add the score to - ;; this article. + (let (new-score score multiple) + (dolist (gnus-advanced-headers gnus-newsgroup-headers) + (when (setq multiple (gnus-advanced-score-rule (car rule))) + (setq new-score (or (nth 1 rule) + gnus-score-interactive-default-score)) + (when (numberp multiple) + (setq new-score (* multiple new-score))) + ;; This rule was successful, so we add the score to this + ;; article. (if (setq score (assq (mail-header-number gnus-advanced-headers) gnus-newsgroup-scored)) (setcdr score - (+ (cdr score) - (or (nth 1 rule) - gnus-score-interactive-default-score))) + (+ (cdr score) new-score)) (push (cons (mail-header-number gnus-advanced-headers) - (or (nth 1 rule) - gnus-score-interactive-default-score)) + new-score) gnus-newsgroup-scored) (when trace (push (cons "A file" rule) @@ -116,7 +134,7 @@ ;; 1- type redirection. (string-to-number (substring (symbol-name type) - (match-beginning 0) (match-end 0))) + (match-beginning 1) (match-end 1))) ;; ^^^ type redirection. (length (symbol-name type)))))) (when gnus-advanced-headers @@ -129,9 +147,8 @@ (error "Unknown advanced score type: %s" rule))))) (defun gnus-advanced-score-article (rule) - ;; `rule' is a semi-normal score rule, so we find out - ;; what function that's supposed to do the actual - ;; processing. + ;; `rule' is a semi-normal score rule, so we find out what function + ;; that's supposed to do the actual processing. (let* ((header (car rule)) (func (assoc (downcase header) gnus-advanced-index))) (if (not func) @@ -162,7 +179,7 @@ (defun gnus-advanced-integer (index match type) (if (not (memq type '(< > <= >= =))) (error "No such integer score type: %s" type) - (funcall type match (or (aref gnus-advanced-headers index) 0)))) + (funcall type (or (aref gnus-advanced-headers index) 0) match))) (defun gnus-advanced-date (index match type) (let ((date (apply 'encode-time (parse-time-string @@ -189,8 +206,8 @@ 'gnus-request-body) (t 'gnus-request-article))) ofunc article) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. + ;; Not all backends support partial fetching. In that case, we + ;; just fetch the entire article. (unless (gnus-check-backend-function (intern (concat "request-" header)) gnus-newsgroup-name) @@ -201,8 +218,8 @@ (when (funcall request-func article gnus-newsgroup-name) (goto-char (point-min)) ;; If just parts of the article is to be searched and the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. + ;; backend didn't support partial fetching, we just narrow to + ;; the relevant parts. (when ofunc (if (eq ofunc 'gnus-request-head) (narrow-to-region @@ -227,4 +244,4 @@ (provide 'gnus-logic) -;;; gnus-logic.el ends here. +;;; gnus-logic.el ends here diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 2bdfec8..1752cf7 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -1,5 +1,6 @@ ;;; mailcap.el --- MIME media types configuration -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -36,6 +37,7 @@ (defgroup mailcap nil "Definition of viewers for MIME types." + :version "21.1" :group 'mime) (defvar mailcap-parse-args-syntax-table @@ -47,12 +49,34 @@ table) "A syntax table for parsing sgml attributes.") +(eval-and-compile + (when (featurep 'xemacs) + (condition-case nil + (require 'lpr) + (error nil)))) + +(defvar mailcap-print-command + (mapconcat 'identity + (cons (if (boundp 'lpr-command) + lpr-command + "lpr") + (when (boundp 'lpr-switches) + (if (stringp lpr-switches) + (list lpr-switches) + lpr-switches))) + " ") + "Shell command (including switches) used to print Postscript files.") + ;; 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" + `(("application" + ("vnd.ms-excel" + (viewer . "gnumeric %s") + (test . (getenv "DISPLAY")) + (type . "application/vnd.ms-excel")) ("x-x509-ca-cert" (viewer . ssl-view-site-cert) (test . (fboundp 'ssl-view-site-cert)) @@ -65,23 +89,23 @@ (viewer . mailcap-save-binary-file) (non-viewer . t) (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)) + (viewer . "xdvi -safer %s") + (test . (eq window-system 'x)) ("needsx11") - (type . "application/dvi")) + (type . "application/dvi") + ("print" . "dvips -qRP %s")) ("dvi" (viewer . "dvitty %s") (test . (not (getenv "DISPLAY"))) - (type . "application/dvi")) + (type . "application/dvi") + ("print" . "dvips -qRP %s")) ("emacs-lisp" (viewer . mailcap-maybe-eval) (type . "application/emacs-lisp")) + ("x-emacs-lisp" + (viewer . mailcap-maybe-eval) + (type . "application/x-emacs-lisp")) ("x-tar" (viewer . mailcap-save-binary-file) (non-viewer . t) @@ -113,36 +137,52 @@ ("copiousoutput")) ;; Prefer free viewers. ("pdf" - (viewer . "gv %s") + (viewer . "gv -safer %s") (type . "application/pdf") - (test . window-system)) + (test . window-system) + ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command))) ("pdf" (viewer . "xpdf %s") (type . "application/pdf") - (test . (eq (mm-device-type) 'x))) + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + (test . (eq window-system '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))) + (type . "application/pdf") + ("print" . ,(concat "cat %s | acroread -toPostScript | " + mailcap-print-command)) + (test . window-system)) + ("pdf" + (viewer . ,(concat "pdftotext %s -")) + (type . "application/pdf") + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + ("copiousoutput")) ("postscript" (viewer . "gv -safer %s") (type . "application/postscript") (test . window-system) + ("print" . ,(concat mailcap-print-command " %s")) ("needsx11")) ("postscript" (viewer . "ghostview -dSAFER %s") (type . "application/postscript") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) + ("print" . ,(concat mailcap-print-command " %s")) ("needsx11")) ("postscript" (viewer . "ps2ascii %s") (type . "application/postscript") (test . (not (getenv "DISPLAY"))) - ("copiousoutput"))) + ("print" . ,(concat mailcap-print-command " %s")) + ("copiousoutput")) + ("sieve" + (viewer . sieve-mode) + (test . (fboundp 'sieve-mode)) + (type . "application/sieve")) + ("pgp-keys" + (viewer . "gpg --import --interactive --verbose") + (type . "application/pgp-keys") + ("needsterminal"))) ("audio" ("x-mpeg" (viewer . "maplay %s") @@ -172,34 +212,29 @@ (viewer . "xwud -in %s") (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) ("x11-dump" (viewer . "xwud -in %s") (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) ("windowdump" (viewer . "xwud -in %s") (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) -;;; XEmacs says `ns' device-type not implemented. -;; (".*" -;; (viewer . "aopen %s") -;; (type . "image/*") -;; (test . (eq (mm-device-type) 'ns))) (".*" (viewer . "display %s") (type . "image/*") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) (".*" (viewer . "ee %s") (type . "image/*") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11"))) ("text" ("plain" @@ -214,7 +249,7 @@ (viewer . fundamental-mode) (type . "text/plain")) ("enriched" - (viewer . enriched-decode-region) + (viewer . enriched-decode) (test . (fboundp 'enriched-decode)) (type . "text/enriched")) ("html" @@ -225,7 +260,7 @@ ("mpeg" (viewer . "mpeg_play %s") (type . "video/mpeg") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11"))) ("x-world" ("x-vrml" @@ -273,11 +308,15 @@ 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." +nil means your home directory." :type '(choice (const :tag "Home directory" nil) directory) :group 'mailcap) +(defvar mailcap-poor-system-types + '(ms-dos ms-windows windows-nt win32 w32 mswindows) + "Systems that don't have a Unix-like directory hierarchy.") + ;;; ;;; Utility functions ;;; @@ -305,7 +344,7 @@ 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." (let ((lisp-buffer (current-buffer))) @@ -354,7 +393,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (cond (path nil) ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) - ((memq system-type '(ms-dos ms-windows windows-nt)) + ((memq system-type mailcap-poor-system-types) (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) (t (setq path ;; This is per RFC 1524, specifically @@ -372,7 +411,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (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." @@ -627,18 +666,18 @@ to supply to the test." (setq mailcap-mime-data (cons (cons major (list (cons minor info))) mailcap-mime-data)) - (let ((cur-minor (assoc minor old-major))) - (cond - ((or (null cur-minor) ; New minor area, or - (assq 'test info)) ; Has a test, insert at beginning - (setcdr old-major (cons (cons minor info) (cdr old-major)))) - ((and (not (assq 'test info)) ; No test info, replace completely - (not (assq 'test cur-minor)) + (let ((cur-minor (assoc minor old-major))) + (cond + ((or (null cur-minor) ; New minor area, or + (assq 'test info)) ; Has a test, insert at beginning + (setcdr old-major (cons (cons minor info) (cdr old-major)))) + ((and (not (assq 'test info)) ; No test info, replace completely + (not (assq 'test cur-minor)) (equal (assq 'viewer info) ; Keep alternative viewer (assq 'viewer cur-minor))) - (setcdr cur-minor info)) - (t - (setcdr old-major (cons (cons minor info) (cdr old-major)))))) + (setcdr cur-minor info)) + (t + (setcdr old-major (cons (cons minor info) (cdr old-major)))))) ))) (defun mailcap-add (type viewer &optional test) @@ -721,9 +760,8 @@ this type is returned." ((or (null request) (equal request "")) (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) ((stringp request) - (if (or (eq request 'test) (eq request 'viewer)) - (mailcap-unescape-mime-test - (cdr-safe (assoc request viewer)) info))) + (mailcap-unescape-mime-test + (cdr-safe (assoc request viewer)) info)) ((eq request 'all) passed) (t @@ -740,7 +778,7 @@ this type is returned." ;;; (defvar mailcap-mime-extensions - '(("" . "text/plain") + '(("" . "text/plain") (".abs" . "audio/x-mpeg") (".aif" . "audio/aiff") (".aifc" . "audio/aiff") @@ -806,6 +844,7 @@ this type is returned." (".rtx" . "text/richtext") (".sh" . "application/x-sh") (".sit" . "application/x-stuffit") + (".siv" . "application/sieve") (".snd" . "audio/basic") (".src" . "application/x-wais-source") (".tar" . "archive/tar") @@ -823,6 +862,7 @@ this type is returned." (".vox" . "audio/basic") (".vrml" . "x-world/x-vrml") (".wav" . "audio/x-wav") + (".xls" . "application/vnd.ms-excel") (".wrl" . "x-world/x-vrml") (".xbm" . "image/xbm") (".xpm" . "image/xpm") @@ -849,7 +889,7 @@ If FORCE, re-parse even if already parsed." (cond (path nil) ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) - ((memq system-type '(ms-dos ms-windows windows-nt)) + ((memq system-type mailcap-poor-system-types) (setq path '("~/mime.typ" "~/etc/mime.typ"))) (t (setq path ;; mime.types seems to be the normal name, definitely so diff --git a/lisp/gnus-ml.el b/lisp/gnus-ml.el index b2f57df..25f6685 100644 --- a/lisp/gnus-ml.el +++ b/lisp/gnus-ml.el @@ -1,6 +1,6 @@ ;;; gnus-ml.el --- Mailing list minor mode for Gnus -;; Copyright (C) 2000 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. ;; Author: Julien Gilles ;; Keywords: news @@ -67,7 +67,7 @@ ;;;###autoload (defun turn-on-gnus-mailing-list-mode () - (when (gnus-group-get-parameter gnus-newsgroup-name 'to-list) + (when (gnus-group-find-parameter gnus-newsgroup-name 'to-list) (gnus-mailing-list-mode 1))) ;;;###autoload @@ -75,7 +75,7 @@ "Setup group parameters from List-Post header. If FORCE is non-nil, replace the old ones." (interactive "P") - (let ((list-post + (let ((list-post (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-post")))) (if list-post @@ -84,7 +84,7 @@ If FORCE is non-nil, replace the old ones." (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 + (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.")))) @@ -109,8 +109,8 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-help () "Get help from mailing list server." - (interactive) - (let ((list-help + (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)) @@ -119,7 +119,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-subscribe () "Subscribe" (interactive) - (let ((list-subscribe + (let ((list-subscribe (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-subscribe")))) (cond (list-subscribe (gnus-mailing-list-message list-subscribe)) @@ -128,7 +128,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-unsubscribe () "Unsubscribe" (interactive) - (let ((list-unsubscribe + (let ((list-unsubscribe (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-unsubscribe")))) (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe)) @@ -137,7 +137,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-post () "Post message (really useful ?)" (interactive) - (let ((list-post + (let ((list-post (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-post")))) (cond (list-post (gnus-mailing-list-message list-post)) @@ -146,7 +146,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-owner () "Mail to the owner" (interactive) - (let ((list-owner + (let ((list-owner (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-owner")))) (cond (list-owner (gnus-mailing-list-message list-owner)) @@ -156,10 +156,10 @@ If FORCE is non-nil, replace the old ones." "Browse archive" (interactive) (require 'browse-url) - (let ((list-archive + (let ((list-archive (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-archive")))) - (cond (list-archive + (cond (list-archive (if (string-match "<\\(http:[^>]*\\)>" list-archive) (browse-url (match-string 1 list-archive)) (browse-url list-archive))) @@ -174,10 +174,10 @@ If FORCE is non-nil, replace the old ones." (subject "None") (body "") ) - (cond + (cond ((string-match "]*\\)>" address) (let ((args (match-string 1 address))) - (cond ; with param + (cond ; with param ((string-match "\\(.*\\)\\?\\(.*\\)" args) (setq mailto (match-string 1 args)) (let ((param (match-string 2 args))) @@ -187,9 +187,9 @@ If FORCE is non-nil, replace the old ones." (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 ;; Keywords: news, mail -;; 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 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. -;; 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. +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; 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) (require 'gnus-sum) @@ -56,7 +63,7 @@ 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." +`gnus-group-split-fancy' for details." (interactive "P") (setq nnmail-split-methods 'nnmail-split-fancy) (when catch-all @@ -82,7 +89,7 @@ instead. This variable is set by gnus-group-split-setup." ;;;###autoload (defun gnus-group-split () "Uses information from group parameters in order to split mail. -See gnus-group-split-fancy for more information. +See `gnus-group-split-fancy' for more information. gnus-group-split is a valid value for nnmail-split-methods." (let (nnmail-split-fancy) @@ -92,16 +99,16 @@ gnus-group-split is a valid value for nnmail-split-methods." ;;;###autoload (defun gnus-group-split-fancy (&optional groups no-crosspost catch-all) - "Uses information from group parameters in order to split mail. It -can be embedded into nnmail-split-fancy lists with the SPLIT + "Uses information from group parameters in order to split mail. +It can be embedded into `nnmail-split-fancy' lists with the SPLIT \(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL\) GROUPS may be a regular expression or a list of group names, that will -be used to select candidate groups. If it is ommited or nil, all +be used to select candidate groups. If it is omitted or nil, all existing groups are considered. -if NO-CROSSPOST is ommitted or nil, a & split will be returned, +if NO-CROSSPOST is omitted or nil, a & split will be returned, otherwise, a | split, that does not allow crossposting, will be returned. @@ -134,12 +141,12 @@ nnml:mail.foo: nnml:mail.others: \((split-spec . catch-all)) -Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: +Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: \(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\" \"mail.bar\") (any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\" - - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\")) + - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\")) \"mail.others\")" (let* ((newsrc (cdr gnus-newsrc-alist)) split) @@ -196,12 +203,9 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: (list 'any split-regexp) ;; Generate RESTRICTs for SPLIT-EXCLUDEs. (if (listp split-exclude) - (let ((seq split-exclude) - res) - (while seq - (push (cons '- (pop seq)) - res)) - (apply #'nconc (nreverse res))) + (apply #'append + (mapcar (lambda (arg) (list '- arg)) + split-exclude)) (list '- split-exclude)) (list group-clean)) split) @@ -223,3 +227,5 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: split)) (provide 'gnus-mlspl) + +;;; gnus-mlspl.el ends here diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 030d1ee..6d2e1b0 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,5 @@ ;;; gnus-msg.el --- mail and post interface for Semi-gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -38,28 +38,29 @@ (require 'gnus-ems) (require 'message) (require 'gnus-art) +(require 'gnus-util) (defcustom gnus-post-method 'current "*Preferred method for posting USENET news. -If this variable is `current', Gnus will use the \"current\" select -method when posting. If it is nil (which is the default), Gnus will -use the native select method when posting. +If this variable is `current' (which is the default), Gnus will use +the \"current\" select method when posting. If it is `native', Gnus +will use the native select method when posting. 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 +If not `native' nor `current', 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 method to use when posting." :group 'gnus-group-foreign - :type `(choice (const nil) - (const current) - (const native) + :link '(custom-manual "(gnus)Posting Server") + :type `(choice (const native) + (const current) (sexp :tag "Methods" ,gnus-select-method))) -(defvar gnus-outgoing-message-group nil +(defcustom gnus-outgoing-message-group nil "*All outgoing messages will be put in this group. If you want to store all your outgoing mail and articles in the group \"nnml:archive\", you set this variable to that value. This variable @@ -68,18 +69,26 @@ can also be a list of group names. If you want to have greater control over what group to put each message in, you can set this variable to a function that checks the current newsgroup name and then returns a suitable group name (or list -of names).") +of names)." + :group 'gnus-message + :type '(choice (string :tag "Group") + (function))) -(defvar gnus-mailing-list-groups nil - "*Regexp matching groups that are really mailing lists. +(defcustom gnus-mailing-list-groups nil + "*If non-nil a regexp matching groups that are really mailing lists. This is useful when you're reading a mailing list that has been gatewayed to a newsgroup, and you want to followup to an article in -the group.") +the group." + :group 'gnus-message + :type '(choice (regexp) + (const nil))) -(defvar gnus-add-to-list nil - "*If non-nil, add a `to-list' parameter automatically.") +(defcustom gnus-add-to-list nil + "*If non-nil, add a `to-list' parameter automatically." + :group 'gnus-message + :type 'boolean) -(defvar gnus-crosspost-complaint +(defcustom gnus-crosspost-complaint "Hi, You posted the article below with the following Newsgroups header: @@ -95,26 +104,101 @@ Thank you. " "Format string to be inserted when complaining about crossposts. The first %s will be replaced by the Newsgroups header; -the second with the current group name.") - -(defvar gnus-message-setup-hook '(gnus-maybe-setup-default-charset) - "Hook run after setting up a message buffer.") - -(defvar gnus-bug-create-help-buffer t - "*Should we create the *Gnus Help Bug* buffer?") - -(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\\|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. +the second with the current group name." + :group 'gnus-message + :type 'string) + +(defcustom gnus-message-setup-hook nil + "Hook run after setting up a message buffer." + :group 'gnus-message + :type 'hook) + +(defcustom gnus-bug-create-help-buffer t + "*Should we create the *Gnus Help Bug* buffer?" + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-posting-styles nil + "*Alist of styles to use when posting. +See Info node `(gnus)Posting Styles'." + :group 'gnus-message + :link '(custom-manual "(gnus)Posting Styles") + :type '(repeat (cons (choice (regexp) + (variable) + (list (const header) + (string :tag "Header") + (regexp :tag "Regexp")) + (function) + (sexp)) + (repeat (list + (choice (const signature) + (const signature-file) + (const organization) + (const address) + (const x-face-file) + (const name) + (const body) + (const import) + (symbol) + (string :tag "Header")) + (choice (string) + (function) + (variable) + (sexp))))))) + +(defcustom gnus-named-posting-styles nil + "Alist mapping names to the user-defined posting styles." + :group 'gnus-message + :type '(repeat (cons string + (repeat (list + (choice (const signature) + (const signature-file) + (const organization) + (const address) + (const x-face-file) + (const name) + (const body) + (const import) + (symbol) + (string :tag "Header")) + (choice (string) + (function) + (variable) + (sexp))))))) + +(defcustom gnus-gcc-mark-as-read nil + "If non-nil, automatically mark Gcc articles as read." + :version "21.1" + :group 'gnus-message + :type 'boolean) + +(make-obsolete-variable 'gnus-inews-mark-gcc-as-read + 'gnus-gcc-mark-as-read) + +(defcustom gnus-gcc-externalize-attachments nil + "Should local-file attachments be included as external parts in Gcc copies? +If it is `all', attach files as external parts; +if a regexp and matches the Gcc group name, attach files as external parts; +if nil, attach files as normal parts." + :version "21.1" + :group 'gnus-message + :type '(choice (const nil :tag "None") + (const all :tag "Any") + (string :tag "Regexp"))) + +(gnus-define-group-parameter + posting-charset-alist + :type list + :function-document + "Return the permitted unencoded charsets for posting of GROUP." + :variable gnus-group-posting-charset-alist + :variable-default + '(("^\\(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)) + :variable-document + "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, @@ -126,31 +210,136 @@ 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) + :variable-group gnus-charset + :variable-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"))))) + :parameter-type '(choice :tag "Permitted unencoded charsets" + :value nil + (repeat (symbol))) + :parameter-document "\ +List of charsets that are permitted to be unencoded.") + +(defcustom gnus-debug-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" + "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el" + "mm-util.el" "mm-decode.el" "nnmail.el" "nntp.el" "message.el") + "Files whose variables will be reported in `gnus-bug'." + :version "21.1" + :group 'gnus-message + :type '(repeat (string :tag "File"))) + +(defcustom gnus-debug-exclude-variables + '(mm-mime-mule-charset-alist + nnmail-split-fancy message-minibuffer-local-map) + "Variables that should not be reported in `gnus-bug'." + :version "21.1" + :group 'gnus-message + :type '(repeat (symbol :tag "Variable"))) + +(defcustom gnus-discouraged-post-methods + '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) + "A list of back ends that are not used in \"real\" newsgroups. +This variable is used only when `gnus-post-method' is `current'." + :version "21.3" + :group 'gnus-group-foreign + :type '(repeat (symbol :tag "Back end"))) + +(defcustom gnus-message-replysign + nil + "Automatically sign replies to signed messages. +See also the `mml-default-sign-method' variable." + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-message-replyencrypt + nil + "Automatically encrypt replies to encrypted messages. +See also the `mml-default-encrypt-method' variable." + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-message-replysignencrypted + t + "Setting this causes automatically encryped messages to also be signed." + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-confirm-mail-reply-to-news nil + "If non-nil, Gnus requests confirmation when replying to news. +This is done because new users often reply by mistake when reading +news. +This can also be a function receiving the group name as the only +parameter which should return non-nil iff a confirmation is needed, or +a regexp, in which case a confirmation is asked for iff the group name +matches the regexp." + :group 'gnus-message + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (regexp :tag "Iff group matches regexp") + (function :tag "Iff function evaluates to non-nil"))) + +(defcustom gnus-confirm-treat-mail-like-news + nil + "If non-nil, Gnus will treat mail like news with regard to confirmation +when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable +for fine-tuning this. +If nil, Gnus will never ask for confirmation if replying to mail." + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-summary-resend-default-address t + "If non-nil, Gnus tries to suggest a default address to resend to. +If nil, the address field will always be empty after invoking +`gnus-summary-resend-message'." + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-user-agent 'emacs-gnus-type + "Which information should be exposed in the User-Agent header. + +It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus' +\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as +`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as +`emacs-gnus' plus system type\) or a custom string. If you set it to a +string, be sure to use a valid format, see RFC 2616." + :group 'gnus-message + :type '(choice + (item :tag "Show Gnus and Emacs versions and system type" + emacs-gnus-type) + (item :tag "Show Gnus and Emacs versions and system configuration" + emacs-gnus-config) + (item :tag "Show Gnus and Emacs versions" emacs-gnus) + (item :tag "Show only Gnus version" gnus) + (string :tag "Other"))) ;;; Internal variables. (defvar gnus-inhibit-posting-styles nil "Inhibit the use of posting styles.") +(defvar gnus-article-yanked-articles nil) (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) +(defvar gnus-msg-force-broken-reply-to nil) + (defconst gnus-bug-message (format "Sending a bug report to the Gnus Towers. ======================================== @@ -196,6 +385,7 @@ Thank you for your help in stamping out bugs. (gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) "p" gnus-summary-post-news + "i" gnus-summary-news-other-window "f" gnus-summary-followup "F" gnus-summary-followup-with-original "c" gnus-summary-cancel-article @@ -205,32 +395,45 @@ Thank you for your help in stamping out bugs. "R" gnus-summary-reply-with-original "w" gnus-summary-wide-reply "W" gnus-summary-wide-reply-with-original + "v" gnus-summary-very-wide-reply + "V" gnus-summary-very-wide-reply-with-original "n" gnus-summary-followup-to-mail "N" gnus-summary-followup-to-mail-with-original "m" gnus-summary-mail-other-window "u" gnus-uu-post-news "\M-c" gnus-summary-mail-crosspost-complaint + "Br" gnus-summary-reply-broken-reply-to + "BR" gnus-summary-reply-broken-reply-to-with-original "om" gnus-summary-mail-forward "op" gnus-summary-post-forward "Om" gnus-summary-digest-mail-forward - "Op" gnus-summary-digest-post-forward) + "Op" gnus-summary-digest-post-forward + "P" gnus-summary-execute-command-with-posting-style) (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) "b" gnus-summary-resend-bounced-mail ;; "c" gnus-summary-send-draft - "r" gnus-summary-resend-message) + "r" gnus-summary-resend-message + "e" gnus-summary-resend-message-edit) ;;; Internal functions. +(defun gnus-inews-make-draft () + `(lambda () + (gnus-inews-make-draft-meta-information + ,gnus-newsgroup-name ',gnus-article-reply))) + (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) (let ((winconf (make-symbol "gnus-setup-message-winconf")) (buffer (make-symbol "gnus-setup-message-buffer")) (article (make-symbol "gnus-setup-message-article")) + (yanked (make-symbol "gnus-setup-yanked-articles")) (group (make-symbol "gnus-setup-message-group"))) `(let ((,winconf (current-window-configuration)) (,buffer (buffer-name (current-buffer))) - (,article (and gnus-article-reply (gnus-summary-article-number))) + (,article gnus-article-reply) + (,yanked gnus-article-yanked-articles) (,group gnus-newsgroup-name) (message-header-setup-hook (copy-sequence message-header-setup-hook)) @@ -241,35 +444,94 @@ Thank you for your help in stamping out bugs. (user-agent . Gnus)))) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) - (add-hook 'message-mode-hook 'gnus-configure-posting-styles) + ;; #### FIXME: for a reason that I did not manage to identify yet, + ;; the variable `gnus-newsgroup-name' does not honor a dynamically + ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'. + ;; After evaluation of @forms below, it gets the value we actually want + ;; to override, and the posting styles are used. For that reason, I've + ;; added an optional argument to `gnus-configure-posting-styles' to + ;; make sure that the correct value for the group name is used. -- drv + (add-hook 'message-mode-hook + (lambda () + (gnus-configure-posting-styles ,group))) + (gnus-pull ',(intern gnus-draft-meta-information-header) + message-required-headers) + (when (and ,group + (not (string= ,group ""))) + (push (cons + (intern gnus-draft-meta-information-header) + (gnus-inews-make-draft)) + message-required-headers)) (unwind-protect (progn ,@forms) - (gnus-inews-add-send-actions ,winconf ,buffer ,article) + (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config + ,yanked) (setq gnus-message-buffer (current-buffer)) (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) (set (make-local-variable 'gnus-newsgroup-name) ,group) + (gnus-maybe-setup-default-charset) (gnus-run-hooks 'gnus-message-setup-hook)) + (message-hide-headers) (gnus-add-buffer) (gnus-configure-windows ,config t) + (run-hooks 'post-command-hook) (set-buffer-modified-p nil)))) +(defun gnus-inews-make-draft-meta-information (group article) + (concat "(\"" group "\" " + (if article (number-to-string + (if (listp article) + (car article) + article)) "\"\"") + ")")) + ;;;###autoload -(defun gnus-msg-mail (&rest args) +(defun gnus-msg-mail (&optional to subject other-headers continue + switch-action yank-action send-actions) "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)) + (let ((buf (current-buffer)) + mail-buf) + (gnus-setup-message 'message + (message-mail to subject other-headers continue + nil yank-action send-actions)) + (when switch-action + (setq mail-buf (current-buffer)) + (switch-to-buffer buf) + (apply switch-action mail-buf nil))) ;; COMPOSEFUNC should return t if succeed. Undocumented ??? t) +(defvar save-selected-window-window) + +;;;###autoload +(defun gnus-button-mailto (address) + "Mail to ADDRESS." + (set-buffer (gnus-copy-article-buffer)) + (gnus-setup-message 'message + (message-reply address)) + (and (boundp 'save-selected-window-window) + (not (window-live-p save-selected-window-window)) + (setq save-selected-window-window (selected-window)))) + +;;;###autoload +(defun gnus-button-reply (&optional to-address wide) + "Like `message-reply'." + (interactive) + (gnus-setup-message 'message + (message-reply to-address wide)) + (and (boundp 'save-selected-window-window) + (not (window-live-p save-selected-window-window)) + (setq save-selected-window-window (selected-window)))) + ;;;###autoload (define-mail-user-agent 'gnus-user-agent - 'gnus-msg-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook) + '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) @@ -280,33 +542,42 @@ Gcc: header for archiving purposes." (while (setq elem (pop alist)) (when (or (and (stringp (car elem)) (string-match (car elem) group)) - (and (gnus-functionp (car elem)) + (and (functionp (car elem)) (funcall (car elem) group)) (and (symbolp (car elem)) (symbol-value (car elem)))) (throw 'found (cons (cadr elem) (caddr elem))))))))) -(defun gnus-inews-add-send-actions (winconf buffer article) - (make-local-hook 'message-sent-hook) +(defun gnus-inews-add-send-actions (winconf buffer article + &optional config yanked) + (gnus-make-local-hook 'message-sent-hook) (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) + (gnus-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))) (setq message-user-agent (gnus-extended-version)) - (when (not message-use-multi-frames) + (unless message-use-multi-frames (message-add-action - `(set-window-configuration ,winconf) 'exit 'postpone 'kill)) - (message-add-action - `(when (gnus-buffer-exists-p ,buffer) - (save-excursion - (set-buffer ,buffer) - ,(when article - `(gnus-summary-mark-article-as-replied ,article)))) - 'send)) + `(if (gnus-buffer-exists-p ,buffer) + (set-window-configuration ,winconf)) + 'exit 'postpone 'kill)) + (let ((to-be-marked (cond + (yanked yanked) + (article (if (listp article) article (list article))) + (t nil)))) + (message-add-action + `(when (gnus-buffer-exists-p ,buffer) + (save-excursion + (set-buffer ,buffer) + ,(when to-be-marked + (if (eq config 'forward) + `(gnus-summary-mark-article-as-forwarded ',to-be-marked) + `(gnus-summary-mark-article-as-replied ',to-be-marked))))) + 'send))) (put 'gnus-setup-message 'lisp-indent-function 1) (put 'gnus-setup-message 'edebug-form-spec '(form body)) @@ -321,6 +592,8 @@ If ARG is 1, prompt for a group name to find the posting style." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -332,15 +605,49 @@ If ARG is 1, prompt for a group name to find the posting style." (gnus-read-active-file-p)) (gnus-group-group-name)) "")) + ;; #### see comment in gnus-setup-message -- drv (gnus-setup-message 'message (message-mail))) (save-excursion (set-buffer buffer) (setq gnus-newsgroup-name group))))) +(defun gnus-group-news (&optional arg) + "Start composing a news. +If ARG, post to group under point. +If ARG is 1, prompt for group name to post to. + +This function prepares a news even when using mail groups. This is useful +for posting messages to mail groups without actually sending them over the +network. The corresponding backend must have a 'request-post method." + (interactive "P") + ;; We can't `let' gnus-newsgroup-name here, since that leads + ;; to local variables leaking. + (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) + (buffer (current-buffer))) + (unwind-protect + (progn + (setq gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (completing-read "Use group: " + gnus-active-hashtb nil + (gnus-read-active-file-p)) + (gnus-group-group-name)) + "")) + ;; #### see comment in gnus-setup-message -- drv + (gnus-setup-message 'message + (message-news (gnus-group-real-name gnus-newsgroup-name)))) + (save-excursion + (set-buffer buffer) + (setq gnus-newsgroup-name group))))) + (defun gnus-group-post-news (&optional arg) - "Start composing a news message. -If ARG, post to the group under point. -If ARG is 1, prompt for a group name." + "Start composing a message (a news by default). +If ARG, post to group under point. If ARG is 1, prompt for group name. +Depending on the selected group, the message might be either a mail or +a news." (interactive "P") ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name @@ -349,22 +656,111 @@ If ARG is 1, prompt for a group name." (completing-read "Newsgroup: " gnus-active-hashtb nil (gnus-read-active-file-p)) (gnus-group-group-name)) - ""))) + "")) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy)) + (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil + (string= gnus-newsgroup-name "")))) + +(defun gnus-summary-mail-other-window (&optional arg) + "Start composing a mail in another window. +Use the posting of the current group by default. +If ARG, don't do that. If ARG is 1, prompt for group name to find the +posting style." + (interactive "P") + ;; We can't `let' gnus-newsgroup-name here, since that leads + ;; to local variables leaking. + (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) + (buffer (current-buffer))) + (unwind-protect + (progn + (setq gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (completing-read "Use group: " + gnus-active-hashtb nil + (gnus-read-active-file-p)) + "") + gnus-newsgroup-name)) + ;; #### see comment in gnus-setup-message -- drv + (gnus-setup-message 'message (message-mail))) + (save-excursion + (set-buffer buffer) + (setq gnus-newsgroup-name group))))) + +(defun gnus-summary-news-other-window (&optional arg) + "Start composing a news in another window. +Post to the current group by default. +If ARG, don't do that. If ARG is 1, prompt for group name to post to. + +This function prepares a news even when using mail groups. This is useful +for posting messages to mail groups without actually sending them over the +network. The corresponding backend must have a 'request-post method." + (interactive "P") + ;; We can't `let' gnus-newsgroup-name here, since that leads + ;; to local variables leaking. + (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) + (buffer (current-buffer))) + (unwind-protect + (progn + (setq gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (completing-read "Use group: " + gnus-active-hashtb nil + (gnus-read-active-file-p)) + "") + gnus-newsgroup-name)) + ;; #### see comment in gnus-setup-message -- drv + (gnus-setup-message 'message + (progn + (message-news (gnus-group-real-name gnus-newsgroup-name)) + (set (make-local-variable 'gnus-discouraged-post-methods) + (delq + (car (gnus-find-method-for-group gnus-newsgroup-name)) + (copy-sequence gnus-discouraged-post-methods)))))) + (save-excursion + (set-buffer buffer) + (setq gnus-newsgroup-name group))))) + +(defun gnus-summary-post-news (&optional arg) + "Start composing a message. Post to the current group by default. +If ARG, don't do that. If ARG is 1, prompt for a group name to post to. +Depending on the selected group, the message might be either a mail or +a news." + (interactive "P") + ;; Bind this variable here to make message mode hooks work ok. + (let ((gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (completing-read "Newsgroup: " gnus-active-hashtb nil + (gnus-read-active-file-p)) + "") + gnus-newsgroup-name)) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy)) (gnus-post-news 'post gnus-newsgroup-name))) -(defun gnus-summary-post-news () - "Start composing a news message." - (interactive) - (gnus-post-news 'post gnus-newsgroup-name)) (defun gnus-summary-followup (yank &optional force-news) "Compose a followup to an article. -If prefix argument YANK is non-nil, original article is yanked automatically." +If prefix argument YANK is non-nil, the original article is yanked +automatically. +YANK is a list of elements, where the car of each element is the +article number, and the two following numbers is the region to be +yanked." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (when yank - (gnus-summary-goto-subject (car yank))) + (gnus-summary-goto-subject + (if (listp (car yank)) + (caar yank) + (car yank)))) (save-window-excursion (gnus-summary-select-article)) (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) @@ -372,7 +768,8 @@ If prefix argument YANK is non-nil, original article is yanked automatically." ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name headers gnus-article-buffer - yank nil force-news))) + yank nil force-news) + (gnus-summary-handle-replysign))) (defun gnus-summary-followup-with-original (n &optional force-news) "Compose a followup to an article and include the original article." @@ -392,29 +789,38 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (gnus-summary-followup (gnus-summary-work-articles arg) t)) (defun gnus-inews-yank-articles (articles) - (let* ((more-than-one (cdr articles)) - (frame (when (and message-use-multi-frames more-than-one) - (window-frame (get-buffer-window (current-buffer))))) - refs beg article) + (let (beg article yank-string + (more-than-one (cdr articles)) + (cur (current-buffer)) + refs window) (message-goto-body) (while (setq article (pop articles)) + (when (listp article) + (setq yank-string (nth 1 article) + article (nth 0 article))) (save-window-excursion (set-buffer gnus-summary-buffer) (gnus-summary-select-article nil nil nil article) (gnus-summary-remove-process-mark article)) - (when frame - (select-frame frame)) ;; Gathering references. (when more-than-one (setq refs (message-list-references refs (mail-header-references gnus-current-headers) - (mail-header-message-id gnus-current-headers)))) + (mail-header-message-id gnus-current-headers))) + (when message-use-multi-frames + (when (setq window (get-buffer-window cur t)) + (select-frame (window-frame window))))) - (gnus-copy-article-buffer) + (gnus-copy-article-buffer nil yank-string) (let ((message-reply-buffer gnus-article-copy) - (message-reply-headers gnus-current-headers)) + (message-reply-headers + ;; The headers are decoded. + (with-current-buffer gnus-article-copy + (save-restriction + (nnheader-narrow-to-headers) + (nnheader-parse-naked-head))))) (message-yank-original) (setq beg (or beg (mark t)))) (when articles @@ -450,7 +856,7 @@ post using the current select method." (let ((articles (gnus-summary-work-articles n)) (message-post-method `(lambda (arg) - (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name))) + (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) @@ -468,8 +874,7 @@ post using the current select method." This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) - (let ((article (gnus-summary-article-number)) - (gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) + (let ((article (gnus-summary-article-number))) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) @@ -485,12 +890,15 @@ header line with the old Message-ID." -(defun gnus-copy-article-buffer (&optional article-buffer) +(defun gnus-copy-article-buffer (&optional article-buffer yank-string) ;; make a copy of the article buffer with all text properties removed ;; this copy is in the buffer gnus-article-copy. ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used ;; this buffer should be passed to all mail/news reply/post routines. (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*")) + (save-excursion + (set-buffer gnus-article-copy) + (set-buffer-multibyte t)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg) (if (not (and (get-buffer article-buffer) @@ -498,13 +906,26 @@ 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)) + (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) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-buffer gnus-article-copy) + ;; There's invisible and intangible text in T-gnus. Especially, + ;; if there is a boundary line (X-Boundary: ------------------), + ;; in the end of a header, it will cause a serious problem. + (add-text-properties (point-min) (point-max) + '(invisible nil intangible nil)) + (when yank-string + (message-goto-body) + (delete-region (point) (point-max)) + (insert yank-string)) ;; Encode bitmap smileys to ordinary text. ;; Possibly, the original text might be restored. (static-unless (featurep 'xemacs) @@ -513,6 +934,7 @@ header line with the old Message-ID." (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 'gnus-decoration) (gnus-remove-text-with-property 'x-face-mule-bitmap-image) (insert (prog1 @@ -522,28 +944,40 @@ header line with the old Message-ID." (buffer-substring-no-properties (point-min) (point-max))) (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) - (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))) + (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)) + (let ((mail-header-separator "")) + (setq beg (point) + end (or (message-goto-body) + ;; There may be just a header. + (point-max)))) + ;; Delete the headers from the displayed articles. + (set-buffer gnus-article-copy) + (let ((mail-header-separator "")) + (delete-region (goto-char (point-min)) + (or (message-goto-body) (point-max)))) + ;; Insert the original article headers. + (insert-buffer-substring gnus-original-article-buffer beg end) + ;; Decode charsets. + (let ((gnus-article-decode-hook + (delq 'article-decode-charset + (copy-sequence gnus-article-decode-hook)))) + ;; Needed for T-gnus. + (add-hook 'gnus-article-decode-hook + 'article-decode-encoded-words) + (run-hooks 'gnus-article-decode-hook))))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject force-news) (when article-buffer (gnus-copy-article-buffer)) - (let ((gnus-article-reply article-buffer) + (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number))) + (gnus-article-yanked-articles yank) (add-to-list gnus-add-to-list)) (gnus-setup-message (cond (yank 'reply-yank) (article-buffer 'reply) @@ -554,9 +988,9 @@ header line with the old Message-ID." to-address to-group mailing-list to-list newsgroup-p) (when group - (setq to-address (gnus-group-find-parameter group 'to-address) + (setq to-address (gnus-parameter-to-address group) to-group (gnus-group-find-parameter group 'to-group) - to-list (gnus-group-find-parameter group 'to-list) + to-list (gnus-parameter-to-list group) newsgroup-p (gnus-group-find-parameter group 'newsgroup) mailing-list (when gnus-mailing-list-groups (string-match gnus-mailing-list-groups group)) @@ -568,8 +1002,7 @@ header line with the old Message-ID." force-news (and (gnus-news-group-p (or pgroup gnus-newsgroup-name) - (if header (mail-header-number header) - gnus-current-article)) + (or header gnus-current-article)) (not mailing-list) (not to-list) (not to-address))) @@ -578,7 +1011,13 @@ header line with the old Message-ID." (message-news (or to-group group)) (set-buffer gnus-article-copy) (gnus-msg-treat-broken-reply-to) - (message-followup (if (or newsgroup-p force-news) nil to-group))) + (message-followup (if (or newsgroup-p force-news) + (if (save-restriction + (article-narrow-to-head) + (message-fetch-field "newsgroups")) + nil + "") + to-group))) ;; The is mail. (if post (progn @@ -596,10 +1035,11 @@ header line with the old Message-ID." (when yank (gnus-inews-yank-articles yank)))))) -(defun gnus-msg-treat-broken-reply-to () - "Remove the Reply-to header iff broken-reply-to." - (when (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to) +(defun gnus-msg-treat-broken-reply-to (&optional force) + "Remove the Reply-to header if broken-reply-to." + (when (or force + (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to)) (save-restriction (message-narrow-to-head) (message-remove-header "reply-to")))) @@ -607,28 +1047,31 @@ header line with the old Message-ID." (defun gnus-post-method (arg group &optional silent) "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." - (let ((group-method (gnus-find-method-for-group group))) + (let ((gnus-post-method (or (gnus-parameter-post-method group) + gnus-post-method)) + (group-method (gnus-find-method-for-group group))) (cond ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) - (or (and (null (eq gnus-post-method 'active)) gnus-post-method) - gnus-select-method message-post-method)) + (or (and (listp gnus-post-method) ;If not current/native/nil + (not (listp (car gnus-post-method))) ; and not a list of methods + gnus-post-method) ;then use it. + 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) + (if (eq gnus-post-method 'current) gnus-select-method group-method)) ;; We query the user for a post method. ((or arg - (and gnus-post-method - (not (eq gnus-post-method 'current)) + (and (listp gnus-post-method) (listp (car gnus-post-method)))) (let* ((methods ;; Collect all methods we know about. (append - (when (and gnus-post-method - (not (eq gnus-post-method 'current))) + (when (listp gnus-post-method) (if (listp (car gnus-post-method)) gnus-post-method (list gnus-post-method))) @@ -667,58 +1110,103 @@ If SILENT, don't prompt the user." method-alist)))) ;; Override normal method. ((and (eq gnus-post-method 'current) - (not (eq (car group-method) 'nndraft)) - (gnus-get-function group-method 'request-post t) - (not arg)) + (not (memq (car group-method) gnus-discouraged-post-methods)) + (gnus-get-function group-method 'request-post t)) + (assert (not arg)) group-method) - ((and gnus-post-method - (not (eq gnus-post-method 'current))) + ;; Use gnus-post-method. + ((listp gnus-post-method) ;A method... + (assert (not (listp (car gnus-post-method)))) ;... not a list of methods. gnus-post-method) - ;; Use the normal select method. + ;; Use the normal select method (nil or native). (t gnus-select-method)))) - -(defun gnus-message-make-user-agent (&optional include-mime-info max-column) - "Return user-agent info. -INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable - `mime-edit-user-agent-value' exists, the return value will include it. -MAX-COLUMN the optional second argument if it is specified, the return value - will be folded up in the proper way." +(defun gnus-message-make-user-agent (&optional include-mime-info max-column + newline-product) + "Return a user-agent info. If INCLUDE-MIME-INFO is non-nil and the +variable `mime-edit-user-agent-value' is bound, the value will be +included in the return value. If MAX-COLUMN is specified, the return +value will be folded up as it were filled. NEWLINE-PRODUCT specifies +whether a newline should be inserted in front of each product-token. +If the value is t or `hard', it works strictly. Otherwise, if it is +non-nil (e.g. `soft'), it works semi-strictly. + +Here is an example of how to use this function: + +\(add-hook 'gnus-message-setup-hook + (lambda nil + (setq message-user-agent nil) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (goto-char (point-max)) + (insert \"User-Agent: \" + (gnus-message-make-user-agent t 76 'soft) + \"\\n\"))))) +" (let ((user-agent (if (and include-mime-info (boundp 'mime-edit-user-agent-value)) (concat (gnus-extended-version) " " mime-edit-user-agent-value) (gnus-extended-version)))) - (if max-column - (let (boundary) - (unless (natnump max-column) (setq max-column 76)) - (with-temp-buffer - (insert " " user-agent) - (goto-char 13) - (while (re-search-forward "[\n\t ]+" nil t) - (replace-match " ")) - (goto-char 13) - (while (re-search-forward "[^ ()/]+\\(/[^ ()/]+\\)? ?" nil t) - (while (eq ?\( (char-after (point))) - (forward-list) - (skip-chars-forward " ")) - (skip-chars-backward " ") - (if (> (current-column) max-column) - (progn - (if (or (not boundary) (eq ?\n (char-after boundary))) - (progn - (setq boundary (point)) - (unless (eobp) - (delete-char 1) - (insert "\n "))) - (goto-char boundary) - (delete-char 1) - (insert "\n "))) - (setq boundary (point)))) - (buffer-substring 13 (point-max)))) - user-agent))) + (when max-column + (unless (natnump max-column) + (setq max-column 76)) + (with-temp-buffer + (set-buffer-multibyte t) + (insert (mapconcat 'identity (split-string user-agent) " ")) + (goto-char (point-min)) + (let ((bol t) + start agent agents width element swidth) + (while (re-search-forward "\\([^ ]+\\) ?" nil t) + (setq start (match-beginning 0)) + (if (eq (char-after start) ?\() + (progn + (goto-char start) + (forward-list) + (push (buffer-substring start (point)) agent)) + (when agent + (push (nreverse agent) agents)) + (setq agent (list (match-string 1))))) + (when agent + (push (nreverse agent) agents)) + (setq agents (nreverse agents)) + (if (> (+ 12 (string-width (caar agents))) max-column) + (setq user-agent "\n" + width 0) + (setq user-agent "" + width 11)) + (while agents + (setq agent (car agents) + agents (cdr agents)) + (when (and (not bol) + (or (memq newline-product '(t hard)) + (and newline-product + (> (+ width 1 + (string-width (mapconcat 'identity + agent " "))) + max-column)))) + (setq user-agent (concat user-agent "\n") + width 0 + bol t)) + (while agent + (setq element (car agent) + swidth (string-width element) + agent (cdr agent)) + (if bol + (setq user-agent (if (member user-agent '("" "\n")) + (concat user-agent element) + (concat user-agent " " element)) + width (+ width 1 swidth) + bol nil) + (if (> (+ width 1 swidth) max-column) + (setq user-agent (concat user-agent "\n " element) + width (1+ swidth)) + (setq user-agent (concat user-agent " " element) + width (+ width 1 swidth))))))))) + user-agent)) ;;; @@ -727,24 +1215,76 @@ MAX-COLUMN the optional second argument if it is specified, the return value ;;; Mail reply commands of Gnus summary mode -(defun gnus-summary-reply (&optional yank wide) - "Start composing a reply mail to the current message. +(defun gnus-summary-reply (&optional yank wide very-wide) + "Start composing a mail reply to the current message. If prefix argument YANK is non-nil, the original article is yanked -automatically." +automatically. +If WIDE, make a wide reply. +If VERY-WIDE, make a very wide reply." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (when yank - (gnus-summary-goto-subject (car yank))) - (let ((gnus-article-reply t)) - (gnus-setup-message (if yank 'reply-yank 'reply) - (gnus-summary-select-article) - (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to) - (message-reply nil wide) + ;; Allow user to require confirmation before replying by mail to the + ;; author of a news article (or mail message). + (when (or + (not (or (gnus-news-group-p gnus-newsgroup-name) + gnus-confirm-treat-mail-like-news)) + (not (cond ((stringp gnus-confirm-mail-reply-to-news) + (string-match gnus-confirm-mail-reply-to-news + gnus-newsgroup-name)) + ((functionp gnus-confirm-mail-reply-to-news) + (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name)) + (t gnus-confirm-mail-reply-to-news))) + (y-or-n-p "Really reply by mail to article author? ")) + (let* ((article + (if (listp (car yank)) + (caar yank) + (car yank))) + (gnus-article-reply (or article (gnus-summary-article-number))) + (gnus-article-yanked-articles yank) + (headers "")) + ;; Stripping headers should be specified with mail-yank-ignored-headers. (when yank - (gnus-inews-yank-articles yank))))) + (gnus-summary-goto-subject article)) + (gnus-setup-message (if yank 'reply-yank 'reply) + (if (not very-wide) + (gnus-summary-select-article) + (dolist (article very-wide) + (gnus-summary-select-article nil nil nil article) + (save-excursion + (set-buffer (gnus-copy-article-buffer)) + (gnus-msg-treat-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (setq headers (concat headers (buffer-string))))))) + (set-buffer (gnus-copy-article-buffer)) + (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (when very-wide + (erase-buffer) + (insert headers)) + (goto-char (point-max))) + (message-reply nil wide) + (when yank + (gnus-inews-yank-articles yank)) + (gnus-summary-handle-replysign))))) + +(defun gnus-summary-handle-replysign () + "Check the various replysign variables and take action accordingly." + (when nil;;(or gnus-message-replysign gnus-message-replyencrypt) + (let (signed encrypted) + (save-excursion + (set-buffer gnus-article-buffer) + (setq signed (memq 'signed gnus-article-wash-types)) + (setq encrypted (memq 'encrypted gnus-article-wash-types))) + (cond ((and gnus-message-replyencrypt encrypted) + (mml-secure-message mml-default-encrypt-method + (if gnus-message-replysignencrypted + 'signencrypt + 'encrypt))) + ((and gnus-message-replysign signed) + (mml-secure-message mml-default-sign-method 'sign)))))) (defun gnus-summary-reply-with-original (n &optional wide) "Start composing a reply mail to the current message. @@ -752,6 +1292,24 @@ The original article will be yanked." (interactive "P") (gnus-summary-reply (gnus-summary-work-articles n) wide)) +(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide) + "Like `gnus-summary-reply' except removing reply-to field. +If prefix argument YANK is non-nil, the original article is yanked +automatically. +If WIDE, make a wide reply. +If VERY-WIDE, make a very wide reply." + (interactive + (list (and current-prefix-arg + (gnus-summary-work-articles 1)))) + (let ((gnus-msg-force-broken-reply-to t)) + (gnus-summary-reply yank wide very-wide))) + +(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide) + "Like `gnus-summary-reply-with-original' except removing reply-to field. +The original article will be yanked." + (interactive "P") + (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide)) + (defun gnus-summary-wide-reply (&optional yank) "Start composing a wide reply mail to the current message. If prefix argument YANK is non-nil, the original article is yanked @@ -763,24 +1321,51 @@ automatically." (defun gnus-summary-wide-reply-with-original (n) "Start composing a wide reply mail to the current message. -The original article will be yanked." +The original article will be yanked. +Uses the process/prefix convention." (interactive "P") (gnus-summary-reply-with-original n t)) +(defun gnus-summary-very-wide-reply (&optional yank) + "Start composing a very wide reply mail to the current message. +If prefix argument YANK is non-nil, the original article is yanked +automatically." + (interactive + (list (and current-prefix-arg + (gnus-summary-work-articles 1)))) + (gnus-summary-reply yank t (gnus-summary-work-articles yank))) + +(defun gnus-summary-very-wide-reply-with-original (n) + "Start composing a very wide reply mail to the current message. +The original article will be yanked." + (interactive "P") + (gnus-summary-reply + (gnus-summary-work-articles n) t (gnus-summary-work-articles n))) + (defun gnus-summary-mail-forward (&optional full-headers post) - "Forward the current message to another user. -If FULL-HEADERS (the prefix), include full headers when forwarding." + "Forward the current message(s) to another user. +If process marks exist, forward all marked messages; +If FULL-HEADERS (the prefix), include full headers when forwarding. + +Note that this function definition for T-gnus is totally different +from the original Gnus." (interactive "P") - (gnus-setup-message 'forward - (gnus-summary-select-article) - (let ((charset default-mime-charset)) - (set-buffer gnus-original-article-buffer) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - ) - (let ((message-included-forward-headers - (if full-headers "" message-included-forward-headers))) - (message-forward post)))) + (if (cdr (gnus-summary-work-articles nil)) + ;; Process marks are given. + (gnus-summary-digest-mail-forward nil post) + ;; No process marks. + (let* ((gnus-article-reply (gnus-summary-article-number)) + (gnus-article-yanked-articles (list gnus-article-reply)) + charset + (message-included-forward-headers + (if full-headers "" message-included-forward-headers))) + (gnus-setup-message 'forward + (gnus-summary-select-article) + (setq charset default-mime-charset) + (set-buffer gnus-original-article-buffer) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + (message-forward post))))) (defun gnus-summary-digest-mail-forward (&optional n post) "Digests and forwards all articles in this series. @@ -790,9 +1375,10 @@ If N is nil and any articles have been marked with the process mark, forward those articles instead. Optional POST will use news to forward instead of mail." (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - (topics "Topics:\n") - subject article frame) + (let* ((articles (gnus-summary-work-articles n)) + (gnus-article-yanked-articles (copy-sequence articles)) + (topics "Topics:\n") + subject article frame) (when (car articles) (gnus-setup-message 'forward (gnus-summary-select-article) @@ -842,14 +1428,75 @@ forward those articles instead." (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." - (interactive "sResend message(s) to: \nP") + (interactive + (list (message-read-from-minibuffer + "Resend message(s) to: " + (when (and gnus-summary-resend-default-address + (gnus-buffer-live-p gnus-original-article-buffer)) + ;; If some other article is currently selected, the + ;; initial-contents is wrong. Whatever, it is just the + ;; initial-contents. + (with-current-buffer gnus-original-article-buffer + (nnmail-fetch-field "to")))) + current-prefix-arg)) (let ((articles (gnus-summary-work-articles n)) article) (while (setq article (pop articles)) (gnus-summary-select-article nil nil nil article) (save-excursion (set-buffer gnus-original-article-buffer) - (message-resend address))))) + (message-resend address)) + (gnus-summary-mark-article-as-forwarded article)))) + +;; From: Matthieu Moy +(defun gnus-summary-resend-message-edit () + "Resend an article that has already been sent. +A new buffer will be created to allow the user to modify body and +contents of the message, and then, everything will happen as when +composing a new message." + (interactive) + (let ((article (gnus-summary-article-number))) + (gnus-setup-message 'reply-yank + (gnus-summary-select-article t) + (set-buffer gnus-original-article-buffer) + (let ((cur (current-buffer)) + (to (message-fetch-field "to"))) + ;; Get a normal message buffer. + (message-pop-to-buffer (message-buffer-name "Resend" to)) + (insert-buffer-substring cur) + + ;; T-gnus change: Use MIME-Edit to recompose a message. + ;;(mime-to-mml) + (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer))) + (fset 'mime-edit-decode-single-part-in-buffer + (lambda (&rest args) + (if (let ((content-type (car args))) + (and (eq 'message (mime-content-type-primary-type + content-type)) + (eq 'rfc822 (mime-content-type-subtype + content-type)))) + (setcar (cdr args) 'not-decode-text)) + (apply ofn args))) + (unwind-protect + (mime-edit-again nil t) + (fset 'mime-edit-decode-single-part-in-buffer ofn))) + (message-narrow-to-head-1) + (insert "From: " (message-make-from) "\n") + (while (re-search-forward "^From:" nil t) + (beginning-of-line) + (insert "Original-")) + (message-remove-header "^>From[\t ]" t) + + ;; Gnus will generate a new one when sending. + (message-remove-header "Message-ID") + (message-remove-header message-ignored-resent-headers t) + ;; Remove unwanted headers. + (goto-char (point-max)) + (insert mail-header-separator) + (goto-char (point-min)) + (re-search-forward "^To:\\|^Newsgroups:" nil 'move) + (forward-char 1) + (widen))))) (defun gnus-summary-post-forward (&optional full-headers) "Forward the current article to a newsgroup. @@ -910,12 +1557,6 @@ The current group name will be inserted at \"%s\".") (when (gnus-y-or-n-p "Send this complaint? ") (message-send-and-exit))))))) -(defun gnus-summary-mail-other-window () - "Compose mail in other window." - (interactive) - (gnus-setup-message 'message - (message-mail))) - (defun gnus-mail-parse-comma-list () (let (accumulated beg) @@ -959,35 +1600,34 @@ The current group name will be inserted at \"%s\".") (let ((reply gnus-article-reply) (winconf gnus-prev-winconf) (group gnus-newsgroup-name)) + (unless (and group + (not (gnus-group-read-only-p group))) + (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) - (or (and group (not (gnus-group-read-only-p group))) - (setq group (read-string "Put in group: " nil - (gnus-writable-groups)))) (when (gnus-gethash group gnus-newsrc-hashtb) (error "No such group: %s" group)) - (save-excursion (save-restriction (widen) (message-narrow-to-headers) - (let (gnus-deletable-headers) - (if (message-news-p) - (message-generate-headers message-required-news-headers) - (message-generate-headers message-required-mail-headers))) + (let ((gnus-deletable-headers nil)) + (message-generate-headers + (if (message-news-p) + message-required-news-headers + message-required-mail-headers))) (goto-char (point-max)) - (insert "Gcc: " group "\n") + (if (string-match " " group) + (insert "Gcc: \"" group "\"\n") + (insert "Gcc: " group "\n")) (widen))) - (gnus-inews-do-gcc) - - (when (get-buffer gnus-group-buffer) - (when (gnus-buffer-exists-p (car-safe reply)) - (set-buffer (car reply)) - (and (cdr reply) - (gnus-summary-mark-article-as-replied - (cdr reply)))) - (when winconf - (set-window-configuration winconf))))) + (when (and (get-buffer gnus-group-buffer) + (gnus-buffer-exists-p (car-safe reply)) + (cdr reply)) + (set-buffer (car reply)) + (gnus-summary-mark-article-as-replied (cdr reply))) + (when winconf + (set-window-configuration winconf)))) (defun gnus-article-mail (yank) "Send a reply to the address near point. @@ -998,7 +1638,7 @@ If YANK is non-nil, include the original article." (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) (when address - (message-reply address) + (gnus-msg-mail address) (when yank (gnus-inews-yank-articles (list (cdr gnus-article-current))))))) @@ -1008,15 +1648,19 @@ 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) + (message-pop-to-buffer "*Gnus 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)) + (sit-for 0) + (set-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)) @@ -1032,7 +1676,9 @@ If YANK is non-nil, include the original article." (insert nntp-server-type)) (insert "\n\n\n\n\n") (let (mime-content-types) - (mime-edit-insert-tag "text" "plain" "; type=emacs-lisp")) + (mime-edit-insert-tag + "application" "emacs-lisp" + "\nContent-Disposition: inline\nContent-Description: User settings")) (insert (with-temp-buffer (gnus-debug) (buffer-string))) @@ -1083,10 +1729,7 @@ If YANK is non-nil, include the original article." "Attempts to go through the Gnus source file and report what variables have been changed. The source file has to be in the Emacs load path." (interactive) - (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" "nntp.el" "message.el")) + (let ((files gnus-debug-files) (point (point)) file expr olist sym) (gnus-message 4 "Please wait while we snoop your variables...") @@ -1108,6 +1751,7 @@ The source file has to be in the Emacs load path." (ignore-errors (and (memq (car expr) '(defvar defcustom defvoo)) (stringp (nth 3 expr)) + (not (memq (nth 1 expr) gnus-debug-exclude-variables)) (or (not (boundp (nth 1 expr))) (not (equal (eval (nth 2 expr)) (symbol-value (nth 1 expr))))) @@ -1117,17 +1761,15 @@ The source file has to be in the Emacs load path." (insert ";----------------- Environment follows ------------------\n\n")) (while olist (if (boundp (car olist)) - (condition-case () - (pp `(setq ,(car olist) - ,(if (or (consp (setq sym (symbol-value (car olist)))) - (and (symbolp sym) - (not (or (eq sym nil) - (eq sym t))))) - (list 'quote (symbol-value (car olist))) - (symbol-value (car olist)))) - (current-buffer)) - (error - (format "(setq %s 'whatever)\n" (car olist)))) + (ignore-errors + (pp `(setq ,(car olist) + ,(if (or (consp (setq sym (symbol-value (car olist)))) + (and (symbolp sym) + (not (or (eq sym nil) + (eq sym t))))) + (list 'quote (symbol-value (car olist))) + (symbol-value (car olist)))) + (current-buffer))) (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) ;; Remove any control chars - they seem to cause trouble for some @@ -1155,69 +1797,83 @@ this is a reply." (interactive "P") (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) - (let ((gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) - (message-bounce) - ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers)))))) + (gnus-setup-message 'compose-bounce + (let* ((references (mail-fetch-field "references")) + (parent (and references (gnus-parent-id references)))) + (message-bounce) + ;; If there are references, we fetch the article we answered to. + (and fetch parent + (gnus-summary-refer-article parent) + (gnus-summary-show-all-headers))))) ;;; Gcc handling. (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)))) + (cond + ;; If the group doesn't exist, we assume + ;; it's an archive group... + ((and (null (gnus-get-info group)) + (eq (car (gnus-server-to-method gnus-message-archive-method)) + (car (gnus-server-to-method (gnus-group-method 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-server-to-method (gnus-group-method group))))) ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) (interactive) - (when (gnus-alive-p) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (coding-system-for-write 'raw-text) - (output-coding-system 'raw-text) - groups group method) - (when gcc - (message-remove-header "gcc") - (widen) - (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 (gnus-inews-group-method group))) - (unless (gnus-request-group group t method) - (gnus-request-create-group group method)) - (save-excursion - (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring message-encoding-buffer) - (gnus-run-hooks 'gnus-before-do-gcc-hook) - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (replace-match "" t t )) - (unless (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)) - (kill-buffer (current-buffer)))))))))) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) + (coding-system-for-write 'raw-text) + (output-coding-system 'raw-text) + groups group method group-art + mml-externalize-attachments) + (when gcc + (message-remove-header "gcc") + (widen) + (setq groups (message-unquote-tokens + (message-tokenize-header gcc " ,"))) + ;; Copy the article over to some group(s). + (while (setq group (pop groups)) + (unless (gnus-check-server + (setq method (gnus-inews-group-method group))) + (error "Can't open server %s" (if (stringp method) method + (car method)))) + (unless (gnus-request-group group nil method) + (gnus-request-create-group group method)) + (setq mml-externalize-attachments + (if (stringp gnus-gcc-externalize-attachments) + (string-match gnus-gcc-externalize-attachments group) + gnus-gcc-externalize-attachments)) + (save-excursion + (nnheader-set-temp-buffer " *acc*") + (insert-buffer-substring message-encoding-buffer) + (gnus-run-hooks 'gnus-before-do-gcc-hook) + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (replace-match "" 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 + ;; FIXME: Should gcc-mark-as-read work when + ;; Gnus is not running? + (gnus-alive-p) + (or gnus-gcc-mark-as-read + (and + (boundp 'gnus-inews-mark-gcc-as-read) + (symbol-value 'gnus-inews-mark-gcc-as-read)))) + (gnus-group-mark-article-read group (cdr group-art))) + (kill-buffer (current-buffer))))))))) (defun gnus-inews-insert-gcc () "Insert Gcc headers based on `gnus-outgoing-message-group'." @@ -1226,14 +1882,21 @@ this is a reply." (message-narrow-to-headers) (let* ((group gnus-outgoing-message-group) (gcc (cond - ((gnus-functionp group) + ((functionp group) (funcall group)) ((or (stringp group) (list group)) group)))) (when gcc (insert "Gcc: " - (if (stringp gcc) gcc - (mapconcat 'identity gcc " ")) + (if (stringp gcc) + (if (string-match " " gcc) + (concat "\"" gcc "\"") + gcc) + (mapconcat (lambda (group) + (if (string-match " " group) + (concat "\"" group "\"") + group)) + gcc " ")) "\n")))))) (defun gnus-inews-insert-archive-gcc (&optional group) @@ -1260,7 +1923,7 @@ this is a reply." ((and (listp var) (stringp (car var))) ;; A list of groups. var) - ((gnus-functionp var) + ((functionp var) ;; A function. (funcall var group)) (t @@ -1273,7 +1936,7 @@ this is a reply." ;; Regexp. (when (string-match (caar var) group) (cdar var))) - ((gnus-functionp (car var)) + ((functionp (car var)) ;; Function. (funcall (car var) group)) (t @@ -1294,32 +1957,47 @@ this is a reply." (progn (insert (if (stringp gcc-self-val) - gcc-self-val - group)) + (if (string-match " " gcc-self-val) + (concat "\"" gcc-self-val "\"") + gcc-self-val) + (if (string-match " " group) + (concat "\"" group "\"") + group))) (if (not (eq gcc-self-val 'none)) (insert "\n") - (progn - (beginning-of-line) - (kill-line)))) + (gnus-delete-line))) ;; Use the list of groups. (while (setq name (pop groups)) - (insert (if (string-match ":" name) - name - (gnus-group-prefixed-name - name gnus-message-archive-method))) + (let ((str (if (string-match ":" name) + name + (gnus-group-prefixed-name + name gnus-message-archive-method)))) + (insert (if (string-match " " str) + (concat "\"" str "\"") + str))) (when groups (insert " "))) (insert "\n"))))))) +(defun gnus-mailing-list-followup-to () + "Look at the headers in the current buffer and return a Mail-Followup-To address." + (let ((x-been-there (gnus-fetch-original-field "x-beenthere")) + (list-post (gnus-fetch-original-field "list-post"))) + (when (and list-post + (string-match "mailto:\\([^>]+\\)" list-post)) + (setq list-post (match-string 1 list-post))) + (or list-post + x-been-there))) + ;;; Posting styles. -(defun gnus-configure-posting-styles () +(defun gnus-configure-posting-styles (&optional group-name) "Configure posting styles according to `gnus-posting-styles'." (unless gnus-inhibit-posting-styles - (let ((group (or gnus-newsgroup-name "")) + (let ((group (or group-name gnus-newsgroup-name "")) (styles gnus-posting-styles) - style match variable attribute value v results - filep name address element) + style match attribute results + name address) ;; If the group has a posting-style parameter, add it at the end with a ;; regexp matching everything, to be sure it takes precedence over all ;; the others. @@ -1336,64 +2014,45 @@ this is a reply." ;; Regexp string match on the group name. (string-match match group)) ((eq match 'header) - (let ((header (message-fetch-field (pop style)))) - (and header - (string-match (pop style) header)))) + ;; Obsolete format of header match. + (and (gnus-buffer-live-p gnus-article-copy) + (with-current-buffer gnus-article-copy + (let ((header (message-fetch-field (pop style)))) + (and header + (string-match (pop style) header)))))) ((or (symbolp match) - (gnus-functionp match)) + (functionp match)) (cond - ((gnus-functionp match) + ((functionp match) ;; Function to be called. (funcall match)) ((boundp match) ;; Variable to be checked. (symbol-value match)))) ((listp match) - ;; This is a form to be evaled. - (eval match))) + (cond + ((eq (car match) 'header) + ;; New format of header match. + (and (gnus-buffer-live-p gnus-article-copy) + (with-current-buffer gnus-article-copy + (let ((header (message-fetch-field (nth 1 match)))) + (and header + (string-match (nth 2 match) header)))))) + (t + ;; This is a form to be evaled. + (eval match))))) ;; We have a match, so we set the variables. + (setq style (gnus-configure-posting-style style nil)) (dolist (attribute style) - (setq element (pop attribute) - variable nil - filep nil) - (setq value - (cond - ((eq (car attribute) ':file) - (setq filep t) - (cadr attribute)) - ((eq (car attribute) :value) - (cadr attribute)) - (t - (car attribute)))) - ;; We get the value. - (setq v - (cond - ((stringp value) - value) - ((or (symbolp value) - (gnus-functionp value)) - (cond ((gnus-functionp value) - (funcall value)) - ((boundp value) - (symbol-value value)))) - ((listp value) - (eval value)))) - ;; Translate obsolescent value. - (when (eq element 'signature-file) - (setq element 'signature - filep t)) - ;; Get the contents of file elems. - (when (and filep v) - (setq v (with-temp-buffer - (insert-file-contents v) - (buffer-string)))) - (setq results (delq (assoc element results) results)) - (push (cons element v) results)))) + (setq results (delq (assoc (car attribute) results) results)) + (push attribute results)))) ;; Now we have all the styles, so we insert them. (setq name (assq 'name results) address (assq 'address results)) (setq results (delq name (delq address results))) - (make-local-variable 'message-setup-hook) + (gnus-make-local-hook 'message-setup-hook) + (setq results (sort results (lambda (x y) + (string-lessp (car x) (car y))))) (dolist (result results) (add-hook 'message-setup-hook (cond @@ -1425,19 +2084,93 @@ this is a reply." (let ((value ,(cdr result))) (when value (message-goto-eoh) - (insert ,header ": " value "\n")))))))))) + (insert ,header ": " value) + (unless (bolp) + (insert "\n"))))))))) + nil 'local)) (when (or name address) (add-hook 'message-setup-hook `(lambda () - (set (make-local-variable 'user-mail-address) - ,(or (cdr address) user-mail-address)) + (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))) (save-excursion (message-remove-header "From") (message-goto-eoh) - (insert "From: " (message-make-from) "\n"))))))))) + (insert "From: " (message-make-from) "\n")))) + nil 'local))))) + +;; splitted from gnus-configure-posting-styles to allow recursive traversal. +(defun gnus-configure-posting-style (style stack) + "Parse one posting style STYLE and returns the value as an alist." + (let (results element variable filep value v) + (dolist (attribute style) + (setq element (pop attribute) + variable nil + filep nil) + (setq value + (cond + ((eq (car attribute) ':file) + (setq filep t) + (cadr attribute)) + ((eq (car attribute) :value) + (cadr attribute)) + (t + (car attribute)))) + ;; We get the value. + (setq v + (cond + ((stringp value) + value) + ((or (symbolp value) + (functionp value)) + (cond ((functionp value) + (funcall value)) + ((boundp value) + (symbol-value value)))) + ((listp value) + (eval value)))) + ;; Translate obsolescent value. + (cond + ((eq element 'signature-file) + (setq element 'signature + filep t)) + ((eq element 'x-face-file) + (setq element 'x-face + filep t))) + ;; Get the contents of file elems. + (when (and filep v) + (setq v (with-temp-buffer + (insert-file-contents v) + (goto-char (point-max)) + (while (bolp) + (delete-char -1)) + (buffer-string)))) + (if (eq element 'import) + (progn + (if (member v stack) + (error "Circular import of \"%s\"" v)) + (setq results + (nconc (nreverse (gnus-configure-posting-style + (cdr (assoc v gnus-named-posting-styles)) + (cons v stack))) + results))) + (push (cons element v) results))) + (nreverse results))) + +(defun gnus-summary-execute-command-with-posting-style (style command) + "Temporarily select a posting-style named STYLE and execute COMMAND." + (interactive + (let ((style (completing-read "Posting style: " + gnus-named-posting-styles nil t))) + (list style + (key-binding + (read-key-sequence + (format "Command to execute with %s: " style)))))) + (let ((gnus-posting-styles (list (list ".*" (list 'import style))))) + (call-interactively command))) ;;; @ for MIME Edit mode @@ -1446,7 +2179,7 @@ this is a reply." (defun gnus-maybe-setup-default-charset () (let ((charset (and (boundp 'gnus-summary-buffer) - (buffer-live-p gnus-summary-buffer) + (buffer-live-p gnus-summary-buffer) (save-excursion (set-buffer gnus-summary-buffer) default-mime-charset)))) diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 6d196b4..38bd552 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -1,6 +1,8 @@ ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002 +;; Free Software Foundation, Inc. + ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -59,6 +61,7 @@ This can also be a list of `(ISSUER CONDITION ...)' elements. See for an issuer registry." :group 'gnus-nocem + :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html") :type '(repeat (choice string sexp))) (defcustom gnus-nocem-directory @@ -83,13 +86,14 @@ isn't bound, the message will be used unconditionally." (defcustom gnus-nocem-liberal-fetch nil "*If t try to fetch all messages which have @@NCM in the subject. Otherwise don't fetch messages which have references or whose message-id -matches an previously scanned and verified nocem message." +matches a 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))) @@ -98,6 +102,7 @@ matches an previously scanned and verified nocem message." 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 diff --git a/lisp/gnus-offline.el b/lisp/gnus-offline.el index 0e4d1a2..79eaa10 100644 --- a/lisp/gnus-offline.el +++ b/lisp/gnus-offline.el @@ -36,7 +36,7 @@ ;;; Note. ;;; This file works only with after version of Emacs 19.30. ;;; This file needs miee.el and SEMI. -;;; If you set gnus-offline-drafts-queue-type to 'agent , you don't need +;;; If you set gnus-offline-drafts-queue-type to 'agent , you don't need ;;; miee.el ;;; You must use T-gnus 6.12.0 or later. ;;; @@ -101,7 +101,7 @@ ;; "A matter of trust" ;; "Modern Woman" ;; "Ahhhhhhh!!" ; 2.10b1 - "Cup of life" ; 2.20 + "Cup of life" ; 2.20 ;; "Code of silence" ) @@ -515,7 +515,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; fetch only mail for gnus-agent (if (and (eq gnus-offline-news-fetch-method 'nnagent) (eq gnus-offline-articles-to-fetch 'mail)) - (setq gnus-agent-handle-level gnus-offline-mail-group-level))) + (setq gnus-agent-handle-level gnus-offline-mail-group-level))) ;; ;; Change mail group level to handle only mail. @@ -607,7 +607,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (setq hdr (concat header " ")) (setq str (concat hdr string)) (setq hdr (concat str "\n")) - (insert-string hdr)))) + (insert hdr)))) ;; ;; Add X-Offline-Backend header. ;; @@ -618,8 +618,8 @@ Please check your .emacs or .gnus.el to work nnspool fine.") nnagent-version nnspool-version)) (str (format "\n with %s" ver))) - (gnus-offline-add-custom-header - "X-Gnus-Offline-Backend:" (concat gnus-offline-header-string str))))) + (gnus-offline-add-custom-header + "X-Gnus-Offline-Backend:" (concat gnus-offline-header-string str))))) ;; @@ -642,7 +642,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") ;; (setenv "MAILHOST" nil)) ;; -;; Hangup line function +;; Hangup line function ;; (defun gnus-offline-hangup-line () "*Hangup line function." @@ -787,7 +787,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (message "%s" (gnus-offline-gettext 'empting-spool-4))) ;; Send queued message by gnus-agent (message "%s" (gnus-offline-gettext 'empting-spool-5)) - (gnus-group-send-drafts) + (gnus-group-send-queue) (message "%s" (gnus-offline-gettext 'empting-spool-6))) ;; (run-hooks 'gnus-offline-after-empting-spool-hook)) diff --git a/lisp/gnus-ofsetup.el b/lisp/gnus-ofsetup.el index 15a3eeb..839db29 100644 --- a/lisp/gnus-ofsetup.el +++ b/lisp/gnus-ofsetup.el @@ -35,8 +35,6 @@ (eval-when-compile (require 'cl)) -(require 'read-passwd) - (eval-and-compile (defvar gnus-offline-lang (cond ((and (featurep 'meadow) @@ -145,7 +143,7 @@ "(add-hook" "'gnus-before-startup-hook" "(lambda () (setq nnmail-spool-file nil) - (setq mail-sources nil)))"))) + (setq mail-sources nil)))"))) ;; Write stting about mail-source.el (insert "(setq gnus-offline-mail-source '" @@ -251,7 +249,7 @@ if you want to use movemail instead of pop3.el which comes with Gnus, you can set a specifier using the kerword :program as shown below: - (pop :program \"movemail -pf po:%u %t %p\") + (pop :program \"movemail -pf po:%u %t %p\") If you want to know more about mail source specifiers and keywords, click the button below.") @@ -334,7 +332,7 @@ POP $B%Q%9%o!<%I$r(B .newsrc.eld $B$KJ]B8$9$k$+H]$+$r;XDj$7$^$9!#(B") (movemail $B$J$I(B) $B$r;H$$$?$$!"$H$$$&>l9g$K$O!"(B:program $B$r$$$&%-!<%o!<(B $B%I$r;XDj$7$F0J2<$NMM$K5-=R$7$^$9!#(B - (pop :program \"movemail -pf po:%u %t %p\") + (pop :program \"movemail -pf po:%u %t %p\") mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B $BCN$j$?$$>l9g$O!"0J2<$N%\%?%s$r%/%j%C%/$7$F$/$@$5$$!#(B(Info $B$N3:Ev2U=j(B @@ -629,7 +627,7 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (choice :tag ,(gnus-ofsetup-gettext 'param-save-passwd-1) :value ,(if (memq 'mail-source-password-cache gnus-variable-list) t - nil) + nil) (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)) @@ -651,36 +649,36 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B (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-gettext 'customize-1)) - (widget-create 'push-button + (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-gettext 'customize-1)) + (widget-create 'push-button :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) - (setq gnus-ofsetup-params - (widget-create 'group - `(set :inline t - :greedy t - :tag ,(gnus-ofsetup-gettext 'customize-4) - :format "%t:\n%h%v" - :doc ,(gnus-ofsetup-gettext 'customize-5) - ,@types))) - - (widget-create 'info-link - :help-echo (gnus-ofsetup-gettext 'customize-6) - :tag " mail sources" - (if (string-match "^ja" gnus-offline-lang) - "(gnus-ja)Mail Sources" - "(gnus)Mail Sources")) - - (use-local-map widget-keymap) - (local-set-key "q" 'bury-buffer) - (widget-setup) - (goto-char (point-min)))) + (widget-insert "\n\n") + (make-local-variable 'gnus-ofsetup-params) + (setq gnus-ofsetup-params + (widget-create 'group + `(set :inline t + :greedy t + :tag ,(gnus-ofsetup-gettext 'customize-4) + :format "%t:\n%h%v" + :doc ,(gnus-ofsetup-gettext 'customize-5) + ,@types))) + + (widget-create 'info-link + :help-echo (gnus-ofsetup-gettext 'customize-6) + :tag " mail sources" + (if (string-match "^ja" gnus-offline-lang) + "(gnus-ja)Mail Sources" + "(gnus)Mail Sources")) + + (use-local-map widget-keymap) + (local-set-key "q" 'bury-buffer) + (widget-setup) + (goto-char (point-min)))) (defun gnus-ofsetup-customize-done (&rest ignore) "Apply changes and bury the buffer." @@ -753,8 +751,6 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B '(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) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 0a8d804..ae2d107 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -1,6 +1,6 @@ ;;; gnus-picon.el --- displaying pretty icons in Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Wes Hardaker @@ -25,731 +25,241 @@ ;;; Commentary: +;; There are three picon types relevant to Gnus: +;; +;; Persons: person@subdomain.dom +;; users/dom/subdomain/person/face.gif +;; usenix/dom/subdomain/person/face.gif +;; misc/MISC/person/face.gif +;; Domains: subdomain.dom +;; domain/dom/subdomain/unknown/face.gif +;; Groups: comp.lang.lisp +;; news/comp/lang/lisp/unknown/face.gif + ;;; Code: (eval-when-compile (require 'cl)) (require 'gnus) -;; (require 'xpm) -(require 'annotations) (require 'custom) (require 'gnus-art) -(require 'gnus-win) ;;; User variables: -(defgroup picons nil - "Show pictures of people, domains, and newsgroups (XEmacs). -For this to work, you must switch on the `gnus-treat-display-picons' -variable." - :group 'gnus-visual) - -(defcustom gnus-picons-display-where 'picons - "Where to display the group and article icons. -Valid values are `article' and `picons'." - :type '(choice symbol string) - :group 'picons) - -(defcustom gnus-picons-has-modeline-p t - "*Whether the picons window should have a modeline. -This is only useful if `gnus-picons-display-where' is `picons'." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-database "/usr/local/faces" - "*Defines the location of the faces database. -For information on obtaining this database of pretty pictures, please -see http://www.cs.indiana.edu/picons/ftp/index.html" - :type 'directory - :group 'picons) - -(defcustom gnus-picons-news-directories '("news") +(defcustom gnus-picon-news-directories '("news") "*List of directories to search for newsgroups faces." :type '(repeat string) - :group 'picons) -(define-obsolete-variable-alias 'gnus-picons-news-directory - 'gnus-picons-news-directories) + :group 'gnus-picon) -(defcustom gnus-picons-user-directories '("local" "users" "usenix" "misc") +(defcustom gnus-picon-user-directories '("users" "usenix" "local" "misc") "*List of directories to search for user faces." :type '(repeat string) - :group 'picons) + :group 'gnus-picon) -(defcustom gnus-picons-domain-directories '("domains") +(defcustom gnus-picon-domain-directories '("domains") "*List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." :type '(repeat string) - :group 'picons) - -(defcustom gnus-picons-refresh-before-display nil - "*If non-nil, display the article buffer before computing the picons." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-group-excluded-groups nil - "*If this regexp matches the group name, group picons will be disabled." - :type 'regexp - :group 'picons) - -(defcustom gnus-picons-display-as-address t - "*If t display textual email addresses along with pictures." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-file-suffixes - (when (featurep 'x) - (let ((types (list "xbm"))) - (when (featurep 'gif) - (push "gif" types)) - (when (featurep 'xpm) - (push "xpm" types)) - types)) + :group 'gnus-picon) + +(defcustom gnus-picon-file-types + (let ((types (list "xbm"))) + (if (gnus-image-type-available-p 'gif) + (setq types (cons "gif" types))) + (if (gnus-image-type-available-p 'xpm) + (setq types (cons "xpm" types))) + types) "*List of suffixes on picon file names to try." :type '(repeat string) - :group 'picons) - -(defcustom gnus-picons-display-article-move-p nil - "*Whether to move point to first empty line when displaying picons. -This has only an effect if `gnus-picons-display-where' has value `article'." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-clear-cache-on-shutdown t - "*Whether to clear the picons cache when exiting gnus. -Gnus caches every picons it finds while it is running. This saves -some time in the search process but eats some memory. If this -variable is set to nil, Gnus will never clear the cache itself; you -will have to manually call `gnus-picons-clear-cache' to clear it. -Otherwise the cache will be cleared every time you exit Gnus." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-piconsearch-url nil - "*The url to query for picons. Setting this to nil will disable it. -The only publicly available address currently known is -http://www.cs.indiana.edu:800/piconsearch. If you know of any other, -please tell me so that we can list it." - :type '(choice (const :tag "Disable" :value nil) - (const :tag "www.cs.indiana.edu" - :value "http://www.cs.indiana.edu:800/piconsearch") - (string)) - :group 'picons) - -(defface gnus-picons-xbm-face '((t (:foreground "black" :background "white"))) - "Face to show xbm picons in." - :group 'picons) - -(defface gnus-picons-face '((t (:foreground "black" :background "white"))) - "Face to show picons in." - :group 'picons) - -(defcustom gnus-picons-setup-hook nil - "Hook run in Picons buffers." - :group 'picons - :type 'hook) + :group 'gnus-picon) -;;; Internal variables: +(defface gnus-picon-xbm-face '((t (:foreground "black" :background "white"))) + "Face to show xbm picon in." + :group 'gnus-picon) -(defvar gnus-picons-setup-p nil) -(defvar gnus-picons-processes-alist nil - "Picons processes currently running and their environment.") -(defvar gnus-picons-glyph-alist nil - "Picons glyphs cache. -List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") -(defvar gnus-picons-url-alist nil - "Picons file names cache. -List of pairs (KEY . NAME) where KEY is (USER HOST DBS) and NAME is an URL.") +(defface gnus-picon-face '((t (:foreground "black" :background "white"))) + "Face to show picon in." + :group 'gnus-picon) -(defvar gnus-picons-jobs-alist nil - "List of jobs that still need be done. -This is a list of (SYM-ANN TAG ARGS...) where SYM-ANN three annotations list, -TAG is one of `picon' or `search' indicating that the job should query a -picon or do a search for picons file names, and ARGS is some additionnal -arguments necessary for the job.") +;;; Internal variables: -(defvar gnus-picons-job-already-running nil - "Lock to ensure only one stream of http requests is running.") +(defvar gnus-picon-setup-p nil) +(defvar gnus-picon-glyph-alist nil + "Picon glyphs cache. +List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") +(defvar gnus-picon-cache nil) ;;; Functions: -(defun gnus-picons-remove-all () - "Removes all picons from the Gnus display(s)." +(defsubst gnus-picon-split-address (address) + (setq address (split-string address "@")) + (if (stringp (cadr address)) + (cons (car address) (split-string (cadr address) "\\.")) + (if (stringp (car address)) + (split-string (car address) "\\.")))) + +(defun gnus-picon-find-face (address directories &optional exact) + (let* ((address (gnus-picon-split-address address)) + (user (pop address)) + (faddress address) + database directory result instance base) + (catch 'found + (dolist (database gnus-picon-databases) + (dolist (directory directories) + (setq address faddress + base (expand-file-name directory database)) + (while address + (when (setq result (gnus-picon-find-image + (concat base "/" (mapconcat 'downcase + (reverse address) + "/") + "/" (downcase user) "/"))) + (throw 'found result)) + (if exact + (setq address nil) + (pop address))) + ;; Kludge to search MISC as well. But not in "news". + (unless (string= directory "news") + (when (setq result (gnus-picon-find-image + (concat base "/MISC/" user "/"))) + (throw 'found result)))))))) + +(defun gnus-picon-find-image (directory) + (let ((types gnus-picon-file-types) + found type file) + (while (and (not found) + (setq type (pop types))) + (setq found (file-exists-p (setq file (concat directory "face." type))))) + (if found + file + nil))) + +(defun gnus-picon-insert-glyph (glyph category) + "Insert GLYPH into the buffer. +GLYPH can be either a glyph or a string." + (if (stringp glyph) + (insert glyph) + (gnus-add-wash-type category) + (gnus-add-image category (car glyph)) + (gnus-put-image (car glyph) (cdr glyph)))) + +(defun gnus-picon-create-glyph (file) + (or (cdr (assoc file gnus-picon-glyph-alist)) + (cdar (push (cons file (gnus-create-image file)) + gnus-picon-glyph-alist)))) + +;;; Functions that does picon transformations: + +(defun gnus-picon-transform-address (header category) + (gnus-with-article-headers + (let ((addresses + (mail-header-parse-addresses (mail-fetch-field header))) + spec file point cache) + (dolist (address addresses) + (setq address (car address)) + (when (and (stringp address) + (setq spec (gnus-picon-split-address address))) + (if (setq cache (cdr (assoc address gnus-picon-cache))) + (setq spec cache) + (when (setq file (or (gnus-picon-find-face + address gnus-picon-user-directories) + (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (cdr spec) ".")) + gnus-picon-user-directories))) + (setcar spec (cons (gnus-picon-create-glyph file) + (car spec)))) + + (dotimes (i (1- (length spec))) + (when (setq file (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (nthcdr (1+ i) spec) ".")) + gnus-picon-domain-directories t)) + (setcar (nthcdr (1+ i) spec) + (cons (gnus-picon-create-glyph file) + (nth (1+ i) spec))))) + (setq spec (nreverse spec)) + (push (cons address spec) gnus-picon-cache)) + + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (when (search-forward address nil t) + (delete-region (match-beginning 0) (match-end 0)) + (setq point (point)) + (while spec + (goto-char point) + (if (> (length spec) 2) + (insert ".") + (if (= (length spec) 2) + (insert "@"))) + (gnus-picon-insert-glyph (pop spec) category)))))))) + +(defun gnus-picon-transform-newsgroups (header) (interactive) - (map-extents (function (lambda (ext unused) (delete-annotation ext) nil)) - nil nil nil nil nil 'gnus-picon) - (setq gnus-picons-jobs-alist '()) - ;; notify running job that it may have been preempted - (if (and (listp gnus-picons-job-already-running) - gnus-picons-job-already-running) - (setq gnus-picons-job-already-running t))) - -(defun gnus-get-buffer-name (variable) - "Returns the buffer name associated with the contents of a variable." - (let ((buf (gnus-get-buffer-create - (gnus-window-to-buffer-helper - (cdr (assq variable gnus-window-to-buffer)))))) - (and buf - (buffer-name buf)))) - -(defun gnus-picons-buffer-name () - (cond ((or (stringp gnus-picons-display-where) - (bufferp gnus-picons-display-where)) - gnus-picons-display-where) - ((eq gnus-picons-display-where 'picons) - (if gnus-single-article-buffer - "*Picons*" - (concat "*Picons " gnus-newsgroup-name "*"))) - (t - (gnus-get-buffer-name gnus-picons-display-where)))) - -(defun gnus-picons-kill-buffer () - (let ((buf (get-buffer (gnus-picons-buffer-name)))) - (when (and (buffer-live-p buf) - (string-match "Picons" (buffer-name buf))) - (kill-buffer buf)))) - -(defun gnus-picons-setup-buffer () - (let ((name (gnus-picons-buffer-name))) - (save-excursion - (if (and (get-buffer name) - (with-current-buffer name - gnus-picons-setup-p)) - (set-buffer name) - (set-buffer (gnus-get-buffer-create name)) - (buffer-disable-undo) - (setq buffer-read-only t) - (run-hooks 'gnus-picons-setup-hook) - (set (make-local-variable 'gnus-picons-setup-p) t) - (add-hook 'gnus-summary-prepare-exit-hook 'gnus-picons-kill-buffer)) - (current-buffer)))) - -(defun gnus-picons-set-buffer () - (set-buffer (gnus-picons-setup-buffer)) - (goto-char (point-min)) - (if (and (eq gnus-picons-display-where 'article) - gnus-picons-display-article-move-p) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (setq buffer-read-only t) - (unless gnus-picons-has-modeline-p - (set-specifier has-modeline-p - (list (list (current-buffer) - (cons nil gnus-picons-has-modeline-p))))))) - -(defun gnus-picons-prepare-for-annotations () - "Prepare picons buffer for putting annotations." - ;; let drawing catch up - (when gnus-picons-refresh-before-display - (sit-for 0)) - (gnus-picons-set-buffer) - (gnus-picons-remove-all)) - -(defun gnus-picons-make-annotation (&rest args) - (let ((annot (apply 'make-annotation args))) - (set-extent-property annot 'gnus-picon t) - (set-extent-property annot 'duplicable t) - annot)) - -(defun gnus-article-display-picons () - "Display faces for an author and her domain in gnus-picons-display-where." + (gnus-with-article-headers + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (let ((groups (message-tokenize-header (mail-fetch-field header))) + spec file point) + (dolist (group groups) + (unless (setq spec (cdr (assoc group gnus-picon-cache))) + (setq spec (nreverse (split-string group "[.]"))) + (dotimes (i (length spec)) + (when (setq file (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (nthcdr i spec) ".")) + gnus-picon-news-directories t)) + (setcar (nthcdr i spec) + (cons (gnus-picon-create-glyph file) + (nth i spec))))) + (push (cons group spec) gnus-picon-cache)) + (when (search-forward group nil t) + (delete-region (match-beginning 0) (match-end 0)) + (save-restriction + (narrow-to-region (point) (point)) + (while spec + (goto-char (point-min)) + (if (> (length spec) 1) + (insert ".")) + (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)) + (goto-char (point-max)))))))) + +;;; Commands: + +;;;###autoload +(defun gnus-treat-from-picon () + "Display picons in the From header. +If picons are already displayed, remove them." (interactive) - (let (from at-idx) - (when (and (featurep 'xpm) - (or (not (fboundp 'device-type)) (equal (device-type) 'x)) - (setq from (mail-fetch-field "from")) - (setq from (downcase (or (cadr (mail-extract-address-components - from)) - ""))) - (or (setq at-idx (string-match "@" from)) - (setq at-idx (length from)))) - (save-excursion - (let ((username (downcase (substring from 0 at-idx))) - (addrs (if (eq at-idx (length from)) - (if gnus-local-domain - (message-tokenize-header gnus-local-domain ".")) - (message-tokenize-header (substring from (1+ at-idx)) - ".")))) - (gnus-picons-prepare-for-annotations) - (gnus-group-display-picons) - (unless gnus-picons-display-article-move-p - (let ((buffer-read-only nil) - (case-fold-search t)) - (when (re-search-forward "^From *: *" nil t) - (when (search-forward from (gnus-point-at-eol) t) - (gnus-put-text-property - (match-beginning 0) (match-end 0) - 'invisible t))))) - (if (null gnus-picons-piconsearch-url) - (progn - (gnus-picons-display-pairs (gnus-picons-lookup-pairs - addrs - gnus-picons-domain-directories) - gnus-picons-display-as-address - "." t) - (if (and gnus-picons-display-as-address addrs) - (gnus-picons-make-annotation - [string :data "@"] nil 'text nil nil nil t)) - (gnus-picons-display-picon-or-name - (gnus-picons-lookup-user username addrs) - username t)) - (push (list 'gnus-article-annotations 'search username addrs - gnus-picons-domain-directories t (point-marker)) - gnus-picons-jobs-alist) - (gnus-picons-next-job))))))) - -(defun gnus-group-display-picons () - "Display icons for the group in the `gnus-picons-display-where' buffer." + (gnus-with-article-buffer + (if (memq 'from-picon gnus-article-wash-types) + (gnus-delete-images 'from-picon) + (gnus-picon-transform-address "from" 'from-picon)))) + +;;;###autoload +(defun gnus-treat-mail-picon () + "Display picons in the Cc and To headers. +If picons are already displayed, remove them." (interactive) - (when (and (featurep 'xpm) - (or (not (fboundp 'device-type)) (equal (device-type) 'x)) - (or (null gnus-picons-group-excluded-groups) - (not (string-match gnus-picons-group-excluded-groups - gnus-newsgroup-name)))) - (let* ((newsgroups (mail-fetch-field "newsgroups")) - (groups - (if (or gnus-picons-display-article-move-p - (not newsgroups)) - (list (gnus-group-real-name gnus-newsgroup-name)) - (split-string newsgroups ","))) - group) - (save-excursion - (gnus-picons-prepare-for-annotations) - (while (setq group (pop groups)) - (unless gnus-picons-display-article-move-p - (let ((buffer-read-only nil) - (case-fold-search t)) - (goto-char (point-min)) - (if (and (re-search-forward "^Newsgroups *: *" nil t) - (search-forward group (gnus-point-at-eol) t)) - (gnus-put-text-property - (match-beginning 0) (match-end 0) - 'invisible t) - (let ((article-goto-body-goes-to-point-min-p nil)) - (article-goto-body)) - (unless (bobp) - (backward-char 1))))) - (if (null gnus-picons-piconsearch-url) - (gnus-picons-display-pairs - (gnus-picons-lookup-pairs - (reverse (split-string group "\\.")) - gnus-picons-news-directories) - t ".") - (push (list 'gnus-group-annotations 'search nil - (split-string group "\\.") - (if (listp gnus-picons-news-directories) - gnus-picons-news-directories - (list gnus-picons-news-directories)) - nil (point-marker)) - gnus-picons-jobs-alist) - (gnus-picons-next-job)) - - (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) - -(defun gnus-picons-lookup-internal (addrs dir) - (setq dir (expand-file-name dir gnus-picons-database)) - (gnus-picons-try-face (dolist (part (reverse addrs) dir) - (setq dir (expand-file-name part dir))))) - -(defun gnus-picons-lookup (addrs dirs) - "Lookup the picon for ADDRS in databases DIRS. -Returns the picon filename or NIL if none found." - (let (result) - (while (and dirs (null result)) - (setq result (gnus-picons-lookup-internal addrs (pop dirs)))) - result)) - -(defun gnus-picons-lookup-user-internal (user domains) - (let ((dirs gnus-picons-user-directories) - domains-tmp dir picon) - (while (and dirs (null picon)) - (setq domains-tmp domains - dir (pop dirs)) - (while (and domains-tmp - (null (setq picon (gnus-picons-lookup-internal - (cons user domains-tmp) dir)))) - (pop domains-tmp)) - ;; Also make a try in MISC subdir - (unless picon - (setq picon (gnus-picons-lookup-internal (list user "MISC") dir)))) - picon)) - -(defun gnus-picons-lookup-user (user domains) - "Lookup the picon for USER at DOMAINS. -USER is a string containing a name. -DOMAINS is a list of strings from the fully qualified domain name." - (or (gnus-picons-lookup-user-internal user domains) - (gnus-picons-lookup-user-internal "unknown" domains))) - -(defun gnus-picons-lookup-pairs (domains directories) - "Lookup picons for DOMAINS and all its parents in DIRECTORIES. -Returns a list of PAIRS whose CAR is the picon filename or NIL if -none, and whose CDR is the corresponding element of DOMAINS." - (let (picons) - (setq directories (if (listp directories) - directories - (list directories))) - (while domains - (push (list (gnus-picons-lookup (cons "unknown" domains) directories) - (pop domains)) - picons)) - picons)) - -(defun gnus-picons-display-picon-or-name (picon name &optional right-p) - (cond (picon (gnus-picons-display-glyph picon name right-p)) - (gnus-picons-display-as-address (list (gnus-picons-make-annotation - (vector 'string :data name) - nil 'text - nil nil nil right-p))))) - -(defun gnus-picons-display-pairs (pairs &optional bar-p dot-p right-p) - "Display picons in list PAIRS." - (let ((domain-p (and gnus-picons-display-as-address dot-p)) - pair picons) - (when (and bar-p domain-p right-p - gnus-picons-display-article-move-p) - (setq picons (gnus-picons-display-glyph - (let ((gnus-picons-file-suffixes '("xbm"))) - (gnus-picons-try-face - gnus-xmas-glyph-directory "bar.")) - nil right-p))) - (while (setq pair (pop pairs)) - (setq picons (nconc picons - (gnus-picons-display-picon-or-name - (car pair) (cadr pair) right-p) - (if (and domain-p pairs) - (list (gnus-picons-make-annotation - (vector 'string :data dot-p) - nil 'text nil nil nil right-p)))))) - picons)) - -(defun gnus-picons-try-face (dir &optional filebase) - (let* ((dir (file-name-as-directory dir)) - (filebase (or filebase "face.")) - (key (concat dir filebase)) - (glyph (cdr (assoc key gnus-picons-glyph-alist))) - (suffixes gnus-picons-file-suffixes) - f suf) - (while (setq suf (pop suffixes)) - (when (file-exists-p (setq f (expand-file-name - (concat filebase suf) - dir))) - (setq suffixes nil - glyph (make-glyph f)) - (if (equal suf "xbm") - (set-glyph-face glyph 'gnus-picons-xbm-face) - (set-glyph-face glyph 'gnus-picons-face)) - (push (cons key glyph) gnus-picons-glyph-alist))) - glyph)) - -(defun gnus-picons-display-glyph (glyph &optional part rightp) - (set-glyph-baseline glyph 70) - (let ((new (gnus-picons-make-annotation - glyph (point) 'text nil nil nil rightp))) - (when (and part gnus-picons-display-as-address) - (set-annotation-data - new (cons new (make-glyph (vector 'string :data part)))) - (set-annotation-action new 'gnus-picons-action-toggle)) - (nconc - (list new) - (if (and (eq major-mode 'gnus-article-mode) - (not gnus-picons-display-as-address) - (not part)) - (list (gnus-picons-make-annotation [string :data " "] (point) - 'text nil nil nil rightp)))))) - -(defun gnus-picons-action-toggle (data) - "Toggle annotation." - (interactive "e") - (let* ((annot (car data)) - (glyph (annotation-glyph annot))) - (set-annotation-glyph annot (cdr data)) - (set-annotation-data annot (cons annot glyph)))) - -(defun gnus-picons-clear-cache () - "Clear the picons cache." + (gnus-with-article-buffer + (if (memq 'mail-picon gnus-article-wash-types) + (gnus-delete-images 'mail-picon) + (gnus-picon-transform-address "cc" 'mail-picon) + (gnus-picon-transform-address "to" 'mail-picon)))) + +;;;###autoload +(defun gnus-treat-newsgroups-picon () + "Display picons in the Newsgroups and Followup-To headers. +If picons are already displayed, remove them." (interactive) - (setq gnus-picons-glyph-alist nil - gnus-picons-url-alist nil)) - -(gnus-add-shutdown 'gnus-picons-close 'gnus) - -(defun gnus-picons-close () - "Shut down the picons." - (if gnus-picons-clear-cache-on-shutdown - (gnus-picons-clear-cache))) - -;;; Query a remote DB. This requires some stuff from w3 ! - -(eval-and-compile - (ignore-errors - (require 'url) - (require 'w3-forms))) - -(defun gnus-picons-url-retrieve (url fn arg) - (let ((old-asynch (default-value 'url-be-asynchronous)) - (url-working-buffer (generate-new-buffer " *picons*")) - (url-package-name "Gnus") - (url-package-version gnus-version-number) - url-request-method) - (setq-default url-be-asynchronous t) - (save-excursion - (set-buffer url-working-buffer) - (setq url-be-asynchronous t - url-current-callback-data arg - url-current-callback-func fn) - (url-retrieve url t)) - (setq-default url-be-asynchronous old-asynch))) - -(defun gnus-picons-make-glyph (type) - "Make a TYPE glyph using current buffer as data. Handles xbm nicely." - (cond ((null type) nil) - ((eq type 'xbm) (let ((fname (make-temp-name "/tmp/picon"))) - (write-region (point-min) (point-max) fname - nil 'quiet) - (prog1 (make-glyph (vector 'xbm :file fname)) - (delete-file fname)))) - (t (make-glyph (vector type :data (buffer-string)))))) - -;;; Parsing of piconsearch result page. - -;; Assumes: -;; 1 - each value field has the form: "key = value" -;; 2 - a "

" separates the keywords from the results -;; 3 - every results begins by the path within the database at the beginning -;; of the line in raw text. -;; 3b - and the href following it is the preferred image type. - -;; if 1 or 2 is not met, it will probably cause an error. The other -;; will go undetected - -(defun gnus-picons-parse-value (name) - (goto-char (point-min)) - (if (re-search-forward (concat "" - (regexp-quote name) - " *= * *\\([^ <][^<]*\\) *") - nil t) - (buffer-substring (match-beginning 1) (match-end 1)))) - -(defun gnus-picons-parse-filenames () - ;; returns an alist of ((USER ADDRS DB) . URL) - (let ((case-fold-search t) - (user (gnus-picons-parse-value "user")) - (host (gnus-picons-parse-value "host")) - (dbs (message-tokenize-header (gnus-picons-parse-value "db") " ")) - start-re cur-db cur-host cur-user types res) - ;; now point will be somewhere in the header. Find beginning of - ;; entries - (when (and user host dbs) - (setq start-re - (concat - ;; dbs - "^\\(" (mapconcat 'regexp-quote dbs "\\|") "\\)/" - ;; host - "\\(\\(" (mapconcat 'regexp-quote - (message-tokenize-header host ".") "/\\|") - "/\\|MISC/\\)*\\)" - ;; user - "\\(" (regexp-quote user) "\\|unknown\\)/" - "face\\.")) - (re-search-forward "

[ \t\n]*") - (while (re-search-forward start-re nil t) - (setq cur-db (buffer-substring (match-beginning 1) (match-end 1)) - cur-host (buffer-substring (match-beginning 2) (match-end 2)) - cur-user (buffer-substring (match-beginning 4) (match-end 4)) - cur-host (nreverse (message-tokenize-header cur-host "/"))) - ;; XXX - KLUDGE: there is a blank picon in news/MISC/unknown - (unless (and (string-equal cur-db "news") - (string-equal cur-user "unknown") - (equal cur-host '("MISC"))) - ;; ok now we have found an entry (USER HOST DB), find the - ;; corresponding picon URL - (save-restriction - ;; restrict region to this entry - (narrow-to-region (point) (search-forward "
")) - (goto-char (point-min)) - (setq types gnus-picons-file-suffixes) - (while (and types - (not (re-search-forward - (concat " ;; Keywords: news @@ -30,6 +31,11 @@ ;;; List and range functions +(defsubst gnus-range-normalize (range) + "Normalize RANGE. +If RANGE is a single range, return (RANGE). Otherwise, return RANGE." + (if (listp (cdr-safe range)) range (list range))) + (defun gnus-last-element (list) "Return last element of LIST." (while (cdr list) @@ -55,6 +61,85 @@ (setq list2 (cdr list2))) list1)) +(defun gnus-range-difference (range1 range2) + "Return the range of elements in RANGE1 that do not appear in RANGE2. +Both ranges must be in ascending order." + (setq range1 (gnus-range-normalize range1)) + (setq range2 (gnus-range-normalize range2)) + (let* ((new-range (cons nil (copy-sequence range1))) + (r new-range) + (safe t)) + (while (cdr r) + (let* ((r1 (cadr r)) + (r2 (car range2)) + (min1 (if (numberp r1) r1 (car r1))) + (max1 (if (numberp r1) r1 (cdr r1))) + (min2 (if (numberp r2) r2 (car r2))) + (max2 (if (numberp r2) r2 (cdr r2)))) + + (cond ((> min1 max1) + ;; Invalid range: may result from overlap condition (below) + ;; remove Invalid range + (setcdr r (cddr r))) + ((and (= min1 max1) + (listp r1)) + ;; Inefficient representation: may result from overlap condition (below) + (setcar (cdr r) min1)) + ((not min2) + ;; All done with range2 + (setq r nil)) + ((< max1 min2) + ;; No overlap: range1 preceeds range2 + (pop r)) + ((< max2 min1) + ;; No overlap: range2 preceeds range1 + (pop range2)) + ((and (<= min2 min1) (<= max1 max2)) + ;; Complete overlap: range1 removed + (setcdr r (cddr r))) + (t + (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r))))))) + (cdr new-range))) + + + +;;;###autoload +(defun gnus-sorted-difference (list1 list2) + "Return a list of elements of LIST1 that do not appear in LIST2. +Both lists have to be sorted over <. +The tail of LIST1 is not copied." + (let (out) + (while (and list1 list2) + (cond ((= (car list1) (car list2)) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< (car list1) (car list2)) + (setq out (cons (car list1) out)) + (setq list1 (cdr list1))) + (t + (setq list2 (cdr list2))))) + (nconc (nreverse out) list1))) + +;;;###autoload +(defun gnus-sorted-ndifference (list1 list2) + "Return a list of elements of LIST1 that do not appear in LIST2. +Both lists have to be sorted over <. +LIST1 is modified." + (let* ((top (cons nil list1)) + (prev top)) + (while (and list1 list2) + (cond ((= (car list1) (car list2)) + (setcdr prev (cdr list1)) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< (car list1) (car list2)) + (setq prev list1 + list1 (cdr list1))) + (t + (setq list2 (cdr list2))))) + (cdr top))) + +;;;###autoload (defun gnus-sorted-complement (list1 list2) "Return a list of elements that are in LIST1 or LIST2 but not both. Both lists have to be sorted over <." @@ -73,6 +158,7 @@ Both lists have to be sorted over <." (setq list2 (cdr list2))))) (nconc (nreverse out) (or list1 list2))))) +;;;###autoload (defun gnus-intersection (list1 list2) (let ((result nil)) (while list2 @@ -81,8 +167,10 @@ Both lists have to be sorted over <." (setq list2 (cdr list2))) result)) +;;;###autoload (defun gnus-sorted-intersection (list1 list2) - ;; LIST1 and LIST2 have to be sorted over <. + "Return intersection of LIST1 and LIST2. +LIST1 and LIST2 have to be sorted over <." (let (out) (while (and list1 list2) (cond ((= (car list1) (car list2)) @@ -95,9 +183,13 @@ Both lists have to be sorted over <." (setq list2 (cdr list2))))) (nreverse out))) -(defun gnus-set-sorted-intersection (list1 list2) - ;; LIST1 and LIST2 have to be sorted over <. - ;; This function modifies LIST1. +;;;###autoload +(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) + +;;;###autoload +(defun gnus-sorted-nintersection (list1 list2) + "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1. +LIST1 and LIST2 have to be sorted over <." (let* ((top (cons nil list1)) (prev top)) (while (and list1 list2) @@ -113,6 +205,55 @@ Both lists have to be sorted over <." (setcdr prev nil) (cdr top))) +;;;###autoload +(defun gnus-sorted-union (list1 list2) + "Return union of LIST1 and LIST2. +LIST1 and LIST2 have to be sorted over <." + (let (out) + (while (and list1 list2) + (cond ((= (car list1) (car list2)) + (setq out (cons (car list1) out) + list1 (cdr list1) + list2 (cdr list2))) + ((< (car list1) (car list2)) + (setq out (cons (car list1) out) + list1 (cdr list1))) + (t + (setq out (cons (car list2) out) + list2 (cdr list2))))) + (while list1 + (setq out (cons (car list1) out) + list1 (cdr list1))) + (while list2 + (setq out (cons (car list2) out) + list2 (cdr list2))) + (nreverse out))) + +;;;###autoload +(defun gnus-sorted-nunion (list1 list2) + "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1. +LIST1 and LIST2 have to be sorted over <." + (let* ((top (cons nil list1)) + (prev top)) + (while (and list1 list2) + (cond ((= (car list1) (car list2)) + (setq prev list1 + list1 (cdr list1) + list2 (cdr list2))) + ((< (car list1) (car list2)) + (setq prev list1 + list1 (cdr list1))) + (t + (setcdr prev (list (car list2))) + (setq prev (cdr prev) + list2 (cdr list2)) + (setcdr prev list1)))) + (while list2 + (setcdr prev (list (car list2))) + (setq prev (cdr prev) + list2 (cdr list2))) + (cdr top))) + (defun gnus-compress-sequence (numbers &optional always-list) "Convert list of numbers to a list of ranges or a single range. If ALWAYS-LIST is non-nil, this function will always release a list of @@ -319,9 +460,58 @@ modified." (setq ranges (cdr ranges))) (not not-stop)))) +(defun gnus-list-range-intersection (list ranges) + "Return a list of numbers in LIST that are members of RANGES. +LIST is a sorted list." + (setq ranges (gnus-range-normalize ranges)) + (let (number result) + (while (setq number (pop list)) + (while (and ranges + (if (numberp (car ranges)) + (< (car ranges) number) + (< (cdar ranges) number))) + (setq ranges (cdr ranges))) + (when (and ranges + (if (numberp (car ranges)) + (= (car ranges) number) + ;; (caar ranges) <= number <= (cdar ranges) + (>= number (caar ranges)))) + (push number result))) + (nreverse result))) + +(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference) + +(defun gnus-list-range-difference (list ranges) + "Return a list of numbers in LIST that are not members of RANGES. +LIST is a sorted list." + (setq ranges (gnus-range-normalize ranges)) + (let (number result) + (while (setq number (pop list)) + (while (and ranges + (if (numberp (car ranges)) + (< (car ranges) number) + (< (cdar ranges) number))) + (setq ranges (cdr ranges))) + (when (or (not ranges) + (if (numberp (car ranges)) + (not (= (car ranges) number)) + ;; not ((caar ranges) <= number <= (cdar ranges)) + (< number (caar ranges)))) + (push number result))) + (nreverse result))) + (defun gnus-range-length (range) "Return the length RANGE would have if uncompressed." - (length (gnus-uncompress-range range))) + (cond + ((null range) + 0) + ((not (listp (cdr range))) + (- (cdr range) (car range) -1)) + (t + (let ((sum 0)) + (dolist (x range sum) + (setq sum + (+ sum (if (consp x) (- (cdr x) (car x) -1) 1)))))))) (defun gnus-sublist-p (list sublist) "Test whether all elements in SUBLIST are members of LIST." @@ -343,7 +533,7 @@ modified." range item selector) (while (or item1 item2) (setq selector - (cond + (cond ((null item1) nil) ((null item2) t) ((and (numberp item1) (numberp item2)) (< item1 item2)) @@ -353,30 +543,30 @@ modified." (setq item (or (let ((tmp1 item) (tmp2 (if selector item1 item2))) - (cond + (cond ((null tmp1) tmp2) ((null tmp2) tmp1) ((and (numberp tmp1) (numberp tmp2)) - (cond + (cond ((eq tmp1 tmp2) tmp1) ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2)) ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1)) (t nil))) ((numberp tmp1) - (cond + (cond ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2) ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2))) ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1)) (t nil))) ((numberp tmp2) - (cond + (cond ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1) ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1))) ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2)) (t nil))) ((< (1+ (cdr tmp1)) (car tmp2)) nil) ((< (1+ (cdr tmp2)) (car tmp1)) nil) - (t (cons (min (car tmp1) (car tmp2)) + (t (cons (min (car tmp1) (car tmp2)) (max (cdr tmp1) (cdr tmp2)))))) (progn (if item (push item range)) @@ -387,6 +577,18 @@ modified." (if item (push item range)) (reverse range))) +;;;###autoload +(defun gnus-add-to-sorted-list (list num) + "Add NUM into sorted LIST by side effect." + (let* ((top (cons nil list)) + (prev top)) + (while (and list (< (car list) num)) + (setq prev list + list (cdr list))) + (unless (eq (car list) num) + (setcdr prev (cons num list))) + (cdr top))) + (provide 'gnus-range) ;;; gnus-range.el ends here diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index dd2aa1f..3727a4f 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -1,6 +1,7 @@ ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2001 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -30,13 +31,15 @@ (require 'gnus) (require 'gnus-sum) +(require 'gnus-win) ;;; ;;; gnus-pick-mode ;;; (defvar gnus-pick-mode nil - "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") + "Minor mode for providing a pick-and-read interface in Gnus +summary buffers.") (defcustom gnus-pick-display-summary nil "*Display summary while reading." @@ -48,18 +51,22 @@ :type 'hook :group 'gnus-summary-pick) +(when (featurep 'xemacs) + (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)) + (defcustom gnus-mark-unpicked-articles-as-read nil "*If non-nil, mark all unpicked articles as read." :type 'boolean :group 'gnus-summary-pick) (defcustom gnus-pick-elegant-flow t - "If non-nil, `gnus-pick-start-reading' runs `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) (defcustom gnus-summary-pick-line-format - "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n" "*The format specification of the lines in pick buffers. It accepts the same format specs that `gnus-summary-line-format' does." :type 'string @@ -148,11 +155,11 @@ If given a prefix, mark all unpicked articles as read." (interactive "P") (if gnus-newsgroup-processable (progn - (gnus-summary-limit-to-articles nil) - (when (or catch-up gnus-mark-unpicked-articles-as-read) + (gnus-summary-limit-to-articles nil) + (when (or catch-up gnus-mark-unpicked-articles-as-read) (gnus-summary-limit-mark-excluded-as-read)) - (gnus-summary-first-article) - (gnus-configure-windows + (gnus-summary-first-article) + (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow (progn @@ -223,7 +230,7 @@ This must be bound to a button-down mouse event." (let* ((echo-keystrokes 0) (start-posn (event-start start-event)) (start-point (posn-point start-posn)) - (start-line (1+ (count-lines 1 start-point))) + (start-line (1+ (count-lines 1 start-point))) (start-window (posn-window start-posn)) (bounds (gnus-window-edges start-window)) (top (nth 1 bounds)) @@ -361,7 +368,7 @@ This must be bound to a button-down mouse event." (defun gnus-binary-display-article (article &optional all-header) "Run ARTICLE through the binary decode functions." (when (gnus-summary-goto-subject article) - (let ((gnus-view-pseudos 'automatic)) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu)))) (defun gnus-binary-show-article (&optional arg) @@ -418,6 +425,11 @@ Two predefined functions are available: :type 'hook :group 'gnus-summary-tree) +(when (featurep 'xemacs) + (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) + (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) + + ;;; Internal variables. (defvar gnus-tree-line-format-alist @@ -543,7 +555,7 @@ Two predefined functions are available: (defun gnus-tree-recenter () "Center point in the tree window." (let ((selected (selected-window)) - (tree-window (get-buffer-window gnus-tree-buffer t))) + (tree-window (gnus-get-buffer-window gnus-tree-buffer t))) (when tree-window (select-window tree-window) (when gnus-selected-tree-overlay @@ -656,6 +668,10 @@ Two predefined functions are available: (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) gnus-summary-default-score 0)) (default gnus-summary-default-score) + (default-high gnus-summary-default-high-score) + (default-low gnus-summary-default-low-score) + (uncached (memq article gnus-newsgroup-undownloaded)) + (downloaded (not uncached)) (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) ;; Eval the cars of the lists until we find a match. (while (and list @@ -686,8 +702,8 @@ Two predefined functions are available: (gnus-tree-minimize) (gnus-tree-recenter) (let ((selected (selected-window))) - (when (get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) + (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) + (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)) (gnus-horizontal-recenter) (select-window selected)))))) @@ -825,6 +841,13 @@ Two predefined functions are available: (defun gnus-tree-close (group) (gnus-kill-buffer gnus-tree-buffer)) +(defun gnus-tree-perhaps-minimize () + (when (and gnus-tree-minimize-window + (get-buffer gnus-tree-buffer)) + (save-excursion + (set-buffer gnus-tree-buffer) + (gnus-tree-minimize)))) + (defun gnus-highlight-selected-tree (article) "Highlight the selected article in the tree." (let ((buf (current-buffer)) @@ -843,8 +866,8 @@ Two predefined functions are available: (gnus-tree-minimize) (gnus-tree-recenter) (let ((selected (selected-window))) - (when (get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) + (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) + (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)) (gnus-horizontal-recenter) (select-window selected)))) ;; If we remove this save-excursion, it updates the wrong mode lines?!? @@ -860,7 +883,7 @@ Two predefined functions are available: (when (setq region (gnus-tree-article-region article)) (gnus-put-text-property (car region) (cdr region) 'face face) (set-window-point - (get-buffer-window (current-buffer) t) (cdr region)))))) + (gnus-get-buffer-window (current-buffer) t) (cdr region)))))) ;;; ;;; gnus-carpal @@ -886,6 +909,7 @@ Two predefined functions are available: ("matching" . gnus-group-list-matching) ("post" . gnus-group-post-news) ("mail" . gnus-group-mail) + ("local" . (lambda () (interactive) (gnus-group-news 0))) ("rescan" . gnus-group-get-new-news) ("browse-foreign" . gnus-group-browse-foreign) ("exit" . gnus-group-exit))) @@ -916,7 +940,8 @@ Two predefined functions are available: ("kill" . gnus-summary-kill-thread) "post" ("post" . gnus-summary-post-news) - ("mail" . gnus-summary-mail) + ("local" . gnus-summary-news-other-window) + ("mail" . gnus-summary-mail-other-window) ("followup" . gnus-summary-followup-with-original) ("reply" . gnus-summary-reply-with-original) ("cancel" . gnus-summary-cancel-article) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 43e688b..865ecdc 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,5 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen @@ -33,9 +33,12 @@ (require 'gnus) (require 'gnus-sum) (require 'gnus-range) +(require 'gnus-win) (require 'message) (require 'score-mode) +(autoload 'ffap-string-at-point "ffap") + (defcustom gnus-global-score-files nil "List of global score files and directories. Set this variable if you want to use people's score files. One entry @@ -48,7 +51,7 @@ score files in the \"/ftp.some-where:/pub/score\" directory. (setq gnus-global-score-files '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\" - \"/ftp.some-where:/pub/score\"))" + \"/ftp.some-where:/pub/score\"))" :group 'gnus-score-files :type '(repeat file)) @@ -60,10 +63,10 @@ Each element of this alist should be of the form If the name of a group is matched by REGEXP, the corresponding scorefiles will be used for that group. The first match found is used, subsequent matching entries are ignored (to -use multiple matches, see gnus-score-file-multiple-match-alist). +use multiple matches, see `gnus-score-file-multiple-match-alist'). These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see)." +`gnus-score-find-score-files-function'." :group 'gnus-score-files :type '(repeat (cons regexp (repeat file)))) @@ -76,10 +79,10 @@ If the name of a group is matched by REGEXP, the corresponding scorefiles will be used for that group. If multiple REGEXPs match a group, the score files corresponding to each match will be used (for only one match to be used, see -gnus-score-file-single-match-alist). +`gnus-score-file-single-match-alist'). These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see)." +`gnus-score-find-score-files-function'." :group 'gnus-score-files :type '(repeat (cons regexp (repeat file)))) @@ -102,9 +105,9 @@ files do not actually have to exist. Predefined values are: -gnus-score-find-single: Only apply the group's own score file. -gnus-score-find-hierarchical: Also apply score files from parent groups. -gnus-score-find-bnews: Apply score files whose names matches. +`gnus-score-find-single': Only apply the group's own score file. +`gnus-score-find-hierarchical': Also apply score files from parent groups. +`gnus-score-find-bnews': Apply score files whose names matches. See the documentation to these functions for more information. @@ -233,6 +236,11 @@ This variable allows the same syntax as `gnus-home-score-file'." (symbol :tag "other")) (integer :tag "Score")))))) +(defcustom gnus-adaptive-word-length-limit nil + "*Words of a length lesser than this limit will be ignored when doing adaptive scoring." + :group 'gnus-score-adapt + :type 'integer) + (defcustom gnus-ignored-adaptive-words nil "List of words to be ignored when doing adaptive word scoring." :group 'gnus-score-adapt @@ -385,7 +393,7 @@ If nil, the user will be asked for a duration." (defcustom gnus-score-after-write-file-function nil "Function called with the name of the score file just written to disk." :group 'gnus-score-files - :type 'function) + :type '(choice (const nil) function)) (defcustom gnus-score-thread-simplify nil "If non-nil, subjects will simplified as in threading." @@ -672,7 +680,7 @@ used as score." (and gnus-extra-headers (equal (nth 1 entry) "extra") (intern ; need symbol - (gnus-completing-read + (gnus-completing-read-with-default (symbol-name (car gnus-extra-headers)) ; default response "Score extra header:" ; prompt (mapcar (lambda (x) ; completion list @@ -764,13 +772,16 @@ used as score." (insert (format format (caar alist) (nth idx (car alist)))) (setq alist (cdr alist)) (setq i (1+ i)))) + (goto-char (point-min)) ;; display ourselves in a small window at the bottom (gnus-appt-select-lowest-window) - (split-window) - (pop-to-buffer "*Score Help*") + (if (< (/ (window-height) 2) window-min-height) + (switch-to-buffer "*Score Help*") + (split-window) + (pop-to-buffer "*Score Help*")) (let ((window-min-height 1)) (shrink-window-if-larger-than-buffer)) - (select-window (get-buffer-window gnus-summary-buffer t)))) + (select-window (gnus-get-buffer-window gnus-summary-buffer t)))) (defun gnus-summary-header (header &optional no-err extra) ;; Return HEADER for current articles, or error. @@ -843,11 +854,11 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (int-to-string match) 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) - (setq match (string-to-int match))) + (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) + (if (stringp match) + (setq match (string-to-int match))) + (set-text-properties 0 (length match) nil match)) (unless (eq date 'now) ;; Add the score entry to the score file. @@ -961,7 +972,6 @@ EXTRA is the possible non-standard header." ;; All score code written by Per Abrahamsen . -;; Added by Per Abrahamsen . (defun gnus-score-set-mark-below (score) "Automatically mark articles with score below SCORE as read." (interactive @@ -1128,6 +1138,22 @@ EXTRA is the possible non-standard header." 4 (substitute-command-keys "\\\\[gnus-score-edit-exit] to save edits"))) +(defun gnus-score-edit-file-at-point () + "Edit score file at point. Useful especially after `V t'." + (interactive) + (let* ((string (ffap-string-at-point)) + ;; FIXME: Should be the full `match element', not just string at + ;; point. + file) + (save-excursion + (end-of-line) + (setq file (ffap-string-at-point))) + (gnus-score-edit-file file) + (unless (string= string file) + (goto-char (point-min)) + ;; Goto first match + (search-forward string nil t)))) + (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. (let* ((file (expand-file-name @@ -1178,7 +1204,7 @@ EXTRA is the possible non-standard header." (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) - (orphan (car (gnus-score-get 'orphan alist))) + (orphan (car (gnus-score-get 'orphan alist))) (adapt (gnus-score-get 'adapt alist)) (thread-mark-and-expunge (car (gnus-score-get 'thread-mark-and-expunge alist))) @@ -1237,7 +1263,6 @@ EXTRA is the possible non-standard header." (setq gnus-newsgroup-adaptive t) adapt) (t - ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) (setq gnus-thread-expunge-below (or thread-mark-and-expunge gnus-thread-expunge-below)) @@ -1463,7 +1488,7 @@ EXTRA is the possible non-standard header." (headers gnus-newsgroup-headers) (current-score-file gnus-current-score-file) entry header new) - (gnus-message 5 "Scoring...") + (gnus-message 7 "Scoring...") ;; Create articles, an alist of the form `(HEADER . SCORE)'. (while (setq header (pop headers)) ;; WARNING: The assq makes the function O(N*S) while it could @@ -1505,7 +1530,7 @@ EXTRA is the possible non-standard header." (with-current-buffer gnus-summary-buffer (setq gnus-newsgroup-scored scored)))) ;; Remove the buffer. - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) ;; Add articles to `gnus-newsgroup-scored'. (while gnus-scores-articles @@ -1524,15 +1549,15 @@ EXTRA is the possible non-standard header." (gnus-score-advanced (car score) trace)) (pop score)))) - (gnus-message 5 "Scoring...done")))))) + (gnus-message 7 "Scoring...done")))))) (defun gnus-score-lower-thread (thread score-adjust) - "Lower the socre on THREAD with SCORE-ADJUST. + "Lower the score 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 +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." +`gnus-newsgroup-scored' is adjusted by SCORE-ADJUST." (while thread (let ((head (car thread))) (if (listp head) @@ -1550,22 +1575,20 @@ GNUS-NEWSGROUP-SCORED is adjusted by SCORE-ADJUST." 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))))) +score in `gnus-newsgroup-scored' by SCORE." + ;; 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. + (dolist (thread (gnus-make-threads)) + (let ((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. + (when (and id + (not (string= id ""))) + (gnus-score-lower-thread thread score))))) (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) @@ -1694,7 +1717,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." entries alist ofunc article last) (when articles (setq last (mail-header-number (caar (last articles)))) - ;; Not all backends support partial fetching. In that case, + ;; 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)) @@ -1709,8 +1732,8 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (widen) (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 + ;; 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) @@ -1753,7 +1776,8 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (setq found t) (when trace (push - (cons (car-safe (rassq alist gnus-score-cache)) kill) + (cons (car-safe (rassq alist gnus-score-cache)) + kill) gnus-score-trace))) ;; Update expire date (unless trace @@ -1785,7 +1809,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." ;; 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 @@ -1795,7 +1819,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) - (setq gnus-scores-articles (sort gnus-scores-articles + (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) @@ -1840,7 +1864,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (goto-char (point-min)) (if (= dmt ?e) (while (funcall search-func match nil t) - (and (= (progn (beginning-of-line) (point)) + (and (= (gnus-point-at-bol) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) @@ -1859,13 +1883,19 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (while (setq art (pop arts)) + (setcdr art (+ score (cdr art))) + (when trace + (push (cons + (car-safe (rassq alist gnus-score-cache)) + kill) + gnus-score-trace)) (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. + ((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. @@ -1906,8 +1936,8 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ;; gnus-score-index is used as a free variable. - (simplify (and gnus-score-thread-simplify - (string= "subject" header))) + (simplify (and gnus-score-thread-simplify + (string= "subject" header))) alike last this art entries alist articles fuzzies arts words kill) @@ -1932,7 +1962,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." ;; 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 (gnus-prin1-to-string this))) ; ick. (if simplify (setq this (gnus-map-function gnus-simplify-subject-functions this))) @@ -1971,10 +2001,10 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (dmt (downcase mt)) ;; Assume user already simplified regexp and fuzzies (match (if (and simplify (not (memq dmt '(?f ?r)))) - (gnus-map-function - gnus-simplify-subject-functions - (nth 0 kill)) - (nth 0 kill))) + (gnus-map-function + gnus-simplify-subject-functions + (nth 0 kill)) + (nth 0 kill))) (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) @@ -1984,7 +2014,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." ;; Evil hackery to make match usable in non-standard headers. (when extra (setq match (concat "[ (](" extra " \\. \"[^)]*" - match "[^(]*\")[ )]") + match "[^\"]*\")[ )]") search-func 're-search-forward)) ; XXX danger?!? (cond @@ -2310,11 +2340,14 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." ;; Put the word and score into the hashtb. (setq val (gnus-gethash (setq word (match-string 0)) hashtb)) - (setq val (+ score (or val 0))) - (if (and gnus-adaptive-word-minimum - (< val gnus-adaptive-word-minimum)) - (setq val gnus-adaptive-word-minimum)) - (gnus-sethash word val hashtb)) + (when (or (not gnus-adaptive-word-length-limit) + (> (length word) + gnus-adaptive-word-length-limit)) + (setq val (+ score (or val 0))) + (if (and gnus-adaptive-word-minimum + (< val gnus-adaptive-word-minimum)) + (setq val gnus-adaptive-word-minimum)) + (gnus-sethash word val hashtb))) (erase-buffer)))) (set-syntax-table syntab)) ;; Make all the ignorable words ignored. @@ -2363,6 +2396,13 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." 1 "No score rules apply to the current article (default score %d)." gnus-summary-default-score) (set-buffer "*Score Trace*") + ;; ToDo: Use a keymap instead? + (local-set-key "q" + (lambda () + (interactive) + (bury-buffer nil) + (gnus-summary-expand-window))) + (local-set-key "e" 'gnus-score-edit-file-at-point) (setq truncate-lines t) (while trace (insert (format "%S -> %s\n" (cdar trace) @@ -2495,7 +2535,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (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-delta-default score))))) + (gnus-summary-raise-thread (- (gnus-score-delta-default score)))) ;;; Finding score files. @@ -2557,7 +2597,8 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (push file out)))) (or out ;; Return a dummy value. - (list "~/News/this.file.does.not.exist.SCORE")))) + (list (expand-file-name "this.file.does.not.exist.SCORE" + gnus-kill-files-directory))))) (defun gnus-score-file-regexp () "Return a regexp that match all score files." @@ -2595,12 +2636,14 @@ GROUP using BNews sys file syntax." ;; too much. (delete-char (min (1- (point-max)) klen)) (goto-char (point-max)) - (search-backward (char-to-string directory-sep-char)) - (delete-region (1+ (point)) (point-min))) + (if (re-search-backward gnus-directory-sep-char-regexp nil t) + (delete-region (1+ (point)) (point-min)) + (gnus-message 1 "Can't find directory separator in %s" + (car sfiles)))) ;; 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. @@ -2630,13 +2673,13 @@ GROUP using BNews sys file syntax." ;; we add this score file to the list of score files ;; applicable to this group. (when (or (and not-match - (ignore-errors + (ignore-errors (not (string-match regexp group-trans)))) - (and (not not-match) - (ignore-errors (string-match regexp group-trans)))) + (and (not not-match) + (ignore-errors (string-match regexp group-trans)))) (push (car sfiles) ofiles))) (setq sfiles (cdr sfiles))) - (kill-buffer (current-buffer)) + (gnus-kill-buffer (current-buffer)) ;; Slight kludge here - the last score file returned should be ;; the local score file, whether it exists or not. This is so ;; that any score commands the user enters will go to the right @@ -2713,7 +2756,7 @@ Destroys the current buffer." (defun gnus-score-find-alist (group) "Return list of score files for GROUP. -The list is determined from the variable gnus-score-file-alist." +The list is determined from the variable `gnus-score-file-alist'." (let ((alist gnus-score-file-multiple-match-alist) score-files) ;; if this group has been seen before, return the cached entry @@ -2768,9 +2811,10 @@ The list is determined from the variable gnus-score-file-alist." ;; Go through all the functions for finding score files (or actual ;; scores) and add them to a list. (while funcs - (when (gnus-functionp (car funcs)) + (when (functionp (car funcs)) (setq score-files - (nconc score-files (nreverse (funcall (car funcs) group))))) + (append score-files + (nreverse (funcall (car funcs) group))))) (setq funcs (cdr funcs))) (when gnus-score-use-all-scores ;; Add any home score files. @@ -2835,7 +2879,7 @@ The list is determined from the variable gnus-score-file-alist." (let (out) (while files ;; #### /$ Unix-specific? - (if (string-match "/$" (car files)) + (if (file-directory-p (car files)) (setq out (nconc (directory-files (car files) t (concat (gnus-score-file-regexp) "$")))) @@ -2870,16 +2914,17 @@ If ADAPT, return the home adaptive file instead." ((stringp elem) elem) ;; Function. - ((gnus-functionp elem) + ((functionp elem) (funcall elem group)) ;; Regexp-file cons. ((consp elem) (when (string-match (gnus-globalify-regexp (car elem)) group) (replace-match (cadr elem) t nil group)))))) (when found + (setq found (nnheader-translate-file-chars found)) (if (file-name-absolute-p found) - found - (nnheader-concat gnus-kill-files-directory found))))) + found + (nnheader-concat gnus-kill-files-directory found))))) (defun gnus-hierarchial-home-score-file (group) "Return the score file of the top-level hierarchy of GROUP." @@ -2946,7 +2991,7 @@ In the `new' case, the string is a safe replacement for REGEXP. In the `bad' case, the string is a unsafe subexpression of REGEXP, and we do not have a simple replacement to suggest. -See `(Gnus)Scoring Tips' for examples of good regular expressions." +See Info node `(gnus)Scoring Tips' for examples of good regular expressions." (let (case-fold-search) (and ;; First, try a relatively fast necessary condition. diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el index 106e0a9..7ad8883 100644 --- a/lisp/gnus-setup.el +++ b/lisp/gnus-setup.el @@ -1,6 +1,7 @@ ;;; gnus-setup.el --- Initialization & Setup for Gnus 5 -;; Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 2000, 2001 +;; Free Software Foundation, Inc. ;; Author: Steven L. Baur ;; Keywords: news @@ -35,7 +36,7 @@ (eval-when-compile (require 'cl)) (defvar gnus-use-installed-gnus t - "*If non-nil Use installed version of Gnus.") + "*If non-nil use installed version of Gnus.") (defvar gnus-use-installed-mailcrypt (featurep 'xemacs) "*If non-nil use installed version of mailcrypt.") @@ -89,8 +90,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 9b974a8..59b641d 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -1,6 +1,6 @@ ;;; gnus-soup.el --- SOUP packet writing support for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen @@ -154,11 +154,11 @@ move those articles instead." gnus-soup-encoding-type gnus-soup-index-type) (gnus-soup-area-set-number - area (1+ (or (gnus-soup-area-number area) 0)))) - ;; Mark article as read. - (set-buffer gnus-summary-buffer) + area (1+ (or (gnus-soup-area-number area) 0))) + ;; Mark article as read. + (set-buffer gnus-summary-buffer) + (gnus-summary-mark-as-read (car articles) gnus-souped-mark)) (gnus-summary-remove-process-mark (car articles)) - (gnus-summary-mark-as-read (car articles) gnus-souped-mark) (setq articles (cdr articles))) (kill-buffer tmp-buf)) (gnus-soup-save-areas) @@ -541,25 +541,35 @@ Return whether the unpacking was successful." (match-beginning 1) (match-end 1))))) (switch-to-buffer tmp-buf) (erase-buffer) + (set-buffer-multibyte nil) (insert-buffer-substring msg-buf beg end) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (setq message-user-agent (gnus-extended-version)) (cond ((string= (gnus-soup-reply-kind (car replies)) "news") (gnus-message 5 "Sending news message to %s..." (mail-fetch-field "newsgroups")) (sit-for 1) (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function))) + 'dont-check-for-anything-just-trust-me) + (method (if (message-functionp message-post-method) + (funcall message-post-method) + message-post-method)) + result) + (run-hooks 'message-send-news-hook) + (gnus-open-server method) + (message "Sending news via %s..." + (gnus-server-string method)) + (unless (let ((mail-header-separator "")) + (gnus-request-post method)) + (message "Couldn't send message via news: %s" + (nnheader-get-report (car method)))))) ((string= (gnus-soup-reply-kind (car replies)) "mail") (gnus-message 5 "Sending mail to %s..." (mail-fetch-field "to")) (sit-for 1) - (message-send-mail)) + (let ((mail-header-separator "")) + (mm-with-unibyte-current-buffer + (funcall (or message-send-mail-real-function + message-send-mail-function))))) (t (error "Unknown reply kind"))) (set-buffer msg-buf) diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index cf43cfa..a45f1ca 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,5 +1,5 @@ -;;; gnus-spec.el --- format spec functions for Gnus -*- coding: iso-latin-1 -*- -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;;; gnus-spec.el --- format spec functions for Gnus +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -32,6 +32,17 @@ (require 'alist) (require 'gnus) +(defcustom gnus-use-correct-string-widths t + "*If non-nil, use correct functions for dealing with wide characters." + :group 'gnus-format + :type 'boolean) + +(defcustom gnus-make-format-preserve-properties (featurep 'xemacs) + "*If non-nil, use a replacement `format' function which preserves +text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." + :group 'gnus-format + :type 'boolean) + ;;; Internal variables. (defvar gnus-summary-mark-positions nil) @@ -71,6 +82,8 @@ (defvar gnus-tmp-article-number) (defvar gnus-mouse-face) (defvar gnus-mouse-face-prop) +(defvar gnus-tmp-header) +(defvar gnus-tmp-from) (defun gnus-summary-line-format-spec () (insert gnus-tmp-unread gnus-tmp-replied @@ -79,13 +92,15 @@ (point) (progn (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (substring gnus-tmp-name 0 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) + (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines + (let ((val + (inline + (gnus-summary-from-or-to-or-newsgroups + gnus-tmp-header gnus-tmp-from)))) + (if (> (length val) 23) + (substring val 0 23) + val)) + gnus-tmp-closing-bracket)) (point)) gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject-or-nil "\n")) @@ -124,21 +139,23 @@ `((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" + (summary ("%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" ,gnus-summary-line-format-spec))) "Alist of format specs.") +(defvar gnus-default-format-specs gnus-format-specs) + (defvar gnus-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) -;;; Phew. All that gruft is over, fortunately. +;;; Phew. All that gruft is over with, fortunately. ;;;###autoload (defun gnus-update-format (var) @@ -222,8 +239,8 @@ (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.) + ;; 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) @@ -275,49 +292,112 @@ (point) (progn ,@form (point)) '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) -;;; Avoid byte-compile warning. -(defun gnus-tilde-pad-form (el pad-width) - "Dummy function except for XEmacs-mule. It will be redefined -by `gnus-xmas-redefine'." - (let ((val (if (symbolp el) (eval el) el))) - (` (, val)))) - (defun gnus-balloon-face-function (form type) `(gnus-put-text-property (point) (progn ,@form (point)) - 'balloon-help + ,(if (fboundp 'balloon-help-mode) + ''balloon-help + ''help-echo) ,(intern (format "gnus-balloon-face-%d" type)))) +(defun gnus-spec-tab (column) + (if (> column 0) + `(insert (make-string (max (- ,column (current-column)) 0) ? )) + (let ((column (abs column))) + (if gnus-use-correct-string-widths + `(progn + (if (> (current-column) ,column) + (while (progn + (delete-backward-char 1) + (> (current-column) ,column)))) + (insert (make-string (max (- ,column (current-column)) 0) ? ))) + `(progn + (if (> (current-column) ,column) + (delete-region (point) + (- (point) (- (current-column) ,column))) + (insert (make-string (max (- ,column (current-column)) 0) + ? )))))))) + +(defun gnus-correct-length (string) + "Return the correct width of STRING." + (let ((length 0)) + (mapcar (lambda (char) (incf length (gnus-char-width char))) string) + length)) + +(defun gnus-correct-substring (string start &optional end) + (let ((wstart 0) + (wend 0) + (wseek 0) + (seek 0) + (length (length string)) + (string (concat string "\0"))) + ;; Find the start position. + (while (and (< seek length) + (< wseek start)) + (incf wseek (gnus-char-width (aref string seek))) + (incf seek)) + (setq wstart seek) + ;; Find the end position. + (while (and (<= seek length) + (or (not end) + (<= wseek end))) + (incf wseek (gnus-char-width (aref string seek))) + (incf seek)) + (setq wend seek) + (substring string wstart (1- wend)))) + +(defun gnus-string-width-function () + (cond + (gnus-use-correct-string-widths + 'gnus-correct-length) + ((fboundp 'string-width) + 'string-width) + (t + 'length))) + +(defun gnus-substring-function () + (cond + (gnus-use-correct-string-widths + 'gnus-correct-substring) + ((fboundp 'string-width) + 'gnus-correct-substring) + (t + 'substring))) + (defun gnus-tilde-max-form (el max-width) "Return a form that limits EL to MAX-WIDTH." - (let ((max (abs max-width))) + (let ((max (abs max-width)) + (length-fun (gnus-string-width-function)) + (substring-fun (gnus-substring-function))) (if (symbolp el) - `(if (> (length ,el) ,max) + `(if (> (,length-fun ,el) ,max) ,(if (< max-width 0) - `(substring ,el (- (length el) ,max)) - `(substring ,el 0 ,max)) + `(,substring-fun ,el (- (,length-fun ,el) ,max)) + `(,substring-fun ,el 0 ,max)) ,el) `(let ((val (eval ,el))) - (if (> (length val) ,max) + (if (> (,length-fun val) ,max) ,(if (< max-width 0) - `(substring val (- (length val) ,max)) - `(substring val 0 ,max)) + `(,substring-fun val (- (,length-fun val) ,max)) + `(,substring-fun val 0 ,max)) val))))) (defun gnus-tilde-cut-form (el cut-width) "Return a form that cuts CUT-WIDTH off of EL." - (let ((cut (abs cut-width))) + (let ((cut (abs cut-width)) + (length-fun (gnus-string-width-function)) + (substring-fun (gnus-substring-function))) (if (symbolp el) - `(if (> (length ,el) ,cut) + `(if (> (,length-fun ,el) ,cut) ,(if (< cut-width 0) - `(substring ,el 0 (- (length el) ,cut)) - `(substring ,el ,cut)) + `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut)) + `(,substring-fun ,el ,cut)) ,el) `(let ((val (eval ,el))) - (if (> (length val) ,cut) + (if (> (,length-fun val) ,cut) ,(if (< cut-width 0) - `(substring val 0 (- (length val) ,cut)) - `(substring val ,cut)) + `(,substring-fun val 0 (- (,length-fun val) ,cut)) + `(,substring-fun val ,cut)) val))))) (defun gnus-tilde-ignore-form (el ignore-value) @@ -329,6 +409,28 @@ by `gnus-xmas-redefine'." (if (equal val ,ignore-value) "" val)))) +(defun gnus-pad-form (el pad-width) + "Return a form that pads EL to PAD-WIDTH accounting for multi-column +characters correctly. This is because `format' may pad to columns or to +characters when given a pad value." + (let ((pad (abs pad-width)) + (side (< 0 pad-width)) + (length-fun (gnus-string-width-function))) + (if (symbolp el) + `(let ((need (- ,pad (,length-fun ,el)))) + (if (> need 0) + (concat ,(when side '(make-string need ?\ )) + ,el + ,(when (not side) '(make-string need ?\ ))) + ,el)) + `(let* ((val (eval ,el)) + (need (- ,pad (,length-fun val)))) + (if (> need 0) + (concat ,(when side '(make-string need ?\ )) + val + ,(when (not side) '(make-string need ?\ ))) + val))))) + (defun gnus-parse-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return the @@ -336,61 +438,123 @@ by `gnus-xmas-redefine'." ;; the text between them will have the mouse-face text property. ;; If the FORMAT string contains the specifiers %[ and %], the text between ;; them will have the balloon-help text property. - (if (string-match - "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'" - format) - (gnus-parse-complex-format format spec-alist) - ;; This is a simple format. - (gnus-parse-simple-format format spec-alist insert))) + (let ((case-fold-search nil)) + (if (string-match + "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*" + format) + (gnus-parse-complex-format format spec-alist) + ;; This is a simple format. + (gnus-parse-simple-format format spec-alist insert)))) (defun gnus-parse-complex-format (format spec-alist) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "\"" nil t) - (replace-match "\\\"" nil t)) - (goto-char (point-min)) - (insert "(\"") - (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t) - (let ((number (if (match-beginning 1) - (match-string 1) "0")) - (delim (aref (match-string 2) 0))) - (if (or (= delim ?\() - (= delim ?\{) - (= delim ?\«)) - (replace-match (concat "\"(" - (cond ((= delim ?\() "mouse") - ((= delim ?\{) "face") - (t "balloon")) - " " number " \"")) - (replace-match "\")\"")))) - (goto-char (point-max)) - (insert "\")") - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) + (let ((cursor-spec nil)) + (save-excursion + (gnus-set-work-buffer) + (insert format) + (goto-char (point-min)) + (while (re-search-forward "\"" nil t) + (replace-match "\\\"" nil t)) + (goto-char (point-min)) + (insert "(\"") + ;; Convert all font specs into font spec lists. + (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t) + (let ((number (if (match-beginning 1) + (match-string 1) "0")) + (delim (aref (match-string 2) 0))) + (if (or (= delim ?\() + (= delim ?\{) + (= delim ?\«)) + (replace-match (concat "\"(" + (cond ((= delim ?\() "mouse") + ((= delim ?\{) "face") + (t "balloon")) + " " number " \"") + t t) + (replace-match "\")\"")))) + (goto-char (point-max)) + (insert "\")") + ;; Convert point position commands. + (goto-char (point-min)) + (let ((case-fold-search nil)) + (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t) + (replace-match "\"(point)\"" t t) + (setq cursor-spec t))) + ;; Convert TAB commands. + (goto-char (point-min)) + (while (re-search-forward "%\\([-0-9]+\\)=" nil t) + (replace-match (format "\"(tab %s)\"" (match-string 1)) t t)) + ;; Convert the buffer into the spec. + (goto-char (point-min)) + (let ((form (read (current-buffer)))) + (if cursor-spec + `(let (gnus-position) + ,@(gnus-complex-form-to-spec form spec-alist) + (if gnus-position + (gnus-put-text-property gnus-position (1+ gnus-position) + 'gnus-position t))) + `(progn + ,@(gnus-complex-form-to-spec form spec-alist))))))) (defun gnus-complex-form-to-spec (form spec-alist) (delq nil (mapcar (lambda (sform) - (if (stringp sform) - (gnus-parse-simple-format sform spec-alist t) + (cond + ((stringp sform) + (gnus-parse-simple-format sform spec-alist t)) + ((eq (car sform) 'point) + '(setq gnus-position (point))) + ((eq (car sform) 'tab) + (gnus-spec-tab (cadr sform))) + (t (funcall (intern (format "gnus-%s-face-function" (car sform))) (gnus-complex-form-to-spec (cddr sform) spec-alist) - (nth 1 sform)))) + (nth 1 sform))))) form))) + +(defun gnus-xmas-format (fstring &rest args) + "A version of `format' which preserves text properties. + +Required for XEmacs, where the built in `format' function strips all text +properties from both the format string and any inserted strings. + +Only supports the format sequence %s, and %% for inserting +literal % characters. A pad width and an optional - (to right pad) +are supported for %s." + (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s") + (n (length args))) + (with-temp-buffer + (insert fstring) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (goto-char (match-end 0)) + (cond + ((string= (match-string 0) "%%") + (delete-char -1)) + (t + (if (null args) + (error 'wrong-number-of-arguments #'my-format n fstring)) + (let* ((minlen (string-to-int (or (match-string 2) ""))) + (arg (car args)) + (str (if (stringp arg) arg (format "%s" arg))) + (lpad (null (match-string 1))) + (padlen (max 0 (- minlen (length str))))) + (replace-match "") + (if lpad (insert-char ?\ padlen)) + (insert str) + (unless lpad (insert-char ?\ padlen)) + (setq args (cdr args)))))) + (buffer-string)))) + (defun gnus-parse-simple-format (format spec-alist &optional insert) ;; 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 (featurep 'xemacs) (featurep 'mule))) - max-width + (let (max-width spec flist fstring elem result dontinsert user-defined type value pad-width spec-beg cut-width ignore-value - tilde-form tilde elem-type) + tilde-form tilde elem-type extended-spec) (save-excursion (gnus-set-work-buffer) (insert format) @@ -402,7 +566,8 @@ by `gnus-xmas-redefine'." max-width nil cut-width nil ignore-value nil - tilde-form nil) + tilde-form nil + extended-spec nil) (setq spec-beg (1- (point))) ;; Parse this spec fully. @@ -443,10 +608,18 @@ by `gnus-xmas-redefine'." t) (t nil))) - ;; User-defined spec -- find the spec name. - (when (eq (setq spec (char-after)) ?u) + (cond + ;; User-defined spec -- find the spec name. + ((eq (setq spec (char-after)) ?u) (forward-char 1) - (setq user-defined (char-after))) + (when (and (eq (setq user-defined (char-after)) ?&) + (looking-at "&\\([^;]+\\);")) + (setq user-defined (match-string 1)) + (goto-char (match-end 1)))) + ;; extended spec + ((and (eq spec ?&) (looking-at "&\\([^;]+\\);")) + (setq extended-spec (intern (match-string 1))) + (goto-char (match-end 1)))) (forward-char 1) (delete-region spec-beg (point)) @@ -464,21 +637,27 @@ by `gnus-xmas-redefine'." (user-defined (setq elem (list - (list (intern (format "gnus-user-format-function-%c" - user-defined)) + (list (intern (format + (if (stringp user-defined) + "gnus-user-format-function-%s" + "gnus-user-format-function-%c") + user-defined)) 'gnus-tmp-header) ?s))) ;; Find the specification from `spec-alist'. - ((setq elem (cdr (assq spec spec-alist)))) + ((setq elem (cdr (assq (or extended-spec spec) spec-alist)))) (t (setq elem '("*" ?s)))) (setq elem-type (cadr elem)) ;; Insert the new format elements. - (and pad-width (not xemacs-mule-p) - (insert (number-to-string pad-width))) + (when (and pad-width + (not (and (featurep 'xemacs) + gnus-use-correct-string-widths))) + (insert (number-to-string pad-width))) ;; Create the form to be evaled. (if (or max-width cut-width ignore-value - (and pad-width xemacs-mule-p)) + (and (featurep 'xemacs) + gnus-use-correct-string-widths)) (progn (insert ?s) (let ((el (car elem))) @@ -492,18 +671,18 @@ by `gnus-xmas-redefine'." (setq el (gnus-tilde-cut-form el cut-width))) (when max-width (setq el (gnus-tilde-max-form el max-width))) - (and pad-width xemacs-mule-p - (setq el (gnus-tilde-pad-form el pad-width))) + (when pad-width + (setq el (gnus-pad-form el pad-width))) (push el flist))) (insert elem-type) (push (car elem) flist)))) - (setq fstring (buffer-string))) + (setq fstring (buffer-substring-no-properties (point-min) (point-max)))) ;; Do some postprocessing to increase efficiency. (setq result (cond - ;; Emptyness. + ;; Emptiness. ((string= fstring "") nil) ;; Not a format string. @@ -533,6 +712,13 @@ by `gnus-xmas-redefine'." ;; A single string spec in the end of the spec. ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) (list (match-string 1 fstring) (car flist))) + ;; Only string (and %) specs (XEmacs only!) + ((and (featurep 'xemacs) + gnus-make-format-preserve-properties + (string-match + "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'" + fstring)) + (list (cons 'gnus-xmas-format (cons fstring (nreverse flist))))) ;; A more complex spec. (t (list (cons 'format (cons fstring (nreverse flist))))))) @@ -569,7 +755,7 @@ If PROPS, insert the result." (while entries (setq entry (pop entries) type (car entry)) - (if (memq type '(version gnus-version)) + (if (memq type '(gnus-version version)) (setq gnus-format-specs (delq entry gnus-format-specs)) (let ((form (caddr entry))) (when (and (listp form) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index f1224c9..c759d19 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -1,5 +1,5 @@ ;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -34,10 +34,17 @@ (require 'gnus-int) (require 'gnus-range) -(defvar gnus-server-mode-hook nil - "Hook run in `gnus-server-mode' buffers.") +(defcustom gnus-server-mode-hook nil + "Hook run in `gnus-server-mode' buffers." + :group 'gnus-server + :type 'hook) -(defconst gnus-server-line-format " {%(%h:%w%)} %s\n" +(defcustom gnus-server-exit-hook nil + "Hook run when exiting the server buffer." + :group 'gnus-server + :type 'hook) + +(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n" "Format of server lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -47,13 +54,25 @@ The following specs are understood: %h backend %n name %w address -%s status") - -(defvar gnus-server-mode-line-format "Gnus: %%b" - "The format specification for the server mode line.") - -(defvar gnus-server-exit-hook nil - "*Hook run when exiting the server buffer.") +%s status +%a agent covered + +General format specifiers can also be used. +See Info node `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") + :group 'gnus-server-visual + :type 'string) + +(defcustom gnus-server-mode-line-format "Gnus: %%b" + "The format specification for the server mode line." + :group 'gnus-server-visual + :type 'string) + +(defcustom gnus-server-browse-in-group-buffer nil + "Whether server browsing should take place in the group buffer. +If nil, a faster, but more primitive, buffer is used instead." + :group 'gnus-server-visual + :type 'boolean) ;;; Internal variables. @@ -63,7 +82,8 @@ The following specs are understood: `((?h gnus-tmp-how ?s) (?n gnus-tmp-name ?s) (?w gnus-tmp-where ?s) - (?s gnus-tmp-status ?s))) + (?s gnus-tmp-status ?s) + (?a gnus-tmp-agent ?s))) (defvar gnus-server-mode-line-format-alist `((?S gnus-tmp-news-server ?s) @@ -85,7 +105,7 @@ The following specs are understood: (easy-menu-define gnus-server-server-menu gnus-server-mode-map "" '("Server" - ["Add" gnus-server-add-server t] + ["Add..." gnus-server-add-server t] ["Browse" gnus-server-read-server t] ["Scan" gnus-server-scan-server t] ["List" gnus-server-list-servers t] @@ -101,6 +121,7 @@ The following specs are understood: '("Connections" ["Open" gnus-server-open-server t] ["Close" gnus-server-close-server t] + ["Offline" gnus-server-offline-server t] ["Deny" gnus-server-deny-server t] "---" ["Open All" gnus-server-open-all-servers t] @@ -117,7 +138,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 @@ -134,23 +155,93 @@ The following specs are understood: "C" gnus-server-close-server "\M-c" gnus-server-close-all-servers "D" gnus-server-deny-server + "L" gnus-server-offline-server "R" gnus-server-remove-denials "n" next-line "p" previous-line - + "g" gnus-server-regenerate-server "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) +(defface gnus-server-agent-face + '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t)) + (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) + (t (:bold t))) + "Face used for displaying AGENTIZED servers" + :group 'gnus-server-visual) + +(defface gnus-server-opened-face + '((((class color) (background light)) (:foreground "Green3" :bold t)) + (((class color) (background dark)) (:foreground "Green1" :bold t)) + (t (:bold t))) + "Face used for displaying OPENED servers" + :group 'gnus-server-visual) + +(defface gnus-server-closed-face + '((((class color) (background light)) (:foreground "Steel Blue" :italic t)) + (((class color) (background dark)) + (:foreground "Light Steel Blue" :italic t)) + (t (:italic t))) + "Face used for displaying CLOSED servers" + :group 'gnus-server-visual) + +(defface gnus-server-denied-face + '((((class color) (background light)) (:foreground "Red" :bold t)) + (((class color) (background dark)) (:foreground "Pink" :bold t)) + (t (:inverse-video t :bold t))) + "Face used for displaying DENIED servers" + :group 'gnus-server-visual) + +(defface gnus-server-offline-face + '((((class color) (background light)) (:foreground "Orange" :bold t)) + (((class color) (background dark)) (:foreground "Yellow" :bold t)) + (t (:inverse-video t :bold t))) + "Face used for displaying OFFLINE servers" + :group 'gnus-server-visual) + +(defcustom gnus-server-agent-face 'gnus-server-agent-face + "Face name to use on AGENTIZED servers." + :group 'gnus-server-visual + :type 'face) + +(defcustom gnus-server-opened-face 'gnus-server-opened-face + "Face name to use on OPENED servers." + :group 'gnus-server-visual + :type 'face) + +(defcustom gnus-server-closed-face 'gnus-server-closed-face + "Face name to use on CLOSED servers." + :group 'gnus-server-visual + :type 'face) + +(defcustom gnus-server-denied-face 'gnus-server-denied-face + "Face name to use on DENIED servers." + :group 'gnus-server-visual + :type 'face) + +(defcustom gnus-server-offline-face 'gnus-server-offline-face + "Face name to use on OFFLINE servers." + :group 'gnus-server-visual + :type 'face) + +(defvar gnus-server-font-lock-keywords + (list + '("(\\(agent\\))" 1 gnus-server-agent-face) + '("(\\(opened\\))" 1 gnus-server-opened-face) + '("(\\(closed\\))" 1 gnus-server-closed-face) + '("(\\(offline\\))" 1 gnus-server-offline-face) + '("(\\(denied\\))" 1 gnus-server-denied-face))) + (defun gnus-server-mode () "Major mode for listing and editing servers. All normal editing commands are switched off. \\ For more in-depth information on this mode, read the manual -(`\\[gnus-info-find-node]'). +\(`\\[gnus-info-find-node]'). The following commands are available: @@ -168,19 +259,32 @@ The following commands are available: (buffer-disable-undo) (setq truncate-lines t) (setq buffer-read-only t) + (if (featurep 'xemacs) + (put 'gnus-server-mode 'font-lock-defaults '(gnus-server-font-lock-keywords t)) + (set (make-local-variable 'font-lock-defaults) + '(gnus-server-font-lock-keywords t))) (gnus-run-hooks 'gnus-server-mode-hook)) (defun gnus-server-insert-server-line (gnus-tmp-name method) (let* ((gnus-tmp-how (car method)) (gnus-tmp-where (nth 1 method)) (elem (assoc method gnus-opened-servers)) - (gnus-tmp-status (cond ((eq (nth 1 elem) 'denied) - "(denied)") - ((or (gnus-server-opened method) - (eq (nth 1 elem) 'ok)) - "(opened)") - (t - "(closed)")))) + (gnus-tmp-status + (cond + ((eq (nth 1 elem) 'denied) "(denied)") + ((eq (nth 1 elem) 'offline) "(offline)") + (t + (condition-case nil + (if (or (gnus-server-opened method) + (eq (nth 1 elem) 'ok)) + "(opened)" + "(closed)") + ((error) "(error)"))))) + (gnus-tmp-agent (if (and gnus-agent + (member method + gnus-agent-covered-methods)) + " (agent)" + ""))) (beginning-of-line) (gnus-add-text-properties (point) @@ -217,7 +321,7 @@ The following commands are available: (while alist (unless (member (cdar alist) done) (push (cdar alist) done) - (cdr (setq server (pop alist))) + (setq server (pop alist)) (when (and server (car server) (cdr server)) (gnus-server-insert-server-line (car server) (cdr server)))) (when (member (cdar alist) done) @@ -255,7 +359,7 @@ The following commands are available: (when entry (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string (cdr entry)) ")\n"))) + (gnus-prin1-to-string (cdr entry)) ")\n"))) (when (or entry oentry) ;; Buffer may be narrowed. (save-restriction @@ -274,9 +378,13 @@ The following commands are available: (when (and server info) (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string info) ")")) + (gnus-prin1-to-string info) ")")) (let* ((server (nth 1 info)) - (entry (assoc server gnus-server-alist))) + (entry (assoc server gnus-server-alist)) + (cached (assoc server gnus-server-method-cache))) + (if cached + (setq gnus-server-method-cache + (delq cached gnus-server-method-cache))) (if entry (setcdr entry info) (setq gnus-server-alist (nconc gnus-server-alist (list (cons server info)))))))) @@ -328,7 +436,7 @@ The following commands are available: (setq alist (cdr alist))) (if alist (setcdr alist (cons killed (cdr alist))) - (setq gnus-server-alist (list killed))))) + (setq gnus-server-alist (list killed))))) (gnus-server-update-server (car killed)) (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) (gnus-server-position-point))) @@ -337,7 +445,7 @@ The following commands are available: "Return to the group buffer." (interactive) (gnus-run-hooks 'gnus-server-exit-hook) - (kill-buffer (current-buffer)) + (gnus-kill-buffer (current-buffer)) (gnus-configure-windows 'group t)) (defun gnus-server-list-servers () @@ -394,12 +502,23 @@ The following commands are available: (gnus-server-update-server server) (gnus-server-position-point)))) +(defun gnus-server-offline-server (server) + "Set SERVER to offline." + (interactive (list (gnus-server-server-name))) + (let ((method (gnus-server-to-method server))) + (unless method + (error "No such server: %s" server)) + (prog1 + (gnus-close-server method) + (gnus-server-set-status method 'offline) + (gnus-server-update-server server) + (gnus-server-position-point)))) + (defun gnus-server-close-all-servers () "Close all servers." (interactive) - (let ((servers gnus-inserted-opened-servers)) - (while servers - (gnus-server-close-server (car (pop servers)))))) + (dolist (server gnus-inserted-opened-servers) + (gnus-server-close-server (car server)))) (defun gnus-server-deny-server (server) "Make sure SERVER will never be attempted opened." @@ -415,11 +534,9 @@ The following commands are available: (defun gnus-server-remove-denials () "Make all denied servers into closed servers." (interactive) - (let ((servers gnus-opened-servers)) - (while servers - (when (eq (nth 1 (car servers)) 'denied) - (setcar (nthcdr 1 (car servers)) 'closed)) - (setq servers (cdr servers)))) + (dolist (server gnus-opened-servers) + (when (eq (nth 1 server) 'denied) + (setcar (nthcdr 1 server) 'closed))) (gnus-server-list-servers)) (defun gnus-server-copy-server (from to) @@ -489,6 +606,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))) @@ -539,6 +662,7 @@ The following commands are available: "L" gnus-browse-exit "q" gnus-browse-exit "Q" gnus-browse-exit + "d" gnus-browse-describe-group "\C-c\C-c" gnus-browse-exit "?" gnus-browse-describe-briefly @@ -554,8 +678,9 @@ The following commands are available: ["Subscribe" gnus-browse-unsubscribe-current-group t] ["Read" gnus-browse-read-group t] ["Select" gnus-browse-select-group t] + ["Describe" gnus-browse-describe-group t] ["Next" gnus-browse-next-group t] - ["Prev" gnus-browse-next-group t] + ["Prev" gnus-browse-prev-group t] ["Exit" gnus-browse-exit t])) (gnus-run-hooks 'gnus-browse-menu-hook))) @@ -569,6 +694,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)) @@ -587,27 +713,15 @@ 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))) (goto-char (point-min)) (unless (string= gnus-ignored-newsgroups "") (delete-matching-lines gnus-ignored-newsgroups)) - (while (not (eobp)) + (while (not (eobp)) (ignore-errors - (push (cons + (push (cons (if (eq (char-after) ?\") (read cur) (let ((p (point)) (name "")) @@ -620,25 +734,61 @@ 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) 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 "K%7d: %s\n" (cdr group) - (gnus-group-name-decode (car group) charset)))) - (list 'gnus-group (car group))) - (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 'ignore)) + (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) + name + (prefix (let ((gnus-select-method orig-select-method)) + (gnus-group-prefixed-name "" method)))) + (while (setq group (pop groups)) + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + (insert + (format "%c%7d: %s\n" + (let ((level (gnus-group-level + (concat prefix (setq name (car group)))))) + (cond + ((<= level gnus-level-subscribed) ? ) + ((<= level gnus-level-unsubscribed) ?U) + ((= level gnus-level-zombie) ?Z) + (t ?K))) + (max 0 (- (1+ (cddr group)) (cadr group))) + (decode-coding-string + name + (inline (gnus-group-name-charset method name)))))) + (list 'gnus-group name)))) + (switch-to-buffer (current-buffer))) (goto-char (point-min)) (gnus-group-position-point) (gnus-message 5 "Connecting to %s...done" (nth 1 method)) @@ -681,7 +831,7 @@ buffer. (if (or (not (gnus-get-info group)) (gnus-ephemeral-group-p group)) (unless (gnus-group-read-ephemeral-group - (gnus-group-real-name group) gnus-browse-current-method nil + 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) @@ -726,10 +876,14 @@ buffer. (beginning-of-line) (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))))) + (concat (gnus-method-to-server-name gnus-browse-current-method) ":" + (or name + (match-string-no-properties 1))))))) + +(defun gnus-browse-describe-group (group) + "Describe the current group." + (interactive (list (gnus-browse-group-name))) + (gnus-group-describe-group nil group)) (defun gnus-browse-unsubscribe-group () "Toggle subscription of the current group in the browse buffer." @@ -739,13 +893,9 @@ 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) (if sub (progn ;; Make sure the group has been properly removed before we @@ -756,24 +906,26 @@ buffer. nil nil (if (gnus-server-equal gnus-browse-current-method "native") nil - (gnus-method-simplify + (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 () "Quit browsing and return to the group buffer." (interactive) (when (eq major-mode 'gnus-browse-mode) - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) ;; Insert the newly subscribed groups in the group buffer. (save-excursion (set-buffer gnus-group-buffer) @@ -794,16 +946,18 @@ buffer. (let ((server (gnus-server-server-name))) (unless server (error "No server on the current line")) - (if (not (gnus-check-backend-function - 'request-regenerate (car (gnus-server-to-method server)))) - (error "This backend doesn't support regeneration") - (gnus-message 5 "Requesting regeneration of %s..." server) - (unless (gnus-open-server server) - (error "Couldn't open server")) - (if (gnus-request-regenerate server) - (gnus-message 5 "Requesting regeneration of %s...done" server) - (gnus-message 5 "Couldn't regenerate %s" server))))) + (condition-case () + (gnus-get-function (gnus-server-to-method server) + 'request-regenerate) + (error + (error "This backend doesn't support regeneration"))) + (gnus-message 5 "Requesting regeneration of %s..." server) + (unless (gnus-open-server server) + (error "Couldn't open server")) + (if (gnus-request-regenerate server) + (gnus-message 5 "Requesting regeneration of %s...done" server) + (gnus-message 5 "Couldn't regenerate %s" server)))) (provide 'gnus-srvr) -;;; gnus-srvr.el ends here. +;;; gnus-srvr.el ends here diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index a536302..bee9b60 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,5 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -35,7 +35,7 @@ (require 'gnus-spec) (require 'gnus-range) (require 'gnus-util) -(require 'message) +(autoload 'message-make-date "message") (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") "Your `.newsrc' file. @@ -49,6 +49,24 @@ :group 'gnus-start :type '(choice directory (const nil))) +(defcustom gnus-backup-startup-file 'never + "Whether to create backup files. +This variable takes the same values as the `version-control' +variable." + :group 'gnus-start + :type '(choice (const :tag "Never" never) + (const :tag "If existing" nil) + (other :tag "Always" t))) + +(defcustom gnus-save-startup-file-via-temp-buffer t + "Whether to write the startup file contents to a buffer then save +the buffer or write directly to the file. The buffer is faster +because all of the contents are written at once. The direct write +uses considerably less memory." + :group 'gnus-start + :type '(choice (const :tag "Write via buffer" t) + (const :tag "Write directly to file" 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." @@ -205,6 +223,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) @@ -236,7 +255,7 @@ not match this regexp will be removed before saving the list." (defcustom gnus-ignored-newsgroups (mapconcat 'identity '("^to\\." ; not "real" groups - "^[0-9. \t]+ " ; all digits in name + "^[0-9. \t]+\\( \\|$\\)" ; all digits in name "^[\"][]\"[#'()]" ; bogus characters ) "\\|") @@ -248,7 +267,7 @@ thus making them effectively non-existent." :type 'regexp) (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies - "*Function called with a group name when new group is detected. + "*Function(s) called with a group name when new group is detected. A few pre-made functions are supplied: `gnus-subscribe-randomly' inserts new groups at the beginning of the list of groups; `gnus-subscribe-alphabetically' inserts new groups in strict @@ -266,11 +285,18 @@ claim them." (function-item gnus-subscribe-killed) (function-item gnus-subscribe-zombies) (function-item gnus-subscribe-topics) - function)) + function + (repeat function))) + +(defcustom gnus-subscribe-newsgroup-hooks nil + "*Hooks run after you subscribe to a new group. The hooks will be called +with new group's name as argument." + :group 'gnus-group-new + :type 'hook) (defcustom gnus-subscribe-options-newsgroup-method 'gnus-subscribe-alphabetically - "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. + "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines. If, for instance, you want to subscribe to all newsgroups in the \"no\" and \"alt\" hierarchies, you'd put the following in your .newsrc file: @@ -286,7 +312,9 @@ the subscription method in this variable." (function-item gnus-subscribe-interactively) (function-item gnus-subscribe-killed) (function-item gnus-subscribe-zombies) - function)) + (function-item gnus-subscribe-topics) + function + (repeat function))) (defcustom gnus-subscribe-hierarchical-interactive nil "*If non-nil, Gnus will offer to subscribe hierarchically. @@ -301,7 +329,7 @@ hierarchy in its entirety." :type 'boolean) (defcustom gnus-auto-subscribed-groups - "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" + "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir" "*All new groups that match this regexp will be subscribed automatically. Note that this variable only deals with new groups. It has no effect whatsoever on old groups. @@ -361,23 +389,34 @@ This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) -(defcustom gnus-setup-news-hook nil +(defcustom gnus-setup-news-hook + '(gnus-fixup-nnimap-unread-after-getting-new-news) "A hook after reading the .newsrc file, but before generating the buffer." :group 'gnus-start :type 'hook) +(defcustom gnus-get-top-new-news-hook nil + "A hook run just before Gnus checks for new news globally." + :group 'gnus-group-new + :type 'hook) + (defcustom gnus-get-new-news-hook nil "A hook run just before Gnus checks for new news." :group 'gnus-group-new :type 'hook) (defcustom gnus-after-getting-new-news-hook - (when (gnus-boundp 'display-time-timer) - '(display-time-event-handler)) + '(gnus-display-time-event-handler + gnus-fixup-nnimap-unread-after-getting-new-news) "A hook run after Gnus checks for new news when Gnus is already running." :group 'gnus-group-new :type 'hook) +(defcustom gnus-read-newsrc-el-hook nil + "A hook called after reading the newsrc.eld? file." + :group 'gnus-newsrc + :type 'hook) + (defcustom gnus-save-newsrc-hook nil "A hook called before saving any of the newsrc files." :group 'gnus-newsrc @@ -395,18 +434,25 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'hook) +(defcustom gnus-group-mode-hook nil + "Hook for Gnus group mode." + :group 'gnus-group-various + :options '(gnus-topic-mode) + :type 'hook) + (defcustom gnus-always-read-dribble-file nil "Unconditionally read the dribble file." :group 'gnus-newsrc :type 'boolean) -(defvar gnus-startup-file-coding-system (static-if (boundp 'MULE) - '*ctext* - 'ctext) - "*Coding system for startup file.") - ;;; Internal variables +(defvar gnus-ding-file-coding-system (static-if (boundp 'MULE) + '*ctext* + 'ctext) + "Coding system for ding file.") +;; Note that the ding file for T-gnus ought not to have byte-codes. + (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) (defvar gnus-dribble-buffer nil) @@ -433,19 +479,15 @@ Can be used to turn version control on or off." (if gnus-init-inhibit (setq gnus-init-inhibit nil) (setq gnus-init-inhibit inhibit-next) - (let ((files (list gnus-site-init-file gnus-init-file)) - file) - (while files - (and (setq file (pop files)) - (or (and (file-exists-p file) - ;; Don't try to load a directory. - (not (file-directory-p file))) - (file-exists-p (concat file ".el")) - (file-exists-p (concat file ".elc"))) - (condition-case var - (load file nil t) - (error - (error "Error in %s: %s" file var))))))))) + (dolist (file (list gnus-site-init-file gnus-init-file)) + (when (and file + (locate-library file)) + (if (or debug-on-error debug-on-quit) + (load file nil t) + (condition-case var + (load file nil t) + (error + (error "Error in %s: %s" file (cadr var)))))))))) ;; For subscribing new newsgroup @@ -535,22 +577,22 @@ Can be used to turn version control on or off." ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (save-excursion (set-buffer (nnheader-find-file-noselect gnus-current-startup-file)) - (let ((groupkey newgroup) - before) - (while (and (not before) groupkey) - (goto-char (point-min)) - (let ((groupkey-re - (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) - (while (and (re-search-forward groupkey-re nil t) - (progn - (setq before (match-string 1)) - (string< before newgroup))))) - ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) - (setq groupkey - (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey) - (substring groupkey (match-beginning 1) (match-end 1))))) - (gnus-subscribe-newsgroup newgroup before)) - (kill-buffer (current-buffer)))) + (prog1 + (let ((groupkey newgroup) before) + (while (and (not before) groupkey) + (goto-char (point-min)) + (let ((groupkey-re + (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) + (while (and (re-search-forward groupkey-re nil t) + (progn + (setq before (match-string 1)) + (string< before newgroup))))) + ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) + (setq groupkey + (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey) + (substring groupkey (match-beginning 1) (match-end 1))))) + (gnus-subscribe-newsgroup newgroup before)) + (kill-buffer (current-buffer))))) (defun gnus-subscribe-interactively (group) "Subscribe the new GROUP interactively. @@ -579,7 +621,9 @@ the first newsgroup." newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) - (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))) + (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) + (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) + t)) (defun gnus-read-active-file-p () "Say whether the active file has been read from `gnus-select-method'." @@ -588,16 +632,21 @@ the first newsgroup." ;;; General various misc type functions. ;; Silence byte-compiler. -(defvar gnus-current-headers) -(defvar gnus-thread-indent-array) -(defvar gnus-newsgroup-name) -(defvar gnus-newsgroup-headers) -(defvar gnus-group-list-mode) -(defvar gnus-group-mark-positions) -(defvar gnus-newsgroup-data) -(defvar gnus-newsgroup-unreads) -(defvar nnoo-state-alist) -(defvar gnus-current-select-method) +(eval-when-compile + (defvar gnus-current-headers) + (defvar gnus-thread-indent-array) + (defvar gnus-newsgroup-name) + (defvar gnus-newsgroup-headers) + (defvar gnus-group-list-mode) + (defvar gnus-group-mark-positions) + (defvar gnus-newsgroup-data) + (defvar gnus-newsgroup-unreads) + (defvar nnoo-state-alist) + (defvar gnus-current-select-method) + (defvar mail-sources) + (defvar nnmail-scan-directory-mail-source-once) + (defvar nnmail-split-history) + (defvar nnmail-spool-file)) (defun gnus-clear-quick-file-variables () "Clear all variables in quick startup files." @@ -614,6 +663,12 @@ the first newsgroup." (setq variables (cdr variables)))) (setq files (cdr files))))) +(defun gnus-close-all-servers () + "Close all servers." + (interactive) + (dolist (server gnus-opened-servers) + (gnus-close-server (car server)))) + (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear gnus variables. @@ -655,9 +710,8 @@ the first newsgroup." (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) (gnus-kill-buffer nntp-server-buffer) ;; Kill Gnus buffers. - (let ((buffers (gnus-buffers))) - (when buffers - (mapcar 'kill-buffer buffers))) + (dolist (buffer (gnus-buffers)) + (gnus-kill-buffer buffer)) ;; Remove Gnus frames. (gnus-kill-gnus-frames)) @@ -695,13 +749,15 @@ prompt the user for the name of an NNTP server to use." (nnheader-init-server-buffer) (setq gnus-slave slave) (gnus-read-init-file) + (if gnus-agent + (gnus-agentize)) (when gnus-simple-splash (setq gnus-simple-splash nil) (cond ((featurep 'xemacs) (gnus-xmas-splash)) - ((and (eq window-system 'x) + ((and window-system (= (frame-height) (1+ (window-height)))) (gnus-x-splash)))) @@ -732,6 +788,9 @@ prompt the user for the name of an NNTP server to use." (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) ;; Do the actual startup. + (if gnus-agent + (gnus-request-create-group "queue" '(nndraft ""))) + (gnus-request-create-group "drafts" '(nndraft "")) (gnus-setup-news nil level dont-connect) (gnus-run-hooks 'gnus-setup-news-hook) (gnus-start-draft-setup) @@ -753,17 +812,6 @@ prompt the user for the name of an NNTP server to use." (gnus-group-set-parameter "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) -;;;###autoload -(defun gnus-unload () - "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) - (dolist (feature features) - (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature)) - (unload-feature feature 'force)))) - ;;; ;;; Dribble file @@ -790,7 +838,11 @@ cautiously -- unloading may cause trouble." (set-buffer gnus-dribble-buffer) (goto-char (point-max)) (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) + ;; This has been commented by Josh Huber + ;; It causes problems with both XEmacs and Emacs 21, and doesn't + ;; seem to be of much value. (FIXME: remove this after we make sure + ;; it's not needed). + ;; (set-window-point (get-buffer-window (current-buffer)) (point-max)) (bury-buffer gnus-dribble-buffer) (save-excursion (set-buffer gnus-group-buffer) @@ -816,6 +868,7 @@ cautiously -- unloading may cause trouble." (set-buffer-modified-p nil) (let ((auto (make-auto-save-file-name)) (gnus-dribble-ignore t) + (purpose nil) modes) (when (or (file-exists-p auto) (file-exists-p dribble-file)) ;; Load whichever file is newest -- the auto save file @@ -831,10 +884,15 @@ cautiously -- unloading may cause trouble." (file-exists-p dribble-file) (setq modes (file-modes gnus-current-startup-file))) (set-file-modes dribble-file modes)) + (goto-char (point-min)) + (when (search-forward "Gnus was exited on purpose" nil t) + (setq purpose t)) ;; Possibly eval the file later. (when (or gnus-always-read-dribble-file (gnus-y-or-n-p - "Gnus auto-save file exists. Do you want to read it? ")) + (if purpose + "Gnus exited on purpose without saving; read auto-save file anyway? " + "Gnus auto-save file exists. Do you want to read it? "))) (setq gnus-dribble-eval-file t))))))) (defun gnus-dribble-eval-file () @@ -896,10 +954,17 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Make sure the archive server is available to all and sundry. (when gnus-message-archive-method - (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist) - gnus-server-alist)) - (push (cons "archive" gnus-message-archive-method) - gnus-server-alist)) + (unless (assoc "archive" gnus-server-alist) + (push `("archive" + 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)) + gnus-server-alist))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. @@ -935,6 +1000,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; See whether we need to read the description file. (when (and (boundp 'gnus-group-line-format) + (stringp gnus-group-line-format) (let ((case-fold-search nil)) (string-match "%[-,0-9]*D" gnus-group-line-format)) (not gnus-description-hashtb) @@ -949,6 +1015,12 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." gnus-plugged) (gnus-find-new-newsgroups)) + ;; Check and remove bogus newsgroups. + (when (and init gnus-check-bogus-newsgroups + gnus-read-active-file (not level) + (gnus-server-opened gnus-select-method)) + (gnus-check-bogus-newsgroups)) + ;; We might read in new NoCeM messages here. (when (and gnus-use-nocem (not level) @@ -960,12 +1032,22 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Find the number of unread articles in each non-dead group. (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) - (gnus-get-unread-articles level)) - - (when (and init gnus-check-bogus-newsgroups - gnus-read-active-file (not level) - (gnus-server-opened gnus-select-method)) - (gnus-check-bogus-newsgroups)))) + (gnus-get-unread-articles level)))) + +(defun gnus-call-subscribe-functions (method group) + "Call METHOD to subscribe GROUP. +If no function returns `non-nil', call `gnus-subscribe-zombies'." + (unless (cond + ((functionp method) + (funcall method group)) + ((listp method) + (catch 'found + (dolist (func method) + (if (funcall func group) + (throw 'found t))) + nil)) + (t nil)) + (gnus-subscribe-zombies group))) (defun gnus-find-new-newsgroups (&optional arg) "Search for new newsgroups and add them. @@ -1001,7 +1083,7 @@ for new groups, and subscribe the new groups as zombies." (gnus-message 5 "Looking for new newsgroups...") (unless gnus-have-read-active-file (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (current-time-string)) + (setq gnus-newsrc-last-checked-date (message-make-date)) (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) ;; Go though every newsgroup in `gnus-active-hashtb' and compare @@ -1019,7 +1101,8 @@ for new groups, and subscribe the new groups as zombies." ((eq do-sub 'subscribe) (setq groups (1+ groups)) (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t @@ -1027,7 +1110,8 @@ for new groups, and subscribe the new groups as zombies." (gnus-sethash group group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) + (gnus-call-subscribe-functions + gnus-subscribe-newsgroup-method group))))))) gnus-active-hashtb) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) @@ -1064,7 +1148,8 @@ for new groups, and subscribe the new groups as zombies." (and regs (cdar regs)))))) (defun gnus-ask-server-for-new-groups () - (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) + (let* ((new-date (message-make-date)) + (date (or gnus-newsrc-last-checked-date new-date)) (methods (cons gnus-select-method (nconc (when (gnus-archive-server-wanted-p) @@ -1074,7 +1159,6 @@ for new groups, and subscribe the new groups as zombies." gnus-check-new-newsgroups) gnus-secondary-select-methods)))) (groups 0) - (new-date (current-time-string)) group new-newsgroups got-new method hashtb gnus-override-subscribe-method) (unless gnus-killed-hashtb @@ -1112,7 +1196,8 @@ for new groups, and subscribe the new groups as zombies." ((eq do-sub 'subscribe) (incf groups) (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) ((eq do-sub 'ignore) nil) (t @@ -1120,7 +1205,8 @@ for new groups, and subscribe the new groups as zombies." (gnus-sethash group group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) + (gnus-call-subscribe-functions + gnus-subscribe-newsgroup-method group))))))) hashtb)) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups))) @@ -1136,10 +1222,8 @@ for new groups, and subscribe the new groups as zombies." (catch 'ended ;; 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") + (dolist (file (list (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) @@ -1148,26 +1232,27 @@ for new groups, and subscribe the new groups as zombies." (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)) + (setq gnus-newsrc-last-checked-date (message-make-date)) ;; Subscribe to the default newsgroups. (let ((groups (or gnus-default-subscribed-newsgroups gnus-backup-default-subscribed-newsgroups)) group) - (when (eq groups t) - ;; If t, we subscribe (or not) all groups as if they were new. - (mapatoms - (lambda (sym) - (when (setq group (symbol-name sym)) - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (push group gnus-killed-list)))))) - gnus-active-hashtb) + (if (eq groups t) + ;; If t, we subscribe (or not) all groups as if they were new. + (mapatoms + (lambda (sym) + (when (setq group (symbol-name sym)) + (let ((do-sub (gnus-matches-options-n group))) + (cond + ((eq do-sub 'subscribe) + (gnus-sethash group group gnus-killed-hashtb) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) + ((eq do-sub 'ignore) + nil) + (t + (push group gnus-killed-list)))))) + gnus-active-hashtb) (dolist (group groups) ;; Only subscribe the default groups that are activated. (when (gnus-active group) @@ -1175,7 +1260,9 @@ for new groups, and subscribe the new groups as zombies." group gnus-level-default-subscribed gnus-level-killed))) (save-excursion (set-buffer gnus-group-buffer) - (gnus-group-make-help-group)) + ;; Don't error if the group already exists. This happens when a + ;; first-time user types 'F'. -- didier + (gnus-group-make-help-group t)) (when gnus-novice-user (gnus-message 7 "`A k' to list killed groups")))))) @@ -1240,9 +1327,9 @@ for new groups, and subscribe the new groups as zombies." ;; it from the newsrc hash table and assoc. (cond ((>= oldlevel gnus-level-zombie) - (if (= oldlevel gnus-level-zombie) - (setq gnus-zombie-list (delete group gnus-zombie-list)) - (setq gnus-killed-list (delete group gnus-killed-list)))) + ;; oldlevel could be wrong. + (setq gnus-zombie-list (delete group gnus-zombie-list)) + (setq gnus-killed-list (delete group gnus-killed-list))) (t (when (and (>= level gnus-level-zombie) entry) @@ -1265,7 +1352,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 @@ -1333,7 +1424,9 @@ newsgroup." (setq info (pop newsrc) group (gnus-info-group info)) (unless (or (gnus-active group) ; Active - (gnus-info-method info)) ; Foreign + (and (gnus-info-method info) + (not (gnus-secondary-method-p + (gnus-info-method info))))) ; Foreign ;; Found a bogus newsgroup. (push group bogus))) (if confirm @@ -1404,24 +1497,27 @@ newsgroup." (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan group method)) t) - (condition-case () + (if (or debug-on-error debug-on-quit) (inline (gnus-request-group group dont-check method)) - ;;(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 - ;; ignore this if we already have an active entry - ;; for the group. - (if (and (zerop (car active)) - (zerop (cdr active)) - (gnus-active group)) - (gnus-active group) - (gnus-set-active group active) - ;; Return the new active info. - active)))) + (condition-case nil + (inline (gnus-request-group group dont-check method)) + ;;(error nil) + (quit + (message "Quit activating %s" group) + nil))) + (unless dont-check + (setq active (gnus-parse-active)) + ;; If there are no articles in the group, the GROUP + ;; command may have responded with the `(0 . 0)'. We + ;; ignore this if we already have an active entry + ;; for the group. + (if (and (zerop (car active)) + (zerop (cdr active)) + (gnus-active group)) + (gnus-active group) + (gnus-set-active group active) + ;; Return the new active info. + active))))) (defun gnus-get-unread-articles-in-group (info active &optional update) (when active @@ -1504,13 +1600,15 @@ newsgroup." (setq range (cdr range))) (setq num (max 0 (- (cdr active) num))))) ;; Set the number of unread articles. - (when info + (when (and info + (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb)) (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) num))) ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. (defun gnus-get-unread-articles (&optional level) + (setq gnus-server-method-cache nil) (let* ((newsrc (cdr gnus-newsrc-alist)) (level (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level @@ -1522,8 +1620,8 @@ newsgroup." gnus-activate-foreign-newsgroups) (t 0)) level)) - scanned-methods info group active method retrievegroups) - (gnus-message 5 "Checking new news...") + scanned-methods info group active method retrieve-groups) + (gnus-message 6 "Checking new news...") (while newsrc (setq active (gnus-active (setq group (gnus-info-group @@ -1549,9 +1647,9 @@ newsgroup." (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) + (setq active (gnus-activate-group group 'scan))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent gnus-plugged active) + (when (and gnus-agent active (gnus-online method)) (gnus-agent-save-group-info method (gnus-group-real-name group) active)) (unless (inline (gnus-virtual-group-p group)) @@ -1569,10 +1667,10 @@ newsgroup." (if (gnus-check-backend-function 'retrieve-groups group) ;; if server support gnus-retrieve-groups we push ;; the group onto retrievegroups for later checking - (if (assoc method retrievegroups) - (setcdr (assoc method retrievegroups) - (cons group (cdr (assoc method retrievegroups)))) - (push (list method group) retrievegroups)) + (if (assoc method retrieve-groups) + (setcdr (assoc method retrieve-groups) + (cons group (cdr (assoc method retrieve-groups)))) + (push (list method group) retrieve-groups)) ;; 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. @@ -1590,8 +1688,8 @@ newsgroup." (setq active (gnus-activate-group group)) (setq active (gnus-activate-group group 'scan)) (push method scanned-methods)) - (when active - (gnus-close-group group)))))) + (when active + (gnus-close-group group)))))) ;; Get the number of unread articles in the group. (cond @@ -1605,33 +1703,33 @@ newsgroup." ;; unread articles and stuff. (gnus-set-active group nil) (let ((tmp (gnus-gethash group gnus-newsrc-hashtb))) - (if tmp (setcar tmp t)))))) + (when tmp + (setcar tmp t)))))) ;; iterate through groups on methods which support gnus-retrieve-groups ;; and fetch a partial active file and use it to find new news. - (while retrievegroups - (let* ((mg (pop retrievegroups)) - (method (or (car mg) gnus-select-method)) - (groups (cdr mg))) + (dolist (rg retrieve-groups) + (let ((method (or (car rg) gnus-select-method)) + (groups (cdr rg))) (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"))) + ;; 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 6 "Checking new news...done"))) ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. @@ -1691,8 +1789,82 @@ newsgroup." (setq article (pop articles)) ranges) (push article news))) (when news + ;; Enter this list into the group info. (gnus-info-set-read info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) + + ;; Set the number of unread articles in gnus-newsrc-hashtb. + (gnus-get-unread-articles-in-group info (gnus-active group)) + + ;; Insert the change into the group buffer and the dribble file. + (gnus-group-update-group group t)))) + +(defun gnus-make-ascending-articles-unread (group articles) + "Mark ascending ARTICLES in GROUP as unread." + (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb) + (gnus-gethash (gnus-group-real-name group) + gnus-newsrc-hashtb))) + (info (nth 2 entry)) + (ranges (gnus-info-read info)) + (r ranges) + modified) + + (while articles + (let ((article (pop articles))) ; get the next article to remove from ranges + (while (let ((range (car ranges))) ; note the current range + (if (atom range) ; single value range + (cond ((not range) + ;; the articles extend past the end of the ranges + ;; OK - I'm done + (setq articles nil)) + ((< range article) + ;; this range preceeds the article. Leave the range unmodified. + (pop ranges) + ranges) + ((= range article) + ;; this range exactly matches the article; REMOVE THE RANGE. + ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end. + (setcar ranges (cadr ranges)) + (setcdr ranges (cddr ranges)) + (setq modified (if (car ranges) t 'remove-null)) + nil)) + (let ((min (car range)) + (max (cdr range))) + ;; I have a min/max range to consider + (cond ((> min max) ; invalid range introduced by splitter + (setcar ranges (cadr ranges)) + (setcdr ranges (cddr ranges)) + (setq modified (if (car ranges) t 'remove-null)) + ranges) + ((= min max) + ;; replace min/max range with a single-value range + (setcar ranges min) + ranges) + ((< max article) + ;; this range preceeds the article. Leave the range unmodified. + (pop ranges) + ranges) + ((< article min) + ;; this article preceeds the range. Return null to move to the + ;; next article + nil) + (t + ;; this article splits the range into two parts + (setcdr ranges (cons (cons (1+ article) max) (cdr ranges))) + (setcdr range (1- article)) + (setq modified t) + ranges)))))))) + + (when modified + (when (eq modified 'remove-null) + (setq r (delq nil r))) + ;; Enter this list into the group info. + (gnus-info-set-read info r) + + ;; Set the number of unread articles in gnus-newsrc-hashtb. + (gnus-get-unread-articles-in-group info (gnus-active group)) + + ;; Insert the change into the group buffer and the dribble file. (gnus-group-update-group group t)))) ;; Enter all dead groups into the hashtb. @@ -1758,13 +1930,15 @@ newsgroup." ;; Only do each method once, in case the methods appear more ;; than once in this list. (unless (member method methods) - (condition-case () + (if (or debug-on-error debug-on-quit) (gnus-read-active-file-1 method force) - ;; We catch C-g so that we can continue past servers - ;; that do not respond. - (quit - (message "Quit reading the active file") - nil))))))) + (condition-case () + (gnus-read-active-file-1 method force) + ;; We catch C-g so that we can continue past servers + ;; that do not respond. + (quit + (message "Quit reading the active file") + nil)))))))) (defun gnus-read-active-file-1 (method force) (let (where mesg) @@ -1856,7 +2030,7 @@ newsgroup." (insert ?\\))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active gnus-plugged) + (when (and gnus-agent real-active (gnus-online method)) (gnus-agent-save-active method)) ;; If these are groups from a foreign select method, we insert the @@ -1876,7 +2050,7 @@ newsgroup." (goto-char (point-min)) (let (group max min) (while (not (eobp)) - (condition-case err + (condition-case () (progn (narrow-to-region (point) (gnus-point-at-eol)) ;; group gets set to a symbol interned in the hash table @@ -1932,7 +2106,7 @@ newsgroup." ;; Let the Gnus agent save the active file. (if (and gnus-agent real-active - gnus-plugged + (gnus-online method) (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) @@ -2004,26 +2178,39 @@ If FORCE is non-nil, the .newsrc file is read." (kill-buffer (current-buffer)) (gnus-message 5 "Reading %s...done" newsrc-file)))))) +(defun gnus-load (file &optional coding-system) + "Load FILE, but in such a way that read errors can be reported." + (with-temp-buffer + (if coding-system + (insert-file-contents-as-coding-system coding-system file) + (insert-file-contents file)) + (while (not (eobp)) + (condition-case type + (let ((form (read (current-buffer)))) + (eval form)) + (error + (unless (eq (car type) 'end-of-file) + (let ((error (format "Error in %s line %d" file + (count-lines (point-min) (point))))) + (ding) + (unless (gnus-yes-or-no-p (concat error "; continue? ")) + (error "%s" error))))))))) + (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) - ;; We always, always read the .eld file. - (gnus-message 5 "Reading %s..." ding-file) - (let (gnus-newsrc-assoc) - (when (file-exists-p 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 (file-exists-p ding-file) + ;; We always, always read the .eld file. + (gnus-message 5 "Reading %s..." ding-file) + (let (gnus-newsrc-assoc) + (gnus-load ding-file gnus-ding-file-coding-system) +;; ;; Older versions of `gnus-format-specs' are no longer valid +;; ;; in Oort Gnus 0.01. +;; (let ((version +;; (and gnus-newsrc-file-version +;; (gnus-continuum-version gnus-newsrc-file-version)))) +;; (when (or (not version) +;; (< version 5.090009)) +;; (setq gnus-format-specs gnus-default-format-specs))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) (gnus-make-hashtable-from-newsrc-alist) @@ -2038,58 +2225,72 @@ If FORCE is non-nil, the .newsrc file is read." (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)) + (setq list (cdr list))))) + (gnus-run-hooks 'gnus-read-newsrc-el-hook)) + +;;(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) +;; (goto-char (point-min)) +;; (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-ding-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 + (when (or (condition-case err + (let ((coding-system-for-read coding) + (input-coding-system coding)) + (load (expand-file-name file gnus-product-directory) + nil nil t) + nil) + (error + (message "Error while reading %s: %s" + (expand-file-name file gnus-product-directory) + (error-message-string err)) + (setq error t))) + (and (setq method (assq 'product-version checking-methods)) + (not (and (setq file-ver + (cdr (assq 'product-version + gnus-product-file-version))) + (zerop (product-version-compare file-ver + (cadr method)))))) + (and (assq 'emacs-version checking-methods) + (not (and (assq 'emacs-version gnus-product-file-version) + (string-equal + 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)))) + gnus-product-file-version)))))) + (and (assq 'correct-string-widths checking-methods) + (not (and (assq 'correct-string-widths + gnus-product-file-version) + (eq (and gnus-use-correct-string-widths t) + (and (cdr (assq 'correct-string-widths + gnus-product-file-version)) + t)))))) (unless error (message "\"%s\" seems to have mismatched contents, updating..." file)) @@ -2408,6 +2609,12 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (setq gnus-newsrc-options-n out)))) +(eval-and-compile + (defalias 'gnus-long-file-names + (if (fboundp 'msdos-long-file-names) + 'msdos-long-file-names + (lambda () t)))) + (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file." ;; Note: We cannot save .newsrc file if all newsgroups are removed @@ -2434,17 +2641,64 @@ The backup file \".newsrc.eld_\" will be created before re-reading." ;; Save .newsrc.eld. (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) (make-local-variable 'version-control) - (setq version-control 'never) + (setq version-control gnus-backup-startup-file) (setq buffer-file-name (concat gnus-current-startup-file ".eld")) (setq default-directory (file-name-directory buffer-file-name)) (buffer-disable-undo) (erase-buffer) - (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) - (gnus-gnus-to-quick-newsrc-format) - (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer-as-coding-system gnus-startup-file-coding-system) - (kill-buffer (current-buffer)) + (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) + + (if gnus-save-startup-file-via-temp-buffer + (let ((coding-system-for-write gnus-ding-file-coding-system) + (output-coding-system gnus-ding-file-coding-system) + (standard-output (current-buffer))) + (gnus-gnus-to-quick-newsrc-format) + (gnus-run-hooks 'gnus-save-quick-newsrc-hook) + (save-buffer)) + (let ((coding-system-for-write gnus-ding-file-coding-system) + (output-coding-system gnus-ding-file-coding-system) + (version-control gnus-backup-startup-file) + (startup-file (concat gnus-current-startup-file ".eld")) + (working-dir (file-name-directory gnus-current-startup-file)) + working-file + (i -1)) + ;; Generate the name of a non-existent file. + (while (progn (setq working-file + (format + (if (and (eq system-type 'ms-dos) + (not (gnus-long-file-names))) + "%s#%d.tm#" ; MSDOS limits files to 8+3 + (if (memq system-type '(vax-vms axp-vms)) + "%s$tmp$%d" + "%s#tmp#%d")) + working-dir (setq i (1+ i)))) + (file-exists-p working-file))) + + (unwind-protect + (progn + (gnus-with-output-to-file working-file + (gnus-gnus-to-quick-newsrc-format) + (gnus-run-hooks 'gnus-save-quick-newsrc-hook)) + + ;; These bindings will mislead the current buffer + ;; into thinking that it is visiting the startup + ;; file. + (let ((buffer-backed-up nil) + (buffer-file-name startup-file) + (file-precious-flag t) + (setmodes (file-modes startup-file))) + ;; Backup the current version of the startup file. + (backup-buffer) + + ;; Replace the existing startup file with the temp file. + (rename-file working-file startup-file t) + (set-file-modes startup-file setmodes))) + (condition-case nil + (delete-file working-file) + (file-error nil))))) + + (gnus-kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) (gnus-dribble-delete-file) @@ -2462,18 +2716,23 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (gnus-save-newsrc-file))) (defun gnus-gnus-to-quick-newsrc-format () - "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 "\ + "Print Gnus variables such as gnus-newsrc-alist in lisp format." + (princ ";; -*- emacs-lisp -*-\n") + (princ ";; Gnus startup file.\n") + (princ "\ ;; Never delete this file -- if you want to force Gnus to read the ;; .newsrc file (if you have one), touch .newsrc instead.\n") - (insert "(setq gnus-newsrc-file-version " - (prin1-to-string gnus-version) ")\n") - (let* ((gnus-killed-list + (princ "(setq gnus-newsrc-file-version ") + (princ (gnus-prin1-to-string gnus-version)) + (princ ")\n") + (let* ((print-quoted t) + (print-readably t) + (print-escape-multibyte nil) + (print-escape-nonascii t) + (print-length nil) + (print-level nil) + (print-escape-newlines t) + (gnus-killed-list (if (and gnus-save-killed-list (stringp gnus-save-killed-list)) (gnus-strip-killed-list) @@ -2490,9 +2749,11 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (while variables (when (and (boundp (setq variable (pop variables))) (symbol-value variable)) - (insert "(setq " (symbol-name variable) " '") - (gnus-prin1 (symbol-value variable)) - (insert ")\n")))))) + (princ "(setq ") + (princ (symbol-name variable)) + (princ " '") + (prin1 (symbol-value variable)) + (princ ")\n"))))) (defun gnus-product-variable-touch (&rest variables) (while variables @@ -2543,7 +2804,7 @@ The backup file \".newsrc.eld_\" will be created before re-reading." "Insert gnus product depend variables in lisp format." (let ((print-quoted t) (print-escape-newlines t) - variable param) + print-length print-level 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))) @@ -2553,16 +2814,20 @@ The backup file \".newsrc.eld_\" will be created before re-reading." "\t0)\n" " (error \"This file was created by later version of " "gnus.\"))\n")) - (insert "(setq gnus-product-file-version \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") + "\t(emacs-version . " + (prin1-to-string emacs-version) ")\n" + "\t(correct-string-widths . " + (if gnus-use-correct-string-widths "t" "nil") + ")))\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"))))) + (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'." @@ -2646,11 +2911,11 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (save-excursion (set-buffer gnus-dribble-buffer) (let ((slave-name - (make-temp-name (concat gnus-current-startup-file "-slave-"))) + (mm-make-temp-file (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) - (gnus-write-buffer-as-coding-system - gnus-startup-file-coding-system slave-name) + (gnus-write-buffer-as-coding-system gnus-ding-file-coding-system + slave-name) (when modes (set-file-modes slave-name modes))))) @@ -2770,16 +3035,16 @@ The backup file \".newsrc.eld_\" will be created before re-reading." (skip-chars-forward " \t") ;; ... which leads to this line being effectively ignored. (when (symbolp group) - (let ((str (buffer-substring - (point) (progn (end-of-line) (point)))) - (coding - (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'gnus-mule-get-coding-system) - (gnus-mule-get-coding-system (symbol-name group))))) - (when coding - (setq str (decode-coding-string str (car coding)))) + (let* ((str (buffer-substring + (point) (progn (end-of-line) (point)))) + (name (symbol-name group)) + (charset + (or (gnus-group-name-charset method name) + (gnus-parameter-charset name) + gnus-default-charset))) + ;; Fixme: Don't decode in unibyte mode. + (when (and str charset (featurep 'mule)) + (setq str (decode-coding-string str charset))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") @@ -2811,6 +3076,28 @@ If this variable is nil, don't do anything." (file-name-as-directory (expand-file-name gnus-default-directory)) default-directory))) +(eval-and-compile +(defalias 'gnus-display-time-event-handler + (if (gnus-boundp 'display-time-timer) + 'display-time-event-handler + (lambda () "Does nothing as `display-time-timer' is not bound. +Would otherwise be an alias for `display-time-event-handler'." nil)))) + +;;;###autoload +(defun gnus-fixup-nnimap-unread-after-getting-new-news () + (let (server group info) + (mapatoms + (lambda (sym) + (when (and (setq group (symbol-name sym)) + (gnus-group-entry group) + (setq info (symbol-value sym))) + (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group))) + gnus-newsrc-hashtb))) + (if (boundp 'nnimap-mailbox-info) + (symbol-value 'nnimap-mailbox-info) + (make-vector 1 0))))) + + (provide 'gnus-start) ;;; gnus-start.el ends here diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 158221d..acdac21 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,5 @@ ;;; gnus-sum.el --- summary mode commands for Semi-gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -28,7 +28,10 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'gnus-clfns) + (defvar tool-bar-map)) (require 'gnus) (require 'gnus-group) @@ -37,6 +40,7 @@ (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) +(require 'nnoo) (require 'mime-view) (eval-when-compile @@ -44,15 +48,20 @@ (require 'static)) (eval-and-compile - (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 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) +(autoload 'mm-uu-dissect "mm-uu") +(autoload 'gnus-article-outlook-deuglify-article "deuglify" + "Deuglify broken Outlook (Express) articles and redisplay." + t) +(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t) +(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t) +(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t) (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -116,6 +125,11 @@ given by the `gnus-summary-same-subject' variable.)" (const adopt) (const empty))) +(defcustom gnus-summary-make-false-root-always nil + "Always make a false dummy root." + :group 'gnus-thread + :type 'boolean) + (defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" "*A regexp to match subjects to be excluded from loose thread gathering. As loose thread gathering is done on subjects only, that means that @@ -143,13 +157,14 @@ comparing subjects." "List of functions taking a string argument that simplify subjects. The functions are applied recursively. -Useful functions to put in this list include: `gnus-simplify-subject-re', -`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'." +Useful functions to put in this list include: +`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy', +`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'." :group 'gnus-thread :type '(repeat function)) (defcustom gnus-simplify-ignored-prefixes nil - "*Regexp, matches for which are removed from subject lines when simplifying fuzzily." + "*Remove matches for this regexp from subject lines when simplifying fuzzily." :group 'gnus-thread :type '(choice (const :tag "off" nil) regexp)) @@ -191,7 +206,7 @@ This applies to marking commands as well as other commands that 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 +\(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 @@ -208,6 +223,20 @@ If this variable is nil, scoring will be disabled." :type '(choice (const :tag "disable") integer)) +(defcustom gnus-summary-default-high-score 0 + "*Default threshold for a high scored article. +An article will be highlighted as high scored if its score is greater +than this score." + :group 'gnus-score-default + :type 'integer) + +(defcustom gnus-summary-default-low-score 0 + "*Default threshold for a low scored article. +An article will be highlighted as low scored if its score is smaller +than this score." + :group 'gnus-score-default + :type 'integer) + (defcustom gnus-summary-zcore-fuzz 0 "*Fuzziness factor for the zcore in the summary buffer. Articles with scores closer than this to `gnus-summary-default-score' @@ -230,6 +259,7 @@ simplification is selected." (defcustom gnus-thread-hide-subtree nil "*If non-nil, hide all threads initially. +This can be a predicate specifier which says which threads to hide. If threads are hidden, you have to run the command `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' to expose hidden threads." @@ -273,25 +303,33 @@ equal will be included." :type 'boolean) (defcustom gnus-auto-select-first t - "*If nil, don't select the first unread article when entering a group. -If this variable is `best', select the highest-scored unread article -in the group. If t, select the first unread article. - -This variable can also be a function to place point on a likely -subject line. Useful values include `gnus-summary-first-unread-subject', -`gnus-summary-first-unread-article' and -`gnus-summary-best-unread-article'. - -If you want to prevent automatic selection of the first unread article -in some newsgroups, set the variable to nil in -`gnus-select-group-hook'." + "*If non-nil, select the article under point. +Which article this is is controlled by the `gnus-auto-select-subject' +variable. + +If you want to prevent automatic selection of articles in some +newsgroups, set the variable to nil in `gnus-select-group-hook'." :group 'gnus-group-select :type '(choice (const :tag "none" nil) - (const best) - (sexp :menu-tag "first" t) - (function-item gnus-summary-first-unread-subject) - (function-item gnus-summary-first-unread-article) - (function-item gnus-summary-best-unread-article))) + (sexp :menu-tag "first" t))) + +(defcustom gnus-auto-select-subject 'unread + "*Says what subject to place under point when entering a group. + +This variable can either be the symbols `first' (place point on the +first subject), `unread' (place point on the subject line of the first +unread article), `best' (place point on the subject line of the +higest-scored article), `unseen' (place point on the subject line of +the first unseen article), 'unseen-or-unread' (place point on the subject +line of the first unseen article or, if all article have been seen, on the +subject line of the first unread article), or a function to be called to +place point on some subject line." + :group 'gnus-group-select + :type '(choice (const best) + (const unread) + (const first) + (const unseen) + (const unseen-or-unread))) (defcustom gnus-dont-select-after-jump-to-other-group nil "If non-nil, don't select the first unread article after entering the @@ -304,13 +342,13 @@ or not." (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit -summary mode and go back to group mode. If the value is neither nil -nor t, Gnus will select the following unread newsgroup. In +summary mode and go back to group mode. If the value is neither nil +nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmation, and if it is `almost-quietly', the next group will be selected without any confirmation if you are located on the last article in the group. -Finally, if this variable is `slightly-quietly', the `Z n' command +Finally, if this variable is `slightly-quietly', the `\\\\[gnus-summary-catchup-and-goto-next-group]' command will go to the next group without confirmation." :group 'gnus-summary-maneuvering :type '(choice (const :tag "off" nil) @@ -326,6 +364,23 @@ the first unread article." :group 'gnus-summary-maneuvering :type 'boolean) +(defcustom gnus-auto-goto-ignores 'unfetched + "*Says how to handle unfetched articles when maneuvering. + +This variable can either be the symbols `nil' (maneuver to any +article), `undownloaded' (maneuvering while unplugged ignores articles +that have not been fetched), `always-undownloaded' (maneuvering always +ignores articles that have not been fetched), `unfetched' (maneuvering +ignores articles whose headers have not been fetched). + +NOTE: The list of unfetched articles will always be nil when plugged +and, when unplugged, a subset of the undownloaded article list." + :group 'gnus-summary-maneuvering + :type '(choice (const :tag "None" nil) + (const :tag "Undownloaded when unplugged" undownloaded) + (const :tag "Undownloaded" always-undownloaded) + (const :tag "Unfetched" unfetched))) + (defcustom gnus-summary-check-current nil "*If non-nil, consider the current article when moving. The \"unread\" movement commands will stay on the same line if the @@ -343,6 +398,9 @@ and non-`vertical', do both horizontal and vertical recentering." (integer :tag "height") (sexp :menu-tag "both" t))) +(defvar gnus-auto-center-group t + "*If non-nil, always center the group buffer.") + (defcustom gnus-show-all-headers nil "*If non-nil, don't hide any headers." :group 'gnus-article-hiding @@ -384,7 +442,7 @@ this variable specifies group names." (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) @@ -419,8 +477,13 @@ this variable specifies group names." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-spam-mark ?$ + "*Mark used for spam articles." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-souped-mark ?F - "*Mark used for killed articles." + "*Mark used for souped articles." :group 'gnus-summary-marks :type 'character) @@ -444,13 +507,33 @@ this variable specifies group names." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-forwarded-mark ?F + "*Mark used for articles that have been forwarded." + :group 'gnus-summary-marks + :type 'character) + +(defcustom gnus-recent-mark ?N + "*Mark used for articles that are recent." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-cached-mark ?* "*Mark used for articles that are in the cache." :group 'gnus-summary-marks :type 'character) (defcustom gnus-saved-mark ?S - "*Mark used for articles that have been saved to." + "*Mark used for articles that have been saved." + :group 'gnus-summary-marks + :type 'character) + +(defcustom gnus-unseen-mark ?. + "*Mark used for articles that haven't been seen." + :group 'gnus-summary-marks + :type 'character) + +(defcustom gnus-no-mark ?\ ;;;Whitespace + "*Mark used for articles that have no other secondary mark." :group 'gnus-summary-marks :type 'character) @@ -474,11 +557,16 @@ this variable specifies group names." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-undownloaded-mark ?@ +(defcustom gnus-undownloaded-mark ?- "*Mark used for articles that weren't downloaded." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-downloaded-mark ?+ + "*Mark used for articles that were downloaded." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-downloadable-mark ?% "*Mark used for articles that are to be downloaded." :group 'gnus-summary-marks @@ -499,7 +587,7 @@ this variable specifies group names." :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) @@ -519,11 +607,13 @@ this variable specifies group names." 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) @@ -549,12 +639,16 @@ list of parameters to that command." :type 'boolean) (defcustom gnus-summary-dummy-line-format - " %(: :%) %S\n" + " %(: :%) %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. -%S The subject" +%S The subject + +General format specifiers can also be used. +See `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-threading :type 'string) @@ -584,6 +678,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) @@ -599,29 +694,55 @@ score file." (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) "*List of functions used for sorting articles in the summary buffer. -This variable is only used when not using a threaded display." + +Each function takes two articles and returns non-nil if the first +article should be sorted before the other. If you use more than one +function, the primary sort function should be the last. You should +probably always include `gnus-article-sort-by-number' in the list of +sorting functions -- preferably first. Also note that sorting by date +is often much slower than sorting by number, and the sorting order is +very similar. (Sorting by date means sorting by the time the message +was sent, sorting by number means sorting by arrival time.) + +Ready-made functions include `gnus-article-sort-by-number', +`gnus-article-sort-by-author', `gnus-article-sort-by-subject', +`gnus-article-sort-by-date', `gnus-article-sort-by-random' +and `gnus-article-sort-by-score'. + +When threading is turned on, the variable `gnus-thread-sort-functions' +controls how articles are sorted." :group 'gnus-summary-sort :type '(repeat (choice (function-item gnus-article-sort-by-number) (function-item gnus-article-sort-by-author) (function-item gnus-article-sort-by-subject) (function-item gnus-article-sort-by-date) (function-item gnus-article-sort-by-score) + (function-item gnus-article-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) "*List of functions used for sorting threads in the summary buffer. By default, threads are sorted by article number. -Each function takes two threads and return non-nil if the first thread -should be sorted before the other. If you use more than one function, -the primary sort function should be the last. You should probably -always include `gnus-thread-sort-by-number' in the list of sorting -functions -- preferably first. +Each function takes two threads and returns non-nil if the first +thread should be sorted before the other. If you use more than one +function, the primary sort function should be the last. You should +probably always include `gnus-thread-sort-by-number' in the list of +sorting functions -- preferably first. Also note that sorting by date +is often much slower than sorting by number, and the sorting order is +very similar. (Sorting by date means sorting by the time the message +was sent, sorting by number means sorting by arrival time.) Ready-made functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', -`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and -`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')." +`gnus-thread-sort-by-date', `gnus-thread-sort-by-score', +`gnus-thread-sort-by-most-recent-number', +`gnus-thread-sort-by-most-recent-date', +`gnus-thread-sort-by-random', and +`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). + +When threading is turned off, the variable +`gnus-article-sort-functions' controls how articles are sorted." :group 'gnus-summary-sort :type '(repeat (choice (function-item gnus-thread-sort-by-number) (function-item gnus-thread-sort-by-author) @@ -629,6 +750,7 @@ Ready-made functions include `gnus-thread-sort-by-number', (function-item gnus-thread-sort-by-date) (function-item gnus-thread-sort-by-score) (function-item gnus-thread-sort-by-total-score) + (function-item gnus-thread-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-score-function '+ @@ -662,9 +784,17 @@ 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 gnus-pick-mode) :group 'gnus-summary-various :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) + (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) + (add-hook 'gnus-summary-mode-hook + 'gnus-xmas-switch-horizontal-scrollbar-off)) + (defcustom gnus-summary-menu-hook nil "*Hook run after the creation of the summary mode menu." :group 'gnus-summary-visual @@ -701,21 +831,21 @@ If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the following hook: - (setq gnus-select-group-hook - (list - (lambda () - (mapcar (lambda (header) - (mail-header-set-subject - header - (gnus-simplify-subject - (mail-header-subject header) 're-only))) - gnus-newsgroup-headers))))" + (add-hook gnus-select-group-hook + (lambda () + (mapcar (lambda (header) + (mail-header-set-subject + header + (gnus-simplify-subject + (mail-header-subject header) 're-only))) + gnus-newsgroup-headers)))" :group 'gnus-group-select :type 'hook) (defcustom gnus-select-article-hook nil "*A hook called when an article is selected." :group 'gnus-summary-choose + :options '(gnus-agent-fetch-selected-article) :type 'hook) (defcustom gnus-visual-mark-article-hook @@ -726,7 +856,7 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -(defcustom gnus-parse-headers-hook '(gnus-set-summary-default-charset) +(defcustom gnus-parse-headers-hook '(gnus-summary-inherit-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -765,51 +895,71 @@ automatically when it is selected." :group 'gnus-summary :type 'hook) +(defcustom gnus-summary-article-move-hook nil + "*A hook called after an article is moved, copied, respooled, or crossposted." + :group 'gnus-summary + :type 'hook) + +(defcustom gnus-summary-article-delete-hook nil + "*A hook called after an article is deleted." + :group 'gnus-summary + :type 'hook) + +(defcustom gnus-summary-article-expire-hook nil + "*A hook called after an article is expired." + :group 'gnus-summary + :type 'hook) + +(defcustom gnus-summary-display-arrow + (and (fboundp 'display-graphic-p) + (display-graphic-p)) + "*If non-nil, display an arrow highlighting the current article." + :version "21.1" + :group 'gnus-summary + :type 'boolean) + (defcustom gnus-summary-selected-face 'gnus-summary-selected-face "Face used for highlighting the current article in the summary buffer." :group 'gnus-summary-visual :type 'face) +(defvar gnus-tmp-downloaded nil) + (defcustom gnus-summary-highlight - '(((= mark gnus-canceled-mark) + '(((eq mark gnus-canceled-mark) . gnus-summary-cancelled-face) - ((and (> score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) + ((and uncached (> score default-high)) + . gnus-summary-high-undownloaded-face) + ((and uncached (< score default-low)) + . gnus-summary-low-undownloaded-face) + (uncached + . gnus-summary-normal-undownloaded-face) + ((and (> score default-high) + (or (eq mark gnus-dormant-mark) + (eq mark gnus-ticked-mark))) . gnus-summary-high-ticked-face) - ((and (< score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) + ((and (< score default-low) + (or (eq mark gnus-dormant-mark) + (eq mark gnus-ticked-mark))) . gnus-summary-low-ticked-face) - ((or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark)) + ((or (eq mark gnus-dormant-mark) + (eq mark gnus-ticked-mark)) . gnus-summary-normal-ticked-face) - ((and (> score default) (= mark gnus-ancient-mark)) + ((and (> score default-high) (eq mark gnus-ancient-mark)) . gnus-summary-high-ancient-face) - ((and (< score default) (= mark gnus-ancient-mark)) + ((and (< score default-low) (eq mark gnus-ancient-mark)) . gnus-summary-low-ancient-face) - ((= mark gnus-ancient-mark) + ((eq mark gnus-ancient-mark) . gnus-summary-normal-ancient-face) - ((and (> score default) (= mark gnus-unread-mark)) + ((and (> score default-high) (eq mark gnus-unread-mark)) . gnus-summary-high-unread-face) - ((and (< score default) (= mark gnus-unread-mark)) + ((and (< score default-low) (eq mark gnus-unread-mark)) . gnus-summary-low-unread-face) - ((and (memq article gnus-newsgroup-incorporated) - (= mark gnus-unread-mark)) - . gnus-summary-incorporated-face) - ((= mark gnus-unread-mark) + ((eq mark gnus-unread-mark) . gnus-summary-normal-unread-face) - ((and (> score default) (memq mark (list gnus-downloadable-mark - gnus-undownloaded-mark))) - . gnus-summary-high-unread-face) - ((and (< score default) (memq mark (list gnus-downloadable-mark - gnus-undownloaded-mark))) - . gnus-summary-low-unread-face) - ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark)) - . gnus-summary-normal-unread-face) - ((> score default) + ((> score default-high) . gnus-summary-high-read-face) - ((< score default) + ((< score default-low) . gnus-summary-low-read-face) (t . gnus-summary-normal-read-face)) @@ -822,10 +972,12 @@ how those summary lines are displayed, by editing the face field. You can use the following variables in the FORM field. -score: The articles score -default: The default article score. -below: The score below which articles are automatically marked as read. -mark: The articles mark." +score: The article's score +default: The default article score. +default-high: The default score for high scored articles. +default-low: The default score for low scored articles. +below: The score below which articles are automatically marked as read. +mark: The articles mark." :group 'gnus-summary-visual :type '(repeat (cons (sexp :tag "Form" nil) face))) @@ -833,61 +985,64 @@ mark: The articles mark." (defcustom gnus-alter-header-function nil "Function called to allow alteration of article header structures. The function is called with one parameter, the article header vector, -which it may alter in any way.") +which it may alter in any way." + :type '(choice (const :tag "None" nil) + function) + :group 'gnus-summary) (defvar gnus-decode-encoded-word-function (mime-find-field-decoder 'From 'nov) "Variable that says which function should be used to decode a string with encoded words.") -(defcustom gnus-extra-headers nil +(defcustom gnus-extra-headers '(To Newsgroups) "*Extra headers to parse." + :version "21.1" :group 'gnus-summary :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) -(defcustom gnus-group-charset-alist - '(("^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." - :type '(repeat (list (regexp :tag "Group") - (symbol :tag "Charset"))) - :group 'gnus-charset) - (defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) "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 - '(("alt\\.chinese\\.text" iso-8859-1)) - "Alist of regexps (to match group names) and charsets that should be ignored. +(gnus-define-group-parameter + ignored-charsets + :type list + :function-document + "Return the ignored charsets of GROUP." + :variable gnus-group-ignored-charsets-alist + :variable-default + '(("alt\\.chinese\\.text" iso-8859-1)) + :variable-document + "Alist of regexps (to match group names) and charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." - :type '(repeat (cons (regexp :tag "Group") - (repeat symbol))) - :group 'gnus-charset) + :variable-group gnus-charset + :variable-type '(repeat (cons (regexp :tag "Group") + (repeat symbol))) + :parameter-type '(choice :tag "Ignored charsets" + :value nil + (repeat (symbol))) + :parameter-document "\ +List of charsets that should be ignored. + +When these charsets are used in the \"charset\" parameter, the +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) @@ -921,18 +1076,20 @@ by moving the mouse over the edge of the article window." 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 + :type '(choice (const nil) function) :group 'gnus-summary) (defcustom gnus-orphan-score nil @@ -942,20 +1099,54 @@ For example: ((1 . cn-gb-2312) (2 . big5))." 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." + "*A regexp to match MIME parts when saving multiple parts of a +message with `gnus-summary-save-parts' (\\\\[gnus-summary-save-parts]). +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-read-all-available-headers nil + "Whether Gnus should parse all headers made available to it. +This is mostly relevant for slow backends where the user may +wish to widen the summary buffer to include all headers +that were fetched. Say, for nnultimate groups." + :group 'gnus-summary + :type '(choice boolean regexp)) + +(defcustom gnus-summary-muttprint-program "muttprint" + "Command (and optional arguments) used to run Muttprint." + :version "21.3" + :group 'gnus-summary + :type 'string) + +(defcustom gnus-article-loose-mime nil + "If non-nil, don't require MIME-Version header. +Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not +supply the MIME-Version header or deliberately strip it From the mail. +Set it to non-nil, Gnus will treat some articles as MIME even if +the MIME-Version header is missed." + :version "21.3" + :type 'boolean + :group 'gnus-article-mime) + +(defcustom gnus-article-emulate-mime t + "If non-nil, use MIME emulation for uuencode and the like. +This means that Gnus will search message bodies for text that look +like uuencoded bits, yEncoded bits, and so on, and present that using +the normal Gnus MIME machinery." + :type 'boolean + :group 'gnus-article-mime) ;;; Internal variables +(defvar gnus-summary-display-cache nil) (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) (defvar gnus-original-article nil) (defvar gnus-article-internal-prepare-hook nil) @@ -978,6 +1169,7 @@ when prompting the user for which type of files to save." (defvar gnus-current-move-group nil) (defvar gnus-current-copy-group nil) (defvar gnus-current-crosspost-group nil) +(defvar gnus-newsgroup-display nil) (defvar gnus-newsgroup-dependencies nil) (defvar gnus-newsgroup-adaptive nil) @@ -1003,7 +1195,9 @@ when prompting the user for which type of files to save." (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) - (?L gnus-tmp-lines ?d) + (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) + (?L gnus-tmp-lines ?s) + (?O gnus-tmp-downloaded ?c) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) (?R gnus-tmp-replied ?c) @@ -1016,7 +1210,8 @@ when prompting the user for which type of files to save." (?l (bbb-grouplens-score gnus-tmp-header) ?s) (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) (?U gnus-tmp-unread ?c) - (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s) + (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from) + ?s) (?t (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level) ?d) @@ -1024,7 +1219,10 @@ when prompting the user for which type of files to save." (and (boundp 'thread) (car thread)) gnus-tmp-level t) ?c) (?u gnus-tmp-user-defined ?s) - (?P (gnus-pick-line-number) ?d)) + (?P (gnus-pick-line-number) ?d) + (?B gnus-tmp-thread-tree-header-string ?s) + (user-date (gnus-user-date + ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s)) "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).") @@ -1047,6 +1245,7 @@ the type of the variable (string, integer, character, etc).") (?u gnus-tmp-user-defined ?s) (?d (length gnus-newsgroup-dormant) ?d) (?t (length gnus-newsgroup-marked) ?d) + (?h (length gnus-newsgroup-spam-marked) ?d) (?r (length gnus-newsgroup-reads) ?d) (?z (gnus-summary-article-score gnus-tmp-article-number) ?d) (?E gnus-newsgroup-expunged-tally ?d) @@ -1063,6 +1262,8 @@ end position and text.") (defvar gnus-last-shell-command nil "Default shell command on article.") +(defvar gnus-newsgroup-agentized nil + "Locally bound in each summary buffer to indicate whether the server has been agentized.") (defvar gnus-newsgroup-begin nil) (defvar gnus-newsgroup-end nil) (defvar gnus-newsgroup-last-rmail nil) @@ -1078,10 +1279,10 @@ end position and text.") (defvar gnus-newsgroup-limits nil) (defvar gnus-newsgroup-unreads nil - "List of unread articles in the current newsgroup.") + "Sorted list of unread articles in the current newsgroup.") (defvar gnus-newsgroup-unselected nil - "List of unselected unread articles in the current newsgroup.") + "Sorted list of unselected unread articles in the current newsgroup.") (defvar gnus-newsgroup-reads nil "Alist of read articles and article marks in the current newsgroup.") @@ -1089,13 +1290,16 @@ end position and text.") (defvar gnus-newsgroup-expunged-tally nil) (defvar gnus-newsgroup-marked nil - "List of ticked articles in the current newsgroup (a subset of unread art).") + "Sorted list of ticked articles in the current newsgroup (a subset of unread art).") + +(defvar gnus-newsgroup-spam-marked nil + "List of ranges of articles that have been marked as spam.") (defvar gnus-newsgroup-killed nil "List of ranges of articles that have been through the scoring process.") (defvar gnus-newsgroup-cached nil - "List of articles that come from the article cache.") + "Sorted list of articles that come from the article cache.") (defvar gnus-newsgroup-saved nil "List of articles that have been saved.") @@ -1105,17 +1309,29 @@ end position and text.") (defvar gnus-newsgroup-replied nil "List of articles that have been replied to in the current newsgroup.") +(defvar gnus-newsgroup-forwarded nil + "List of articles that have been forwarded in the current newsgroup.") + +(defvar gnus-newsgroup-recent nil + "List of articles that have are recent in the current newsgroup.") + (defvar gnus-newsgroup-expirable nil - "List of articles in the current newsgroup that can be expired.") + "Sorted list of articles in the current newsgroup that can be expired.") (defvar gnus-newsgroup-processable nil "List of articles in the current newsgroup that can be processed.") (defvar gnus-newsgroup-downloadable nil - "List of articles in the current newsgroup that can be processed.") + "Sorted list of articles in the current newsgroup that can be processed.") + +(defvar gnus-newsgroup-unfetched nil + "Sorted list of articles in the current newsgroup whose headers have +not been fetched into the agent. + +This list will always be a subset of gnus-newsgroup-undownloaded.") (defvar gnus-newsgroup-undownloaded nil - "List of articles in the current newsgroup that haven't been downloaded..") + "List of articles in the current newsgroup that haven't been downloaded.") (defvar gnus-newsgroup-unsendable nil "List of articles in the current newsgroup that won't be sent.") @@ -1124,7 +1340,16 @@ end position and text.") "List of articles in the current newsgroup that have bookmarks.") (defvar gnus-newsgroup-dormant nil - "List of dormant articles in the current newsgroup.") + "Sorted list of dormant articles in the current newsgroup.") + +(defvar gnus-newsgroup-unseen nil + "List of unseen articles in the current newsgroup.") + +(defvar gnus-newsgroup-seen nil + "Range of seen articles in the current newsgroup.") + +(defvar gnus-newsgroup-articles nil + "List of articles in the current newsgroup.") (defvar gnus-newsgroup-scored nil "List of scored articles in the current newsgroup.") @@ -1155,18 +1380,25 @@ end position and text.") (defvar gnus-newsgroup-ephemeral-charset nil) (defvar gnus-newsgroup-ephemeral-ignored-charsets nil) -(defconst gnus-summary-local-variables +(defvar gnus-article-before-search nil) + +(defvar gnus-summary-local-variables '(gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked + gnus-newsgroup-spam-marked gnus-newsgroup-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-expirable + gnus-newsgroup-replied gnus-newsgroup-forwarded + gnus-newsgroup-recent + gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-downloadable gnus-newsgroup-undownloaded - gnus-newsgroup-unsendable + gnus-newsgroup-unfetched + gnus-newsgroup-unsendable gnus-newsgroup-unseen + gnus-newsgroup-seen gnus-newsgroup-articles gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-threads gnus-newsgroup-prepared gnus-summary-highlight-line-function @@ -1188,34 +1420,68 @@ end position and text.") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset + gnus-newsgroup-charset gnus-newsgroup-display gnus-newsgroup-incorporated) "Variables that are buffer-local to the summary buffers.") +(defvar gnus-newsgroup-variables nil + "A list of variables that have separate values in different newsgroups. +A list of newsgroup (summary buffer) local variables, or cons of +variables and their default values (when the default values are not +nil), that should be made global while the summary buffer is active. +These variables can be used to set variables in the group parameters +while still allowing them to affect operations done in other +buffers. For example: + +\(setq gnus-newsgroup-variables + '(message-use-followup-to + (gnus-visible-headers . + \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\"))) +") + ;; Byte-compiler warning. -(defvar gnus-article-mode-map) +(eval-when-compile + ;; Bind features so that require will believe that gnus-sum has + ;; already been loaded (avoids infinite recursion) + (let ((features (cons 'gnus-sum features))) + ;; Several of the declarations in gnus-sum are needed to load the + ;; following files. Right now, these definitions have been + ;; compiled but not defined (evaluated). We could either do a + ;; eval-and-compile about all of the declarations or evaluate the + ;; source file. + (if (boundp 'gnus-newsgroup-variables) + nil + (load "gnus-sum.el" t t t)) + (require 'gnus) + (require 'gnus-agent) + (require 'gnus-art))) ;; Subject simplification. (defun gnus-simplify-whitespace (str) "Remove excessive whitespace from STR." - (let ((mystr str)) - ;; Multiple spaces. - (while (string-match "[ \t][ \t]+" mystr) - (setq mystr (concat (substring mystr 0 (match-beginning 0)) - " " - (substring mystr (match-end 0))))) - ;; Leading spaces. - (when (string-match "^[ \t]+" mystr) - (setq mystr (substring mystr (match-end 0)))) - ;; Trailing spaces. - (when (string-match "[ \t]+$" mystr) - (setq mystr (substring mystr 0 (match-beginning 0)))) - mystr)) + ;; Multiple spaces. + (while (string-match "[ \t][ \t]+" str) + (setq str (concat (substring str 0 (match-beginning 0)) + " " + (substring str (match-end 0))))) + ;; Leading spaces. + (when (string-match "^[ \t]+" str) + (setq str (substring str (match-end 0)))) + ;; Trailing spaces. + (when (string-match "[ \t]+$" str) + (setq str (substring str 0 (match-beginning 0)))) + str) + +(defun gnus-simplify-all-whitespace (str) + "Remove all whitespace from STR." + (while (string-match "[ \t\n]+" str) + (setq str (replace-match "" nil nil str))) + str) (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) + (if (string-match message-subject-re-regexp subject) (substring subject (match-end 0)) subject)) @@ -1289,7 +1555,7 @@ See `gnus-simplify-buffer-fuzzy' for details." (buffer-string)))) (defsubst gnus-simplify-subject-fully (subject) - "Simplify a subject string according to gnus-summary-gather-subject-limit." + "Simplify a subject string according to `gnus-summary-gather-subject-limit'." (cond (gnus-simplify-subject-functions (gnus-map-function gnus-simplify-subject-functions subject)) @@ -1305,7 +1571,7 @@ See `gnus-simplify-buffer-fuzzy' for details." (defsubst gnus-subject-equal (s1 s2 &optional simple-first) "Check whether two subjects are equal. -If optional argument simple-first is t, first argument is already +If optional argument SIMPLE-FIRST is t, first argument is already simplified." (cond ((null simple-first) @@ -1328,346 +1594,462 @@ increase the score of each group you read." (put 'gnus-summary-mode 'mode-class 'special) -(when t - ;; Non-orthogonal keys - - (gnus-define-keys gnus-summary-mode-map - " " gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - [backspace] gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\M-\C-n" gnus-summary-next-same-subject - "\M-\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "." gnus-summary-first-unread-article - "," gnus-summary-best-unread-article - "\M-s" gnus-summary-search-article-forward - "\M-r" gnus-summary-search-article-backward - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "j" gnus-summary-goto-article - "^" gnus-summary-refer-parent-article - "\M-^" gnus-summary-refer-article - "u" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "U" gnus-summary-tick-article-backward - "d" gnus-summary-mark-as-read-forward - "D" gnus-summary-mark-as-read-backward - "E" gnus-summary-mark-as-expirable - "\M-u" gnus-summary-clear-mark-forward - "\M-U" gnus-summary-clear-mark-backward - "k" gnus-summary-kill-same-subject-and-select - "\C-k" gnus-summary-kill-same-subject - "\M-\C-k" gnus-summary-kill-thread - "\M-\C-l" gnus-summary-lower-thread - "e" gnus-summary-edit-article - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "\M-\C-t" gnus-summary-toggle-threads - "\M-\C-s" gnus-summary-show-thread - "\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 - "c" gnus-summary-catchup-and-exit - "\C-w" gnus-summary-mark-region-as-read - "\C-t" gnus-summary-toggle-truncation - "?" gnus-summary-mark-as-dormant - "\C-c\M-\C-s" gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" gnus-summary-sort-by-number - "\C-c\C-s\C-l" gnus-summary-sort-by-lines - "\C-c\C-s\C-c" gnus-summary-sort-by-chars - "\C-c\C-s\C-a" gnus-summary-sort-by-author - "\C-c\C-s\C-s" gnus-summary-sort-by-subject - "\C-c\C-s\C-d" gnus-summary-sort-by-date - "\C-c\C-s\C-i" gnus-summary-sort-by-score - "=" gnus-summary-expand-window - "\C-x\C-s" gnus-summary-reselect-current-group - "\M-g" gnus-summary-rescan-group - "w" gnus-summary-stop-page-breaking - "\C-c\C-r" gnus-summary-caesar-message - "\M-t" gnus-summary-toggle-mime - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "C" gnus-summary-cancel-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "\C-c\C-f" gnus-summary-mail-forward - "o" gnus-summary-save-article - "\C-o" gnus-summary-save-article-mail - "|" gnus-summary-pipe-output - "\M-k" gnus-summary-edit-local-kill - "\M-K" gnus-summary-edit-global-kill - ;; "V" gnus-version - "\C-c\C-d" gnus-summary-describe-group - "q" gnus-summary-exit - "Q" gnus-summary-exit-no-update - "\C-c\C-i" gnus-info-find-node - gnus-mouse-2 gnus-mouse-pick-article - "m" gnus-summary-mail-other-window - "a" gnus-summary-post-news - "x" gnus-summary-limit-to-unread - "s" gnus-summary-isearch-article - "t" gnus-article-toggle-headers - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "v" gnus-summary-preview-mime-message - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\M-\C-d" gnus-summary-read-document - "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-a" gnus-summary-customize-parameters - "\C-c\C-b" gnus-bug - "*" gnus-cache-enter-article - "\M-*" gnus-cache-remove-article - "\M-&" gnus-summary-universal-argument - "\C-l" gnus-recenter - "I" gnus-summary-increase-score - "L" gnus-summary-lower-score - "\M-i" gnus-symbolic-argument - "h" gnus-summary-select-article-buffer - - "V" gnus-summary-score-map - "X" gnus-uu-extract-map - "S" gnus-summary-send-map) +(defvar gnus-article-commands-menu) + +;; Non-orthogonal keys + +(gnus-define-keys gnus-summary-mode-map + " " gnus-summary-next-page + "\177" gnus-summary-prev-page + [delete] gnus-summary-prev-page + [backspace] gnus-summary-prev-page + "\r" gnus-summary-scroll-up + "\M-\r" gnus-summary-scroll-down + "n" gnus-summary-next-unread-article + "p" gnus-summary-prev-unread-article + "N" gnus-summary-next-article + "P" gnus-summary-prev-article + "\M-\C-n" gnus-summary-next-same-subject + "\M-\C-p" gnus-summary-prev-same-subject + "\M-n" gnus-summary-next-unread-subject + "\M-p" gnus-summary-prev-unread-subject + "." gnus-summary-first-unread-article + "," gnus-summary-best-unread-article + "\M-s" gnus-summary-search-article-forward + "\M-r" gnus-summary-search-article-backward + "<" gnus-summary-beginning-of-article + ">" gnus-summary-end-of-article + "j" gnus-summary-goto-article + "^" gnus-summary-refer-parent-article + "\M-^" gnus-summary-refer-article + "u" gnus-summary-tick-article-forward + "!" gnus-summary-tick-article-forward + "U" gnus-summary-tick-article-backward + "d" gnus-summary-mark-as-read-forward + "D" gnus-summary-mark-as-read-backward + "E" gnus-summary-mark-as-expirable + "\M-u" gnus-summary-clear-mark-forward + "\M-U" gnus-summary-clear-mark-backward + "k" gnus-summary-kill-same-subject-and-select + "\C-k" gnus-summary-kill-same-subject + "\M-\C-k" gnus-summary-kill-thread + "\M-\C-l" gnus-summary-lower-thread + "e" gnus-summary-edit-article + "#" gnus-summary-mark-as-processable + "\M-#" gnus-summary-unmark-as-processable + "\M-\C-t" gnus-summary-toggle-threads + "\M-\C-s" gnus-summary-show-thread + "\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 + "c" gnus-summary-catchup-and-exit + "\C-w" gnus-summary-mark-region-as-read + "\C-t" gnus-summary-toggle-truncation + "?" gnus-summary-mark-as-dormant + "\C-c\M-\C-s" gnus-summary-limit-include-expunged + "\C-c\C-s\C-n" gnus-summary-sort-by-number + "\C-c\C-s\C-l" gnus-summary-sort-by-lines + "\C-c\C-s\C-c" gnus-summary-sort-by-chars + "\C-c\C-s\C-a" gnus-summary-sort-by-author + "\C-c\C-s\C-s" gnus-summary-sort-by-subject + "\C-c\C-s\C-d" gnus-summary-sort-by-date + "\C-c\C-s\C-i" gnus-summary-sort-by-score + "\C-c\C-s\C-o" gnus-summary-sort-by-original + "\C-c\C-s\C-r" gnus-summary-sort-by-random + "=" gnus-summary-expand-window + "\C-x\C-s" gnus-summary-reselect-current-group + "\M-g" gnus-summary-rescan-group + "w" gnus-summary-stop-page-breaking + "\C-c\C-r" gnus-summary-caesar-message + "\M-t" gnus-summary-toggle-mime + "f" gnus-summary-followup + "F" gnus-summary-followup-with-original + "C" gnus-summary-cancel-article + "r" gnus-summary-reply + "R" gnus-summary-reply-with-original + "\C-c\C-f" gnus-summary-mail-forward + "o" gnus-summary-save-article + "\C-o" gnus-summary-save-article-mail + "|" gnus-summary-pipe-output + "\M-k" gnus-summary-edit-local-kill + "\M-K" gnus-summary-edit-global-kill + ;; "V" gnus-version + "\C-c\C-d" gnus-summary-describe-group + "q" gnus-summary-exit + "Q" gnus-summary-exit-no-update + "\C-c\C-i" gnus-info-find-node + gnus-mouse-2 gnus-mouse-pick-article + "m" gnus-summary-mail-other-window + "a" gnus-summary-post-news + "i" gnus-summary-news-other-window + "x" gnus-summary-limit-to-unread + "s" gnus-summary-isearch-article + "t" gnus-summary-toggle-header + "g" gnus-summary-show-article + "l" gnus-summary-goto-last-article + "v" gnus-summary-preview-mime-message + "\C-c\C-v\C-v" gnus-uu-decode-uu-view + "\C-d" gnus-summary-enter-digest-group + "\M-\C-d" gnus-summary-read-document + "\M-\C-e" gnus-summary-edit-parameters + "\M-\C-a" gnus-summary-customize-parameters + "\C-c\C-b" gnus-bug + "\C-c\C-n" gnus-namazu-search + "*" gnus-cache-enter-article + "\M-*" gnus-cache-remove-article + "\M-&" gnus-summary-universal-argument + "\C-l" gnus-recenter + "I" gnus-summary-increase-score + "L" gnus-summary-lower-score + "\M-i" gnus-symbolic-argument + "h" gnus-summary-select-article-buffer + + "V" gnus-summary-score-map + "X" gnus-uu-extract-map + "S" gnus-summary-send-map) ;; Sort of orthogonal keymap - (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) - "t" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "d" gnus-summary-mark-as-read-forward - "r" gnus-summary-mark-as-read-forward - "c" gnus-summary-clear-mark-forward - " " gnus-summary-clear-mark-forward - "e" gnus-summary-mark-as-expirable - "x" gnus-summary-mark-as-expirable - "?" gnus-summary-mark-as-dormant - "b" gnus-summary-set-bookmark - "B" gnus-summary-remove-bookmark - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "S" gnus-summary-limit-include-expunged - "C" gnus-summary-catchup - "H" gnus-summary-catchup-to-here - "\C-c" gnus-summary-catchup-all - "k" gnus-summary-kill-same-subject-and-select - "K" gnus-summary-kill-same-subject - "P" gnus-uu-mark-map) - - (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) - "c" gnus-summary-clear-above - "u" gnus-summary-tick-above - "m" gnus-summary-mark-above - "k" gnus-summary-kill-below) - - (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) - "/" gnus-summary-limit-to-subject - "n" gnus-summary-limit-to-articles - "w" gnus-summary-pop-limit - "s" gnus-summary-limit-to-subject - "a" gnus-summary-limit-to-author - "u" gnus-summary-limit-to-unread - "m" gnus-summary-limit-to-marks - "M" gnus-summary-limit-exclude-marks - "v" gnus-summary-limit-to-score - "*" gnus-summary-limit-include-cached - "D" gnus-summary-limit-include-dormant - "T" gnus-summary-limit-include-thread - "d" gnus-summary-limit-exclude-dormant - "t" gnus-summary-limit-to-age - "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) - - (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\C-n" gnus-summary-next-same-subject - "\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "f" gnus-summary-first-unread-article - "b" gnus-summary-best-unread-article - "j" gnus-summary-goto-article - "g" gnus-summary-goto-subject - "l" gnus-summary-goto-last-article - "o" gnus-summary-pop-article) - - (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) - "k" gnus-summary-kill-thread - "l" gnus-summary-lower-thread - "i" gnus-summary-raise-thread - "T" gnus-summary-toggle-threads - "t" gnus-summary-rethread-current - "^" gnus-summary-reparent-thread - "s" gnus-summary-show-thread - "S" gnus-summary-show-all-threads - "h" gnus-summary-hide-thread - "H" gnus-summary-hide-all-threads - "n" gnus-summary-next-thread - "p" gnus-summary-prev-thread - "u" gnus-summary-up-thread - "o" gnus-summary-top-thread - "d" gnus-summary-down-thread - "#" gnus-uu-mark-thread - "\M-#" gnus-uu-unmark-thread) - - (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) - "g" gnus-summary-prepare - "c" gnus-summary-insert-cached-articles) - - (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) - "c" gnus-summary-catchup-and-exit - "C" gnus-summary-catchup-all-and-exit - "E" gnus-summary-exit-no-update - "J" gnus-summary-jump-to-other-group - "Q" gnus-summary-exit - "Z" gnus-summary-exit - "n" gnus-summary-catchup-and-goto-next-group - "R" gnus-summary-reselect-current-group - "G" gnus-summary-rescan-group - "N" gnus-summary-next-group - "s" gnus-summary-save-newsrc - "P" gnus-summary-prev-group) - - (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) - " " gnus-summary-next-page - "n" gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "p" gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "b" gnus-summary-beginning-of-article - "e" gnus-summary-end-of-article - "^" gnus-summary-refer-parent-article - "r" gnus-summary-refer-parent-article - "D" gnus-summary-enter-digest-group - "R" gnus-summary-refer-references - "T" gnus-summary-refer-thread - "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) - "b" gnus-article-add-buttons - "B" gnus-article-add-buttons-to-head - "o" gnus-article-treat-overstrike - "e" gnus-article-emphasize - "w" gnus-article-fill-cited-article - "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 - "t" gnus-article-toggle-headers - "v" gnus-summary-verbose-headers - "m" gnus-summary-toggle-mime - "H" gnus-article-strip-headers-in-body - "d" gnus-article-treat-dumbquotes - "s" gnus-smiley-display) - - (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) - "a" gnus-article-hide - "h" gnus-article-toggle-headers - "b" gnus-article-hide-boring-headers - "s" gnus-article-hide-signature - "c" gnus-article-hide-citation - "C" gnus-article-hide-citation-in-followups - "l" gnus-article-hide-list-identifiers - "p" gnus-article-hide-pgp - "B" gnus-article-strip-banner - "P" gnus-article-hide-pem - "\C-c" gnus-article-hide-citation-maybe) - - (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) - "a" gnus-article-highlight - "h" gnus-article-highlight-headers - "c" gnus-article-highlight-citation - "s" gnus-article-highlight-signature) - - (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) - "z" gnus-article-date-ut - "u" gnus-article-date-ut - "l" gnus-article-date-local - "e" gnus-article-date-lapsed - "o" gnus-article-date-original - "i" gnus-article-date-iso8601 - "s" gnus-article-date-user) - - (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) - "t" gnus-article-remove-trailing-blank-lines - "l" gnus-article-strip-leading-blank-lines - "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines - "A" gnus-article-strip-all-blank-lines - "s" gnus-article-strip-leading-space - "e" gnus-article-strip-trailing-space) - - (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) - "v" gnus-version - "f" gnus-summary-fetch-faq - "d" gnus-summary-describe-group - "h" gnus-summary-describe-briefly - "i" gnus-info-find-node) - - (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) - "e" gnus-summary-expire-articles - "\M-\C-e" gnus-summary-expire-articles-now - "\177" gnus-summary-delete-article - [delete] gnus-summary-delete-article - [backspace] gnus-summary-delete-article - "m" gnus-summary-move-article - "r" gnus-summary-respool-article - "w" gnus-summary-edit-article - "c" gnus-summary-copy-article - "B" gnus-summary-crosspost-article - "q" gnus-summary-respool-query - "t" gnus-summary-respool-trace - "i" gnus-summary-import-article - "p" gnus-summary-article-posted-p) - - (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) - "o" gnus-summary-save-article - "m" gnus-summary-save-article-mail - "F" gnus-summary-write-article-file - "r" gnus-summary-save-article-rmail - "f" gnus-summary-save-article-file - "b" gnus-summary-save-article-body-file - "h" gnus-summary-save-article-folder - "v" gnus-summary-save-article-vm - "p" gnus-summary-pipe-output - "s" gnus-soup-add-article) - - (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) - "b" gnus-summary-display-buttonized - "m" gnus-summary-repair-multipart - "v" gnus-article-view-part - "o" gnus-article-save-part - "c" gnus-article-copy-part - "e" gnus-article-externalize-part - "i" gnus-article-inline-part - "|" gnus-article-pipe-part)) +(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) + "t" gnus-summary-tick-article-forward + "!" gnus-summary-tick-article-forward + "d" gnus-summary-mark-as-read-forward + "r" gnus-summary-mark-as-read-forward + "c" gnus-summary-clear-mark-forward + " " gnus-summary-clear-mark-forward + "e" gnus-summary-mark-as-expirable + "x" gnus-summary-mark-as-expirable + "?" gnus-summary-mark-as-dormant + "b" gnus-summary-set-bookmark + "B" gnus-summary-remove-bookmark + "#" gnus-summary-mark-as-processable + "\M-#" gnus-summary-unmark-as-processable + "S" gnus-summary-limit-include-expunged + "C" gnus-summary-catchup + "H" gnus-summary-catchup-to-here + "h" gnus-summary-catchup-from-here + "\C-c" gnus-summary-catchup-all + "k" gnus-summary-kill-same-subject-and-select + "K" gnus-summary-kill-same-subject + "P" gnus-uu-mark-map) + +(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) + "c" gnus-summary-clear-above + "u" gnus-summary-tick-above + "m" gnus-summary-mark-above + "k" gnus-summary-kill-below) + +(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) + "/" gnus-summary-limit-to-subject + "n" gnus-summary-limit-to-articles + "w" gnus-summary-pop-limit + "s" gnus-summary-limit-to-subject + "a" gnus-summary-limit-to-author + "u" gnus-summary-limit-to-unread + "m" gnus-summary-limit-to-marks + "M" gnus-summary-limit-exclude-marks + "v" gnus-summary-limit-to-score + "*" gnus-summary-limit-include-cached + "D" gnus-summary-limit-include-dormant + "T" gnus-summary-limit-include-thread + "d" gnus-summary-limit-exclude-dormant + "t" gnus-summary-limit-to-age + "." gnus-summary-limit-to-unseen + "x" gnus-summary-limit-to-extra + "p" gnus-summary-limit-to-display-predicate + "E" gnus-summary-limit-include-expunged + "c" gnus-summary-limit-exclude-childless-dormant + "C" gnus-summary-limit-mark-excluded-as-read + "o" gnus-summary-insert-old-articles + "N" gnus-summary-insert-new-articles) + +(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) + "n" gnus-summary-next-unread-article + "p" gnus-summary-prev-unread-article + "N" gnus-summary-next-article + "P" gnus-summary-prev-article + "\C-n" gnus-summary-next-same-subject + "\C-p" gnus-summary-prev-same-subject + "\M-n" gnus-summary-next-unread-subject + "\M-p" gnus-summary-prev-unread-subject + "f" gnus-summary-first-unread-article + "b" gnus-summary-best-unread-article + "j" gnus-summary-goto-article + "g" gnus-summary-goto-subject + "l" gnus-summary-goto-last-article + "o" gnus-summary-pop-article) + +(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) + "k" gnus-summary-kill-thread + "l" gnus-summary-lower-thread + "i" gnus-summary-raise-thread + "T" gnus-summary-toggle-threads + "t" gnus-summary-rethread-current + "^" gnus-summary-reparent-thread + "s" gnus-summary-show-thread + "S" gnus-summary-show-all-threads + "h" gnus-summary-hide-thread + "H" gnus-summary-hide-all-threads + "n" gnus-summary-next-thread + "p" gnus-summary-prev-thread + "u" gnus-summary-up-thread + "o" gnus-summary-top-thread + "d" gnus-summary-down-thread + "#" gnus-uu-mark-thread + "\M-#" gnus-uu-unmark-thread) + +(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) + "g" gnus-summary-prepare + "c" gnus-summary-insert-cached-articles + "d" gnus-summary-insert-dormant-articles) + +(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) + "c" gnus-summary-catchup-and-exit + "C" gnus-summary-catchup-all-and-exit + "E" gnus-summary-exit-no-update + "J" gnus-summary-jump-to-other-group + "Q" gnus-summary-exit + "Z" gnus-summary-exit + "n" gnus-summary-catchup-and-goto-next-group + "R" gnus-summary-reselect-current-group + "G" gnus-summary-rescan-group + "N" gnus-summary-next-group + "s" gnus-summary-save-newsrc + "P" gnus-summary-prev-group) + +(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) + " " gnus-summary-next-page + "n" gnus-summary-next-page + "\177" gnus-summary-prev-page + [delete] gnus-summary-prev-page + "p" gnus-summary-prev-page + "\r" gnus-summary-scroll-up + "\M-\r" gnus-summary-scroll-down + "<" gnus-summary-beginning-of-article + ">" gnus-summary-end-of-article + "b" gnus-summary-beginning-of-article + "e" gnus-summary-end-of-article + "^" gnus-summary-refer-parent-article + "r" gnus-summary-refer-parent-article + "D" gnus-summary-enter-digest-group + "R" gnus-summary-refer-references + "T" gnus-summary-refer-thread + "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) + "b" gnus-article-add-buttons + "B" gnus-article-add-buttons-to-head + "o" gnus-article-treat-overstrike + "e" gnus-article-emphasize + "w" gnus-article-fill-cited-article + "Q" gnus-article-fill-long-lines + "C" gnus-article-capitalize-sentences + "c" gnus-article-remove-cr + "Z" gnus-article-decode-HZ + "h" gnus-article-wash-html + "u" gnus-article-unsplit-urls + "f" gnus-article-display-x-face + "l" gnus-summary-stop-page-breaking + "r" gnus-summary-caesar-message + "m" gnus-summary-morse-message + "t" gnus-summary-toggle-header + "g" gnus-treat-smiley + "v" gnus-summary-verbose-headers + "m" gnus-summary-toggle-mime + "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive + "p" gnus-article-verify-x-pgp-sig + "d" gnus-article-treat-dumbquotes) + +(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) + ;; mnemonic: deuglif*Y* + "u" gnus-article-outlook-unwrap-lines + "a" gnus-article-outlook-repair-attribution + "c" gnus-article-outlook-rearrange-citation + "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify + +(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) + "a" gnus-article-hide + "h" gnus-article-hide-headers + "b" gnus-article-hide-boring-headers + "s" gnus-article-hide-signature + "c" gnus-article-hide-citation + "C" gnus-article-hide-citation-in-followups + "l" gnus-article-hide-list-identifiers + "B" gnus-article-strip-banner + "P" gnus-article-hide-pem + "\C-c" gnus-article-hide-citation-maybe) + +(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) + "a" gnus-article-highlight + "h" gnus-article-highlight-headers + "c" gnus-article-highlight-citation + "s" gnus-article-highlight-signature) + +(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map) + "f" gnus-article-treat-fold-headers + "u" gnus-article-treat-unfold-headers + "n" gnus-article-treat-fold-newsgroups) + +(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map) + "x" gnus-article-display-x-face + "d" gnus-article-display-face + "s" gnus-treat-smiley + "D" gnus-article-remove-images + "f" gnus-treat-from-picon + "m" gnus-treat-mail-picon + "n" gnus-treat-newsgroups-picon) + +(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) + "z" gnus-article-date-ut + "u" gnus-article-date-ut + "l" gnus-article-date-local + "p" gnus-article-date-english + "e" gnus-article-date-lapsed + "o" gnus-article-date-original + "i" gnus-article-date-iso8601 + "s" gnus-article-date-user) + +(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) + "t" gnus-article-remove-trailing-blank-lines + "l" gnus-article-strip-leading-blank-lines + "m" gnus-article-strip-multiple-blank-lines + "a" gnus-article-strip-blank-lines + "A" gnus-article-strip-all-blank-lines + "s" gnus-article-strip-leading-space + "e" gnus-article-strip-trailing-space + "w" gnus-article-remove-leading-whitespace) + +(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) + "v" gnus-version + "f" gnus-summary-fetch-faq + "d" gnus-summary-describe-group + "h" gnus-summary-describe-briefly + "i" gnus-info-find-node + "c" gnus-group-fetch-charter + "C" gnus-group-fetch-control) + +(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) + "e" gnus-summary-expire-articles + "\M-\C-e" gnus-summary-expire-articles-now + "\177" gnus-summary-delete-article + [delete] gnus-summary-delete-article + [backspace] gnus-summary-delete-article + "m" gnus-summary-move-article + "r" gnus-summary-respool-article + "w" gnus-summary-edit-article + "c" gnus-summary-copy-article + "B" gnus-summary-crosspost-article + "q" gnus-summary-respool-query + "t" gnus-summary-respool-trace + "i" gnus-summary-import-article + "I" gnus-summary-create-article + "p" gnus-summary-article-posted-p) + +(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) + "o" gnus-summary-save-article + "m" gnus-summary-save-article-mail + "F" gnus-summary-write-article-file + "r" gnus-summary-save-article-rmail + "f" gnus-summary-save-article-file + "b" gnus-summary-save-article-body-file + "h" gnus-summary-save-article-folder + "v" gnus-summary-save-article-vm + "p" gnus-summary-pipe-output + "P" gnus-summary-muttprint + "s" gnus-soup-add-article) + +(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) + "b" gnus-summary-display-buttonized + "m" gnus-summary-repair-multipart + "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-view-part-externally + "E" gnus-article-encrypt-body + "i" gnus-article-inline-part + "|" gnus-article-pipe-part) + +(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) + "p" gnus-summary-mark-as-processable + "u" gnus-summary-unmark-as-processable + "U" gnus-summary-unmark-all-processable + "v" gnus-uu-mark-over + "s" gnus-uu-mark-series + "r" gnus-uu-mark-region + "g" gnus-uu-unmark-region + "R" gnus-uu-mark-by-regexp + "G" gnus-uu-unmark-by-regexp + "t" gnus-uu-mark-thread + "T" gnus-uu-unmark-thread + "a" gnus-uu-mark-all + "b" gnus-uu-mark-buffer + "S" gnus-uu-mark-sparse + "k" gnus-summary-kill-process-mark + "y" gnus-summary-yank-process-mark + "w" gnus-summary-save-process-mark + "i" gnus-uu-invert-processable) + +(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) + ;;"x" gnus-uu-extract-any + "m" gnus-summary-save-parts + "u" gnus-uu-decode-uu + "U" gnus-uu-decode-uu-and-save + "s" gnus-uu-decode-unshar + "S" gnus-uu-decode-unshar-and-save + "o" gnus-uu-decode-save + "O" gnus-uu-decode-save + "b" gnus-uu-decode-binhex + "B" gnus-uu-decode-binhex + "p" gnus-uu-decode-postscript + "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) + +(defvar gnus-article-post-menu nil) + +(defconst gnus-summary-menu-maxlen 20) + +(defun gnus-summary-menu-split (menu) + ;; If we have lots of elements, divide them into groups of 20 + ;; and make a pane (or submenu) for each one. + (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2)) + (let ((menu menu) sublists next + (i 1)) + (while menu + ;; Pull off the next gnus-summary-menu-maxlen elements + ;; and make them the next element of sublist. + (setq next (nthcdr gnus-summary-menu-maxlen menu)) + (if next + (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu) + nil)) + (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0) + (aref (car (last menu)) 0)) menu) + sublists)) + (setq i (1+ i)) + (setq menu next)) + (nreverse sublists)) + ;; Few elements--put them all in one pane. + menu)) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1680,7 +2062,6 @@ increase the score of each group you read." "Score" (nconc (list - ["Enter score..." gnus-summary-score-entry t] ["Customize" gnus-score-customize t]) (gnus-make-score-map 'increase) (gnus-make-score-map 'lower) @@ -1702,123 +2083,186 @@ increase the score of each group you read." ["Increase score..." gnus-summary-increase-score t] ["Lower score..." gnus-summary-lower-score t])))) - ;; Define both the Article menu in the summary buffer and the equivalent - ;; Commands menu in the article buffer here for consistency. + ;; Define both the Article menu in the summary buffer and the + ;; equivalent Commands menu in the article buffer here for + ;; consistency. (let ((innards - '(("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-toggle-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] + `(("Hide" + ["All" gnus-article-hide t] + ["Headers" gnus-article-hide-headers t] + ["Signature" gnus-article-hide-signature t] + ["Citation" gnus-article-hide-citation t] ["List identifiers" gnus-article-hide-list-identifiers t] - ["PGP" gnus-article-hide-pgp t] ["Banner" gnus-article-strip-banner t] - ["Boring headers" gnus-article-hide-boring-headers t]) - ("Highlight" - ["All" gnus-article-highlight t] - ["Headers" gnus-article-highlight-headers t] - ["Signature" gnus-article-highlight-signature t] - ["Citation" gnus-article-highlight-citation t]) - ("Date" - ["Local" gnus-article-date-local t] - ["ISO8601" gnus-article-date-iso8601 t] - ["UT" gnus-article-date-ut t] - ["Original" gnus-article-date-original t] - ["Lapsed" gnus-article-date-lapsed t] - ["User-defined" gnus-article-date-user t]) - ("Washing" - ("Remove Blanks" - ["Leading" gnus-article-strip-leading-blank-lines t] - ["Multiple" gnus-article-strip-multiple-blank-lines t] - ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t] - ["All" gnus-article-strip-all-blank-lines t] - ["Leading space" gnus-article-strip-leading-space t] - ["Trailing space" gnus-article-strip-trailing-space t]) - ["Overstrike" gnus-article-treat-overstrike t] - ["Dumb quotes" gnus-article-treat-dumbquotes t] - ["Emphasis" gnus-article-emphasize t] - ["Word wrap" gnus-article-fill-cited-article t] + ["Boring headers" gnus-article-hide-boring-headers t]) + ("Highlight" + ["All" gnus-article-highlight t] + ["Headers" gnus-article-highlight-headers t] + ["Signature" gnus-article-highlight-signature t] + ["Citation" gnus-article-highlight-citation t]) + ("Date" + ["Local" gnus-article-date-local t] + ["ISO8601" gnus-article-date-iso8601 t] + ["UT" gnus-article-date-ut t] + ["Original" gnus-article-date-original t] + ["Lapsed" gnus-article-date-lapsed t] + ["User-defined" gnus-article-date-user t]) + ("Display" + ["Remove images" gnus-article-remove-images t] + ["Toggle smiley" gnus-treat-smiley t] + ["Show X-Face" gnus-article-display-x-face t] + ["Show picons in From" gnus-treat-from-picon t] + ["Show picons in mail headers" gnus-treat-mail-picon t] + ["Show picons in news headers" gnus-treat-newsgroups-picon t] + ("View as different encoding" + ,@(gnus-summary-menu-split + (mapcar + (lambda (cs) + ;; Since easymenu under Emacs doesn't allow + ;; lambda forms for menu commands, we should + ;; provide intern'ed function symbols. + (let ((command (intern (format "\ +gnus-summary-show-article-from-menu-as-charset-%s" cs)))) + (fset command + `(lambda () + (interactive) + (let ((gnus-summary-show-article-charset-alist + '((1 . ,cs)))) + (gnus-summary-show-article 1)))) + `[,(symbol-name cs) ,command t])) + (sort (if (fboundp 'coding-system-list) + (coding-system-list) + ;;(mapcar 'car mm-mime-mule-charset-alist) + ) + 'string<))))) + ("Washing" + ("Remove Blanks" + ["Leading" gnus-article-strip-leading-blank-lines t] + ["Multiple" gnus-article-strip-multiple-blank-lines t] + ["Trailing" gnus-article-remove-trailing-blank-lines t] + ["All of the above" gnus-article-strip-blank-lines t] + ["All" gnus-article-strip-all-blank-lines t] + ["Leading space" gnus-article-strip-leading-space t] + ["Trailing space" gnus-article-strip-trailing-space t] + ["Leading space in headers" + gnus-article-remove-leading-whitespace t]) + ["Overstrike" gnus-article-treat-overstrike t] + ["Dumb quotes" gnus-article-treat-dumbquotes t] + ["Emphasis" gnus-article-emphasize t] + ["Word wrap" gnus-article-fill-cited-article t] ["Fill long lines" gnus-article-fill-long-lines t] ["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] - ["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] - ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["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] - ["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 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] - ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] - ["Save body in file" gnus-summary-save-article-body-file t] - ["Pipe through a filter" gnus-summary-pipe-output t] - ["Add to SOUP packet" gnus-soup-add-article t] - ["Print" gnus-summary-print-article t]) - ("Backend" - ["Respool article..." gnus-summary-respool-article t] - ["Move article..." gnus-summary-move-article - (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name)] - ["Copy article..." gnus-summary-copy-article t] - ["Crosspost article..." gnus-summary-crosspost-article - (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name)] - ["Import file..." gnus-summary-import-article t] - ["Check if posted" gnus-summary-article-posted-p t] - ["Edit article" gnus-summary-edit-article - (not (gnus-group-read-only-p))] - ["Delete article" gnus-summary-delete-article - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Query respool" gnus-summary-respool-query t] + ["CR" gnus-article-remove-cr t] + ["Rot 13" gnus-summary-caesar-message + ,@(if (featurep 'xemacs) '(t) + '(:help "\"Caesar rotate\" article by 13"))] + ["Morse decode" gnus-summary-morse-message t] + ["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] + ["Stop page breaking" gnus-summary-stop-page-breaking t] + ["Toggle MIME" gnus-summary-toggle-mime t] + ["Verbose header" gnus-summary-verbose-headers t] + ["Toggle header" gnus-summary-toggle-header t] + ["Unfold headers" gnus-article-treat-unfold-headers t] + ["Fold newsgroups" gnus-article-treat-fold-newsgroups t] + ["Html" gnus-article-wash-html t] + ["URLs" gnus-article-unsplit-urls t] + ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] + ["HZ" gnus-article-decode-HZ t] + ("(Outlook) Deuglify" + ["Unwrap lines" gnus-article-outlook-unwrap-lines t] + ["Repair attribution" gnus-article-outlook-repair-attribution t] + ["Rearrange citation" gnus-article-outlook-rearrange-citation t] + ["Full (Outlook) deuglify" + gnus-article-outlook-deuglify-article t]) + ) + ("Output" + ["Save in default format" gnus-summary-save-article + ,@(if (featurep 'xemacs) '(t) + '(:help "Save article using default method"))] + ["Save in file" gnus-summary-save-article-file + ,@(if (featurep 'xemacs) '(t) + '(: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] + ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] + ["Save body in file" gnus-summary-save-article-body-file t] + ["Pipe through a filter" gnus-summary-pipe-output t] + ["Add to SOUP packet" gnus-soup-add-article t] + ["Print with Muttprint" gnus-summary-muttprint t] + ["Print" gnus-summary-print-article t]) + ("Backend" + ["Respool article..." gnus-summary-respool-article t] + ["Move article..." gnus-summary-move-article + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)] + ["Copy article..." gnus-summary-copy-article t] + ["Crosspost article..." gnus-summary-crosspost-article + (gnus-check-backend-function + 'request-replace-article gnus-newsgroup-name)] + ["Import file..." gnus-summary-import-article + (gnus-check-backend-function + 'request-accept-article gnus-newsgroup-name)] + ["Create article..." gnus-summary-create-article + (gnus-check-backend-function + 'request-accept-article gnus-newsgroup-name)] + ["Check if posted" gnus-summary-article-posted-p t] + ["Edit article" gnus-summary-edit-article + (not (gnus-group-read-only-p))] + ["Delete article" gnus-summary-delete-article + (gnus-check-backend-function + 'request-expire-articles gnus-newsgroup-name)] + ["Query respool" gnus-summary-respool-query t] ["Trace respool" gnus-summary-respool-trace t] - ["Delete expirable articles" gnus-summary-expire-articles-now - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)]) - ("Extract" - ["Uudecode" gnus-uu-decode-uu t] - ["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] - ["Save" gnus-uu-decode-save t] - ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t]) - ("Cache" - ["Enter article" gnus-cache-enter-article t] - ["Remove article" gnus-cache-remove-article t]) + ["Delete expirable articles" gnus-summary-expire-articles-now + (gnus-check-backend-function + 'request-expire-articles gnus-newsgroup-name)]) + ("Extract" + ["Uudecode" gnus-uu-decode-uu + ,@(if (featurep 'xemacs) '(t) + '(: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] + ["Save" gnus-uu-decode-save t] + ["Binhex" gnus-uu-decode-binhex t] + ["Postscript" gnus-uu-decode-postscript t]) + ("Cache" + ["Enter article" gnus-cache-enter-article t] + ["Remove article" gnus-cache-remove-article t]) ["Translate" gnus-article-babel t] - ["Select article buffer" gnus-summary-select-article-buffer t] - ["Enter digest buffer" gnus-summary-enter-digest-group t] - ["Isearch article..." gnus-summary-isearch-article t] - ["Beginning of the article" gnus-summary-beginning-of-article t] - ["End of the article" gnus-summary-end-of-article t] - ["Fetch parent of article" gnus-summary-refer-parent-article t] - ["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]))) + ["Select article buffer" gnus-summary-select-article-buffer t] + ["Enter digest buffer" gnus-summary-enter-digest-group t] + ["Isearch article..." gnus-summary-isearch-article t] + ["Beginning of the article" gnus-summary-beginning-of-article t] + ["End of the article" gnus-summary-end-of-article t] + ["Fetch parent of article" gnus-summary-refer-parent-article t] + ["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] + ["Raw article" gnus-summary-show-raw-article :keys "C-u g"]))) (easy-menu-define gnus-summary-article-menu gnus-summary-mode-map "" (cons "Article" innards)) - (easy-menu-define - gnus-article-commands-menu gnus-article-mode-map "" - (cons "Commands" innards))) + (if (not (keymapp gnus-summary-article-menu)) + (easy-menu-define + gnus-article-commands-menu gnus-article-mode-map "" + (cons "Commands" innards)) + ;; in Emacs, don't share menu. + (setq gnus-article-commands-menu + (copy-keymap gnus-summary-article-menu)) + (define-key gnus-article-mode-map [menu-bar commands] + (cons "Commands" gnus-article-commands-menu)))) (easy-menu-define gnus-summary-thread-menu gnus-summary-mode-map "" '("Threads" + ["Find all messages in thread" gnus-summary-refer-thread t] ["Toggle threading" gnus-summary-toggle-threads t] ["Hide threads" gnus-summary-hide-all-threads t] ["Show threads" gnus-summary-show-all-threads t] @@ -1836,24 +2280,42 @@ increase the score of each group you read." (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" + ["Send a message (mail or news)" gnus-summary-post-news + ,@(if (featurep 'xemacs) '(t) + '(:help "Post an article"))] + ["Followup" gnus-summary-followup + ,@(if (featurep 'xemacs) '(t) + '(:help "Post followup to this article"))] + ["Followup and yank" gnus-summary-followup-with-original + ,@(if (featurep 'xemacs) '(t) + '(: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) '(t) + '(: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) '(t) + '(:help "Mail a reply, quoting this article"))] + ["Very wide reply" gnus-summary-very-wide-reply t] + ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original + ,@(if (featurep 'xemacs) '(t) + '(:help "Mail a very wide reply, quoting this article"))] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] ["Digest and mail" gnus-summary-digest-mail-forward t] ["Digest and post" gnus-summary-digest-post-forward t] ["Resend message" gnus-summary-resend-message t] + ["Resend message edit" gnus-summary-resend-message-edit 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] + ["Create a local message" gnus-summary-news-other-window t] + ["Uuencode and post" gnus-uu-post-news + ,@(if (featurep 'xemacs) '(t) + '(: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] @@ -1862,18 +2324,32 @@ increase the score of each group you read." ;;["Send bounced" gnus-resend-bounced-mail t]) )) + (cond + ((not (keymapp gnus-summary-post-menu)) + (setq gnus-article-post-menu gnus-summary-post-menu)) + ((not gnus-article-post-menu) + ;; Don't share post menu. + (setq gnus-article-post-menu + (copy-keymap gnus-summary-post-menu)))) + (define-key gnus-article-mode-map [menu-bar post] + (cons "Post" gnus-article-post-menu)) + (easy-menu-define gnus-summary-misc-menu gnus-summary-mode-map "" - '("Misc" + `("Gnus" ("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) '(t) + '(: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] + ["Catchup from here" gnus-summary-catchup-from-here t] + ["Catchup region" gnus-summary-mark-region-as-read + (gnus-mark-active-p)] ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) ("Mark Various" ["Tick" gnus-summary-tick-article-forward t] @@ -1882,33 +2358,35 @@ increase the score of each group you read." ["Set expirable mark" gnus-summary-mark-as-expirable t] ["Set bookmark" gnus-summary-set-bookmark t] ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Mark Limit" + ("Limit to" ["Marks..." gnus-summary-limit-to-marks t] ["Subject..." gnus-summary-limit-to-subject t] ["Author..." gnus-summary-limit-to-author t] ["Age..." gnus-summary-limit-to-age t] ["Extra..." gnus-summary-limit-to-extra t] - ["Score" gnus-summary-limit-to-score t] + ["Score..." gnus-summary-limit-to-score t] + ["Display Predicate" gnus-summary-limit-to-display-predicate t] ["Unread" gnus-summary-limit-to-unread t] + ["Unseen" gnus-summary-limit-to-unseen t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] - ["Articles" gnus-summary-limit-to-articles t] + ["Next articles" gnus-summary-limit-to-articles t] ["Pop limit" gnus-summary-pop-limit t] ["Show dormant" gnus-summary-limit-include-dormant t] ["Hide childless dormant" gnus-summary-limit-exclude-childless-dormant t] ;;["Hide thread" gnus-summary-limit-exclude-thread t] ["Hide marked" gnus-summary-limit-exclude-marks t] - ["Show expunged" gnus-summary-show-all-expunged t]) + ["Show expunged" gnus-summary-limit-include-expunged t]) ("Process Mark" ["Set mark" gnus-summary-mark-as-processable t] ["Remove mark" gnus-summary-unmark-as-processable t] ["Remove all marks" gnus-summary-unmark-all-processable t] ["Mark above" gnus-uu-mark-over t] ["Mark series" gnus-uu-mark-series t] - ["Mark region" gnus-uu-mark-region t] - ["Unmark region" gnus-uu-unmark-region t] + ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)] + ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)] ["Mark by regexp..." gnus-uu-mark-by-regexp t] - ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] + ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] ["Mark all" gnus-uu-mark-all t] ["Mark buffer" gnus-uu-mark-buffer t] ["Mark sparse" gnus-uu-mark-sparse t] @@ -1918,10 +2396,15 @@ increase the score of each group you read." ["Kill" gnus-summary-kill-process-mark t] ["Yank" gnus-summary-yank-process-mark gnus-newsgroup-process-stack] - ["Save" gnus-summary-save-process-mark t])) + ["Save" gnus-summary-save-process-mark t] + ["Run command on marked..." gnus-summary-universal-argument 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) '(t) + '(:help "Show next page of article"))] + ["Page backward" gnus-summary-prev-page + ,@(if (featurep 'xemacs) '(t) + '(:help "Show previous page of article"))] ["Line forward" gnus-summary-scroll-up t]) ("Move" ["Next unread article" gnus-summary-next-unread-article t] @@ -1945,10 +2428,18 @@ increase the score of each group you read." ["Sort by date" gnus-summary-sort-by-date t] ["Sort by score" gnus-summary-sort-by-score t] ["Sort by lines" gnus-summary-sort-by-lines t] - ["Sort by characters" gnus-summary-sort-by-chars t]) + ["Sort by characters" gnus-summary-sort-by-chars t] + ["Randomize" gnus-summary-sort-by-random t] + ["Original sort" gnus-summary-sort-by-original t]) ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] + ["Fetch charter" gnus-group-fetch-charter + ,@(if (featurep 'xemacs) nil + '(:help "Display the charter of the current group"))] + ["Fetch control message" gnus-group-fetch-control + ,@(if (featurep 'xemacs) nil + '(:help "Display the archived control message for the current group"))] ["Read manual" gnus-info-find-node t]) ("Modes" ["Pick and read" gnus-pick-mode t] @@ -1956,9 +2447,12 @@ increase the score of each group you read." ("Regeneration" ["Regenerate" gnus-summary-prepare t] ["Insert cached articles" gnus-summary-insert-cached-articles t] + ["Insert dormant articles" gnus-summary-insert-dormant-articles t] ["Toggle threading" gnus-summary-toggle-threads t]) + ["See old articles" gnus-summary-insert-old-articles t] + ["See new articles" gnus-summary-insert-new-articles t] ["Filter articles..." gnus-summary-execute-command t] - ["Run command on subjects..." gnus-summary-universal-argument t] + ["Run command on articles..." gnus-summary-universal-argument t] ["Search articles forward..." gnus-summary-search-article-forward t] ["Search articles backward..." gnus-summary-search-article-backward t] ["Toggle line truncation" gnus-summary-toggle-truncation t] @@ -1972,10 +2466,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) '(t) + '(: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) '(t) + '(: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] @@ -1985,6 +2483,50 @@ 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)) + (load-path (mm-image-load-path))) + (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) @@ -2093,10 +2635,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) @@ -2119,7 +2664,7 @@ The following commands are available: (make-local-variable 'gnus-summary-dummy-line-format) (make-local-variable 'gnus-summary-dummy-line-format-spec) (make-local-variable 'gnus-summary-mark-positions) - (make-local-hook 'pre-command-hook) + (gnus-make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-hooks 'gnus-summary-mode-hook) (turn-on-gnus-mailing-list-mode) @@ -2309,6 +2854,7 @@ The following commands are available: (defun gnus-article-read-p (article) "Say whether ARTICLE is read or not." (not (or (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-spam-marked) (memq article gnus-newsgroup-unreads) (memq article gnus-newsgroup-unselected) (memq article gnus-newsgroup-dormant)))) @@ -2317,7 +2863,7 @@ The following commands are available: (defmacro gnus-summary-article-number () "The article number of the article on the current line. -If there isn's an article number here, then we return the current +If there isn't an article number here, then we return the current article number." '(progn (gnus-summary-skip-intangible) @@ -2399,6 +2945,7 @@ article number." This is all marks except unread, ticked, dormant, and expirable." (not (or (= mark gnus-unread-mark) (= mark gnus-ticked-mark) + (= mark gnus-spam-mark) (= mark gnus-dormant-mark) (= mark gnus-expirable-mark)))) @@ -2410,10 +2957,10 @@ time; i.e., when generating the summary lines. After that, marks of articles." `(cond ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark) - ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark) ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) + ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark) ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq ,number gnus-newsgroup-reads)) @@ -2421,9 +2968,6 @@ marks of articles." ;; Saving hidden threads. -(put 'gnus-save-hidden-threads 'lisp-indent-function 0) -(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) - (defmacro gnus-save-hidden-threads (&rest forms) "Save hidden threads, eval FORMS, and restore the hidden threads." (let ((config (make-symbol "config"))) @@ -2432,6 +2976,8 @@ marks of articles." (save-excursion ,@forms) (gnus-restore-hidden-threads-configuration ,config))))) +(put 'gnus-save-hidden-threads 'lisp-indent-function 0) +(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) (defun gnus-data-compute-positions () "Compute the positions of all articles." @@ -2501,9 +3047,29 @@ display only a single character." (aset table i [??])))) (setq buffer-display-table table))) +(defun gnus-summary-set-article-display-arrow (pos) + "Update the overlay arrow to point to line at position POS." + (when (and gnus-summary-display-arrow + (boundp 'overlay-arrow-position) + (boundp 'overlay-arrow-string)) + (save-excursion + (goto-char pos) + (beginning-of-line) + (unless overlay-arrow-position + (setq overlay-arrow-position (make-marker))) + (setq overlay-arrow-string "=>" + overlay-arrow-position (set-marker overlay-arrow-position + (point) + (current-buffer)))))) + (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." - (let ((buffer (concat "*Summary " group "*"))) + (let ((buffer (gnus-summary-buffer-name group)) + (dead-name (concat "*Dead Summary " + (gnus-group-decoded-name group) "*"))) + ;; If a dead summary buffer exists, we kill it. + (when (gnus-buffer-live-p dead-name) + (gnus-kill-buffer dead-name)) (if (get-buffer buffer) (progn (set-buffer buffer) @@ -2519,6 +3085,8 @@ display only a single character." (make-local-variable 'gnus-article-current) (make-local-variable 'gnus-original-article-buffer)) (setq gnus-newsgroup-name group) + ;; Set any local variables in the group parameters. + (gnus-summary-set-local-parameters gnus-newsgroup-name) t))) (defun gnus-set-global-variables () @@ -2529,6 +3097,7 @@ buffer that was in action when the last article was fetched." (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) + (spam gnus-newsgroup-spam-marked) (unread gnus-newsgroup-unreads) (headers gnus-current-headers) (data gnus-newsgroup-data) @@ -2538,11 +3107,20 @@ buffer that was in action when the last article was fetched." (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 gnus-newsgroup-marked marked + gnus-newsgroup-spam-marked spam gnus-newsgroup-unreads unread gnus-current-headers headers gnus-newsgroup-data data @@ -2553,6 +3131,12 @@ buffer that was in action when the last article was fetched." 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) @@ -2594,29 +3178,33 @@ buffer that was in action when the last article was fetched." (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) - (gnus-download-mark 131) + (gnus-undownloaded-mark 131) (spec gnus-summary-line-format-spec) gnus-visual pos) (save-excursion (gnus-set-work-buffer) (let ((gnus-summary-line-format-spec spec) - (gnus-newsgroup-downloadable '((0 . t)))) + (gnus-newsgroup-downloadable '(0))) (gnus-summary-insert-line - (make-full-mail-header 0 "" "nobody" "" "" "" 0 0 "" nil) - 0 nil 128 t nil "" nil 1) + (make-full-mail-header 0 "" "nobody" + "05 Apr 2001 23:33:09 +0400" + "" "" 0 0 "" nil) + 0 nil t 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) 2))))) + (- (point) (point-min) 1))))) (goto-char (point-min)) (push (cons 'replied (and (search-forward "\201" nil t) - (- (point) 2))) + (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) + (push (cons 'score (and (search-forward "\202" nil t) + (- (point) (point-min) 1))) pos) (goto-char (point-min)) (push (cons 'download - (and (search-forward "\203" nil t) (- (point) 2))) + (and (search-forward "\203" nil t) + (- (point) (point-min) 1))) pos))) (setq gnus-summary-mark-positions pos)))) @@ -2627,34 +3215,34 @@ buffer that was in action when the last article was fetched." (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) -(defun gnus-summary-from-or-to-or-newsgroups (header) - (let ((to (cdr (assq 'To (mail-header-extra header)))) - (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))) - (default-mime-charset (with-current-buffer gnus-summary-buffer +(defun gnus-summary-extract-address-component (from) + (or (car (funcall gnus-extract-address-components from)) + from)) + +(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) + (let ((default-mime-charset (with-current-buffer gnus-summary-buffer default-mime-charset))) - (cond - ((and to - gnus-ignored-from-addresses - (string-match gnus-ignored-from-addresses - (mail-header-from header))) - (concat "-> " - (or (car (funcall gnus-extract-address-components - (funcall - gnus-decode-encoded-word-function to))) - (funcall gnus-decode-encoded-word-function to)))) - ((and newsgroups - gnus-ignored-from-addresses - (string-match gnus-ignored-from-addresses - (mail-header-from header))) - (concat "=> " newsgroups)) - (t - (or (car (funcall gnus-extract-address-components - (mail-header-from header))) - (mail-header-from header)))))) + ;; Is it really necessary to do this next part for each summary line? + ;; Luckily, doesn't seem to slow things down much. + (or + (and gnus-ignored-from-addresses + (string-match gnus-ignored-from-addresses gnus-tmp-from) + (let ((extra-headers (mail-header-extra header)) + to + newsgroups) + (cond + ((setq to (cdr (assq 'To extra-headers))) + (concat "-> " + (inline + (gnus-summary-extract-address-component + (funcall gnus-decode-encoded-word-function to))))) + ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) + (concat "=> " newsgroups))))) + (inline (gnus-summary-extract-address-component gnus-tmp-from))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current - gnus-tmp-unread gnus-tmp-replied + undownloaded gnus-tmp-unread gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) @@ -2665,17 +3253,31 @@ buffer that was in action when the last article was fetched." (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-number (mail-header-number gnus-tmp-header)) (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) ((memq gnus-tmp-current gnus-newsgroup-cached) gnus-cached-mark) (gnus-tmp-replied gnus-replied-mark) + ((memq gnus-tmp-current gnus-newsgroup-forwarded) + gnus-forwarded-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) gnus-saved-mark) - (t gnus-unread-mark))) + ((memq gnus-tmp-number gnus-newsgroup-recent) + gnus-recent-mark) + ((memq gnus-tmp-number gnus-newsgroup-unseen) + gnus-unseen-mark) + (t gnus-no-mark))) + (gnus-tmp-downloaded + (cond (undownloaded + gnus-undownloaded-mark) + (gnus-newsgroup-agentized + gnus-downloaded-mark) + (t + gnus-no-mark))) (gnus-tmp-from (mail-header-from gnus-tmp-header)) (gnus-tmp-name (cond @@ -2689,14 +3291,16 @@ buffer that was in action when the last article was fetched." (1+ (match-beginning 0)) (1- (match-end 0)))) (t gnus-tmp-from))) (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) - (gnus-tmp-number (mail-header-number gnus-tmp-header)) (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) (buffer-read-only nil)) (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines 0)) + (setq gnus-tmp-lines -1)) + (if (= gnus-tmp-lines -1) + (setq gnus-tmp-lines "?") + (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) (gnus-put-text-property-excluding-characters-with-faces (point) (progn (eval gnus-summary-line-format-spec) (point)) @@ -2729,7 +3333,7 @@ buffer that was in action when the last article was fetched." (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)) @@ -2767,9 +3371,22 @@ the thread are to be displayed." gnus-empty-thread-mark) number))) +(defsubst gnus-summary-line-message-size (head) + "Return pretty-printed version of message size. +This function is intended to be used in +`gnus-summary-line-format-alist'." + (let ((c (or (mail-header-chars head) -1))) + (cond ((< c 0) "n/a") ; chars not available + ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0))) + ((< c (* 1000 100)) (format "%dk" (/ c 1024.0))) + ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024)))) + (t (format "%dM" (/ c (* 1024.0 1024))))))) + + (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." (let ((params (gnus-group-find-parameter group)) + (vars '(quit-config)) ; Ignore quit-config. elem) (while params (setq elem (car params) @@ -2777,8 +3394,9 @@ the thread are to be displayed." (and (consp elem) ; Has to be a cons. (consp (cdr elem)) ; The cdr has to be a list. (symbolp (car elem)) ; Has to be a symbol in there. - (not (memq (car elem) '(quit-config))) ; Ignore quit-config. + (not (memq (car elem) vars)) (ignore-errors ; So we set it. + (push (car elem) vars) (make-local-variable (car elem)) (set (car elem) (eval (nth 1 elem)))))))) @@ -2835,10 +3453,11 @@ If SHOW-ALL is non-nil, already read articles are also listed." kill-buffer no-display &optional select-articles) ;; Killed foreign groups can't be entered. - (when (and (not (gnus-group-native-p group)) - (not (gnus-gethash group gnus-newsrc-hashtb))) - (error "Dead non-native groups can't be entered")) - (gnus-message 5 "Retrieving newsgroup: %s..." group) + ;; (when (and (not (gnus-group-native-p group)) + ;; (not (gnus-gethash group gnus-newsrc-hashtb))) + ;; (error "Dead non-native groups can't be entered")) + (gnus-message 5 "Retrieving newsgroup: %s..." + (gnus-group-decoded-name group)) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) (did-select (and new-group (gnus-select-newsgroup @@ -2868,7 +3487,11 @@ If SHOW-ALL is non-nil, already read articles are also listed." (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1)) (gnus-handle-ephemeral-exit quit-config))) - (gnus-message 3 "Can't select group") + (let ((grpinfo (gnus-get-info group))) + (if (null (gnus-info-read grpinfo)) + (gnus-message 3 "Group %s contains no messages" + (gnus-group-decoded-name group)) + (gnus-message 3 "Can't select group"))) nil) ;; The user did a `C-g' while prompting for number of articles, ;; so we exit this group. @@ -2896,8 +3519,6 @@ If SHOW-ALL is non-nil, already read articles are also listed." (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this hook. (gnus-run-hooks 'gnus-select-group-hook) - ;; Set any local variables in the group parameters. - (gnus-summary-set-local-parameters gnus-newsgroup-name) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions) @@ -2913,7 +3534,7 @@ If SHOW-ALL is non-nil, already read articles are also listed." (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) (gnus-summary-initial-limit show-all)) - ;; When untreaded, all articles are always shown. + ;; When unthreaded, all articles are always shown. (setq gnus-newsgroup-limit (mapcar (lambda (header) (mail-header-number header)) @@ -2949,11 +3570,10 @@ If SHOW-ALL is non-nil, already read articles are also listed." ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) + (gnus-summary-maybe-hide-threads) (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) + (gnus-summary-auto-select-subject) ;; Show first unread article if requested. (if (and (not no-article) (not no-display) @@ -2961,20 +3581,17 @@ If SHOW-ALL is non-nil, already read articles are also listed." gnus-auto-select-first) (progn (gnus-configure-windows 'summary) - (cond - ((eq gnus-auto-select-first 'best) - (gnus-summary-best-unread-article)) - ((eq gnus-auto-select-first t) - (gnus-summary-first-unread-article)) - ((gnus-functionp gnus-auto-select-first) - (funcall gnus-auto-select-first)))) - ;; Don't select any articles, just move point to the first - ;; article in the group. - (goto-char (point-min)) + (let ((art (gnus-summary-article-number))) + (unless (and (not gnus-plugged) + (or (memq art gnus-newsgroup-undownloaded) + (memq art gnus-newsgroup-downloadable))) + (gnus-summary-goto-article art)))) + ;; Don't select any articles. (gnus-summary-position-point) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary)) - (when (get-buffer-window gnus-group-buffer t) + (when (and gnus-auto-center-group + (get-buffer-window gnus-group-buffer t)) ;; Gotta use windows, because recenter does weird stuff if ;; the current buffer ain't the displayed window. (let ((owin (selected-window))) @@ -2985,8 +3602,28 @@ If SHOW-ALL is non-nil, already read articles are also listed." ;; Mark this buffer as "prepared". (setq gnus-newsgroup-prepared t) (gnus-run-hooks 'gnus-summary-prepared-hook) + (unless (gnus-ephemeral-group-p group) + (gnus-group-update-group group)) t))))) +(defun gnus-summary-auto-select-subject () + "Select the subject line on initial group entry." + (goto-char (point-min)) + (cond + ((eq gnus-auto-select-subject 'best) + (gnus-summary-best-unread-subject)) + ((eq gnus-auto-select-subject 'unread) + (gnus-summary-first-unread-subject)) + ((eq gnus-auto-select-subject 'unseen) + (gnus-summary-first-unseen-subject)) + ((eq gnus-auto-select-subject 'unseen-or-unread) + (gnus-summary-first-unseen-or-unread-subject)) + ((eq gnus-auto-select-subject 'first) + ;; Do nothing. + ) + ((functionp gnus-auto-select-subject) + (funcall gnus-auto-select-subject)))) + (defun gnus-summary-prepare () "Generate the summary buffer." (interactive) @@ -3068,7 +3705,16 @@ If SHOW-ALL is non-nil, already read articles are also listed." (setcdr prev (cdr threads)) (setq threads prev)) ;; Enter this thread into the hash table. - (gnus-sethash subject threads hashtb))) + (gnus-sethash subject + (if gnus-summary-make-false-root-always + (progn + ;; If you want a dummy root above all + ;; threads... + (setcar threads (list whole-subject + (car threads))) + threads) + threads) + hashtb))) (setq prev threads) (setq threads (cdr threads))) result))) @@ -3083,7 +3729,7 @@ If SHOW-ALL is non-nil, already read articles are also listed." (while threads (when (setq references (mail-header-references (caar threads))) (setq id (mail-header-id (caar threads)) - ids (gnus-split-references references) + ids (inline (gnus-split-references references)) entered nil) (while (setq ref (pop ids)) (setq ids (delete ref ids)) @@ -3182,13 +3828,13 @@ if it was already present. If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs will not be entered in the DEPENDENCIES table. Otherwise duplicate -Message-IDs will be renamed be renamed to a unique Message-ID before -being entered. +Message-IDs will be renamed to a unique Message-ID before being +entered. Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) (id-dep (and id (intern id dependencies))) - ref ref-dep ref-header) + parent-id ref ref-dep ref-header replaced) ;; Enter this `header' in the `dependencies' table. (cond ((not id-dep) @@ -3205,7 +3851,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (force-new ;; Overrides an existing entry; ;; just set the header part of the entry. - (setcar (symbol-value id-dep) header)) + (setcar (symbol-value id-dep) header) + (setq replaced t)) ;; Renames the existing `header' to a unique Message-ID. ((not gnus-summary-ignore-duplicates) @@ -3228,9 +3875,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (or (mail-header-xref header) ""))) (setq header nil))) - (when header - ;; First check if that we are not creating a References loop. - (setq ref (gnus-parent-id (mail-header-references header))) + (when (and header (not replaced)) + ;; First check that we are not creating a References loop. + (setq parent-id (gnus-parent-id (mail-header-references header))) + (setq ref parent-id) (while (and ref (setq ref-dep (intern-soft ref dependencies)) (boundp ref-dep) @@ -3240,10 +3888,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; root article. (progn (mail-header-set-references (car (symbol-value id-dep)) "none") - (setq ref nil)) + (setq ref nil) + (setq parent-id nil)) (setq ref (gnus-parent-id (mail-header-references ref-header))))) - (setq ref (gnus-parent-id (mail-header-references header))) - (setq ref-dep (intern (or ref "none") dependencies)) + (setq ref-dep (intern (or parent-id "none") dependencies)) (if (boundp ref-dep) (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) @@ -3251,6 +3899,11 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (set ref-dep (list nil (symbol-value id-dep))))) header)) +(defun gnus-extract-message-id-from-in-reply-to (string) + (if (string-match "<[^>]+>" string) + (substring string (match-beginning 0) (match-end 0)) + nil)) + (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) (mail-parse-charset gnus-newsgroup-charset) @@ -3327,7 +3980,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (gnus-point-at-eol)) (buffer (current-buffer)) - header) + header references in-reply-to) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect @@ -3354,6 +4007,12 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (widen)) + (when (and (string= references "") + (setq in-reply-to (mail-header-extra header)) + (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) + (mail-header-set-references + header (gnus-extract-message-id-from-in-reply-to in-reply-to))) + (when gnus-alter-header-function (funcall gnus-alter-header-function header)) (gnus-dependencies-add-header header dependencies force-new))) @@ -3388,7 +4047,9 @@ the id of the parent article (if any)." (push header gnus-newsgroup-headers) (if (memq number gnus-newsgroup-unselected) (progn - (push number gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + number)) (setq gnus-newsgroup-unselected (delq number gnus-newsgroup-unselected))) (push number gnus-newsgroup-ancient))))))) @@ -3414,7 +4075,9 @@ the id of the parent article (if any)." (if (memq (setq article (mail-header-number header)) gnus-newsgroup-unselected) (progn - (push article gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list + gnus-newsgroup-unreads article)) (setq gnus-newsgroup-unselected (delq article gnus-newsgroup-unselected))) (push article gnus-newsgroup-ancient))) @@ -3431,38 +4094,41 @@ the id of the parent article (if any)." (gnus-summary-goto-subject article) (let* ((datal (gnus-data-find-list article)) (data (car datal)) - (length (when (cdr datal) - (- (gnus-data-pos data) - (gnus-data-pos (cadr datal))))) (buffer-read-only nil) (level (gnus-summary-thread-level))) (gnus-delete-line) - (gnus-summary-insert-line - header level nil (gnus-article-mark article) - (memq article gnus-newsgroup-replied) - (memq article gnus-newsgroup-expirable) - ;; Only insert the Subject string when it's different - ;; from the previous Subject string. - (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)) - (memq article gnus-newsgroup-processable)) - (when length - (gnus-data-update-list - (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) + (let ((inserted (- (point) + (progn + (gnus-summary-insert-line + header level nil + (memq article gnus-newsgroup-undownloaded) + (gnus-article-mark article) + (memq article gnus-newsgroup-replied) + (memq article gnus-newsgroup-expirable) + ;; Only insert the Subject string when it's different + ;; from the previous Subject string. + (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)) + (memq article gnus-newsgroup-processable)) + (point))))) + (when (cdr datal) + (gnus-data-update-list + (cdr datal) + (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted))))))) (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." @@ -3503,7 +4169,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (setq thread (gnus-remove-thread id))) (setq old-pos (gnus-point-at-bol)) (setq current (save-excursion - (and (zerop (forward-line -1)) + (and (re-search-backward "[\r\n]" nil t) (gnus-summary-article-number)))) ;; If this is a gathered thread, we have to go some re-gathering. (when (stringp (car thread)) @@ -3700,11 +4366,11 @@ If LINE, insert the rebuilt thread starting on line LINE." (if (not gnus-thread-sort-functions) threads (gnus-message 8 "Sorting threads...") - (prog1 - (gnus-sort-threads-1 - threads + (let ((max-lisp-eval-depth 5000)) + (prog1 (gnus-sort-threads-1 + threads (gnus-make-sort-function gnus-thread-sort-functions)) - (gnus-message 8 "Sorting threads...done")))) + (gnus-message 8 "Sorting threads...done"))))) (defun gnus-sort-articles (articles) "Sort ARTICLES." @@ -3736,6 +4402,15 @@ using some other form will lead to serious barfage." (gnus-article-sort-by-number (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-random (h1 h2) + "Sort articles by article number." + (zerop (random 2))) + +(defun gnus-thread-sort-by-random (h1 h2) + "Sort threads by root article number." + (gnus-article-sort-by-random + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-lines (h1 h2) "Sort articles by article Lines header." (< (mail-header-lines h1) @@ -3818,15 +4493,47 @@ Unscored articles will be counted as having a score of zero." (defun gnus-thread-total-score (thread) ;; This function find the total score of THREAD. - (cond ((null thread) - 0) - ((consp thread) - (if (stringp (car thread)) - (apply gnus-thread-score-function 0 - (mapcar 'gnus-thread-total-score-1 (cdr thread))) - (gnus-thread-total-score-1 thread))) - (t - (gnus-thread-total-score-1 (list thread))))) + (cond + ((null thread) + 0) + ((consp thread) + (if (stringp (car thread)) + (apply gnus-thread-score-function 0 + (mapcar 'gnus-thread-total-score-1 (cdr thread))) + (gnus-thread-total-score-1 thread))) + (t + (gnus-thread-total-score-1 (list thread))))) + +(defun gnus-thread-sort-by-most-recent-number (h1 h2) + "Sort threads such that the thread with the most recently arrived article comes first." + (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2))) + +(defun gnus-thread-highest-number (thread) + "Return the highest article number in THREAD." + (apply 'max (mapcar (lambda (header) + (mail-header-number header)) + (message-flatten-list thread)))) + +(defun gnus-thread-sort-by-most-recent-date (h1 h2) + "Sort threads such that the thread with the most recently dated article comes first." + (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2))) + +(defun gnus-thread-latest-date (thread) + "Return the highest article date in THREAD." + (let ((previous-time 0)) + (apply 'max + (mapcar + (lambda (header) + (setq previous-time + (time-to-seconds + (condition-case () + (mail-header-parse-date (mail-header-date header)) + (error previous-time))))) + (sort + (message-flatten-list thread) + (lambda (h1 h2) + (< (mail-header-number h1) + (mail-header-number h2)))))))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. @@ -3848,12 +4555,46 @@ 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)))) "")) +(defvar gnus-tmp-thread-tree-header-string "") + +(defcustom gnus-sum-thread-tree-root "> " + "With %B spec, used for the root of a thread. +If nil, use subject instead." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-false-root "> " + "With %B spec, used for a false root of a thread. +If nil, use subject instead." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-single-indent "" + "With %B spec, used for a thread with just one message. +If nil, use subject instead." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-vertical "| " + "With %B spec, used for drawing a vertical line." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-indent " " + "With %B spec, used for indenting." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-leaf-with-other "+-> " + "With %B spec, used for a leaf with brothers." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-single-leaf "\\-> " + "With %B spec, used for a leaf without brothers." + :type 'string + :group 'gnus-thread) + (defun gnus-summary-prepare-threads (threads) "Prepare summary buffer from THREADS and indentation LEVEL. THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' @@ -3866,15 +4607,19 @@ or a straight list of headers." (let ((gnus-tmp-level 0) (default-score (or gnus-summary-default-score 0)) (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) + (building-line-count gnus-summary-display-while-building) + (building-count (integerp gnus-summary-display-while-building)) thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end - gnus-tmp-header gnus-tmp-unread + new-roots gnus-tmp-new-adopts thread-end simp-subject + gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded gnus-tmp-replied gnus-tmp-subject-or-nil gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score gnus-tmp-score-char gnus-tmp-from gnus-tmp-name - gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) + gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket + tree-stack) - (setq gnus-tmp-prev-subject nil) + (setq gnus-tmp-prev-subject nil + gnus-tmp-thread-tree-header-string "") (if (vectorp (car threads)) ;; If this is a straight (sic) list of headers, then a @@ -3884,6 +4629,8 @@ or a straight list of headers." ;; Do the threaded display. + (if gnus-summary-display-while-building + (switch-to-buffer (buffer-name))) (while (or threads stack gnus-tmp-new-adopts new-roots) (if (and (= gnus-tmp-level 0) @@ -3910,7 +4657,8 @@ or a straight list of headers." ;; the stack. (setq state (car stack) gnus-tmp-level (car state) - thread (cdr state) + tree-stack (cadr state) + thread (caddr state) stack (cdr stack) gnus-tmp-header (caar thread)))) @@ -3954,7 +4702,8 @@ or a straight list of headers." (setq gnus-tmp-level -1))) (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header)) + subject (mail-header-subject gnus-tmp-header) + simp-subject (gnus-simplify-subject-fully subject)) (cond ;; If the thread has changed subject, we might want to make @@ -3962,8 +4711,7 @@ or a straight list of headers." ((and (null gnus-thread-ignore-subject) (not (zerop gnus-tmp-level)) gnus-tmp-prev-subject - (not (inline - (gnus-subject-equal gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) (setq new-roots (nconc new-roots (list (car thread))) thread-end t gnus-tmp-header nil)) @@ -3994,7 +4742,9 @@ or a straight list of headers." (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) + (setq gnus-newsgroup-expirable + (gnus-add-to-sorted-list + gnus-newsgroup-expirable number)) (push (cons number gnus-low-score-mark) gnus-newsgroup-reads)))) @@ -4022,15 +4772,13 @@ or a straight list of headers." (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-subject - (not (inline (gnus-subject-equal - gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) subject) ((zerop gnus-tmp-level) (if (and (eq gnus-summary-make-false-root 'empty) (memq number gnus-tmp-gathered) gnus-tmp-prev-subject - (inline (gnus-subject-equal - gnus-tmp-prev-subject subject))) + (string= gnus-tmp-prev-subject simp-subject)) gnus-summary-same-subject subject)) (t gnus-summary-same-subject))) @@ -4051,7 +4799,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 @@ -4061,9 +4809,22 @@ or a straight list of headers." gnus-cached-mark) ((memq number gnus-newsgroup-replied) gnus-replied-mark) + ((memq number gnus-newsgroup-forwarded) + gnus-forwarded-mark) ((memq number gnus-newsgroup-saved) gnus-saved-mark) - (t gnus-unread-mark)) + ((memq number gnus-newsgroup-recent) + gnus-recent-mark) + ((memq number gnus-newsgroup-unseen) + gnus-unseen-mark) + (t gnus-no-mark)) + gnus-tmp-downloaded + (cond ((memq number gnus-newsgroup-undownloaded) + gnus-undownloaded-mark) + (gnus-newsgroup-agentized + gnus-downloaded-mark) + (t + gnus-no-mark)) gnus-tmp-from (mail-header-from gnus-tmp-header) gnus-tmp-name (cond @@ -4075,26 +4836,66 @@ or a straight list of headers." ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from (1+ (match-beginning 0)) (1- (match-end 0)))) - (t gnus-tmp-from))) + (t gnus-tmp-from)) + + ;; Do the %B string + gnus-tmp-thread-tree-header-string + (cond + ((not gnus-show-threads) "") + ((zerop gnus-tmp-level) + (cond ((cdar thread) + (or gnus-sum-thread-tree-root subject)) + (gnus-tmp-new-adopts + (or gnus-sum-thread-tree-false-root subject)) + (t + (or gnus-sum-thread-tree-single-indent subject)))) + (t + (concat (apply 'concat + (mapcar (lambda (item) + (if (= item 1) + gnus-sum-thread-tree-vertical + gnus-sum-thread-tree-indent)) + (cdr (reverse tree-stack)))) + (if (nth 1 thread) + gnus-sum-thread-tree-leaf-with-other + gnus-sum-thread-tree-single-leaf))))) (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines 0)) - (gnus-put-text-property + (setq gnus-tmp-lines -1)) + (if (= gnus-tmp-lines -1) + (setq gnus-tmp-lines "?") + (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) + (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number number) + 'gnus-number number) (when gnus-visual-p (forward-line -1) (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)) - (setq gnus-tmp-prev-subject subject))) + (setq gnus-tmp-prev-subject simp-subject))) (when (nth 1 thread) - (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) + (push (list (max 0 gnus-tmp-level) + (copy-sequence tree-stack) + (nthcdr 1 thread)) + stack)) + (push (if (nth 1 thread) 1 0) tree-stack) (incf gnus-tmp-level) (setq threads (if thread-end nil (cdar thread))) + (if gnus-summary-display-while-building + (if building-count + (progn + ;; use a set frequency + (setq building-line-count (1- building-line-count)) + (when (= building-line-count 0) + (sit-for 0) + (setq building-line-count + gnus-summary-display-while-building))) + ;; always + (sit-for 0))) (unless threads (setq gnus-tmp-level 0))))) (gnus-message 7 "Generating summary...done")) @@ -4128,6 +4929,7 @@ or a straight list of headers." gnus-newsgroup-data) (gnus-summary-insert-line header 0 number + (memq number gnus-newsgroup-undownloaded) mark (memq number gnus-newsgroup-replied) (memq number gnus-newsgroup-expirable) (mail-header-subject header) nil @@ -4136,21 +4938,50 @@ or a straight list of headers." (defun gnus-summary-remove-list-identifiers () "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." - (let ((regexp (if (stringp gnus-list-identifiers) - gnus-list-identifiers - (mapconcat 'identity gnus-list-identifiers " *\\|")))) - (dolist (header gnus-newsgroup-headers) - (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 1)) - (or - (match-string 3 (mail-header-subject header)) - (match-string 5 (mail-header-subject header))) - (substring (mail-header-subject header) - (match-end 1)))))))) + (let ((regexp (if (consp gnus-list-identifiers) + (mapconcat 'identity gnus-list-identifiers " *\\|") + gnus-list-identifiers)) + changed subject) + (when regexp + (dolist (header gnus-newsgroup-headers) + (setq subject (mail-header-subject header) + changed nil) + (while (string-match + (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)") + subject) + (setq subject + (concat (substring subject 0 (match-beginning 2)) + (substring subject (match-end 0))) + changed t)) + (when (and changed + (string-match + "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject)) + (setq subject + (concat (substring subject 0 (match-beginning 1)) + (substring subject (match-end 1))))) + (when changed + (mail-header-set-subject header subject)))))) + +(defun gnus-fetch-headers (articles) + "Fetch headers of ARTICLES." + (let ((name (gnus-group-decoded-name gnus-newsgroup-name))) + (gnus-message 5 "Fetching headers for %s..." name) + (prog1 + (if (eq 'nov + (setq gnus-headers-retrieved-by + (gnus-retrieve-headers + articles gnus-newsgroup-name + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and + (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers)))) + (gnus-get-newsgroup-headers-xover + articles nil nil gnus-newsgroup-name t) + (gnus-get-newsgroup-headers)) + (gnus-message 5 "Fetching headers for %s...done" name)))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. @@ -4159,60 +4990,101 @@ If SELECT-ARTICLES, only select those articles from GROUP." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) ;;!!! Dirty hack; should be removed. (gnus-summary-ignore-duplicates - (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) + (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) t gnus-summary-ignore-duplicates)) (info (nth 2 entry)) articles fetched-articles cached) (unless (gnus-check-server - (setq gnus-current-select-method - (gnus-find-method-for-group group))) + (set (make-local-variable 'gnus-current-select-method) + (gnus-find-method-for-group group))) (error "Couldn't open server")) (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) (error "Couldn't activate group %s: %s" group (gnus-status-message group)))) (unless (gnus-request-group group t) (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) + (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" group (gnus-status-message group))) - (setq gnus-newsgroup-name group) - (setq gnus-newsgroup-unselected nil) - (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - (gnus-summary-setup-default-charset) + (when gnus-agent + ;; The agent may be storing articles that are no longer in the + ;; server's active range. If that is the case, the active range + ;; needs to be expanded such that the agent's articles can be + ;; included in the summary. + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (alist (gnus-agent-load-alist group)) + (active (gnus-active group))) + (if (and (car alist) + (< (caar alist) (car active))) + (gnus-set-active group (cons (caar alist) (cdr active)))))) + + (setq gnus-newsgroup-name group + gnus-newsgroup-unselected nil + gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) + + (let ((display (gnus-group-find-parameter group 'display))) + (setq gnus-newsgroup-display + (cond + ((not (zerop (or (car-safe read-all) 0))) + ;; The user entered the group with C-u SPC/RET, let's show + ;; all articles. + 'gnus-not-ignore) + ((eq display 'all) + 'gnus-not-ignore) + ((arrayp display) + (gnus-summary-display-make-predicate (mapcar 'identity display))) + ((numberp display) + ;; The following is probably the "correct" solution, but + ;; it makes Gnus fetch all headers and then limit the + ;; articles (which is slow), so instead we hack the + ;; select-articles parameter instead. -- Simon Josefsson + ;; + ;; + ;; (gnus-byte-compile + ;; `(lambda () (> number ,(- (cdr (gnus-active group)) + ;; display))))) + (setq select-articles + (gnus-uncompress-range + (cons (let ((tmp (- (cdr (gnus-active group)) display))) + (if (> tmp 0) + tmp + 1)) + (cdr (gnus-active group))))) + nil) + (t + nil)))) - ;; Adjust and set lists of article marks. - (when info - (gnus-adjust-marked-articles info)) + (gnus-summary-setup-default-charset) ;; Kludge to avoid having cached articles nixed out in virtual groups. - (setq cached - (if (gnus-virtual-group-p group) - gnus-newsgroup-cached - (gnus-cache-articles-in-group group))) + (when (gnus-virtual-group-p group) + (setq cached gnus-newsgroup-cached)) (setq gnus-newsgroup-unreads - (gnus-set-difference - (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) + (gnus-sorted-ndifference + (gnus-sorted-ndifference gnus-newsgroup-unreads + gnus-newsgroup-marked) gnus-newsgroup-dormant)) (setq gnus-newsgroup-processable nil) (gnus-update-read-articles group gnus-newsgroup-unreads) + ;; Adjust and set lists of article marks. + (when info + (gnus-adjust-marked-articles info)) (if (setq articles select-articles) (setq gnus-newsgroup-unselected - (gnus-sorted-intersection - gnus-newsgroup-unreads - (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (gnus-sorted-difference gnus-newsgroup-unreads articles)) (setq articles (gnus-articles-to-read group read-all))) (cond @@ -4226,34 +5098,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-make-hashtable (length articles))) (gnus-set-global-variables) ;; Retrieve the headers and read them in. - (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) - (setq gnus-newsgroup-headers - ;;;!!! FIXME: temporary fix for an infloop on nnimap. - (if (eq 'nnimap (car (gnus-find-method-for-group group))) - (if (eq 'nov - (setq - gnus-headers-retrieved-by - (gnus-retrieve-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers)))) - (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers)) - (gnus-retrieve-parsed-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers)))) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) + + (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) + + ;; Kludge to avoid having cached articles nixed out in virtual groups. + (when cached + (setq gnus-newsgroup-cached cached)) ;; Suppress duplicates? (when gnus-suppress-duplicates @@ -4262,20 +5112,18 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Set the initial limit. (setq gnus-newsgroup-limit (copy-sequence articles)) ;; Remove canceled articles from the list of unread articles. + (setq fetched-articles + (mapcar (lambda (headers) (mail-header-number headers)) + gnus-newsgroup-headers)) + (setq gnus-newsgroup-articles fetched-articles) (setq gnus-newsgroup-unreads - (gnus-set-sorted-intersection - gnus-newsgroup-unreads - (setq fetched-articles - (mapcar (lambda (headers) (mail-header-number headers)) - gnus-newsgroup-headers)))) + (gnus-sorted-nintersection + gnus-newsgroup-unreads fetched-articles)) + (gnus-compute-unseen-list) + ;; Removed marked articles that do not exist. (gnus-update-missing-marks - (gnus-sorted-complement fetched-articles articles)) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when cached - (setq gnus-newsgroup-cached cached)) - + (gnus-sorted-difference articles fetched-articles)) ;; We might want to build some more threads first. (when (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)) @@ -4304,22 +5152,97 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; GROUP is successfully selected. (or gnus-newsgroup-headers t))))) +(defun gnus-compute-unseen-list () + ;; The `seen' marks are treated specially. + (if (not gnus-newsgroup-seen) + (setq gnus-newsgroup-unseen gnus-newsgroup-articles) + (setq gnus-newsgroup-unseen + (gnus-inverse-list-range-intersection + gnus-newsgroup-articles gnus-newsgroup-seen)))) + +(defun gnus-summary-display-make-predicate (display) + (require 'gnus-agent) + (when (= (length display) 1) + (setq display (car display))) + (unless gnus-summary-display-cache + (dolist (elem (append '((unread . unread) + (read . read) + (unseen . unseen)) + gnus-article-mark-lists)) + (push (cons (cdr elem) + (gnus-byte-compile + `(lambda () (gnus-article-marked-p ',(cdr elem))))) + gnus-summary-display-cache))) + (let ((gnus-category-predicate-alist gnus-summary-display-cache) + (gnus-category-predicate-cache gnus-summary-display-cache)) + (gnus-get-predicate display))) + +;; Uses the dynamically bound `number' variable. +(eval-when-compile + (defvar number)) +(defun gnus-article-marked-p (type &optional article) + (let ((article (or article number))) + (cond + ((eq type 'tick) + (memq article gnus-newsgroup-marked)) + ((eq type 'spam) + (memq article gnus-newsgroup-spam-marked)) + ((eq type 'unsend) + (memq article gnus-newsgroup-unsendable)) + ((eq type 'undownload) + (memq article gnus-newsgroup-undownloaded)) + ((eq type 'download) + (memq article gnus-newsgroup-downloadable)) + ((eq type 'unread) + (memq article gnus-newsgroup-unreads)) + ((eq type 'read) + (memq article gnus-newsgroup-reads)) + ((eq type 'dormant) + (memq article gnus-newsgroup-dormant) ) + ((eq type 'expire) + (memq article gnus-newsgroup-expirable)) + ((eq type 'reply) + (memq article gnus-newsgroup-replied)) + ((eq type 'killed) + (memq article gnus-newsgroup-killed)) + ((eq type 'bookmark) + (assq article gnus-newsgroup-bookmarks)) + ((eq type 'score) + (assq article gnus-newsgroup-scored)) + ((eq type 'save) + (memq article gnus-newsgroup-saved)) + ((eq type 'cache) + (memq article gnus-newsgroup-cached)) + ((eq type 'forward) + (memq article gnus-newsgroup-forwarded)) + ((eq type 'seen) + (not (memq article gnus-newsgroup-unseen))) + ((eq type 'recent) + (memq article gnus-newsgroup-recent)) + (t t)))) + (defun gnus-articles-to-read (group &optional read-all) "Find out what articles the user wants to read." - (let* ((articles + (let* ((display (gnus-group-find-parameter group 'display)) + (articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all (and (zerop (length gnus-newsgroup-marked)) (zerop (length gnus-newsgroup-unreads))) - (eq (gnus-group-find-parameter group 'display) - 'all)) + ;; Fetch all if the predicate is non-nil. + gnus-newsgroup-display) + ;; We want to select the headers for all the articles in + ;; the group, so we select either all the active + ;; articles in the group, or (if that's nil), the + ;; articles in the cache. (or (gnus-uncompress-range (gnus-active group)) (gnus-cache-articles-in-group group)) - (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked - (copy-sequence gnus-newsgroup-unreads)) - '<))) + ;; Select only the "normal" subset of articles. + (gnus-sorted-nunion + (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) + gnus-newsgroup-unreads))) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) (scored (length scored-list)) (number (length articles)) @@ -4329,30 +5252,38 @@ If SELECT-ARTICLES, only select those articles from GROUP." (cond ((numberp read-all) read-all) + ((numberp gnus-newsgroup-display) + gnus-newsgroup-display) (t (condition-case () (cond ((and (or (<= scored marked) (= scored number)) - (natnump gnus-large-newsgroup) + (numberp gnus-large-newsgroup) (> number gnus-large-newsgroup)) (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))) + (initial (gnus-parameter-large-newsgroup-initial + gnus-newsgroup-name)) + (input + (read-string + (format + "How many articles from %s (%s %d): " + (gnus-limit-string + (gnus-group-decoded-name gnus-newsgroup-name) + 35) + (if initial "max" "default") + number) + (if initial + (cons (number-to-string initial) + 0))))) + (if (string-match "^[ \t]*$" input) number input))) ((and (> scored marked) (< scored number) (> (- scored number) 20)) (let ((input (read-string (format "%s %s (%d scored, %d total): " "How many articles from" - group scored number)))) + (gnus-group-decoded-name group) + scored number)))) (if (string-match "^[ \t]*$" input) number input))) (t number)) @@ -4375,14 +5306,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Select the N most recent articles. (setq articles (nthcdr (- number select) articles)))) (setq gnus-newsgroup-unselected - (gnus-sorted-intersection - gnus-newsgroup-unreads - (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (gnus-sorted-difference gnus-newsgroup-unreads articles)) (when gnus-alter-articles-to-read-function - (setq gnus-newsgroup-unreads + (setq articles (sort (funcall gnus-alter-articles-to-read-function - gnus-newsgroup-name gnus-newsgroup-unreads) + gnus-newsgroup-name articles) '<))) articles))) @@ -4405,6 +5334,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq marks (cdr marks))) out)) +(defun gnus-article-mark-to-type (mark) + "Return the type of MARK." + (or (cadr (assq mark gnus-article-special-mark-lists)) + 'list)) + +(defun gnus-article-unpropagatable-p (mark) + "Return whether MARK should be propagated to backend." + (memq mark gnus-article-unpropagated-mark-lists)) + (defun gnus-adjust-marked-articles (info) "Set all article lists and remove all marks that are no longer valid." (let* ((marked-lists (gnus-info-marks info)) @@ -4412,28 +5350,26 @@ If SELECT-ARTICLES, only select those articles from GROUP." (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - (uncompressed '(score bookmark killed)) - marks var articles article mark) - - (while marked-lists - (setq marks (pop marked-lists)) - (set (setq var (intern (format "gnus-newsgroup-%s" - (car (rassq (setq mark (car marks)) - types))))) - (if (memq (car marks) uncompressed) (cdr marks) - (gnus-uncompress-range (cdr marks)))) + marks var articles article mark mark-type) - (setq articles (symbol-value var)) + (dolist (marks marked-lists) + (setq mark (car marks) + mark-type (gnus-article-mark-to-type mark) + var (intern (format "gnus-newsgroup-%s" (car (rassq mark types))))) - ;; All articles have to be subsets of the active articles. + ;; We set the variable according to the type of the marks list, + ;; and then adjust the marks to a subset of the active articles. (cond ;; Adjust "simple" lists. - ((memq mark '(tick dormant expire reply save)) - (while articles - (when (or (< (setq article (pop articles)) min) (> article max)) - (set var (delq article (symbol-value var)))))) + ((eq mark-type 'list) + (set var (setq articles (gnus-uncompress-range (cdr marks)))) + (when (memq mark '(tick dormant expire reply save)) + (while articles + (when (or (< (setq article (pop articles)) min) (> article max)) + (set var (delq article (symbol-value var))))))) ;; Adjust assocs. - ((memq mark uncompressed) + ((eq mark-type 'tuple) + (set var (setq articles (cdr marks))) (when (not (listp (cdr (symbol-value var)))) (set var (list (symbol-value var)))) (when (not (listp (cdr articles))) @@ -4442,36 +5378,50 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when (or (not (consp (setq article (pop articles)))) (< (car article) min) (> (car article) max)) - (set var (delq article (symbol-value var)))))))))) + (set var (delq article (symbol-value var)))))) + ;; Adjust ranges (sloppily). + ((eq mark-type 'range) + (cond + ((eq mark 'seen) + ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2). + ;; It should be (seen (NUM1 . NUM2)). + (when (numberp (cddr marks)) + (setcdr marks (list (cdr marks)))) + (setq articles (cdr marks)) + (while (and articles + (or (and (consp (car articles)) + (> min (cdar articles))) + (and (numberp (car articles)) + (> min (car articles))))) + (pop articles)) + (set var articles)))))))) (defun gnus-update-missing-marks (missing) "Go through the list of MISSING articles and remove them from the mark lists." (when missing - (let ((types gnus-article-mark-lists) - var m) + (let (var m) ;; Go through all types. - (while types - (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) - (when (symbol-value var) - ;; This list has articles. So we delete all missing articles - ;; from it. - (setq m missing) - (while m - (set var (delq (pop m) (symbol-value var))))))))) + (dolist (elem gnus-article-mark-lists) + (when (eq (gnus-article-mark-to-type (cdr elem)) 'list) + (setq var (intern (format "gnus-newsgroup-%s" (car elem)))) + (when (symbol-value var) + ;; This list has articles. So we delete all missing + ;; articles from it. + (setq m missing) + (while m + (set var (delq (pop m) (symbol-value var)))))))))) (defun gnus-update-marks () "Enter the various lists of marked articles into the newsgroup info list." (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) - (uncompressed '(score bookmark killed)) type list newmarked symbol delta-marks) (when info ;; 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)))))) + (intern (format "gnus-newsgroup-%s" (car type)))))) (when list ;; Get rid of the entries of the articles that have the @@ -4490,27 +5440,23 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq arts (cdr arts))) (setq list (cdr all))))) - (unless (memq (cdr type) uncompressed) + (when (eq (cdr type) 'seen) + (setq list (gnus-range-add list gnus-newsgroup-unseen))) + + (when (eq (gnus-article-mark-to-type (cdr type)) 'list) (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 (and (gnus-check-backend-function + 'request-set-mark gnus-newsgroup-name) + (not (gnus-article-unpropagatable-p (cdr type)))) + (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))) @@ -4551,11 +5497,8 @@ 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-group-name-decode - gnus-newsgroup-name - (gnus-group-name-charset - nil - gnus-newsgroup-name))) + (gnus-tmp-group-name (gnus-group-decoded-name + 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)) @@ -4717,9 +5660,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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-request-set-mark ,group (list (list ',range 'del '(read)))) (gnus-group-update-group ,group t)))) ;; Add the read articles to the range. (gnus-info-set-read info range) + (gnus-request-set-mark group (list (list range 'add '(read)))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (when active @@ -4739,7 +5684,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Update the number of unread articles. (setcar entry num) ;; Update the group buffer. - (gnus-group-update-group group t))))) + (unless (gnus-ephemeral-group-p group) + (gnus-group-update-group group t)))))) (defvar gnus-newsgroup-none-id 0) @@ -4791,22 +5737,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Subject. (progn (goto-char p) - (if (search-forward "\nsubject: " nil t) + (if (search-forward "\nsubject:" nil t) (nnheader-header-value) "(none)")) ;; From. (progn (goto-char p) - (if (or (search-forward "\nfrom: " nil t) - (search-forward "\nfrom:" nil t)) + (if (search-forward "\nfrom:" nil t) (nnheader-header-value) "(nobody)")) ;; Date. (progn (goto-char p) - (if (search-forward "\ndate: " nil t) - (nnheader-header-value) - "")) + (if (search-forward "\ndate:" nil t) + (nnheader-header-value) "")) ;; Message-ID. (progn (goto-char p) @@ -4822,7 +5766,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; References. (progn (goto-char p) - (if (search-forward "\nreferences: " nil t) + (if (search-forward "\nreferences:" nil t) (progn (setq end (point)) (prog1 @@ -4830,7 +5774,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ref (buffer-substring (progn - ;; (end-of-line) + ;; (end-of-line) (search-backward ">" end t) (1+ (point))) (progn @@ -4839,7 +5783,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Get the references from the in-reply-to header if there ;; were no references and the in-reply-to header looks ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) + (if (and (search-forward "\nin-reply-to:" nil t) (setq in-reply-to (nnheader-header-value)) (string-match "<[^>]+>" in-reply-to)) (let (ref2) @@ -4857,19 +5801,19 @@ The resulting hash table is returned, or nil if no Xrefs were found." (goto-char p) (if (search-forward "\nchars: " nil t) (if (numberp (setq chars (ignore-errors (read cur)))) - chars 0) - 0)) + chars -1) + -1)) ;; Lines. (progn (goto-char p) (if (search-forward "\nlines: " nil t) (if (numberp (setq lines (ignore-errors (read cur)))) - lines 0) - 0)) + lines -1) + -1)) ;; Xref. (progn (goto-char p) - (and (search-forward "\nxref: " nil t) + (and (search-forward "\nxref:" nil t) (nnheader-header-value))) ;; Extra. (when gnus-extra-headers @@ -4878,7 +5822,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (while extra (goto-char p) (when (search-forward - (concat "\n" (symbol-name (car extra)) ": ") nil t) + (concat "\n" (symbol-name (car extra)) ":") nil t) (push (cons (car extra) (nnheader-header-value)) out)) (pop extra)) out)))) @@ -4917,6 +5861,13 @@ Return a list of headers that match SEQUENCE (see (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) (cur nntp-server-buffer) (dependencies (or dependencies gnus-newsgroup-dependencies)) + (allp (cond + ((eq gnus-read-all-available-headers t) + t) + ((stringp gnus-read-all-available-headers) + (string-match gnus-read-all-available-headers group)) + (t + nil))) number headers header) (save-excursion (set-buffer nntp-server-buffer) @@ -4924,26 +5875,24 @@ Return a list of headers that match SEQUENCE (see ;; Allow the user to mangle the headers before parsing them. (gnus-run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) - (while (not (eobp)) - (condition-case () - (while (and sequence (not (eobp))) - (setq number (read cur)) - (while (and sequence - (< (car sequence) number)) - (setq sequence (cdr sequence))) - (and sequence - (eq number (car sequence)) - (progn - (setq sequence (cdr sequence)) - (setq header (inline - (gnus-nov-parse-line - number dependencies force-new)))) - (push header headers)) - (forward-line 1)) - (error - (gnus-error 4 "Strange nov line (%d)" - (count-lines (point-min) (point))))) - (forward-line 1)) + (gnus-parse-without-error + (while (and (or sequence allp) + (not (eobp))) + (setq number (read cur)) + (when (not allp) + (while (and sequence + (< (car sequence) number)) + (setq sequence (cdr sequence)))) + (when (and (or allp + (and sequence + (eq number (car sequence)))) + (progn + (setq sequence (cdr sequence)) + (setq header (inline + (gnus-nov-parse-line + number dependencies force-new))))) + (push header headers)) + (forward-line 1))) ;; A common bug in inn is that if you have posted an article and ;; then retrieves the active file, it will answer correctly -- ;; the new article is included. However, a NOV entry for the @@ -4957,11 +5906,8 @@ Return a list of headers that match SEQUENCE (see (let ((gnus-nov-is-evil t)) (nconc (nreverse headers) - ;;;!!! FIXME: temporary fix for an infloop on nnimap. - (if (eq 'nnimap (car (gnus-find-method-for-group group))) - (when (gnus-retrieve-headers sequence group) - (gnus-get-newsgroup-headers)) - (gnus-retrieve-parsed-headers sequence group)))))))) + (when (eq (gnus-retrieve-headers sequence group) 'headers) + (gnus-get-newsgroup-headers)))))))) (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. @@ -4982,8 +5928,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) - (progn (end-of-line) (point)))) + (setq xref (buffer-substring (point) (gnus-point-at-eol))) (mail-header-set-xref headers xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) @@ -5145,53 +6090,68 @@ If EXCLUDE-GROUP, do not go to this group." (save-excursion (gnus-group-best-unread-group exclude-group)))) -(defun gnus-summary-find-next (&optional unread article backward undownloaded) - (if backward (gnus-summary-find-prev) +(defun gnus-summary-find-next (&optional unread article backward) + (if backward (gnus-summary-find-prev unread article) (let* ((dummy (gnus-summary-article-intangible-p)) (article (or article (gnus-summary-article-number))) - (arts (gnus-data-find-list article)) + (data (gnus-data-find-list article)) result) (when (and (not dummy) (or (not gnus-summary-check-current) (not unread) - (not (gnus-data-unread-p (car arts))))) - (setq arts (cdr arts))) + (not (gnus-data-unread-p (car data))))) + (setq data (cdr data))) (when (setq result (if unread (progn - (while arts - (when (or (and undownloaded - (eq gnus-undownloaded-mark - (gnus-data-mark (car arts)))) - (gnus-data-unread-p (car arts))) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) + (while data + (unless (memq (gnus-data-number (car data)) + (cond ((eq gnus-auto-goto-ignores 'always-undownloaded) + gnus-newsgroup-undownloaded) + (gnus-plugged + nil) + ((eq gnus-auto-goto-ignores 'unfetched) + gnus-newsgroup-unfetched) + ((eq gnus-auto-goto-ignores 'undownloaded) + gnus-newsgroup-undownloaded))) + (when (gnus-data-unread-p (car data)) + (setq result (car data) + data nil))) + (setq data (cdr data))) result) - (car arts))) + (car data))) (goto-char (gnus-data-pos result)) (gnus-data-number result))))) (defun gnus-summary-find-prev (&optional unread article) (let* ((eobp (eobp)) (article (or article (gnus-summary-article-number))) - (arts (gnus-data-find-list article (gnus-data-list 'rev))) + (data (gnus-data-find-list article (gnus-data-list 'rev))) result) (when (and (not eobp) (or (not gnus-summary-check-current) (not unread) - (not (gnus-data-unread-p (car arts))))) - (setq arts (cdr arts))) + (not (gnus-data-unread-p (car data))))) + (setq data (cdr data))) (when (setq result (if unread (progn - (while arts - (when (gnus-data-unread-p (car arts)) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) + (while data + (unless (memq (gnus-data-number (car data)) + (cond ((eq gnus-auto-goto-ignores 'always-undownloaded) + gnus-newsgroup-undownloaded) + (gnus-plugged + nil) + ((eq gnus-auto-goto-ignores 'unfetched) + gnus-newsgroup-unfetched) + ((eq gnus-auto-goto-ignores 'undownloaded) + gnus-newsgroup-undownloaded))) + (when (gnus-data-unread-p (car data)) + (setq result (car data) + data nil))) + (setq data (cdr data))) result) - (car arts))) + (car data))) (goto-char (gnus-data-pos result)) (gnus-data-number result)))) @@ -5242,27 +6202,39 @@ 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) - gnus-auto-center-summary - 2)))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - ;; The user has to want it. - (when gnus-auto-center-summary + ;; The user has to want it. + (when gnus-auto-center-summary + (let* ((top (cond ((< (window-height) 4) 0) + ((< (window-height) 7) 1) + (t (if (numberp gnus-auto-center-summary) + gnus-auto-center-summary + 2)))) + (height (1- (window-height))) + (bottom (save-excursion (goto-char (point-max)) + (forward-line (- height)) + (point))) + (window (get-buffer-window (current-buffer)))) (when (get-buffer-window gnus-article-buffer) ;; Only do recentering when the article buffer is displayed, ;; 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))) @@ -5333,13 +6305,13 @@ displayed, no centering will be performed." (marked (gnus-info-marks info)) (active (gnus-active group))) (and info active - (gnus-set-difference - (gnus-sorted-complement - (gnus-uncompress-range active) - (gnus-list-of-unread-articles group)) - (append - (gnus-uncompress-range (cdr (assq 'dormant marked))) - (gnus-uncompress-range (cdr (assq 'tick marked)))))))) + (gnus-list-range-difference + (gnus-list-range-difference + (gnus-sorted-complement + (gnus-uncompress-range active) + (gnus-list-of-unread-articles group)) + (cdr (assq 'dormant marked))) + (cdr (assq 'tick marked)))))) ;; Various summary commands @@ -5375,20 +6347,37 @@ displayed, no centering will be performed." (defun gnus-summary-toggle-truncation (&optional arg) "Toggle truncation of summary lines. -With arg, turn line truncation on iff arg is positive." +With arg, turn line truncation on if arg is positive." (interactive "P") (setq truncate-lines (if (null arg) (not truncate-lines) (> (prefix-numeric-value arg) 0))) (redraw-display)) +(defun gnus-summary-find-for-reselect () + "Return the number of an article to stay on across a reselect. +The current article is considered, then following articles, then previous +articles. An article is sought which is not cancelled and isn't a temporary +insertion from another group. If there's no such then return a dummy 0." + (let (found) + (dolist (rev '(nil t)) + (unless found ; don't demand the reverse list if we don't need it + (let ((data (gnus-data-find-list + (gnus-summary-article-number) (gnus-data-list rev)))) + (while (and data (not found)) + (if (and (< 0 (gnus-data-number (car data))) + (not (eq gnus-canceled-mark (gnus-data-mark (car data))))) + (setq found (gnus-data-number (car data)))) + (setq data (cdr data)))))) + (or found 0))) + (defun gnus-summary-reselect-current-group (&optional all rescan) "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)) + (let ((current-subject (gnus-summary-find-for-reselect)) (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) (gnus-summary-exit) @@ -5416,13 +6405,10 @@ The prefix argument ALL means to select all articles." (when gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed (gnus-compress-sequence - (nconc - (gnus-set-sorted-intersection - (gnus-uncompress-range gnus-newsgroup-killed) - (setq gnus-newsgroup-unselected - (sort gnus-newsgroup-unselected '<))) - (setq gnus-newsgroup-unreads - (sort gnus-newsgroup-unreads '<))) + (gnus-sorted-union + (gnus-list-range-intersection + gnus-newsgroup-unselected gnus-newsgroup-killed) + gnus-newsgroup-unreads) t))) (unless (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) @@ -5432,7 +6418,8 @@ The prefix argument ALL means to select all articles." (set-buffer gnus-group-buffer) (gnus-undo-force-boundary)) (gnus-update-read-articles - group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) + group (gnus-sorted-union + gnus-newsgroup-unreads gnus-newsgroup-unselected)) ;; Set the current article marks. (let ((gnus-newsgroup-scored (if (and (not gnus-save-score) @@ -5468,8 +6455,9 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-async-halt-prefetch) (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) + (gnus-group-is-exiting-p t) (mode major-mode) - (group-point nil) + (group-point nil) (buf (current-buffer))) (unless quit-config ;; Do adaptive scoring, and possibly save score files. @@ -5519,18 +6507,24 @@ If FORCE (the prefix), also save the .newsrc file(s)." (setq gnus-article-current nil)) (set-buffer buf) (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) + (progn + (gnus-deaden-summary) + (setq mode nil)) ;; We set all buffer-local variables to nil. It is unclear why ;; this is needed, but if we don't, buffer-local variables are ;; 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))) @@ -5557,14 +6551,14 @@ If FORCE (the prefix), also save the .newsrc file(s)." "Quit reading current newsgroup without updating read article info." (interactive) (let* ((group gnus-newsgroup-name) + (gnus-group-is-exiting-p t) + (gnus-group-is-exiting-without-update-p t) (quit-config (gnus-group-quit-config group))) (when (or no-questions gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) - (mapcar 'funcall - (delq 'gnus-summary-expire-articles - (copy-sequence gnus-summary-prepare-exit-hook))) + (run-hooks 'gnus-summary-prepare-exit-hook) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5574,10 +6568,13 @@ If FORCE (the prefix), also save the .newsrc file(s)." (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) - (when (get-buffer gnus-summary-buffer) - (kill-buffer gnus-summary-buffer))) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) + (gnus-kill-buffer gnus-summary-buffer)) (unless gnus-single-article-buffer (setq gnus-article-current nil)) (when gnus-use-trees @@ -5589,10 +6586,12 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-configure-windows 'group 'force) ;; Clear the current group name. (setq gnus-newsgroup-name nil) + (unless (gnus-ephemeral-group-p group) + (gnus-group-update-group group)) (when (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (when quit-config - (gnus-handle-ephemeral-exit quit-config))))) + (gnus-handle-ephemeral-exit quit-config))))) (defun gnus-handle-ephemeral-exit (quit-config) "Handle movement when leaving an ephemeral group. @@ -5601,25 +6600,25 @@ The state which existed when entering the ephemeral is reset." (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (cond ((eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - ((eq major-mode 'gnus-article-mode) - (save-excursion - ;; The `gnus-summary-buffer' variable may point - ;; to the old summary buffer when using a single - ;; article buffer. - (unless (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-group-buffer)) - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables)))) + (gnus-set-global-variables)) + ((eq major-mode 'gnus-article-mode) + (save-excursion + ;; The `gnus-summary-buffer' variable may point + ;; to the old summary buffer when using a single + ;; article buffer. + (unless (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-group-buffer)) + (set-buffer gnus-summary-buffer) + (gnus-set-global-variables)))) (if (or (eq (cdr quit-config) 'article) - (eq (cdr quit-config) 'pick)) - (progn - ;; The current article may be from the ephemeral group - ;; thus it is best that we reload this article - (gnus-summary-show-article) - (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) - (gnus-configure-windows 'pick 'force) - (gnus-configure-windows (cdr quit-config) 'force))) + (eq (cdr quit-config) 'pick)) + (progn + ;; The current article may be from the ephemeral group + ;; thus it is best that we reload this article + (gnus-summary-show-article) + (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) + (gnus-configure-windows 'pick 'force) + (gnus-configure-windows (cdr quit-config) 'force))) (gnus-configure-windows (cdr quit-config) 'force)) (when (eq major-mode 'gnus-summary-mode) (gnus-summary-next-subject 1 nil t) @@ -5632,7 +6631,9 @@ The state which existed when entering the ephemeral is reset." (let ((gnus-break-pages nil) (gnus-show-mime t)) (gnus-summary-select-article gnus-show-all-headers t)) - (select-window (get-buffer-window gnus-article-buffer))) + (let ((w (get-buffer-window gnus-article-buffer))) + (when w + (select-window (get-buffer-window gnus-article-buffer))))) ;;; Dead summaries. @@ -5643,10 +6644,11 @@ The state which existed when entering the ephemeral is reset." (suppress-keymap gnus-dead-summary-mode-map) (substitute-key-definition 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) - (let ((keys '("\C-d" "\r" "\177" [delete]))) - (while keys - (define-key gnus-dead-summary-mode-map - (pop keys) 'gnus-summary-wake-up-the-dead)))) + (dolist (key '("\C-d" "\r" "\177" [delete])) + (define-key gnus-dead-summary-mode-map + key 'gnus-summary-wake-up-the-dead)) + (dolist (key '("q" "Q")) + (define-key gnus-dead-summary-mode-map key 'bury-buffer))) (defvar gnus-dead-summary-mode nil "Minor mode for Gnus summary buffers.") @@ -5692,17 +6694,20 @@ The state which existed when entering the ephemeral is reset." (set-buffer buffer) (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer))) - (cond (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (gnus-buffer-exists-p buffer)) - (save-excursion - (set-buffer buffer) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((gnus-buffer-exists-p buffer) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary)))))) + (cond + ;; Kill the buffer. + (gnus-kill-summary-on-exit + (when (and gnus-use-trees + (gnus-buffer-exists-p buffer)) + (save-excursion + (set-buffer buffer) + (gnus-tree-close gnus-newsgroup-name))) + (gnus-kill-buffer buffer)) + ;; Deaden the buffer. + ((gnus-buffer-exists-p buffer) + (save-excursion + (set-buffer buffer) + (gnus-deaden-summary)))))) (defun gnus-summary-wake-up-the-dead (&rest args) "Wake up the dead summary buffer." @@ -5725,7 +6730,7 @@ in." (list (when current-prefix-arg (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) + "FAQ dir: " (and (listp gnus-group-faq-directory) (mapcar (lambda (file) (list file)) gnus-group-faq-directory)))))) (let (gnus-faq-buffer) @@ -5749,7 +6754,7 @@ in." (defun gnus-summary-next-group (&optional no-article target-group backward) "Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected -initially. If NEXT-GROUP, go to this group. If BACKWARD, go to +initially. If TARGET-GROUP, go to this group. If BACKWARD, go to previous group instead." (interactive "P") ;; Stop pre-fetching. @@ -5786,10 +6791,10 @@ previous group instead." (let ((unreads (gnus-group-group-unread))) (if (and (or (eq t unreads) (and unreads (not (zerop unreads)))) - (gnus-summary-read-group - target-group nil no-article - (and (buffer-name current-buffer) current-buffer) - nil backward)) + (gnus-summary-read-group + target-group nil no-article + (and (buffer-name current-buffer) current-buffer) + nil backward)) (setq entered t) (setq current-group target-group target-group nil))))))) @@ -5802,38 +6807,56 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially." ;; Walking around summary lines. -(defun gnus-summary-first-subject (&optional unread undownloaded) - "Go to the first unread subject. -If UNREAD is non-nil, go to the first unread article. -Returns the article selected or nil if there are no unread articles." +(defun gnus-summary-first-subject (&optional unread undownloaded unseen) + "Go to the first subject satisfying any non-nil constraint. +If UNREAD is non-nil, the article should be unread. +If UNDOWNLOADED is non-nil, the article should be undownloaded. +If UNSEED is non-nil, the article should be unseen. +Returns the article selected or nil if there are no matching articles." (interactive "P") - (prog1 - (cond - ;; Empty summary. - ((null gnus-newsgroup-data) - (gnus-message 3 "No articles in the group") - nil) - ;; Pick the first article. - ((not unread) - (goto-char (gnus-data-pos (car gnus-newsgroup-data))) - (gnus-data-number (car gnus-newsgroup-data))) - ;; No unread articles. - ((null gnus-newsgroup-unreads) - (gnus-message 3 "No more unread articles") - nil) - ;; Find the first unread article. - (t - (let ((data gnus-newsgroup-data)) - (while (and data - (and (not (and undownloaded - (eq gnus-undownloaded-mark - (gnus-data-mark (car data))))) - (not (gnus-data-unread-p (car data))))) - (setq data (cdr data))) - (when data - (goto-char (gnus-data-pos (car data))) - (gnus-data-number (car data)))))) - (gnus-summary-position-point))) + (cond + ;; Empty summary. + ((null gnus-newsgroup-data) + (gnus-message 3 "No articles in the group") + nil) + ;; Pick the first article. + ((not (or unread undownloaded unseen)) + (goto-char (gnus-data-pos (car gnus-newsgroup-data))) + (gnus-data-number (car gnus-newsgroup-data))) + ;; Find the first unread article. + (t + (let ((data gnus-newsgroup-data)) + (while (and data + (let ((num (gnus-data-number (car data)))) + (or (memq num gnus-newsgroup-unfetched) + (not (or (and unread + (memq num gnus-newsgroup-unreads)) + (and undownloaded + (memq num gnus-newsgroup-undownloaded)) + (and unseen + (memq num gnus-newsgroup-unseen))))))) + (setq data (cdr data))) + (prog1 + (if data + (progn + (goto-char (gnus-data-pos (car data))) + (gnus-data-number (car data))) + (gnus-message 3 "No more%s articles" + (let* ((r (when unread " unread")) + (d (when undownloaded " undownloaded")) + (s (when unseen " unseen")) + (l (delq nil (list r d s)))) + (cond ((= 3 (length l)) + (concat r "," d ", or" s)) + ((= 2 (length l)) + (concat (car l) ", or" (cadr l))) + ((= 1 (length l)) + (car l)) + (t + "")))) + nil + ) + (gnus-summary-position-point)))))) (defun gnus-summary-next-subject (n &optional unread dont-display) "Go to next N'th summary line. @@ -5874,10 +6897,20 @@ If optional argument UNREAD is non-nil, only unread article is selected." (interactive "p") (gnus-summary-next-subject (- n) t)) +(defun gnus-summary-goto-subjects (articles) + "Insert the subject header for ARTICLES in the current buffer." + (save-excursion + (dolist (article articles) + (gnus-summary-goto-subject article t))) + (gnus-summary-limit (append articles gnus-newsgroup-limit)) + (gnus-summary-position-point)) + (defun gnus-summary-goto-subject (article &optional force silent) "Go the subject line of ARTICLE. If FORCE, also allow jumping to articles not currently shown." (interactive "nArticle number: ") + (unless (numberp article) + (error "Article %s is not a number" article)) (let ((b (point)) (data (gnus-data-find article))) ;; We read in the article if we have to. @@ -5894,7 +6927,9 @@ If FORCE, also allow jumping to articles not currently shown." (unless silent (gnus-message 3 "Can't find article %d" article)) nil) - (goto-char (gnus-data-pos data)) + (let ((pt (gnus-data-pos data))) + (goto-char pt) + (gnus-summary-set-article-display-arrow pt)) (gnus-summary-position-point) article))) @@ -5910,7 +6945,15 @@ 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 + (set-buffer-multibyte t))) (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) + (set-buffer-multibyte t))) (if (null article) nil (prog1 @@ -5963,15 +7006,21 @@ be displayed." ;; 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)) (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 () + "Display buttons for signed/encrypted parts and verify/decrypt them." + (interactive) + (let ((mm-verify-option 'known) + (mm-decrypt-option 'known) + (gnus-buttonized-mime-types (append (list "multipart/signed" + "multipart/encrypted") + gnus-buttonized-mime-types))) + (gnus-summary-select-article nil 'force))) + (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." nil) @@ -6043,7 +7092,7 @@ If BACKWARD, the previous article is selected instead of the next." (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) (?\C-p (gnus-group-prev-unread-group 1)))) (cursor-in-echo-area t) - keve key group ended) + keve key group ended prompt) (save-excursion (set-buffer gnus-group-buffer) (goto-char start) @@ -6052,19 +7101,20 @@ If BACKWARD, the previous article is selected instead of the next." (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) (while (not ended) - (gnus-message - 5 "No more%s articles%s" (if unread " unread" "") - (if (and group - (not (gnus-ephemeral-group-p gnus-newsgroup-name))) - (format " (Type %s for %s [%s])" - (single-key-description cmd) group - (car (gnus-gethash group gnus-newsrc-hashtb))) - (format " (Type %s to exit %s)" - (single-key-description cmd) - gnus-newsgroup-name))) + (setq prompt + (format + "No more%s articles%s " (if unread " unread" "") + (if (and group + (not (gnus-ephemeral-group-p gnus-newsgroup-name))) + (format " (Type %s for %s [%s])" + (single-key-description cmd) group + (car (gnus-gethash group gnus-newsrc-hashtb))) + (format " (Type %s to exit %s)" + (single-key-description cmd) + gnus-newsgroup-name)))) ;; Confirm auto selection. - (setq key (car (setq keve (gnus-read-event-char)))) - (setq ended t) + (setq key (car (setq keve (gnus-read-event-char prompt))) + ended t) (cond ((assq key keystrokes) (let ((obuf (current-buffer))) @@ -6107,14 +7157,16 @@ If UNREAD is non-nil, only unread articles are selected." (and gnus-auto-select-same (gnus-summary-article-subject)))) -(defun gnus-summary-next-page (&optional lines circular) +(defun gnus-summary-next-page (&optional lines circular stop) "Show next page of the selected article. If at the end of the current article, select the next article. LINES says how many lines should be scrolled up. If CIRCULAR is non-nil, go to the start of the article instead of selecting the next article when reaching the end of the current -article." +article. + +If STOP is non-nil, just stop when reaching the end of the message." (interactive "P") (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) @@ -6138,9 +7190,12 @@ article." (gnus-summary-display-article article) (when article-window (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-next-page lines))) + (setq endp (or (gnus-article-next-page lines) + (gnus-article-only-boring-p)))) (when endp - (cond (circular + (cond (stop + (gnus-message 3 "End of message")) + (circular (gnus-summary-beginning-of-article)) (lines (gnus-message 3 "End of message")) @@ -6252,6 +7307,30 @@ Return nil if there are no unread articles." (gnus-summary-first-subject t)) (gnus-summary-position-point))) +(defun gnus-summary-first-unseen-subject () + "Place the point on the subject line of the first unseen article. +Return nil if there are no unseen articles." + (interactive) + (prog1 + (when (gnus-summary-first-subject nil nil t) + (gnus-summary-show-thread) + (gnus-summary-first-subject nil nil t)) + (gnus-summary-position-point))) + +(defun gnus-summary-first-unseen-or-unread-subject () + "Place the point on the subject line of the first unseen article or, +if all article have been seen, on the subject line of the first unread +article." + (interactive) + (prog1 + (unless (when (gnus-summary-first-subject nil nil t) + (gnus-summary-show-thread) + (gnus-summary-first-subject nil nil t)) + (when (gnus-summary-first-subject t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t))) + (gnus-summary-position-point))) + (defun gnus-summary-first-article () "Select the first article. Return nil if there are no articles." @@ -6263,8 +7342,20 @@ Return nil if there are no articles." (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) -(defun gnus-summary-best-unread-article () - "Select the unread article with the highest score." +(defun gnus-summary-best-unread-article (&optional arg) + "Select the unread article with the highest score. +If given a prefix argument, select the next unread article that has a +score higher than the default score." + (interactive "P") + (let ((article (if arg + (gnus-summary-better-unread-subject) + (gnus-summary-best-unread-subject)))) + (if article + (gnus-summary-goto-article article) + (error "No unread articles")))) + +(defun gnus-summary-best-unread-subject () + "Select the unread subject with the highest score." (interactive) (let ((best -1000000) (data gnus-newsgroup-data) @@ -6277,11 +7368,25 @@ Return nil if there are no articles." (setq best score article (gnus-data-number (car data)))) (setq data (cdr data))) - (prog1 - (if article - (gnus-summary-goto-article article) - (error "No unread articles")) - (gnus-summary-position-point)))) + (when article + (gnus-summary-goto-subject article)) + (gnus-summary-position-point) + article)) + +(defun gnus-summary-better-unread-subject () + "Select the first unread subject that has a score over the default score." + (interactive) + (let ((data gnus-newsgroup-data) + article score) + (while (and (setq article (gnus-data-number (car data))) + (or (gnus-data-read-p (car data)) + (not (> (gnus-summary-article-score article) + gnus-summary-default-score)))) + (setq data (cdr data))) + (when article + (gnus-summary-goto-subject article)) + (gnus-summary-position-point) + article)) (defun gnus-summary-last-subject () "Go to the last displayed subject line in the group." @@ -6359,24 +7464,35 @@ If given a prefix, remove all limits." (gnus-summary-limit nil 'pop) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-subject (subject &optional header) - "Limit the summary buffer to articles that have subjects that match a regexp." - (interactive "sLimit to subject (regexp): ") +(defun gnus-summary-limit-to-subject (subject &optional header not-matching) + "Limit the summary buffer to articles that have subjects that match a regexp. +If NOT-MATCHING, excluding articles that have subjects that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude subject (regexp): " + "Limit to subject (regexp): ")) + nil current-prefix-arg)) (unless header (setq header "subject")) (when (not (equal "" subject)) (prog1 (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all))) + (or header "subject") subject 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" subject)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) -(defun gnus-summary-limit-to-author (from) - "Limit the summary buffer to articles that have authors that match a regexp." - (interactive "sLimit to author (regexp): ") - (gnus-summary-limit-to-subject from "from")) +(defun gnus-summary-limit-to-author (from &optional not-matching) + "Limit the summary buffer to articles that have authors that match a regexp. +If NOT-MATCHING, excluding articles that have authors that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude author (regexp): " + "Limit to author (regexp): ")) + current-prefix-arg)) + (gnus-summary-limit-to-subject from "from" not-matching)) (defun gnus-summary-limit-to-age (age &optional younger-p) "Limit the summary buffer to articles that are older than (or equal) AGE days. @@ -6388,12 +7504,18 @@ articles that are younger than AGE days." days) (while (not days-got) (setq days (if younger - (read-string "Limit to articles within (in days): ") - (read-string "Limit to articles older than (in days): "))) + (read-string "Limit to articles younger than (in days, older when negative): ") + (read-string + "Limit to articles older than (in days, younger when negative): "))) (when (> (length days) 0) (setq days (read days))) (if (numberp days) - (setq days-got t) + (progn + (setq days-got t) + (if (< days 0) + (progn + (setq younger (not younger)) + (setq days (* days -1))))) (message "Please enter a number.") (sleep-for 1))) (list days younger))) @@ -6416,30 +7538,48 @@ articles that are younger than AGE days." (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-extra (header regexp) +(defun gnus-summary-limit-to-extra (header regexp &optional not-matching) "Limit the summary buffer to articles that match an 'extra' header." (interactive (let ((header (intern - (gnus-completing-read + (gnus-completing-read-with-default (symbol-name (car gnus-extra-headers)) - "Limit extra header:" + (if current-prefix-arg + "Exclude extra header:" + "Limit extra header:") (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) nil t)))) (list header - (read-string (format "Limit to header %s (regexp): " header))))) + (read-string (format "%s header %s (regexp): " + (if current-prefix-arg "Exclude" "Limit to") + header)) + current-prefix-arg))) (when (not (equal "" regexp)) (prog1 (let ((articles (gnus-summary-find-matching - (cons 'extra header) regexp 'all))) + (cons 'extra header) regexp 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" regexp)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) +(defun gnus-summary-limit-to-display-predicate () + "Limit the summary buffer to the predicated in the `display' group parameter." + (interactive) + (unless gnus-newsgroup-display + (error "There is no `display' group parameter")) + (let (articles) + (dolist (number gnus-newsgroup-articles) + (when (funcall gnus-newsgroup-display) + (push number articles))) + (gnus-summary-limit articles)) + (gnus-summary-position-point)) + (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) @@ -6454,7 +7594,7 @@ If ALL is non-nil, limit strictly to unread articles." ;; Concat all the marks that say that an article is read and have ;; those removed. (list gnus-del-mark gnus-read-mark gnus-ancient-mark - gnus-killed-mark gnus-kill-file-mark + gnus-killed-mark gnus-spam-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark gnus-duplicate-mark gnus-souped-mark) @@ -6462,7 +7602,7 @@ If ALL is non-nil, limit strictly to unread articles." (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) (make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exlude-marks) + 'gnus-summary-limit-exclude-marks) (defun gnus-summary-limit-exclude-marks (marks &optional reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). @@ -6492,12 +7632,9 @@ Returns how many articles were removed." (gnus-summary-limit articles)) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-score (&optional score) +(defun gnus-summary-limit-to-score (score) "Limit to articles with score at or above SCORE." - (interactive "P") - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) + (interactive "NLimit to articles with score of at least: ") (let ((data gnus-newsgroup-data) articles) (while data @@ -6509,15 +7646,45 @@ Returns how many articles were removed." (gnus-summary-limit articles) (gnus-summary-position-point)))) +(defun gnus-summary-limit-to-unseen () + "Limit to unseen articles." + (interactive) + (prog1 + (gnus-summary-limit gnus-newsgroup-unseen) + (gnus-summary-position-point))) + (defun gnus-summary-limit-include-thread (id) - "Display all the hidden articles that in the current thread." + "Display all the hidden articles that is in the thread with ID in it. +When called interactively, ID is the Message-ID of the current +article." (interactive (list (mail-header-id (gnus-summary-article-header)))) (let ((articles (gnus-articles-in-thread (gnus-id-to-thread (gnus-root-id id))))) (prog1 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) + (gnus-summary-limit-include-matching-articles + "subject" + (regexp-quote (gnus-simplify-subject-re + (mail-header-subject (gnus-id-to-header id))))) + (gnus-summary-position-point)))) + +(defun gnus-summary-limit-include-matching-articles (header regexp) + "Display all the hidden articles that have HEADERs that match REGEXP." + (interactive (list (read-string "Match on header: ") + (read-string "Regexp: "))) + (let ((articles (gnus-find-matching-articles header regexp))) + (prog1 + (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) (gnus-summary-position-point)))) +(defun gnus-summary-insert-dormant-articles () + "Insert all the dormat articles for this group into the current buffer." + (interactive) + (let ((gnus-verbose (max 6 gnus-verbose))) + (if (not gnus-newsgroup-dormant) + (gnus-message 3 "No cached articles for this group") + (gnus-summary-goto-subjects gnus-newsgroup-dormant)))) + (defun gnus-summary-limit-include-dormant () "Display all the hidden articles that are marked as dormant. Note that this command only works on a subset of the articles currently @@ -6564,15 +7731,17 @@ fetched for this group." "Mark all unread excluded articles as read. If ALL, mark even excluded ticked and dormants as read." (interactive "P") - (let ((articles (gnus-sorted-complement + (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<)) + (let ((articles (gnus-sorted-ndifference (sort (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers) '<) - (sort gnus-newsgroup-limit '<))) + gnus-newsgroup-limit)) article) (setq gnus-newsgroup-unreads - (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit)) + (gnus-sorted-intersection gnus-newsgroup-unreads + gnus-newsgroup-limit)) (if all (setq gnus-newsgroup-dormant nil gnus-newsgroup-marked nil @@ -6602,9 +7771,7 @@ If ALL, mark even excluded ticked and dormants as read." ;; according to the new limit. (gnus-summary-prepare) ;; Hide any threads, possibly. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) + (gnus-summary-maybe-hide-threads) ;; Try to return to the article you were at, or one in the ;; neighborhood. (when data @@ -6684,6 +7851,7 @@ fetch-old-headers verbiage, and so on." ;; Most groups have nothing to remove. (if (or gnus-inhibit-limiting (and (null gnus-newsgroup-dormant) + (eq gnus-newsgroup-display 'gnus-not-ignore) (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers)) (not (eq gnus-fetch-old-headers 'invisible)) @@ -6723,7 +7891,8 @@ fetch-old-headers verbiage, and so on." ;; will really go down to a leaf article first, before slowly ;; working its way up towards the root. (when thread - (let ((children + (let* ((max-lisp-eval-depth 5000) + (children (if (cdr thread) (apply '+ (mapcar 'gnus-summary-limit-children (cdr thread))) @@ -6772,6 +7941,9 @@ fetch-old-headers verbiage, and so on." (push (cons number gnus-low-score-mark) gnus-newsgroup-reads))) t) + ;; Do the `display' group parameter. + (and gnus-newsgroup-display + (not (funcall gnus-newsgroup-display))) ;; Check NoCeM things. (if (and gnus-use-nocem (gnus-nocem-unwanted-article-p @@ -6875,16 +8047,21 @@ of what's specified by the `gnus-refer-thread-limit' variable." (let ((id (mail-header-id (gnus-summary-article-header))) (limit (if limit (prefix-numeric-value limit) gnus-refer-thread-limit))) - ;; We want to fetch LIMIT *old* headers, but we also have to - ;; re-fetch all the headers in the current buffer, because many of - ;; them may be undisplayed. So we adjust LIMIT. - (when (numberp limit) - (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin))) (unless (eq gnus-fetch-old-headers 'invisible) (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) ;; Retrieve the headers and read them in. - (if (eq (gnus-retrieve-headers - (list gnus-newsgroup-end) gnus-newsgroup-name limit) + (if (eq (if (numberp limit) + (gnus-retrieve-headers + (list (min + (+ (mail-header-number + (gnus-summary-article-header)) + limit) + gnus-newsgroup-end)) + gnus-newsgroup-name (* limit 2)) + ;; gnus-refer-thread-limit is t, i.e. fetch _all_ + ;; headers. + (gnus-retrieve-headers (list gnus-newsgroup-end) + gnus-newsgroup-name limit)) 'nov) (gnus-build-all-threads) (error "Can't fetch thread from backends that don't support NOV")) @@ -6924,15 +8101,16 @@ of what's specified by the `gnus-refer-thread-limit' variable." ;; We fetch the article. (catch 'found (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)) + (when (and (gnus-check-server gnus-override-method) + ;; Fetch the header, + (setq number (gnus-summary-insert-subject message-id))) + ;; and display the article. (gnus-summary-select-article nil nil nil number) (throw 'found t))) (gnus-message 3 "Couldn't fetch article %s" message-id))))))) (defun gnus-refer-article-methods () - "Return a list of referrable methods." + "Return a list of referable methods." (cond ;; No method, so we default to current and native. ((null gnus-refer-article-method) @@ -6990,10 +8168,10 @@ to guess what the document format is." (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 + (when (setq to-address (or (gnus-fetch-field "reply-to") + (gnus-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*")) @@ -7007,21 +8185,24 @@ to guess what the document format is." (delete-matching-lines "^Path:\\|^From ") (widen)) (unwind-protect - (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) + (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) (gnus-newsgroup-ephemeral-ignored-charsets gnus-newsgroup-ignored-charsets)) (gnus-group-read-ephemeral-group name `(nndoc ,name (nndoc-address ,(get-buffer dig)) (nndoc-article-type - ,(if force 'mbox 'guess))) t)) + ,(if force 'mbox 'guess))) + t nil nil nil + `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name + "ADAPT"))))) ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info name)) - params) - ;; Couldn't select this doc group. - (switch-to-buffer buf) - (gnus-set-global-variables) - (gnus-configure-windows 'summary) - (gnus-message 3 "Article couldn't be entered?")) + (nconc (gnus-info-params (gnus-get-info name)) + params) + ;; Couldn't select this doc group. + (switch-to-buffer buf) + (gnus-set-global-variables) + (gnus-configure-windows 'summary) + (gnus-message 3 "Article couldn't be entered?")) (kill-buffer dig))))) (defun gnus-summary-read-document (n) @@ -7102,10 +8283,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." @@ -7209,6 +8394,12 @@ Optional argument BACKWARD means do search for backward. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. (gnus-use-trees nil) ;Inhibit updating tree buffer. + (gnus-visual nil) + (gnus-keep-backlog nil) + (gnus-break-pages nil) + (gnus-summary-display-arrow nil) + (gnus-updated-mode-lines nil) + (gnus-auto-center-summary nil) (sum (current-buffer)) (found nil) point treated) @@ -7288,18 +8479,28 @@ Optional argument BACKWARD means do search for backward. (gnus-summary-position-point) t))) +(defun gnus-find-matching-articles (header regexp) + "Return a list of all articles that match REGEXP on HEADER. +This search includes all articles in the current group that Gnus has +fetched headers for, whether they are displayed or not." + (let ((articles nil) + (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) + (case-fold-search t)) + (dolist (header gnus-newsgroup-headers) + (when (string-match regexp (funcall func header)) + (push (mail-header-number header) articles))) + (nreverse articles))) + (defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold) + not-case-fold not-matching) "Return a list of all articles that match REGEXP on HEADER. The search stars on the current article and goes forwards unless BACKWARD is non-nil. If BACKWARD is `all', do all articles. If UNREAD is non-nil, only unread articles will be taken into consideration. If NOT-CASE-FOLD, case won't be folded -in the comparisons." - (let ((data (if (eq backward 'all) gnus-newsgroup-data - (gnus-data-find-list - (gnus-summary-article-number) (gnus-data-list backward)))) - (case-fold-search (not not-case-fold)) +in the comparisons. If NOT-MATCHING, return a list of all articles that +not match REGEXP on HEADER." + (let ((case-fold-search (not not-case-fold)) articles d func) (if (consp header) (if (eq (car header) 'extra) @@ -7311,14 +8512,21 @@ in the comparisons." (unless (fboundp (intern (concat "mail-header-" header))) (error "%s is not a valid header" header)) (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) - (while data - (setq d (car data)) - (and (or (not unread) ; We want all articles... - (gnus-data-unread-p d)) ; Or just unreads. - (vectorp (gnus-data-header d)) ; It's not a pseudo. - (string-match regexp (funcall func (gnus-data-header d))) ; Match. - (push (gnus-data-number d) articles)) ; Success! - (setq data (cdr data))) + (dolist (d (if (eq backward 'all) + gnus-newsgroup-data + (gnus-data-find-list + (gnus-summary-article-number) + (gnus-data-list backward)))) + (when (and (or (not unread) ; We want all articles... + (gnus-data-unread-p d)) ; Or just unreads. + (vectorp (gnus-data-header d)) ; It's not a pseudo. + (if not-matching + (not (string-match + regexp + (funcall func (gnus-data-header d)))) + (string-match regexp + (funcall func (gnus-data-header d))))) + (push (gnus-data-number d) articles))) ; Success! (nreverse articles))) (defun gnus-summary-execute-command (header regexp command &optional backward) @@ -7345,12 +8553,19 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." ;; We don't want to change current point nor window configuration. (save-excursion (save-window-excursion - (gnus-message 6 "Executing %s..." (key-description command)) - ;; We'd like to execute COMMAND interactively so as to give arguments. - (gnus-execute header regexp - `(call-interactively ',(key-binding command)) - backward) - (gnus-message 6 "Executing %s...done" (key-description command))))) + (let (gnus-visual + gnus-treat-strip-trailing-blank-lines + gnus-treat-strip-leading-blank-lines + gnus-treat-strip-multiple-blank-lines + gnus-treat-hide-boring-headers + gnus-treat-fold-newsgroups + gnus-article-prepare-hook) + (gnus-message 6 "Executing %s..." (key-description command)) + ;; We'd like to execute COMMAND interactively so as to give arguments. + (gnus-execute header regexp + `(call-interactively ',(key-binding command)) + backward) + (gnus-message 6 "Executing %s...done" (key-description command)))))) (defun gnus-summary-beginning-of-article () "Scroll the article back to the beginning." @@ -7375,6 +8590,13 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (when gnus-page-broken (gnus-narrow-to-page)))) +(defun gnus-summary-print-truncate-and-quote (string &optional len) + "Truncate to LEN and quote all \"(\"'s in STRING." + (gnus-replace-in-string (if (and len (> (length string) len)) + (substring string 0 len) + string) + "[()]" "\\\\\\&")) + (defun gnus-summary-print-article (&optional filename n) "Generate and print a PostScript image of the N next (mail) articles. @@ -7385,59 +8607,89 @@ If the optional first argument FILENAME is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." - (interactive (list (ps-print-preprint current-prefix-arg) - current-prefix-arg)) + (interactive (list (ps-print-preprint current-prefix-arg))) (dolist (article (gnus-summary-work-articles n)) (gnus-summary-select-article nil nil 'pseudo article) (gnus-eval-in-buffer-window gnus-article-buffer - (let ((buffer (generate-new-buffer " *print*"))) - (unwind-protect - (progn - (copy-to-buffer buffer (point-min) (point-max)) - (set-buffer buffer) - (gnus-article-delete-invisible-text) - (let ((ps-left-header - (list - (concat "(" - (mail-header-subject gnus-current-headers) ")") - (concat "(" - (mail-header-from gnus-current-headers) ")"))) - (ps-right-header - (list - "/pagenumberstring load" - (concat "(" - (mail-header-date gnus-current-headers) ")")))) - (gnus-run-hooks 'gnus-ps-print-hook) - (save-excursion - (ps-print-buffer-with-faces filename)))) - (kill-buffer buffer)))))) + (gnus-print-buffer)) + (gnus-summary-remove-process-mark article)) + (ps-despool filename)) + +(defun gnus-print-buffer () + (let ((buffer (generate-new-buffer " *print*"))) + (unwind-protect + (progn + (copy-to-buffer buffer (point-min) (point-max)) + (set-buffer buffer) + (gnus-article-delete-invisible-text) + (gnus-remove-text-with-property 'gnus-decoration) + (when (gnus-visual-p 'article-highlight 'highlight) + ;; Copy-to-buffer doesn't copy overlay. So redo + ;; highlight. + (let ((gnus-article-buffer buffer)) + (gnus-article-highlight-citation t) + (gnus-article-highlight-signature))) + (let ((ps-left-header + (list + (concat "(" + (gnus-summary-print-truncate-and-quote + (mail-header-subject gnus-current-headers) + 66) ")") + (concat "(" + (gnus-summary-print-truncate-and-quote + (mail-header-from gnus-current-headers) + 45) ")"))) + (ps-right-header + (list + "/pagenumberstring load" + (concat "(" + (mail-header-date gnus-current-headers) ")")))) + (gnus-run-hooks 'gnus-ps-print-hook) + (save-excursion + (if window-system + (ps-spool-buffer-with-faces) + (ps-spool-buffer))))) + (kill-buffer buffer)))) (defun gnus-summary-show-article (&optional arg) - "Force re-fetching of the current article. + "Force redisplaying of the current article. 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. +input. If ARG (the prefix) is non-nil and not a number, show the raw article -without any article massaging functions being run." +without any article massaging functions being run. Normally, the key +strokes are `C-u g'." (interactive "P") (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-show-article t) + (let* ((gnus-newsgroup-charset + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) + (mm-read-coding-system + "View as charset: " ;; actually it is coding system. + (save-excursion + (set-buffer gnus-article-buffer) + (mm-detect-coding-region (point) (point-max)))))) + (default-mime-charset gnus-newsgroup-charset) + (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) (let ((deps gnus-newsgroup-dependencies) - head header) + head header lines) (save-excursion (set-buffer gnus-original-article-buffer) (save-restriction (message-narrow-to-head) - (setq head (buffer-string))) + (setq head (buffer-string)) + (goto-char (point-min)) + (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t) + (goto-char (point-max)) + (widen) + (setq lines (1- (count-lines (point) (point-max)))))) (with-temp-buffer (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) + (if lines (insert (format "Lines: %d\n" lines))) (insert ".\n") (let ((nntp-server-buffer (current-buffer))) (setq header (car (gnus-get-newsgroup-headers deps t)))))) @@ -7445,7 +8697,9 @@ without any article massaging functions being run." (gnus-data-find (cdr gnus-article-current)) header) (gnus-summary-update-article-line - (cdr gnus-article-current) header)))) + (cdr gnus-article-current) header) + (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark (cdr gnus-article-current)))))) ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) @@ -7465,6 +8719,11 @@ without any article massaging functions being run." (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) +(defun gnus-summary-show-raw-article () + "Show the raw article without any article massaging functions being run." + (interactive) + (gnus-summary-show-article t)) + (defun gnus-summary-verbose-headers (&optional arg) "Toggle permanent full header display. If ARG is a positive number, turn header display on. @@ -7483,43 +8742,44 @@ If ARG is a negative number, turn header display off." If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines." (interactive "P") - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction + (let ((window (and (gnus-buffer-live-p gnus-article-buffer) + (get-buffer-window gnus-article-buffer t)))) + (with-current-buffer gnus-article-buffer + (widen) + (article-narrow-to-head) (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) - hidden e) - (setq hidden - (if (numberp arg) - (>= arg 0) - (save-restriction - (article-narrow-to-head) - (gnus-article-hidden-text-p 'headers)))) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (1- (point)))) - (goto-char (point-min)) - (save-excursion - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) - (insert-buffer-substring gnus-original-article-buffer 1 e) - (save-restriction - (narrow-to-region (point-min) (point)) - (article-decode-encoded-words) - (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))) + (hidden (if (numberp arg) + (>= arg 0) + (gnus-article-hidden-text-p 'headers))) + s e) + (delete-region (point-min) (point-max)) + (with-current-buffer gnus-original-article-buffer + (goto-char (setq s (point-min))) + (setq e (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max)))) + (insert-buffer-substring gnus-original-article-buffer s e) + (run-hooks 'gnus-article-decode-hook) + (if hidden + (let ((gnus-treat-hide-headers nil) + (gnus-treat-hide-boring-headers nil)) + (gnus-delete-wash-type 'headers) + (gnus-treat-article 'head)) + (gnus-treat-article 'head)) + (widen) + (if window + (set-window-start window (goto-char (point-min)))) + (setq gnus-page-broken + (when gnus-break-pages + (gnus-narrow-to-page) + t)) (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." (interactive) - (gnus-article-show-all-headers)) + (gnus-summary-toggle-header 1)) (defun gnus-summary-toggle-mime (&optional arg) "Toggle MIME processing. @@ -7546,6 +8806,31 @@ forward." (message-caesar-buffer-body arg) (set-window-start (get-buffer-window (current-buffer)) start)))))) +(autoload 'unmorse-region "morse" + "Convert morse coded text in region to ordinary ASCII text." + t) + +(defun gnus-summary-morse-message (&optional arg) + "Morse decode the current article." + (interactive "P") + (gnus-summary-select-article) + (let ((mail-header-separator "")) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (let ((pos (window-start)) + buffer-read-only) + (goto-char (point-min)) + (when (message-goto-body) + (gnus-narrow-to-body)) + (goto-char (point-min)) + (while (re-search-forward "·" (point-max) t) + (replace-match ".")) + (unmorse-region (point-min) (point-max)) + (widen) + (set-window-start (get-buffer-window (current-buffer)) pos))))))) + (defun gnus-summary-stop-page-breaking () "Stop page breaking in the current article." (interactive) @@ -7569,6 +8854,10 @@ If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method. +When called interactively with TO-NEWSGROUP being nil, the value of +the variable `gnus-move-split-methods' is used for finding a default +for the target newsgroup. + 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. @@ -7577,10 +8866,6 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (interactive "P") (unless action (setq action 'move)) - ;; Disable marking as read. - (let (gnus-mark-article-hook) - (save-window-excursion - (gnus-summary-select-article))) ;; Check whether the source group supports the required functions. (cond ((and (eq action 'move) (not (gnus-check-backend-function @@ -7592,7 +8877,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) (prefix (if (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name) + 'request-move-article gnus-newsgroup-name) (gnus-group-real-prefix gnus-newsgroup-name) "")) (names '((move "Move" "Moving") @@ -7609,6 +8894,18 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; Read the newsgroup name. (when (and (not to-newsgroup) (not select-method)) + (if (and gnus-move-split-methods + (not + (and (memq gnus-current-article articles) + (gnus-buffer-live-p gnus-original-article-buffer)))) + ;; When `gnus-move-split-methods' is non-nil, we have to + ;; select an article to give `gnus-read-move-group-name' an + ;; opportunity to suggest an appropriate default. However, + ;; we needn't render or mark the article. + (let ((gnus-display-mime-function nil) + (gnus-article-prepare-hook nil) + (gnus-mark-article-hook nil)) + (gnus-summary-select-article nil nil nil (car articles)))) (setq to-newsgroup (gnus-read-move-group-name (cadr (assq action names)) @@ -7658,7 +8955,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (mail-header-xref (gnus-summary-article-header article)) " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) - ":" article)) + ":" (number-to-string article))) (unless xref (setq xref (list (system-name)))) (setq new-xref @@ -7675,7 +8972,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-request-accept-article to-newsgroup select-method (not articles)))) (setq new-xref (concat new-xref " " (car art-group) - ":" (cdr art-group))) + ":" + (number-to-string (cdr art-group)))) ;; Now we have the new Xrefs header, so we insert ;; it and replace the new article. (nnheader-replace-header "Xref" new-xref) @@ -7690,14 +8988,21 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ((eq art-group 'junk) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article))) + (gnus-message 4 "Deleted article %s" article) + ;; run the delete hook + (run-hook-with-args 'gnus-summary-article-delete-hook + action + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name nil + select-method))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) (entry (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) - (to-group (gnus-info-group info)) + (to-group (gnus-info-group info)) to-marks) ;; Update the group that has been moved to. (when (and info @@ -7740,26 +9045,26 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (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)) + (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (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-request-set-mark + to-group (list (list (list to-article) 'add to-marks)))) (gnus-dribble-enter (concat "(gnus-group-set-info '" @@ -7774,22 +9079,29 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-request-article-this-buffer article gnus-newsgroup-name) (nnheader-replace-header "Xref" new-xref) (gnus-request-replace-article - article gnus-newsgroup-name (current-buffer))))) + article gnus-newsgroup-name (current-buffer)))) + + ;; run the move/copy/crosspost/respool hook + (run-hook-with-args 'gnus-summary-article-move-hook + action + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + to-newsgroup + select-method)) ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) (gnus-summary-remove-process-mark article)) ;; Re-activate all groups that have been moved to. - (while to-groups - (save-excursion - (set-buffer gnus-group-buffer) - (when (gnus-group-goto-group (car to-groups) t) - (gnus-group-get-new-news-this-group 1 t)) - (pop to-groups))) + (save-excursion + (set-buffer gnus-group-buffer) + (let ((gnus-group-marked to-groups)) + (gnus-group-get-new-news-this-group nil t))) (gnus-kill-buffer copy-buf) (gnus-summary-position-point) @@ -7798,6 +9110,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. +When called interactively, if TO-NEWSGROUP is nil, use the value of +the variable `gnus-move-split-methods' for finding a default target +newsgroup. If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method." (interactive "P") @@ -7809,12 +9124,20 @@ re-spool using this method." (gnus-summary-move-article n nil nil 'crosspost)) (defcustom gnus-summary-respool-default-method nil - "Default method for respooling an article. + "Default method type for respooling an article. If nil, use to the current newsgroup method." - :type '(choice (gnus-select-method :value (nnml "")) - (const nil)) + :type 'symbol :group 'gnus-summary-mail) +(defcustom gnus-summary-display-while-building nil + "If non-nil, show and update the summary buffer as it's being built. +If the value is t, update the buffer after every line is inserted. If +the value is an integer (N), update the display every N lines." + :group 'gnus-thread + :type '(choice (const :tag "off" nil) + number + (const :tag "frequently" t))) + (defun gnus-summary-respool-article (&optional n method) "Respool the current article. The article will be squeezed through the mail spooling process again, @@ -7837,7 +9160,7 @@ latter case, they will be copied into the relevant groups." (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method - (gnus-completing-read + (gnus-completing-read-with-default methname "What backend do you want to use when respooling?" methods nil t nil 'gnus-mail-method-history)) ms) @@ -7859,12 +9182,12 @@ latter case, they will be copied into the relevant groups." (gnus-summary-move-article n nil method) (gnus-summary-copy-article n nil method))) -(defun gnus-summary-import-article (file) +(defun gnus-summary-import-article (file &optional edit) "Import an arbitrary file into a mail newsgroup." - (interactive "fImport file: ") + (interactive "fImport file: \nP") (let ((group gnus-newsgroup-name) (now (current-time)) - atts lines) + atts lines group-art) (unless (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) (or (file-readable-p file) @@ -7875,19 +9198,55 @@ latter case, they will be copied into the relevant groups." (erase-buffer) (nnheader-insert-file-contents file) (goto-char (point-min)) - (unless (nnheader-article-p) + (if (nnheader-article-p) + (save-restriction + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (narrow-to-region (point-min) (1- (point))) + (goto-char (point-min)) + (unless (re-search-forward "^date:" nil t) + (goto-char (point-max)) + (insert "Date: " (message-make-date (nth 5 atts)) "\n"))) ;; This doesn't look like an article, so we fudge some headers. (setq atts (file-attributes file) lines (count-lines (point-min) (point-max))) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" - "Date: " (message-make-date (nth 5 atts)) - "\n" + "Date: " (message-make-date (nth 5 atts)) "\n" "Message-ID: " (message-make-message-id) "\n" "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) - (gnus-request-accept-article group nil t) - (kill-buffer (current-buffer))))) + (setq group-art (gnus-request-accept-article group nil t)) + (kill-buffer (current-buffer))) + (setq gnus-newsgroup-active (gnus-activate-group group)) + (forward-line 1) + (gnus-summary-goto-article (cdr group-art) nil t) + (when edit + (gnus-summary-edit-article)))) + +(defun gnus-summary-create-article () + "Create an article in a mail newsgroup." + (interactive) + (let ((group gnus-newsgroup-name) + (now (current-time)) + group-art) + (unless (gnus-check-backend-function 'request-accept-article group) + (error "%s does not support article importing" group)) + (save-excursion + (set-buffer (gnus-get-buffer-create " *import file*")) + (erase-buffer) + (goto-char (point-min)) + ;; This doesn't look like an article, so we fudge some headers. + (insert "From: " (read-string "From: ") "\n" + "Subject: " (read-string "Subject: ") "\n" + "Date: " (message-make-date now) "\n" + "Message-ID: " (message-make-message-id) "\n") + (setq group-art (gnus-request-accept-article group nil t)) + (kill-buffer (current-buffer))) + (setq gnus-newsgroup-active (gnus-activate-group group)) + (forward-line 1) + (gnus-summary-goto-article (cdr group-art) nil t) + (gnus-summary-edit-article))) (defun gnus-summary-article-posted-p () "Say whether the current (mail) article is available from news as well. @@ -7905,8 +9264,9 @@ This will be the case if the article has both been mailed and posted." (defun gnus-summary-expire-articles (&optional now) "Expire all articles that are marked as expirable in the current group." (interactive) - (when (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name) + (when (and (not gnus-group-is-exiting-without-update-p) + (gnus-check-backend-function + 'request-expire-articles gnus-newsgroup-name)) ;; This backend supports expiry. (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) (expirable (if total @@ -7947,12 +9307,17 @@ This will be the case if the article has both been mailed and posted." ;; 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)))))) + (dolist (article expirable) + (when (and (not (memq article es)) + (gnus-data-find article)) + (gnus-summary-mark-article article gnus-canceled-mark) + (run-hook-with-args 'gnus-summary-article-expire-hook + 'delete + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + nil + nil)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -7972,9 +9337,13 @@ deleted forever, right now." This command actually deletes articles. This is not a marking command. The article will disappear forever from your life, never to return. + If N is negative, delete backwards. If N is nil and articles have been marked with the process mark, -delete these instead." +delete these instead. + +If `gnus-novice-user' is non-nil you will be asked for +confirmation before the articles are deleted." (interactive "P") (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) @@ -7983,6 +9352,7 @@ delete these instead." (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) + (nnmail-expiry-target 'delete) not-deleted) (if (and gnus-novice-user (not (gnus-yes-or-no-p @@ -8000,6 +9370,12 @@ delete these instead." ;; after all. (unless (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) + (let* ((article (car articles)) + (id (mail-header-id (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (run-hook-with-args 'gnus-summary-article-delete-hook + 'delete id gnus-newsgroup-name nil + nil)) (setq articles (cdr articles))) (when not-deleted (gnus-message 4 "Couldn't delete articles %s" not-deleted))) @@ -8064,11 +9440,11 @@ groups." (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) - (current-buffer) t))) + (current-buffer) t))) (error "Couldn't replace article") ;; Update the summary buffer. (if (and references @@ -8088,20 +9464,24 @@ groups." (insert ".\n") (let ((nntp-server-buffer (current-buffer))) (setq header (car (gnus-get-newsgroup-headers - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies) - t)))) + nil t)))) (save-excursion (set-buffer gnus-summary-buffer) (gnus-data-set-header (gnus-data-find (cdr gnus-article-current)) header) (gnus-summary-update-article-line - (cdr gnus-article-current) header)))))) + (cdr gnus-article-current) header) + (if (gnus-summary-goto-subject + (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark + (cdr gnus-article-current)))))))) ;; Update threads. (set-buffer (or buffer gnus-summary-buffer)) - (gnus-summary-update-article (cdr gnus-article-current))) + (gnus-summary-update-article (cdr gnus-article-current)) + (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark + (cdr gnus-article-current)))) ;; Prettify the article buffer again. (unless no-highlight (save-excursion @@ -8227,28 +9607,31 @@ If optional argument UNMARK is negative, mark articles as unread instead." If N is negative, mark backward instead. If UNMARK is non-nil, remove the process mark instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and - (> n 0) - (if unmark - (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more articles")) - (gnus-summary-recenter) - (gnus-summary-position-point) - n)) + (interactive "P") + (if (and (null n) (gnus-region-active-p)) + (gnus-uu-mark-region (region-beginning) (region-end) unmark) + (setq n (prefix-numeric-value n)) + (let ((backward (< n 0)) + (n (abs n))) + (while (and + (> n 0) + (if unmark + (gnus-summary-remove-process-mark + (gnus-summary-article-number)) + (gnus-summary-set-process-mark (gnus-summary-article-number))) + (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) + (setq n (1- n))) + (when (/= 0 n) + (gnus-message 7 "No more articles")) + (gnus-summary-recenter) + (gnus-summary-position-point) + n))) (defun gnus-summary-unmark-as-processable (n) "Remove the process mark from the next N articles. If N is negative, unmark backward instead. The difference between N and the actual number of articles unmarked is returned." - (interactive "p") + (interactive "P") (gnus-summary-mark-as-processable n t)) (defun gnus-summary-unmark-all-processable () @@ -8259,6 +9642,20 @@ the actual number of articles unmarked is returned." (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) (gnus-summary-position-point)) +(defun gnus-summary-add-mark (article type) + "Mark ARTICLE with a mark of TYPE." + (let ((vtype (car (assq type gnus-article-mark-lists))) + var) + (if (not vtype) + (error "No such mark type: %s" type) + (setq var (intern (format "gnus-newsgroup-%s" type))) + (set var (cons article (symbol-value var))) + (if (memq type '(processable cached replied forwarded recent saved)) + (gnus-summary-update-secondary-mark article) + ;;; !!! This is bogus. We should find out what primary + ;;; !!! mark we want to set. + (gnus-summary-update-mark gnus-del-mark 'unread))))) + (defun gnus-summary-mark-as-expirable (n) "Mark N articles forward as expirable. If N is negative, mark backward instead. The difference between N and @@ -8266,12 +9663,35 @@ the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-expirable-mark)) +(defun gnus-summary-mark-as-spam (n) + "Mark N articles forward as spam. +If N is negative, mark backward instead. The difference between N and +the actual number of articles marked is returned." + (interactive "p") + (gnus-summary-mark-forward n gnus-spam-mark)) + (defun gnus-summary-mark-article-as-replied (article) - "Mark ARTICLE replied and update the summary line." - (push article gnus-newsgroup-replied) - (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-secondary-mark article)))) + "Mark ARTICLE as replied to and update the summary line. +ARTICLE can also be a list of articles." + (interactive (list (gnus-summary-article-number))) + (let ((articles (if (listp article) article (list article)))) + (dolist (article articles) + (unless (numberp article) + (error "%s is not a number" article)) + (push article gnus-newsgroup-replied) + (let ((buffer-read-only nil)) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-secondary-mark article)))))) + +(defun gnus-summary-mark-article-as-forwarded (article) + "Mark ARTICLE as forwarded and update the summary line. +ARTICLE can also be a list of articles." + (let ((articles (if (listp article) article (list article)))) + (dolist (article articles) + (push article gnus-newsgroup-forwarded) + (let ((buffer-read-only nil)) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-secondary-mark article)))))) (defun gnus-summary-set-bookmark (article) "Set a bookmark in current article." @@ -8282,10 +9702,7 @@ the actual number of articles marked is returned." (not (equal gnus-newsgroup-name (car gnus-article-current)))) (error "No current article selected")) ;; Remove old bookmark, if one exists. - (let ((old (assq article gnus-newsgroup-bookmarks))) - (when old - (setq gnus-newsgroup-bookmarks - (delq old gnus-newsgroup-bookmarks)))) + (gnus-pull article gnus-newsgroup-bookmarks) ;; Set the new bookmark, which is on the form ;; (article-number . line-number-in-body). (push @@ -8295,8 +9712,7 @@ the actual number of articles marked is returned." (count-lines (min (point) (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (point))) (point)))) gnus-newsgroup-bookmarks) @@ -8306,13 +9722,10 @@ the actual number of articles marked is returned." "Remove the bookmark from the current article." (interactive (list (gnus-summary-article-number))) ;; Remove old bookmark, if one exists. - (let ((old (assq article gnus-newsgroup-bookmarks))) - (if old - (progn - (setq gnus-newsgroup-bookmarks - (delq old gnus-newsgroup-bookmarks)) - (gnus-message 6 "Removed bookmark.")) - (gnus-message 6 "No bookmark in current article.")))) + (if (not (assq article gnus-newsgroup-bookmarks)) + (gnus-message 6 "No bookmark in current article.") + (gnus-pull article gnus-newsgroup-bookmarks) + (gnus-message 6 "Removed bookmark."))) ;; Suggested by Daniel Quinlan . (defun gnus-summary-mark-as-dormant (n) @@ -8351,14 +9764,14 @@ the actual number of articles marked is returned." 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. -Iff NO-EXPIRE, auto-expiry will be inhibited." +If NO-EXPIRE, auto-expiry will be inhibited." (interactive "p") (gnus-summary-show-thread) (let ((backward (< n 0)) (gnus-summary-goto-unread (and gnus-summary-goto-unread (not (eq gnus-summary-goto-unread 'never)) - (not (memq mark (list gnus-unread-mark + (not (memq mark (list gnus-unread-mark gnus-spam-mark gnus-ticked-mark gnus-dormant-mark))))) (n (abs n)) (mark (or mark gnus-del-mark))) @@ -8382,6 +9795,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (let ((article (gnus-summary-article-number))) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -8413,15 +9827,27 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked + (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) + (setq gnus-newsgroup-marked + (gnus-add-to-sorted-list gnus-newsgroup-marked + article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked + article))) ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-dormant + (gnus-add-to-sorted-list gnus-newsgroup-dormant + article))) (t - (push article gnus-newsgroup-unreads))) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + article)))) (gnus-pull article gnus-newsgroup-reads) ;; See whether the article is to be put in the cache. @@ -8445,7 +9871,7 @@ Four MARK strings are reserved: `? ' (unread), `?!' (ticked), 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. -Iff NO-EXPIRE, auto-expiry will be inhibited." +If NO-EXPIRE, auto-expiry will be inhibited." ;; The mark might be a string. (when (stringp mark) (setq mark (aref mark 0))) @@ -8454,7 +9880,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (setq mark gnus-del-mark)) (when (and (not no-expire) gnus-newsgroup-auto-expire - (memq mark gnus-auto-expirable-marks)) + (memq mark gnus-auto-expirable-marks)) (setq mark gnus-expirable-mark)) (let ((article (or article (gnus-summary-article-number))) (old-mark (gnus-summary-article-mark article))) @@ -8466,6 +9892,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (error "No article on current line")) (if (not (if (or (= mark gnus-unread-mark) (= mark gnus-ticked-mark) + (= mark gnus-spam-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) (gnus-mark-article-as-read article mark))) @@ -8497,17 +9924,36 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." gnus-cached-mark) ((memq article gnus-newsgroup-replied) gnus-replied-mark) + ((memq article gnus-newsgroup-forwarded) + gnus-forwarded-mark) ((memq article gnus-newsgroup-saved) gnus-saved-mark) - (t gnus-unread-mark)) + ((memq article gnus-newsgroup-recent) + gnus-recent-mark) + ((memq article gnus-newsgroup-unseen) + gnus-unseen-mark) + (t gnus-no-mark)) 'replied) (when (gnus-visual-p 'summary-highlight 'highlight) (gnus-run-hooks 'gnus-summary-update-hook)) t) +(defun gnus-summary-update-download-mark (article) + "Update the download mark." + (gnus-summary-update-mark + (cond ((memq article gnus-newsgroup-undownloaded) + gnus-undownloaded-mark) + (gnus-newsgroup-agentized + gnus-downloaded-mark) + (t + gnus-no-mark)) + 'download) + (gnus-summary-update-line t) + t) + (defun gnus-summary-update-mark (mark type) (let ((forward (cdr (assq type gnus-summary-mark-positions))) - (buffer-read-only nil)) + (buffer-read-only nil)) (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) (when forward (when (looking-at "\r") @@ -8527,12 +9973,14 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." "Enter ARTICLE in the pertinent lists and remove it from others." ;; Make the article expirable. (let ((mark (or mark gnus-del-mark))) - (if (= mark gnus-expirable-mark) - (push article gnus-newsgroup-expirable) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) + (setq gnus-newsgroup-expirable + (if (= mark gnus-expirable-mark) + (gnus-add-to-sorted-list gnus-newsgroup-expirable article) + (delq article gnus-newsgroup-expirable))) ;; Remove from unread and marked lists. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -8548,6 +9996,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) + gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked) gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) @@ -8557,11 +10006,18 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-dup-unsuppress-article article)) (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) + (setq gnus-newsgroup-marked + (gnus-add-to-sorted-list gnus-newsgroup-marked article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked + article))) ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-dormant + (gnus-add-to-sorted-list gnus-newsgroup-dormant article))) (t - (push article gnus-newsgroup-unreads))) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads article)))) (gnus-pull article gnus-newsgroup-reads) t))) @@ -8636,12 +10092,18 @@ The difference between N and the number of marks cleared is returned." (when (memq gnus-current-article gnus-newsgroup-unreads) (gnus-summary-mark-article gnus-current-article gnus-read-mark))) -(defun gnus-summary-mark-read-and-unread-as-read () +(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark) "Intended to be used by `gnus-summary-mark-article-hook'." (let ((mark (gnus-summary-article-mark))) (when (or (gnus-unread-mark-p mark) (gnus-read-mark-p mark)) - (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) + (gnus-summary-mark-article gnus-current-article + (or new-mark gnus-read-mark))))) + +(defun gnus-summary-mark-unread-as-ticked () + "Intended to be used by `gnus-summary-mark-article-hook'." + (when (memq gnus-current-article gnus-newsgroup-unreads) + (gnus-summary-mark-article gnus-current-article gnus-ticked-mark))) (defun gnus-summary-mark-region-as-read (point mark all) "Mark all unread articles between point and mark as read. @@ -8716,8 +10178,8 @@ even ticked and dormant ones." (let ((scored gnus-newsgroup-scored) headers h) (while scored - (unless (gnus-summary-goto-subject (caar scored)) - (and (setq h (gnus-summary-article-header (caar scored))) + (unless (gnus-summary-article-header (caar scored)) + (and (setq h (gnus-number-to-header (caar scored))) (< (cdar scored) gnus-summary-expunge-below) (push h headers))) (setq scored (cdr scored))) @@ -8725,18 +10187,23 @@ even ticked and dormant ones." (when (not no-error) (error "No expunged articles hidden")) (goto-char (point-min)) + (push gnus-newsgroup-limit gnus-newsgroup-limits) + (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit)) + (mapcar (lambda (x) (push (mail-header-number x) + gnus-newsgroup-limit)) + headers) (gnus-summary-prepare-unthreaded (nreverse headers)) (goto-char (point-min)) (gnus-summary-position-point) t)))) -(defun gnus-summary-catchup (&optional all quietly to-here not-mark) +(defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse) "Mark all unread articles in this newsgroup as read. If prefix argument ALL is non-nil, ticked and dormant articles will also be marked as read. If QUIETLY is non-nil, no questions will be asked. If TO-HERE is non-nil, it should be a point in the buffer. All -articles before this point will be marked as read. +articles before (after, if REVERSE is set) this point will be marked as read. Note that this function will only catch up the unread article in the current summary buffer limitation. The number of articles marked as read is returned." @@ -8759,16 +10226,27 @@ The number of articles marked as read is returned." (progn (when all (setq gnus-newsgroup-marked nil + gnus-newsgroup-spam-marked nil gnus-newsgroup-dormant nil)) - (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable)) + (setq gnus-newsgroup-unreads + (gnus-sorted-nunion + (gnus-intersection gnus-newsgroup-unreads + gnus-newsgroup-downloadable) + gnus-newsgroup-unfetched))) ;; We actually mark all articles as canceled, which we ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) - (when (gnus-summary-first-subject (not all) t) - (while (and - (if to-here (< (point) to-here) t) - (gnus-summary-mark-article-as-read gnus-catchup-mark) - (gnus-summary-find-next (not all) nil nil t)))) + (if (and to-here reverse) + (progn + (goto-char to-here) + (gnus-summary-mark-read-and-unread-as-read gnus-catchup-mark) + (while (gnus-summary-find-next (not all)) + (gnus-summary-mark-article-as-read gnus-catchup-mark))) + (when (gnus-summary-first-subject (not all)) + (while (and + (if to-here (< (point) to-here) t) + (gnus-summary-mark-article-as-read gnus-catchup-mark) + (gnus-summary-find-next (not all)))))) (gnus-set-mode-line 'summary)) t)) (gnus-summary-position-point))) @@ -8785,14 +10263,29 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (gnus-summary-catchup all t beg))))) (gnus-summary-position-point)) +(defun gnus-summary-catchup-from-here (&optional all) + "Mark all unticked articles after (and including) the current one as read. +If ALL is non-nil, also mark ticked and dormant articles as read." + (interactive "P") + (save-excursion + (gnus-save-hidden-threads + (let ((beg (point))) + ;; We check that there are unread articles. + (when (or all (gnus-summary-find-next)) + (gnus-summary-catchup all t beg nil t))))) + (gnus-summary-position-point)) + (defun gnus-summary-catchup-all (&optional quietly) - "Mark all articles in this newsgroup as read." + "Mark all articles in this newsgroup as read. +This command is dangerous. Normally, you want \\[gnus-summary-catchup] +instead, which marks only unread articles as read." (interactive "P") (gnus-summary-catchup t quietly)) (defun gnus-summary-catchup-and-exit (&optional all quietly) "Mark all unread articles in this group as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read." +If prefix argument ALL is non-nil, all articles are marked as read. +If QUIETLY is non-nil, no questions will be asked." (interactive "P") (when (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. @@ -8802,7 +10295,9 @@ If prefix argument ALL is non-nil, all articles are marked as read." (gnus-summary-exit)))) (defun gnus-summary-catchup-all-and-exit (&optional quietly) - "Mark all articles in this newsgroup as read, and then exit." + "Mark all articles in this newsgroup as read, and then exit. +This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit] +instead, which marks only unread articles as read." (interactive "P") (gnus-summary-catchup-and-exit t quietly)) @@ -8937,6 +10432,8 @@ is non-nil or the Subject: of both articles are the same." (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) + (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark (cdr gnus-article-current))) (gnus-summary-rethread-current) (gnus-message 3 "Article %d is now the child of article %d" current-article parent-article))))) @@ -8968,8 +10465,8 @@ Returns nil if no thread was there to be shown." (interactive) (let ((buffer-read-only nil) (orig (point)) - ;; first goto end then to beg, to have point at beg after let - (end (progn (end-of-line) (point))) + (end (gnus-point-at-eol)) + ;; Leave point at bol (beg (progn (beginning-of-line) (point)))) (prog1 ;; Any hidden lines here? @@ -8978,18 +10475,49 @@ Returns nil if no thread was there to be shown." (goto-char orig) (gnus-summary-position-point)))) -(defun gnus-summary-hide-all-threads () - "Hide all thread subtrees." +(defun gnus-summary-maybe-hide-threads () + "If requested, hide the threads that should be hidden." + (when (and gnus-show-threads + gnus-thread-hide-subtree) + (gnus-summary-hide-all-threads + (if (or (consp gnus-thread-hide-subtree) + (functionp gnus-thread-hide-subtree)) + (gnus-make-predicate gnus-thread-hide-subtree) + nil)))) + +;;; Hiding predicates. + +(defun gnus-article-unread-p (header) + (memq (mail-header-number header) gnus-newsgroup-unreads)) + +(defun gnus-article-unseen-p (header) + (memq (mail-header-number header) gnus-newsgroup-unseen)) + +(defun gnus-map-articles (predicate articles) + "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil." + (apply 'gnus-or (mapcar predicate + (mapcar 'gnus-summary-article-header articles)))) + +(defun gnus-summary-hide-all-threads (&optional predicate) + "Hide all thread subtrees. +If PREDICATE is supplied, threads that satisfy this predicate +will not be hidden." (interactive) (save-excursion (goto-char (point-min)) - (gnus-summary-hide-thread) - (while (zerop (gnus-summary-next-thread 1 t)) - (gnus-summary-hide-thread))) + (let ((end nil)) + (while (not end) + (when (or (not predicate) + (gnus-map-articles + predicate (gnus-summary-article-children))) + (gnus-summary-hide-thread)) + (setq end (not (zerop (gnus-summary-next-thread 1 t))))))) (gnus-summary-position-point)) (defun gnus-summary-hide-thread () "Hide thread subtrees. +If PREDICATE is supplied, threads that satisfy this predicate +will not be hidden. Returns nil if no threads were there to be hidden." (interactive) (let ((buffer-read-only nil) @@ -9087,7 +10615,7 @@ taken." (defun gnus-summary-up-thread (n) "Go up thread N steps. -If N is negative, go up instead. +If N is negative, go down instead. Returns the difference between N and how many steps down that were taken." (interactive "p") @@ -9138,6 +10666,12 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'number reverse)) +(defun gnus-summary-sort-by-random (&optional reverse) + "Randomize the order in the summary buffer. +Argument REVERSE means to randomize in reverse order." + (interactive "P") + (gnus-summary-sort 'random reverse)) + (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. @@ -9176,6 +10710,17 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'chars reverse)) +(defun gnus-summary-sort-by-original (&optional reverse) + "Sort the summary buffer using the default sorting method. +Argument REVERSE means reverse order." + (interactive "P") + (let* ((buffer-read-only) + (gnus-summary-prepare-hook nil)) + ;; We do the sorting by regenerating the threads. + (gnus-summary-prepare) + ;; Hide subthreads if needed. + (gnus-summary-maybe-hide-threads))) + (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) @@ -9197,8 +10742,7 @@ Argument REVERSE means reverse order." ;; We do the sorting by regenerating the threads. (gnus-summary-prepare) ;; Hide subthreads if needed. - (when (and gnus-show-threads gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads)))) + (gnus-summary-maybe-hide-threads))) ;; Summary saving commands. @@ -9224,7 +10768,9 @@ The variable `gnus-default-article-saver' specifies the saver function." (gnus-message 1 "Article %d is unsaveable" article)) ;; This is a real article. (save-window-excursion - (gnus-summary-select-article t nil nil article)) + (let ((gnus-display-mime-function nil) + (gnus-article-prepare-hook nil)) + (gnus-summary-select-article t nil nil article))) (save-excursion (set-buffer save-buffer) (erase-buffer) @@ -9238,17 +10784,22 @@ The variable `gnus-default-article-saver' specifies the saver function." (gnus-set-mode-line 'summary) n)) -(defun gnus-summary-pipe-output (&optional arg) +(defun gnus-summary-pipe-output (&optional arg headers) "Pipe the current article to a subprocess. If N is a positive number, pipe the N next articles. If N is a negative number, pipe the N previous articles. If N is nil and any articles have been marked with the process mark, -pipe those articles instead." - (interactive "P") +pipe those articles instead. +If HEADERS (the symbolic prefix), include the headers, too." + (interactive (gnus-interactive "P\ny")) (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) + (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe) + (gnus-save-all-headers (or headers gnus-save-all-headers))) (gnus-summary-save-article arg t)) - (gnus-configure-windows 'pipe)) + (let ((buffer (get-buffer "*Shell Command Output*"))) + (when (and buffer + (not (zerop (buffer-size buffer)))) + (gnus-configure-windows 'pipe)))) (defun gnus-summary-save-article-mail (&optional arg) "Append the current article to an mail file. @@ -9305,6 +10856,17 @@ save those articles instead." (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) +(defun gnus-summary-muttprint (&optional arg) + "Print the current article using Muttprint. +If N is a positive number, save the N next articles. +If N is a negative number, save the N previous articles. +If N is nil and any articles have been marked with the process mark, +save those articles instead." + (interactive "P") + (require 'gnus-art) + (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint)) + (gnus-summary-save-article arg t))) + (defun gnus-summary-pipe-message (program) "Pipe the current article through PROGRAM." (interactive "sProgram: ") @@ -9312,11 +10874,11 @@ save those articles instead." (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-pipe-buffer-body program) - (set-window-start (get-buffer-window (current-buffer)) start)))))) + (widen) + (let ((start (window-start)) + buffer-read-only) + (message-pipe-buffer-body program) + (set-window-start (get-buffer-window (current-buffer)) start)))))) (defun gnus-get-split-value (methods) "Return a value based on the split METHODS." @@ -9335,7 +10897,7 @@ save those articles instead." ;; Regular expression. (ignore-errors (re-search-forward match nil t))) - ((gnus-functionp match) + ((functionp match) ;; Function. (save-restriction (widen) @@ -9374,24 +10936,27 @@ save those articles instead." (to-newsgroup (cond ((null split-name) - (gnus-completing-read default prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil prefix - 'gnus-group-history)) + (gnus-completing-read-with-default + default prom + gnus-active-hashtb + 'gnus-valid-move-group-p + nil prefix + 'gnus-group-history)) ((= 1 (length split-name)) - (gnus-completing-read (car split-name) prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil nil - 'gnus-group-history)) + (gnus-completing-read-with-default + (car split-name) prom + gnus-active-hashtb + 'gnus-valid-move-group-p + nil nil + 'gnus-group-history)) (t - (gnus-completing-read nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history)))) - (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) + (gnus-completing-read-with-default + nil prom + (mapcar (lambda (el) (list el)) + (nreverse split-name)) + nil nil nil + 'gnus-group-history)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) @@ -9414,12 +10979,12 @@ save those articles instead." "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive - (list (read-string "Save parts of type: " + (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: " + (read-file-name "Save to directory: " gnus-summary-save-parts-last-directory nil t)) current-prefix-arg)) @@ -9430,7 +10995,9 @@ If REVERSE, save parts that do not match TYPE." (save-excursion (set-buffer gnus-article-buffer) (let ((handles (or gnus-article-mime-handles - (mm-dissect-buffer) (mm-uu-dissect)))) + (mm-dissect-buffer nil gnus-article-loose-mime) + (and gnus-article-emulate-mime + (mm-uu-dissect))))) (when handles (gnus-summary-save-parts-1 type dir handles reverse) (unless gnus-article-mime-handles ;; Don't destroy this case. @@ -9517,7 +11084,9 @@ If REVERSE, save parts that do not match TYPE." (gnus-data-enter after-article gnus-reffed-article-number gnus-unread-mark b (car pslist) 0 (- e b)) - (push gnus-reffed-article-number gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + gnus-reffed-article-number)) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) @@ -9648,8 +11217,8 @@ If REVERSE, save parts that do not match TYPE." ;; Added by Per Abrahamsen . (when gnus-summary-selected-face (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) + (let* ((beg (gnus-point-at-bol)) + (end (gnus-point-at-eol)) ;; Fix by Mike Dugan . (from (if (get-text-property beg gnus-mouse-face-prop) beg @@ -9676,41 +11245,55 @@ If REVERSE, save parts that do not match TYPE." (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) 'face gnus-summary-selected-face)))))) -;; New implementation by Christian Limpach . +(defvar gnus-summary-highlight-line-cached nil) +(defvar gnus-summary-highlight-line-trigger nil) + +(defun gnus-summary-highlight-line-0 () + (if (and (eq gnus-summary-highlight-line-trigger + gnus-summary-highlight) + gnus-summary-highlight-line-cached) + gnus-summary-highlight-line-cached + (setq gnus-summary-highlight-line-trigger gnus-summary-highlight + gnus-summary-highlight-line-cached + (let* ((cond (list 'cond)) + (c cond) + (list gnus-summary-highlight)) + (while list + (setcdr c (cons (list (caar list) (list 'quote (cdar list))) + nil)) + (setq c (cdr c) + list (cdr list))) + (gnus-byte-compile (list 'lambda nil cond)))))) + (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." - (let* ((list gnus-summary-highlight) - (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))) - (article (gnus-summary-article-number)) - (score (or (cdr (assq (or article gnus-current-article) + (let* ((beg (gnus-point-at-bol)) + (article (or (gnus-summary-article-number) gnus-current-article)) + (score (or (cdr (assq article gnus-newsgroup-scored)) gnus-summary-default-score 0)) (mark (or (gnus-summary-article-mark) gnus-unread-mark)) - (inhibit-read-only t)) - ;; Eval the cars of the lists until we find a match. - (let ((default gnus-summary-default-score)) - (while (and list - (not (eval (caar list)))) - (setq list (cdr list)))) - (let ((face (cdar list))) + (inhibit-read-only t) + (default gnus-summary-default-score) + (default-high gnus-summary-default-high-score) + (default-low gnus-summary-default-low-score) + (uncached (memq article gnus-newsgroup-undownloaded)) + (downloaded (not uncached))) + (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (get-text-property beg 'face)) (gnus-put-text-property-excluding-characters-with-faces - beg end 'face + beg (gnus-point-at-eol) 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function - (funcall gnus-summary-highlight-line-function article face)))) - (goto-char p))) + (funcall gnus-summary-highlight-line-function article face)))))) (defun gnus-update-read-articles (group unread &optional compute) - "Update the list of read articles in GROUP." + "Update the list of read articles in GROUP. +UNREAD is a sorted list." (let* ((active (or gnus-newsgroup-active (gnus-active group))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (prev 1) - (unread (sort (copy-sequence unread) '<)) read) (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, @@ -9762,7 +11345,7 @@ If REVERSE, save parts that do not match TYPE." `(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-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t) ,setmarkundo)))) @@ -9774,25 +11357,24 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-offer-save-summaries () "Offer to save all active summary buffers." - (save-excursion - (let ((buflist (buffer-list)) - buffers bufname) - ;; Go through all buffers and find all summaries. - (while buflist - (and (setq bufname (buffer-name (car buflist))) - (string-match "Summary" bufname) - (save-excursion - (set-buffer bufname) - ;; We check that this is, indeed, a summary buffer. - (and (eq major-mode 'gnus-summary-mode) - ;; Also make sure this isn't bogus. - gnus-newsgroup-prepared - ;; Also make sure that this isn't a dead summary buffer. - (not gnus-dead-summary-mode))) - (push bufname buffers)) - (setq buflist (cdr buflist))) - ;; Go through all these summary buffers and offer to save them. - (when buffers + (let (buffers) + ;; Go through all buffers and find all summaries. + (dolist (buffer (buffer-list)) + (when (and (setq buffer (buffer-name buffer)) + (string-match "Summary" buffer) + (save-excursion + (set-buffer buffer) + ;; We check that this is, indeed, a summary buffer. + (and (eq major-mode 'gnus-summary-mode) + ;; Also make sure this isn't bogus. + gnus-newsgroup-prepared + ;; Also make sure that this isn't a + ;; dead summary buffer. + (not gnus-dead-summary-mode)))) + (push buffer buffers))) + ;; Go through all these summary buffers and offer to save them. + (when buffers + (save-excursion (map-y-or-n-p "Update summary buffer %s? " (lambda (buf) @@ -9833,46 +11415,29 @@ 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-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)) - (save-window-excursion - (if (setq swin (get-buffer-window gnus-summary-buffer t)) - (select-window swin) - (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-clear-mark-forward 1) - (gnus-summary-goto-subject cur)) - (when (and cwin (window-frame cwin)) - (select-frame (window-frame cwin))) - (when (boundp 'mime-acting-situation-to-override) - (set-alist 'mime-acting-situation-to-override - 'group - group) - (set-alist 'mime-acting-situation-to-override - 'after-method - `(progn - (save-current-buffer - (set-buffer gnus-group-buffer) - (gnus-activate-group ,group)) - (gnus-summary-goto-article ,cur - gnus-show-all-headers))) - (set-alist 'mime-acting-situation-to-override - 'number num))))) + "Burst a forwarded article." + (save-excursion + (set-buffer gnus-summary-buffer) + (let* ((group (completing-read "Group: " gnus-active-hashtb nil t + gnus-newsgroup-name 'gnus-group-history)) + (gnus-group-marked (list group)) + article info) + (with-temp-buffer + (mime-insert-entity-content entity) + (setq article (gnus-request-accept-article group))) + (when (and (consp article) + (numberp (setq article (cdr article)))) + (setq info (gnus-get-info group)) + (gnus-info-set-read info + (gnus-remove-from-range (gnus-info-read info) + (list article))) + (when (string-equal group gnus-newsgroup-name) + (forward-line 1) + (let (gnus-show-threads) + (gnus-summary-goto-subject article t)) + (gnus-summary-clear-mark-forward 1)) + (set-buffer gnus-group-buffer) + (gnus-group-get-new-news-this-group nil t))))) (mime-add-condition 'action '((type . message)(subtype . rfc822) @@ -9913,39 +11478,52 @@ If REVERSE, save parts that do not match TYPE." ;;; @ end ;;; +(defun gnus-summary-inherit-default-charset () + "Import `default-mime-charset' from summary buffer. +Also take care of `default-mime-charset-unlimited' if the LIMIT version +of FLIM is used." + (if (buffer-live-p gnus-summary-buffer) + (let (d-m-c d-m-c-u) + (with-current-buffer gnus-summary-buffer + (setq d-m-c (if (local-variable-p 'default-mime-charset + gnus-summary-buffer) + default-mime-charset + t) + ;; LIMIT + d-m-c-u (if (local-variable-p 'default-mime-charset-unlimited + gnus-summary-buffer) + (symbol-value 'default-mime-charset-unlimited) + t))) + (if (eq t d-m-c) + (kill-local-variable 'default-mime-charset) + (set (make-local-variable 'default-mime-charset) d-m-c)) + (if (eq t d-m-c-u) + (kill-local-variable 'default-mime-charset-unlimited) + (set (make-local-variable 'default-mime-charset-unlimited) + d-m-c-u))))) + (defun gnus-summary-setup-default-charset () "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)))) + (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts")) + (progn + (setq gnus-newsgroup-charset nil) + (set (make-local-variable 'default-mime-charset) nil) + (when (boundp 'default-mime-charset-unlimited);; LIMIT + (set (make-local-variable 'default-mime-charset-unlimited) nil))) + (let ((ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (gnus-parameter-ignored-charsets gnus-newsgroup-name)) + gnus-newsgroup-ignored-charsets))) + charset) (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))) + (when (and gnus-newsgroup-name + (setq charset (gnus-parameter-charset + gnus-newsgroup-name))) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) gnus-default-charset)) (set (make-local-variable 'gnus-newsgroup-ignored-charsets) ignored-charsets)))) @@ -10168,6 +11746,137 @@ returned." (gnus-set-mode-line 'summary) n)) +(defun gnus-summary-insert-articles (articles) + (when (setq articles + (gnus-sorted-difference articles + (mapcar (lambda (h) + (mail-header-number h)) + gnus-newsgroup-headers))) + (setq gnus-newsgroup-headers + (gnus-merge 'list + gnus-newsgroup-headers + (gnus-fetch-headers articles) + 'gnus-article-sort-by-number)) + ;; Suppress duplicates? + (when gnus-suppress-duplicates + (gnus-dup-suppress-articles)) + + ;; We might want to build some more threads first. + (when (and gnus-fetch-old-headers + (eq gnus-headers-retrieved-by 'nov)) + (if (eq gnus-fetch-old-headers 'invisible) + (gnus-build-all-threads) + (gnus-build-old-threads))) + ;; Let the Gnus agent mark articles as read. + (when gnus-agent + (gnus-agent-get-undownloaded-list)) + ;; Remove list identifiers from subject + (when gnus-list-identifiers + (gnus-summary-remove-list-identifiers)) + ;; First and last article in this newsgroup. + (when gnus-newsgroup-headers + (setq gnus-newsgroup-begin + (mail-header-number (car gnus-newsgroup-headers)) + gnus-newsgroup-end + (mail-header-number + (gnus-last-element gnus-newsgroup-headers)))) + (when gnus-use-scoring + (gnus-possibly-score-headers)))) + +(defun gnus-summary-insert-old-articles (&optional all) + "Insert all old articles in this group. +If ALL is non-nil, already read articles become readable. +If ALL is a number, fetch this number of articles." + (interactive "P") + (prog1 + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) + older len) + (setq older + ;; Some nntp servers lie about their active range. When + ;; this happens, the active range can be in the millions. + ;; Use a compressed range to avoid creating a huge list. + (gnus-range-difference (list gnus-newsgroup-active) old)) + (setq len (gnus-range-length older)) + (cond + ((null older) nil) + ((numberp all) + (if (< all len) + (let ((older-range (nreverse older))) + (setq older nil) + + (while (> all 0) + (let* ((r (pop older-range)) + (min (if (numberp r) r (car r))) + (max (if (numberp r) r (cdr r)))) + (while (and (<= min max) + (> all 0)) + (push max older) + (setq all (1- all) + max (1- max)))))) + (setq older (gnus-uncompress-range older)))) + (all + (setq older (gnus-uncompress-range older))) + (t + (when (and (numberp gnus-large-newsgroup) + (> len gnus-large-newsgroup)) + (let* ((cursor-in-echo-area nil) + (initial (gnus-parameter-large-newsgroup-initial + gnus-newsgroup-name)) + (input + (read-string + (format + "How many articles from %s (%s %d): " + (gnus-limit-string + (gnus-group-decoded-name gnus-newsgroup-name) 35) + (if initial "max" "default") + len) + (if initial + (cons (number-to-string initial) + 0))))) + (unless (string-match "^[ \t]*$" input) + (setq all (string-to-number input)) + (if (< all len) + (let ((older-range (nreverse older))) + (setq older nil) + + (while (> all 0) + (let* ((r (pop older-range)) + (min (if (numberp r) r (car r))) + (max (if (numberp r) r (cdr r)))) + (while (and (<= min max) + (> all 0)) + (push max older) + (setq all (1- all) + max (1- max)))))))))) + (setq older (gnus-uncompress-range older)))) + (if (not older) + (message "No old news.") + (gnus-summary-insert-articles older) + (gnus-summary-limit (gnus-sorted-nunion old older)))) + (gnus-summary-position-point))) + +(defun gnus-summary-insert-new-articles () + "Insert all new articles in this group." + (interactive) + (prog1 + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) + (old-active gnus-newsgroup-active) + (nnmail-fetched-sources (list t)) + i new) + (setq gnus-newsgroup-active + (gnus-activate-group gnus-newsgroup-name 'scan)) + (setq i (cdr gnus-newsgroup-active)) + (while (> i (cdr old-active)) + (push i new) + (decf i)) + (if (not new) + (message "No gnus is bad news.") + (gnus-summary-insert-articles new) + (setq gnus-newsgroup-unreads + (gnus-sorted-nunion gnus-newsgroup-unreads new)) + (gnus-summary-limit (gnus-sorted-nunion old new)))) + (gnus-summary-position-point))) + (gnus-summary-make-all-marking-commands) (gnus-ems-redefine) @@ -10176,4 +11885,8 @@ returned." (run-hooks 'gnus-sum-load-hook) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; gnus-sum.el ends here diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 22fc71b..07d501c 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,5 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Ilja Weis @@ -47,6 +47,9 @@ :type 'hook :group 'gnus-topic) +(when (featurep 'xemacs) + (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add)) + (defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" "Format of topic lines. It works along the same lines as a normal formatting string, @@ -58,7 +61,10 @@ with some simple extensions. %g Number of groups in the topic. %a Number of unread articles in the groups in the topic. %A Number of unread articles in the groups in the topic and its subtopics. -" + +General format specifiers can also be used. +See Info node `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :type 'string :group 'gnus-topic) @@ -162,9 +168,10 @@ with some simple extensions. (mapcar 'list (gnus-topic-list)) nil t))) (dolist (topic (gnus-current-topics topic)) + (gnus-topic-goto-topic topic) (gnus-topic-fold t)) (gnus-topic-goto-topic topic)) - + (defun gnus-current-topic () "Return the name of the current topic." (let ((result @@ -197,7 +204,7 @@ If TOPIC, start with that topic." "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) + info clevel unread group params visible-groups entry active) (setq lowest (or lowest 1)) (setq level (or level gnus-level-unsubscribed)) ;; We go through the newsrc to look for matches. @@ -234,18 +241,40 @@ If RECURSIVE is t, return groups in its subtopics too." ;; Add this group to the list of visible groups. (push (or entry group) visible-groups))) (setq visible-groups (nreverse visible-groups)) - (when recursive + (when recursive (if (eq recursive t) (setq recursive (cdr (gnus-topic-find-topology topic)))) (mapcar (lambda (topic-topology) - (setq visible-groups - (nconc visible-groups + (setq visible-groups + (nconc visible-groups (gnus-topic-find-groups - (caar topic-topology) + (caar topic-topology) level all lowest topic-topology)))) (cdr recursive))) visible-groups)) +(defun gnus-topic-goto-previous-topic (n) + "Go to the N'th previous topic." + (interactive "p") + (gnus-topic-goto-next-topic (- n))) + +(defun gnus-topic-goto-next-topic (n) + "Go to the N'th next topic." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n)) + (topic (gnus-current-topic))) + (while (and (> n 0) + (setq topic + (if backward + (gnus-topic-previous-topic topic) + (gnus-topic-next-topic topic)))) + (gnus-topic-goto-topic topic) + (setq n (1- n))) + (when (/= 0 n) + (gnus-message 7 "No more topics")) + n)) + (defun gnus-topic-previous-topic (topic) "Return the previous topic on the same level as TOPIC." (let ((top (cddr (gnus-topic-find-topology @@ -352,9 +381,17 @@ If RECURSIVE is t, return groups in its subtopics too." "Compute the group parameters for GROUP taking into account inheritance from topics." (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) (save-excursion - (gnus-group-goto-group group) (nconc params-list - (gnus-topic-hierarchical-parameters (gnus-current-topic)))))) + (gnus-topic-hierarchical-parameters + ;; First we try to go to the group within the group + ;; buffer and find the topic for the group that way. + ;; This hopefully copes well with groups that are in + ;; more than one topic. Failing that (i.e. when the + ;; group isn't visible in the group buffer) we find a + ;; topic for the group via gnus-group-topic. + (or (and (gnus-group-goto-group group) + (gnus-current-topic)) + (gnus-group-topic group))))))) (defun gnus-topic-hierarchical-parameters (topic) "Return a topic list computed for TOPIC." @@ -385,15 +422,19 @@ If RECURSIVE is t, return groups in its subtopics too." ;;; 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)) @@ -403,48 +444,63 @@ 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-level-killed ?K - regexp)) + gnus-level-killed ?K regexp) + (when not-in-list + (unless gnus-killed-hashtb + (gnus-make-hashtable-from-killed)) + (gnus-group-prepare-flat-list-dead + (gnus-remove-if (lambda (group) + (or (gnus-gethash group gnus-newsrc-hashtb) + (gnus-gethash group gnus-killed-hashtb))) + not-in-list) + 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) ? )) @@ -459,32 +515,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) @@ -594,7 +679,7 @@ articles in the topic and its subtopics." (when (and (eq major-mode 'gnus-group-mode) gnus-topic-mode) (let ((group (gnus-group-group-name)) - (m (point-marker)) + (m (point-marker)) (buffer-read-only nil)) (when (and group (gnus-get-info group) @@ -612,7 +697,8 @@ articles in the topic and its subtopics." (unfound t) entry) ;; Try to jump to a visible group. - (while (and g (not (gnus-group-goto-group (car g) t))) + (while (and g + (not (gnus-group-goto-group (car g) t))) (pop g)) ;; It wasn't visible, so we try to see where to insert it. (when (not g) @@ -624,20 +710,31 @@ articles in the topic and its subtopics." (when (and unfound topic (not (gnus-topic-goto-missing-topic topic))) - (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)))))) + (gnus-topic-display-missing-topic topic))))) + +(defun gnus-topic-display-missing-topic (topic) + "Insert topic lines recursively for missing topics." + (let ((parent (gnus-topic-find-topology + (gnus-topic-parent-topic topic)))) + (when (and parent + (not (gnus-topic-goto-missing-topic (caadr parent)))) + (gnus-topic-display-missing-topic (caadr parent)))) + (gnus-topic-goto-missing-topic topic) + (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))) + entry) + (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) @@ -656,7 +753,7 @@ articles in the topic and its subtopics." (not (gnus-topic-goto-topic (caaar tp)))) (pop tp)) (if tp - (gnus-topic-forward-topic 1) + (forward-line 1) (gnus-topic-goto-missing-topic (caadr top))))) nil)) @@ -950,6 +1047,7 @@ articles in the topic and its subtopics." "\r" gnus-topic-select-group " " gnus-topic-read-group "\C-c\C-x" gnus-topic-expire-articles + "c" gnus-topic-catchup-articles "\C-k" gnus-topic-kill-group "\C-y" gnus-topic-yank-group "\M-g" gnus-topic-get-new-news-this-topic @@ -976,6 +1074,8 @@ articles in the topic and its subtopics." "j" gnus-topic-jump-to-topic "M" gnus-topic-move-matching "C" gnus-topic-copy-matching + "\M-p" gnus-topic-goto-previous-topic + "\M-n" gnus-topic-goto-next-topic "\C-i" gnus-topic-indent [tab] gnus-topic-indent "r" gnus-topic-rename @@ -988,6 +1088,7 @@ articles in the topic and its subtopics." "a" gnus-topic-sort-groups-by-alphabet "u" gnus-topic-sort-groups-by-unread "l" gnus-topic-sort-groups-by-level + "e" gnus-topic-sort-groups-by-server "v" gnus-topic-sort-groups-by-score "r" gnus-topic-sort-groups-by-rank "m" gnus-topic-sort-groups-by-method)) @@ -999,21 +1100,23 @@ articles in the topic and its subtopics." '("Topics" ["Toggle topics" gnus-topic-mode t] ("Groups" - ["Copy" gnus-topic-copy-group t] - ["Move" gnus-topic-move-group t] + ["Copy..." gnus-topic-copy-group t] + ["Move..." gnus-topic-move-group t] ["Remove" gnus-topic-remove-group t] - ["Copy matching" gnus-topic-copy-matching t] - ["Move matching" gnus-topic-move-matching t]) + ["Copy matching..." gnus-topic-copy-matching t] + ["Move matching..." gnus-topic-move-matching t]) ("Topics" - ["Goto" gnus-topic-jump-to-topic t] + ["Goto..." gnus-topic-jump-to-topic t] ["Show" gnus-topic-show-topic t] ["Hide" gnus-topic-hide-topic t] ["Delete" gnus-topic-delete t] - ["Rename" gnus-topic-rename t] - ["Create" gnus-topic-create-topic t] + ["Rename..." gnus-topic-rename t] + ["Create..." gnus-topic-create-topic t] ["Mark" gnus-topic-mark-topic t] ["Indent" gnus-topic-indent t] ["Sort" gnus-topic-sort-topics t] + ["Previous topic" gnus-topic-goto-previous-topic t] + ["Next topic" gnus-topic-goto-next-topic t] ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t] ["Edit parameters" gnus-topic-edit-parameters t]) ["List active" gnus-topic-list-active t])))) @@ -1028,7 +1131,7 @@ articles in the topic and its subtopics." (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. (if (not gnus-topic-mode) - (setq gnus-goto-missing-group-function nil) + (setq gnus-goto-missing-group-function nil) (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) @@ -1051,8 +1154,9 @@ articles in the topic and its subtopics." 'gnus-group-sort-topic) (setq gnus-group-change-level-function 'gnus-topic-change-level) (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) - (make-local-hook 'gnus-check-bogus-groups-hook) - (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) + (gnus-make-local-hook 'gnus-check-bogus-groups-hook) + (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist + nil 'local) (setq gnus-topology-checked-p nil) ;; We check the topology. (when gnus-newsrc-alist @@ -1071,11 +1175,14 @@ articles in the topic and its subtopics." (defun gnus-topic-select-group (&optional all) "Select this newsgroup. No article is selected automatically. +If the group is opened, just switch the summary buffer. If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles. If performed over a topic line, toggle folding the topic." (interactive "P") + (when (and (eobp) (not (gnus-group-group-name))) + (forward-line -1)) (if (gnus-group-topic-p) (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) @@ -1098,10 +1205,27 @@ If performed over a topic line, toggle folding the topic." (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-topic-find-groups topic gnus-level-killed t + nil t)))) (gnus-group-expire-articles nil)) (gnus-message 5 "Expiring groups in %s...done" topic)))) +(defun gnus-topic-catchup-articles (topic) + "Catchup this topic or group. +Also see `gnus-group-catchup'." + (interactive (list (gnus-group-topic-name))) + (if (not topic) + (call-interactively 'gnus-group-catchup-current) + (save-excursion + (let* ((groups + (mapcar (lambda (entry) (car (nth 2 entry))) + (gnus-topic-find-groups topic gnus-level-killed t + nil t))) + (buffer-read-only nil) + (gnus-group-marked groups)) + (gnus-group-catchup-current) + (mapcar 'gnus-topic-update-topics-containing-group groups))))) + (defun gnus-topic-read-group (&optional all no-article group) "Read news in this newsgroup. If the prefix argument ALL is non-nil, already read articles become @@ -1147,10 +1271,10 @@ 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 +;; 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, +;; 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) @@ -1158,8 +1282,9 @@ When used interactively, PARENT will be the topic under point." If COPYP, copy the groups instead." (interactive (list current-prefix-arg - (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((use-marked (and (not n) (not (gnus-region-active-p)) + (gnus-completing-read "Move to topic" gnus-topic-alist nil t + 'gnus-topic-history))) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) (groups (gnus-group-process-prefix n)) (topicl (assoc topic gnus-topic-alist)) @@ -1186,7 +1311,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." (interactive "P") - (let ((use-marked (and (not n) (not (gnus-region-active-p)) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) (groups (gnus-group-process-prefix n))) (mapcar @@ -1284,7 +1409,7 @@ If PERMANENT, make it stay hidden in subsequent sessions as well." (when (gnus-current-topic) (gnus-topic-goto-topic (gnus-current-topic)) (if permanent - (setcar (cddr + (setcar (cddr (cadr (gnus-topic-find-topology (gnus-current-topic)))) 'hidden)) @@ -1297,45 +1422,49 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (when (gnus-group-topic-p) (if (not permanent) (gnus-topic-remove-topic t nil) - (let ((topic - (gnus-topic-find-topology + (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) +(defun gnus-topic-mark-topic (topic &optional unmark non-recursive) "Mark all groups in the TOPIC with the process mark. -If RECURSIVE is t, mark its subtopics too." +If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." (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 nil - recursive))) + (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil + (not non-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 dummy recursive) +(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive) "Remove the process mark from all groups in the TOPIC. -If RECURSIVE is t, unmark its subtopics too." +If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (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 recursive))) + (gnus-topic-mark-topic topic t non-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) nil (and n t)) - (gnus-group-get-new-news-this-group))) + (let* ((topic (gnus-group-topic-name)) + (data (cadr (gnus-topic-find-topology topic)))) + (save-excursion + (gnus-topic-mark-topic topic nil (and n t)) + (gnus-group-get-new-news-this-group)) + (gnus-topic-remove-topic (eq 'visible (cadr data)))))) (defun gnus-topic-move-matching (regexp topic &optional copyp) "Move all groups that match REGEXP to some topic." @@ -1381,7 +1510,7 @@ If RECURSIVE is t, unmark its subtopics too." (interactive (let ((topic (gnus-current-topic))) (list topic - (read-string "Rename topic to: " topic)))) + (read-string (format "Rename %s to: " topic) topic)))) ;; Check whether the new name exists. (when (gnus-topic-find-topology new-name) (error "Topic '%s' already exists" new-name)) @@ -1417,7 +1546,7 @@ If UNINDENT, remove an indentation." (gnus-topic-kill-group) (push (cdar gnus-topic-killed-topics) gnus-topic-alist) (gnus-topic-create-topic - topic parent nil (cdaar gnus-topic-killed-topics)) + topic parent nil (cdar (car gnus-topic-killed-topics))) (pop gnus-topic-killed-topics) (or (gnus-topic-goto-topic topic) (gnus-topic-goto-topic parent)))))) @@ -1436,7 +1565,7 @@ If UNINDENT, remove an indentation." (push (cdar gnus-topic-killed-topics) gnus-topic-alist) (gnus-topic-create-topic topic grandparent (gnus-topic-next-topic parent) - (cdaar gnus-topic-killed-topics)) + (cdar (car gnus-topic-killed-topics))) (pop gnus-topic-killed-topics) (gnus-topic-goto-topic topic)))) @@ -1553,22 +1682,29 @@ If REVERSE, sort in reverse order." (interactive "P") (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) +(defun gnus-topic-sort-groups-by-server (&optional reverse) + "Sort the current topic alphabetically by server name. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-topic-sort-groups 'gnus-group-sort-by-server reverse)) + (defun gnus-topic-sort-topics-1 (top reverse) (if (cdr top) (let ((subtop - (mapcar `(lambda (top) - (gnus-topic-sort-topics-1 top ,reverse)) + (mapcar (gnus-byte-compile + `(lambda (top) + (gnus-topic-sort-topics-1 top ,reverse))) (sort (cdr top) - '(lambda (t1 t2) - (string-lessp (caar t1) (caar t2))))))) + (lambda (t1 t2) + (string-lessp (caar t1) (caar t2))))))) (setcdr top (if reverse (reverse subtop) subtop)))) top) (defun gnus-topic-sort-topics (&optional topic reverse) - "Sort topics in TOPIC alphabeticaly by topic name. + "Sort topics in TOPIC alphabetically by topic name. If REVERSE, reverse the sorting order." - (interactive - (list (completing-read "Sort topics in : " gnus-topic-alist nil t + (interactive + (list (completing-read "Sort topics in : " gnus-topic-alist nil t (gnus-current-topic)) current-prefix-arg)) (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) @@ -1580,8 +1716,8 @@ If REVERSE, reverse the sorting order." (defun gnus-topic-move (current to) "Move the CURRENT topic to TO." - (interactive - (list + (interactive + (list (gnus-group-topic-name) (completing-read "Move to topic: " gnus-topic-alist nil t))) (unless (and current to) @@ -1613,8 +1749,15 @@ If REVERSE, reverse the sorting order." (gnus-subscribe-alphabetically newsgroup) ;; Add the group to the topic. (nconc (assoc topic gnus-topic-alist) (list newsgroup)) - (throw 'end t)))))) - + ;; if this topic specifies a default level, use it + (let ((subscribe-level (cdr (assq 'subscribe-level + (gnus-topic-parameters topic))))) + (when subscribe-level + (gnus-group-change-level newsgroup subscribe-level + gnus-level-default-subscribed))) + (throw 'end t))) + nil))) + (provide 'gnus-topic) ;;; gnus-topic.el ends here diff --git a/lisp/gnus-undo.el b/lisp/gnus-undo.el index 7dd333f..f022926 100644 --- a/lisp/gnus-undo.el +++ b/lisp/gnus-undo.el @@ -1,6 +1,6 @@ ;;; gnus-undo.el --- minor mode for undoing in Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -114,7 +114,7 @@ (when (gnus-visual-p 'undo-menu 'menu) (gnus-undo-make-menu-bar)) (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map) - (make-local-hook 'post-command-hook) + (gnus-make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'gnus-undo-boundary nil t) (gnus-run-hooks 'gnus-undo-mode-hook))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 4aec9e3..0033120 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,5 +1,5 @@ ;;; gnus-util.el --- utility functions for Semi-gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -32,17 +32,45 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + ;; Fixme: this should be a gnus variable, not nnmail-. + (defvar nnmail-pathname-coding-system)) (eval-when-compile (require 'static)) (require 'custom) -(require 'nnheader) (require 'time-date) +(require 'netrc) (eval-and-compile + (autoload 'message-fetch-field "message") + (autoload 'gnus-get-buffer-window "gnus-win") (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") - (autoload 'rmail-show-message "rmail")) + (autoload 'rmail-show-message "rmail") + (autoload 'nnheader-narrow-to-headers "nnheader") + (autoload 'nnheader-replace-chars-in-string "nnheader")) + +(eval-and-compile + (cond + ((fboundp 'replace-in-string) + (defalias 'gnus-replace-in-string 'replace-in-string)) + ((fboundp 'replace-regexp-in-string) + (defun gnus-replace-in-string (string regexp newtext &optional literal) + (replace-regexp-in-string regexp newtext string nil literal))) + (t + (defun gnus-replace-in-string (string regexp newtext &optional literal) + (let ((start 0) tail) + (while (string-match regexp string start) + (setq tail (- (length string) (match-end 0))) + (setq string (replace-match newtext nil literal string)) + (setq start (- (length string) tail)))) + string)))) + +;;; bring in the netrc functions as aliases +(defalias 'gnus-netrc-get 'netrc-get) +(defalias 'gnus-netrc-machine 'netrc-machine) +(defalias 'gnus-parse-netrc 'netrc-parse) (defun gnus-boundp (variable) "Return non-nil if VARIABLE is bound and non-nil." @@ -52,23 +80,23 @@ (defmacro gnus-eval-in-buffer-window (buffer &rest forms) "Pop to BUFFER, evaluate FORMS, and then return to the original window." (let ((tempvar (make-symbol "GnusStartBufferWindow")) - (w (make-symbol "w")) - (buf (make-symbol "buf")) + (w (make-symbol "w")) + (buf (make-symbol "buf")) (frame (make-symbol "frame"))) `(let* ((,tempvar (selected-window)) - (,buf ,buffer) - (,w (get-buffer-window ,buf 'visible)) + (,buf ,buffer) + (,w (gnus-get-buffer-window ,buf 'visible)) ,frame) (unwind-protect - (progn - (if ,w - (progn - (select-window ,w) - (set-buffer (window-buffer ,w))) - (pop-to-buffer ,buf)) - ,@forms) + (progn + (if ,w + (progn + (select-window ,w) + (set-buffer (window-buffer ,w))) + (pop-to-buffer ,buf)) + ,@forms) (setq ,frame (selected-frame)) - (select-window ,tempvar) + (select-window ,tempvar) (select-frame ,frame))))) (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) @@ -81,26 +109,15 @@ (set symbol nil)) symbol)) -;; Avoid byte-compile warning. -;; In Mule, this function will be redefined to `truncate-string', -;; which takes 3 or 4 args. -(defun gnus-truncate-string (str width &rest ignore) - (substring str 0 width)) - ;; Added by Geoffrey T. Dairiki . A safe way ;; to limit the length of a string. This function is necessary since ;; `(substr "abc" 0 30)' pukes with "Args out of range". +;; Fixme: Why not `truncate-string-to-width'? (defsubst gnus-limit-string (str width) (if (> (length str) width) (substring str 0 width) str)) -(defsubst gnus-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)) - (byte-code-function-p form))) - (defsubst gnus-goto-char (point) (and point (goto-char point))) @@ -110,11 +127,6 @@ (funcall (if (stringp buffer) 'get-buffer 'buffer-name) buffer)))) -(defmacro gnus-kill-buffer (buffer) - `(let ((buf ,buffer)) - (when (gnus-buffer-exists-p buf) - (kill-buffer buf)))) - (static-cond ((fboundp 'point-at-bol) (defalias 'gnus-point-at-bol 'point-at-bol)) @@ -144,6 +156,16 @@ (goto-char p)))) )) +;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and +;; XEmacs. In Emacs we don't need to call `make-local-hook' first. +;; It's harmless, though, so the main purpose of this alias is to shut +;; up the byte compiler. +(defalias 'gnus-make-local-hook + (if (eq (get 'make-local-hook 'byte-compile) + 'byte-compile-obsolete) + 'ignore ; Emacs + 'make-local-hook)) ; XEmacs + (defun gnus-delete-first (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." (if (equal (car list) elt) @@ -158,7 +180,7 @@ ;; Delete the current line (and the next N lines). (defmacro gnus-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) + `(delete-region (gnus-point-at-bol) (progn (forward-line ,(or n 1)) (point)))) (defun gnus-byte-code (func) @@ -183,7 +205,7 @@ (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) (and (setq name (substring from 0 (match-beginning 0))) ;; Strip any quotes from the name. - (string-match "\".*\"" name) + (string-match "^\".*\"$" name) (setq name (substring name 1 (1- (match-end 0)))))) ;; If not, then "address (name)" is used. (or name @@ -208,9 +230,26 @@ (nnheader-narrow-to-headers) (message-fetch-field field))))) +(defun gnus-fetch-original-field (field) + "Fetch FIELD from the original version of the current article." + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field field))) + + (defun gnus-goto-colon () (beginning-of-line) - (search-forward ":" (gnus-point-at-eol) t)) + (let ((eol (gnus-point-at-eol))) + (goto-char (or (text-property-any (point) eol 'gnus-position t) + (search-forward ":" eol t) + (point))))) + +(defun gnus-decode-newsgroups (newsgroups group &optional method) + (let ((method (or method (gnus-find-method-for-group group)))) + (mapconcat (lambda (group) + (gnus-group-name-decode group (gnus-group-name-charset + method group))) + (message-tokenize-header newsgroups) + ","))) (defun gnus-remove-text-with-property (prop) "Delete all text in the current buffer with text property PROP." @@ -223,20 +262,14 @@ (defun gnus-newsgroup-directory-form (newsgroup) "Make hierarchical directory name from NEWSGROUP name." - (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) - (len (length newsgroup)) - idx) - ;; If this is a foreign group, we don't want to translate the - ;; entire name. - (if (setq idx (string-match ":" newsgroup)) - (aset newsgroup idx ?/) - (setq idx 0)) - ;; Replace all occurrences of `.' with `/'. - (while (< idx len) - (when (= (aref newsgroup idx) ?.) - (aset newsgroup idx ?/)) - (setq idx (1+ idx))) - newsgroup)) + (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup)) + (idx (string-match ":" newsgroup))) + (concat + (if idx (substring newsgroup 0 idx)) + (if idx "/") + (nnheader-replace-chars-in-string + (if idx (substring newsgroup (1+ idx)) newsgroup) + ?. ?/)))) (defun gnus-newsgroup-savable-name (group) ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) @@ -299,7 +332,7 @@ (define-key keymap key (pop plist)) (pop plist))))) -(defun gnus-completing-read (default prompt &rest args) +(defun gnus-completing-read-with-default (default prompt &rest args) ;; Like `completing-read', except that DEFAULT is the default argument. (let* ((prompt (if default (concat prompt " (default " default ") ") @@ -321,6 +354,78 @@ (yes-or-no-p prompt) (message ""))) +;; By Frank Schmitt . Allows to have +;; age-depending date representations. (e.g. just the time if it's +;; from today, the day of the week if it's within the last 7 days and +;; the full date if it's older) +(defun gnus-seconds-today () + "Returns the number of seconds passed today" + (let ((now (decode-time (current-time)))) + (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)))) + +(defun gnus-seconds-month () + "Returns the number of seconds passed this month" + (let ((now (decode-time (current-time)))) + (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) + (* (- (car (nthcdr 3 now)) 1) 3600 24)))) + +(defun gnus-seconds-year () + "Returns the number of seconds passed this year" + (let ((now (decode-time (current-time))) + (days (format-time-string "%j" (current-time)))) + (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) + (* (- (string-to-number days) 1) 3600 24)))) + +(defvar gnus-user-date-format-alist + '(((gnus-seconds-today) . "%k:%M") + (604800 . "%a %k:%M") ;;that's one week + ((gnus-seconds-month) . "%a %d") + ((gnus-seconds-year) . "%b %d") + (t . "%b %d '%y")) ;;this one is used when no + ;;other does match + "Specifies date format depending on age of article. +This is an alist of items (AGE . FORMAT). AGE can be a number (of +seconds) or a Lisp expression evaluating to a number. When the age of +the article is less than this number, then use `format-time-string' +with the corresponding FORMAT for displaying the date of the article. +If AGE is not a number or a Lisp expression evaluating to a +non-number, then the corresponding FORMAT is used as a default value. + +Note that the list is processed from the beginning, so it should be +sorted by ascending AGE. Also note that items following the first +non-number AGE will be ignored. + +You can use the functions `gnus-seconds-today', `gnus-seconds-month' +and `gnus-seconds-year' in the AGE spec. They return the number of +seconds passed since the start of today, of this month, of this year, +respectively.") + +(defun gnus-user-date (messy-date) + "Format the messy-date acording to gnus-user-date-format-alist. +Returns \" ? \" if there's bad input or if an other error occurs. +Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." + (condition-case () + (let* ((messy-date (safe-date-to-time messy-date)) + (now (current-time)) + ;;If we don't find something suitable we'll use this one + (my-format "%b %m '%y") + (high (lsh (- (car now) (car messy-date)) 16))) + (if (and (> high -1) (= (logand high 65535) 0)) + ;;overflow and bad input + (let* ((difference (+ high (- (car (cdr now)) + (car (cdr messy-date))))) + (templist gnus-user-date-format-alist) + (top (eval (caar templist)))) + (while (if (numberp top) (< top difference) (not top)) + (progn + (setq templist (cdr templist)) + (setq top (eval (caar templist))))) + (if (stringp (cdr (car templist))) + (setq my-format (cdr (car templist)))))) + (format-time-string (eval my-format) messy-date)) + (error " ? "))) +;;end of Frank's code + (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string." (condition-case () @@ -353,13 +458,7 @@ Cache the result as a text property stored in DATE." (defun gnus-mode-string-quote (string) "Quote all \"%\"'s in STRING." - (save-excursion - (gnus-set-work-buffer) - (insert string) - (goto-char (point-min)) - (while (search-forward "%" nil t) - (insert "%")) - (buffer-string))) + (gnus-replace-in-string string "%" "%%")) ;; Make a hash table (default and minimum size is 256). ;; Optional argument HASHSIZE specifies the table size. @@ -387,12 +486,13 @@ jabbering all the time." :group 'gnus-start :type 'integer) -;; Show message if message has a lower level than `gnus-verbose'. -;; Guideline for numbers: -;; 1 - error messages, 3 - non-serious error messages, 5 - messages -;; for things that take a long time, 7 - not very important messages -;; on stuff, 9 - messages inside loops. (defun gnus-message (level &rest args) + "If LEVEL is lower than `gnus-verbose' print ARGS using `message'. + +Guideline for numbers: +1 - error messages, 3 - non-serious error messages, 5 - messages for things +that take a long time, 7 - not very important messages on stuff, 9 - messages +inside loops." (if (<= level gnus-verbose) (apply 'message args) ;; We have to do this format thingy here even if the result isn't @@ -415,7 +515,7 @@ jabbering all the time." "Return a list of Message-IDs in REFERENCES." (let ((beg 0) ids) - (while (string-match "<[^>]+>" references beg) + (while (string-match "<[^<]+[^< \t]" references beg) (push (substring references (match-beginning 0) (setq beg (match-end 0))) ids)) (nreverse ids))) @@ -423,13 +523,17 @@ jabbering all the time." (defsubst gnus-parent-id (references &optional n) "Return the last Message-ID in REFERENCES. If N, return the Nth ancestor instead." - (when references - (let ((ids (inline (gnus-split-references references)))) - (while (nthcdr (or n 1) ids) - (setq ids (cdr ids))) - (car ids)))) - -(defsubst gnus-buffer-live-p (buffer) + (when (and references + (not (zerop (length references)))) + (if n + (let ((ids (inline (gnus-split-references references)))) + (while (nthcdr n ids) + (setq ids (cdr ids))) + (car ids)) + (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) + (match-string 1 references))))) + +(defun gnus-buffer-live-p (buffer) "Say whether BUFFER is alive or not." (and buffer (get-buffer buffer) @@ -438,9 +542,9 @@ If N, return the Nth ancestor instead." (defun gnus-horizontal-recenter () "Recenter the current buffer horizontally." (if (< (current-column) (/ (window-width) 2)) - (set-window-hscroll (get-buffer-window (current-buffer) t) 0) + (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0) (let* ((orig (point)) - (end (window-end (get-buffer-window (current-buffer) t))) + (end (window-end (gnus-get-buffer-window (current-buffer) t))) (max 0)) (when end ;; Find the longest line currently displayed in the window. @@ -454,15 +558,21 @@ If N, return the Nth ancestor instead." ;; Scroll horizontally to center (sort of) the point. (if (> max (window-width)) (set-window-hscroll - (get-buffer-window (current-buffer) t) + (gnus-get-buffer-window (current-buffer) t) (min (- (current-column) (/ (window-width) 3)) (+ 2 (- max (window-width))))) - (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) + (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0)) max)))) -(defun gnus-read-event-char () +(defun gnus-read-event-char (&optional prompt) "Get the next event." - (let ((event (read-event))) + (let ((event (condition-case nil + (read-event prompt) + ;; `read-event' doesn't allow arguments in Mule 2.3 + (wrong-number-of-arguments + (when prompt + (message "%s" prompt)) + (read-event))))) ;; should be gnus-characterp, but this can't be called in XEmacs anyway (cons (and (numberp event) event) event))) @@ -504,14 +614,15 @@ If N, return the Nth ancestor instead." "Return a composite sort condition based on the functions in FUNC." (cond ;; Just a simple function. - ((gnus-functionp funs) funs) + ((functionp funs) funs) ;; No functions at all. ((null funs) funs) ;; A list of functions. ((or (cdr funs) (listp (car funs))) - `(lambda (t1 t2) - ,(gnus-make-sort-function-1 (reverse funs)))) + (gnus-byte-compile + `(lambda (t1 t2) + ,(gnus-make-sort-function-1 (reverse funs))))) ;; A list containing just one function. (t (car funs)))) @@ -528,7 +639,7 @@ If N, return the Nth ancestor instead." (setq function (cadr function) first 't2 last 't1)) - ((gnus-functionp function) + ((functionp function) ;; Do nothing. ) (t @@ -554,13 +665,18 @@ Bind `print-quoted' and `print-readably' to t while printing." (prin1 form (current-buffer)))) (defun gnus-prin1-to-string (form) - "The same as `prin1', but bind `print-quoted' and `print-readably' to t." + "The same as `prin1'. +Bind `print-quoted' and `print-readably' to t, and `print-length' +and `print-level' to nil." (let ((print-quoted t) - (print-readably t)) + (print-readably t) + (print-length nil) + (print-level nil)) (prin1-to-string form))) (defun gnus-make-directory (directory) "Make DIRECTORY (and all its parents) if it doesn't exist." + (require 'nnmail) (let ((file-name-coding-system nnmail-pathname-coding-system) (pathname-coding-system nnmail-pathname-coding-system)) (when (and directory @@ -614,6 +730,19 @@ Bind `print-quoted' and `print-readably' to t while printing." (setq beg (point))) (gnus-put-text-property beg (point) prop val))))) +(defsubst gnus-put-overlay-excluding-newlines (beg end prop val) + "The same as `put-text-property', but don't put this prop on any newlines in the region." + (save-match-data + (save-excursion + (save-restriction + (goto-char beg) + (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) + (gnus-overlay-put + (gnus-make-overlay beg (match-beginning 0)) + prop val) + (setq beg (point))) + (gnus-overlay-put (gnus-make-overlay beg (point)) prop val))))) + (defun gnus-put-text-property-excluding-characters-with-faces (beg end prop val) "The same as `put-text-property', but don't put props on characters with the `gnus-face' property." @@ -622,9 +751,23 @@ Bind `print-quoted' and `print-readably' to t while printing." (when (get-text-property b 'gnus-face) (setq b (next-single-property-change b 'gnus-face nil end))) (when (/= b end) - (gnus-put-text-property - b (setq b (next-single-property-change b 'gnus-face nil end)) - prop val))))) + (inline + (gnus-put-text-property + b (setq b (next-single-property-change b 'gnus-face nil end)) + prop val)))))) + +(defmacro gnus-faces-at (position) + "Return a list of faces at POSITION." + (if (featurep 'xemacs) + `(let ((pos ,position)) + (mapcar-extents 'extent-face + nil (current-buffer) pos pos nil 'face)) + `(let ((pos ,position)) + (delq nil (cons (get-text-property pos 'face) + (mapcar + (lambda (overlay) + (overlay-get overlay 'face)) + (overlays-at pos))))))) ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 ;;; The primary idea here is to try to protect internal datastructures @@ -655,7 +798,7 @@ non-locally exits. The variables listed in PROTECT are updated atomically. It is safe to use gnus-atomic-progn-assign with long computations. Note that if any of the symbols in PROTECT were unbound, they will be -set to nil on a sucessful assignment. In case of an error or other +set to nil on a successful assignment. In case of an error or other non-local exit, it will still be unbound." (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol (concat (symbol-name x) @@ -734,7 +877,10 @@ with potentially long computations." ;; Decide whether to append to a file or to an Emacs buffer. (let ((outbuf (get-file-buffer filename))) (if (not outbuf) - (write-region-as-binary (point-min) (point-max) filename 'append) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (write-region-as-binary (point-min) (point-max) + filename 'append)) ;; File has been visited, in buffer OUTBUF. (set-buffer outbuf) (let ((buffer-read-only nil) @@ -748,10 +894,10 @@ with potentially long computations." (when msg (goto-char (point-min)) (widen) - (search-backward "\n\^_") - (narrow-to-region (point) (point-max)) - (rmail-count-new-messages t) - (when (rmail-summary-exists) + (search-backward "\n\^_") + (narrow-to-region (point) (point-max)) + (rmail-count-new-messages t) + (when (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))) (rmail-count-new-messages t) @@ -803,8 +949,10 @@ with potentially long computations." (insert "\n")) (insert "\n")) (goto-char (point-max)) - (write-region-as-binary (point-min) (point-max) - filename 'append))) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (write-region-as-binary (point-min) (point-max) + filename 'append)))) ;; File has been visited, in buffer OUTBUF. (set-buffer outbuf) (let ((buffer-read-only nil)) @@ -829,104 +977,14 @@ with potentially long computations." (defun gnus-map-function (funs arg) "Applies the result of the first function in FUNS to the second, and so on. ARG is passed to the first function." - (let ((myfuns funs)) - (while myfuns - (setq arg (funcall (pop myfuns) arg))) - arg)) + (while funs + (setq arg (funcall (pop funs) arg))) + arg) (defun gnus-run-hooks (&rest funcs) - "Does the same as `run-hooks', but saves excursion." - (let ((buf (current-buffer))) - (unwind-protect - (apply 'run-hooks funcs) - (set-buffer buf)))) - -;;; -;;; .netrc and .authinforc parsing -;;; - -(defun gnus-parse-netrc (file) - "Parse FILE and return an list of all entries in the file." - (when (file-exists-p file) - (with-temp-buffer - (let ((tokens '("machine" "default" "login" - "password" "account" "macdef" "force" - "port")) - alist elem result pair) - (insert-file-contents file) - (goto-char (point-min)) - ;; Go through the file, line by line. - (while (not (eobp)) - (narrow-to-region (point) (gnus-point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - ;; Skip lines that begin with a "#". - (if (eq (char-after) ?#) - (goto-char (point-max)) - (unless (eobp) - (setq elem - (if (= (following-char) ?\") - (read (current-buffer)) - (buffer-substring - (point) (progn (skip-chars-forward "^\t ") - (point))))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. - (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored, - ;; except "default". - (when (and pair (or (cdr pair) - (equal (car pair) "default"))) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil))))))) - (when alist - (push (nreverse alist) result)) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) - (nreverse result))))) - -(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)) - (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." - (cdr (assoc type alist))) + "Does the same as `run-hooks', but saves the current buffer." + (save-current-buffer + (apply 'run-hooks funcs))) ;;; Various @@ -940,28 +998,31 @@ Entries without port tokens default to DEFAULTPORT." (eq major-mode 'gnus-group-mode)))) (defun gnus-remove-duplicates (list) - (let (new (tail list)) - (while tail - (or (member (car tail) new) - (setq new (cons (car tail) new))) - (setq tail (cdr tail))) + (let (new) + (while list + (or (member (car list) new) + (setq new (cons (car list) new))) + (setq list (cdr list))) (nreverse new))) -(defun gnus-delete-if (predicate list) - "Delete elements from LIST that satisfy PREDICATE." +(defun gnus-remove-if (predicate list) + "Return a copy of LIST with all items satisfying PREDICATE removed." (let (out) (while list (unless (funcall predicate (car list)) (push (car list) out)) - (pop list)) + (setq list (cdr list))) (nreverse out))) -(defun gnus-delete-alist (key alist) - "Delete all entries in ALIST that have a key eq to KEY." - (let (entry) - (while (setq entry (assq key alist)) - (setq alist (delq entry alist))) - alist)) +(if (fboundp 'assq-delete-all) + (defalias 'gnus-delete-alist 'assq-delete-all) + (defun gnus-delete-alist (key alist) + "Delete from ALIST all elements whose car is KEY. +Return the modified alist." + (let (entry) + (while (setq entry (assq key alist)) + (setq alist (delq entry alist))) + alist))) (defmacro gnus-pull (key alist &optional assoc-p) "Modify ALIST to be without KEY." @@ -978,7 +1039,7 @@ Entries without port tokens default to DEFAULTPORT." (defun gnus-set-window-start (&optional point) "Set the window start to POINT, or (point) if nil." - (let ((win (get-buffer-window (current-buffer) t))) + (let ((win (gnus-get-buffer-window (current-buffer) t))) (when win (set-window-start win (or point (point)))))) @@ -1023,6 +1084,33 @@ Entries without port tokens default to DEFAULTPORT." (while (search-backward "\\." nil t) (delete-char 1))))) +;; Fixme: Why not use `with-output-to-temp-buffer'? +(defmacro gnus-with-output-to-file (file &rest body) + (let ((buffer (make-symbol "output-buffer")) + (size (make-symbol "output-buffer-size")) + (leng (make-symbol "output-buffer-length")) + (append (make-symbol "output-buffer-append"))) + `(let* ((,size 131072) + (,buffer (make-string ,size 0)) + (,leng 0) + (,append nil) + (standard-output + (lambda (c) + (aset ,buffer ,leng c) + + (if (= ,size (setq ,leng (1+ ,leng))) + (progn (write-region ,buffer nil ,file ,append 'no-msg) + (setq ,leng 0 + ,append t)))))) + ,@body + (when (> ,leng 0) + (let ((coding-system-for-write 'no-conversion)) + (write-region (substring ,buffer 0 ,leng) nil ,file + ,append 'no-msg)))))) + +(put 'gnus-with-output-to-file 'lisp-indent-function 1) +(put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) + (if (fboundp 'union) (defalias 'gnus-union 'union) (defun gnus-union (l1 l2) @@ -1064,6 +1152,339 @@ Entries without port tokens default to DEFAULTPORT." (remove-text-properties start end properties object)) t)) +;; This might use `compare-strings' to reduce consing in the +;; case-insensitive case, but it has to cope with null args. +;; (`string-equal' uses symbol print names.) +(defun gnus-string-equal (x y) + "Like `string-equal', except it compares case-insensitively." + (and (= (length x) (length y)) + (or (string-equal x y) + (string-equal (downcase x) (downcase y))))) + +(defcustom gnus-use-byte-compile t + "If non-nil, byte-compile crucial run-time code. +Setting it to nil has no effect after the first time `gnus-byte-compile' +is run." + :type 'boolean + :version "21.1" + :group 'gnus-various) + +(defun gnus-byte-compile (form) + "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." + (if gnus-use-byte-compile + (progn + (condition-case nil + ;; Work around a bug in XEmacs 21.4 + (require 'byte-optimize) + (error)) + (require 'bytecomp) + (defalias 'gnus-byte-compile + (lambda (form) + (let ((byte-compile-warnings '(unresolved callargs redefine))) + (byte-compile form)))) + (gnus-byte-compile form)) + form)) + +(defun gnus-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 +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'." + (when alist + (if (equal key (caar alist)) + (cdr alist) + (setcdr alist (gnus-remassoc key (cdr alist))) + alist))) + +(defun gnus-update-alist-soft (key value alist) + (if value + (cons (cons key value) (gnus-remassoc key alist)) + (gnus-remassoc key alist))) + +(defun gnus-create-info-command (node) + "Create a command that will go to info NODE." + `(lambda () + (interactive) + ,(concat "Enter the info system at node " node) + (Info-goto-node ,node) + (setq gnus-info-buffer (current-buffer)) + (gnus-configure-windows 'info))) + +(defun gnus-not-ignore (&rest args) + t) + +(defvar gnus-directory-sep-char-regexp "/" + "The regexp of directory separator character. +If you find some problem with the directory separator character, try +\"[/\\\\\]\" for some systems.") + +(defun gnus-url-unhex (x) + (if (> x ?9) + (if (>= x ?a) + (+ 10 (- x ?a)) + (+ 10 (- x ?A))) + (- x ?0))) + +;; Fixme: Do it like QP. +(defun gnus-url-unhex-string (str &optional allow-newlines) + "Remove %XX, embedded spaces, etc in a url. +If optional second argument ALLOW-NEWLINES is non-nil, then allow the +decoding of carriage returns and line feeds in the string, which is normally +forbidden in URL encoding." + (setq str (or (mm-subst-char-in-string ?+ ? str) "")) ; why `or'? + (let ((tmp "") + (case-fold-search t)) + (while (string-match "%[0-9a-f][0-9a-f]" str) + (let* ((start (match-beginning 0)) + (ch1 (gnus-url-unhex (elt str (+ start 1)))) + (code (+ (* 16 ch1) + (gnus-url-unhex (elt str (+ start 2)))))) + (setq tmp (concat + tmp (substring str 0 start) + (cond + (allow-newlines + (char-to-string code)) + ((or (= code ?\n) (= code ?\r)) + " ") + (t (char-to-string code)))) + str (substring str (match-end 0))))) + (setq tmp (concat tmp str)) + tmp)) + +(defun gnus-make-predicate (spec) + "Transform SPEC into a function that can be called. +SPEC is a predicate specifier that contains stuff like `or', `and', +`not', lists and functions. The functions all take one parameter." + `(lambda (elem) ,(gnus-make-predicate-1 spec))) + +(defun gnus-make-predicate-1 (spec) + (cond + ((symbolp spec) + `(,spec elem)) + ((listp spec) + (if (memq (car spec) '(or and not)) + `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) + (error "Invalid predicate specifier: %s" spec))))) + +(defun gnus-local-map-property (map) + "Return a list suitable for a text property list specifying keymap MAP." + (cond + ((featurep 'xemacs) + (list 'keymap map)) + ((>= emacs-major-version 21) + (list 'keymap map)) + (t + (list 'local-map map)))) + +(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate + require-match initial-contents + history default) + "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen." + `(completing-read ,prompt ,table ,predicate ,require-match + ,initial-contents ,history + ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2)) + () + (list default)))) + +(defun gnus-completing-read (prompt table &optional predicate require-match + history) + (when (and history + (not (boundp history))) + (set history nil)) + (gnus-completing-read-maybe-default + (if (symbol-value history) + (concat prompt " (" (car (symbol-value history)) "): ") + (concat prompt ": ")) + table + predicate + require-match + nil + history + (car (symbol-value history)))) + +(defun gnus-graphic-display-p () + (or (and (fboundp 'display-graphic-p) + (display-graphic-p)) + ;;;!!!This is bogus. Fixme! + (and (featurep 'xemacs) + t))) + +(put 'gnus-parse-without-error 'lisp-indent-function 0) +(put 'gnus-parse-without-error 'edebug-form-spec '(body)) + +(defmacro gnus-parse-without-error (&rest body) + "Allow continuing onto the next line even if an error occurs." + `(while (not (eobp)) + (condition-case () + (progn + ,@body + (goto-char (point-max))) + (error + (gnus-error 4 "Invalid data on line %d" + (count-lines (point-min) (point))) + (forward-line 1))))) + +(defun gnus-cache-file-contents (file variable function) + "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION." + (let ((time (nth 5 (file-attributes file))) + contents value) + (if (or (null (setq value (symbol-value variable))) + (not (equal (car value) file)) + (not (equal (nth 1 value) time))) + (progn + (setq contents (funcall function file)) + (set variable (list file time contents)) + contents) + (nth 2 value)))) + +(defun gnus-multiple-choice (prompt choice &optional idx) + "Ask user a multiple choice question. +CHOICE is a list of the choice char and help message at IDX." + (let (tchar buf) + (save-window-excursion + (save-excursion + (while (not tchar) + (message "%s (%s): " + prompt + (mapconcat (lambda (s) (char-to-string (car s))) + choice ", ")) + (setq tchar (read-char)) + (when (not (assq tchar choice)) + (setq tchar nil) + (setq buf (get-buffer-create "*Gnus Help*")) + (pop-to-buffer buf) + (fundamental-mode) ; for Emacs 20.4+ + (buffer-disable-undo) + (erase-buffer) + (insert prompt ":\n\n") + (let ((max -1) + (list choice) + (alist choice) + (idx (or idx 1)) + (i 0) + n width pad format) + ;; find the longest string to display + (while list + (setq n (length (nth idx (car list)))) + (unless (> max n) + (setq max n)) + (setq list (cdr list))) + (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end + (setq n (/ (1- (window-width)) max)) ; items per line + (setq width (/ (1- (window-width)) n)) ; width of each item + ;; insert `n' items, each in a field of width `width' + (while alist + (if (< i n) + () + (setq i 0) + (delete-char -1) ; the `\n' takes a char + (insert "\n")) + (setq pad (- width 3)) + (setq format (concat "%c: %-" (int-to-string pad) "s")) + (insert (format format (caar alist) (nth idx (car alist)))) + (setq alist (cdr alist)) + (setq i (1+ i)))))))) + (if (buffer-live-p buf) + (kill-buffer buf)) + tchar)) + +(defun gnus-select-frame-set-input-focus (frame) + "Select FRAME, raise it, and set input focus, if possible." + (cond ((featurep 'xemacs) + (raise-frame frame) + (select-frame frame) + (focus-frame frame)) + ;; The function `select-frame-set-input-focus' won't set + ;; the input focus under Emacs 21.2 and X window system. + ;;((fboundp 'select-frame-set-input-focus) + ;; (defalias 'gnus-select-frame-set-input-focus + ;; 'select-frame-set-input-focus) + ;; (select-frame-set-input-focus frame)) + (t + (raise-frame frame) + (select-frame frame) + (cond ((and (eq window-system 'x) + (fboundp 'x-focus-frame)) + (x-focus-frame frame)) + ((eq window-system 'w32) + (w32-focus-frame frame))) + (when (or (not (boundp 'focus-follows-mouse)) + (symbol-value 'focus-follows-mouse)) + (set-mouse-position frame (1- (frame-width frame)) 0))))) + +(unless (fboundp 'frame-parameter) + (defalias 'frame-parameter + (lambda (frame parameter) + "Return FRAME's value for parameter PARAMETER. +If FRAME is nil, describe the currently selected frame." + (cdr (assq parameter (frame-parameters frame)))))) + +(defun gnus-frame-or-window-display-name (object) + "Given a frame or window, return the associated display name. +Return nil otherwise." + (if (featurep 'xemacs) + (device-connection (dfw-device object)) + (if (or (framep object) + (and (windowp object) + (setq object (window-frame object)))) + (let ((display (frame-parameter object 'display))) + (if (and (stringp display) + ;; Exclude invalid display names. + (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" + display)) + display))))) + +;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile. +(defmacro gnus-mapcar (function seq1 &rest seqs2_n) + "Apply FUNCTION to each element of the sequences, and make a list of the results. +If there are several sequences, FUNCTION is called with that many arguments, +and mapping stops as soon as the shortest sequence runs out. With just one +sequence, this is like `mapcar'. With several, it is like the Common Lisp +`mapcar' function extended to arbitrary sequence types." + + (if seqs2_n + (let* ((seqs (cons seq1 seqs2_n)) + (cnt 0) + (heads (mapcar (lambda (seq) + (make-symbol (concat "head" + (int-to-string + (setq cnt (1+ cnt)))))) + seqs)) + (result (make-symbol "result")) + (result-tail (make-symbol "result-tail"))) + `(let* ,(let* ((bindings (cons nil nil)) + (heads heads)) + (nconc bindings (list (list result '(cons nil nil)))) + (nconc bindings (list (list result-tail result))) + (while heads + (nconc bindings (list (list (pop heads) (pop seqs))))) + (cdr bindings)) + (while (and ,@heads) + (setcdr ,result-tail (cons (funcall ,function + ,@(mapcar (lambda (h) (list 'car h)) + heads)) + nil)) + (setq ,result-tail (cdr ,result-tail) + ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads)))) + (cdr ,result))) + `(mapcar ,function ,seq1))) + +(if (fboundp 'merge) + (defalias 'gnus-merge 'merge) + ;; Adapted from cl-seq.el + (defun gnus-merge (type list1 list2 pred) + "Destructively merge lists LIST1 and LIST2 to produce a new list. +Argument TYPE is for compatibility and ignored. +Ordering of the elements is preserved according to PRED, a `less-than' +predicate on the elements." + (let ((res nil)) + (while (and list1 list2) + (if (funcall pred (car list2) (car list1)) + (push (pop list2) res) + (push (pop list1) res))) + (nconc (nreverse res) list1 list2)))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 4c0cc90..5cb9f64 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,6 +1,6 @@ ;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000, +;; 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 @@ -298,7 +298,8 @@ so I simply dropped them." "^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." +The headers will be included in the sequence they are matched. If nil +include all headers." :group 'gnus-extract :type '(repeat regexp)) @@ -320,7 +321,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-saved-article-name nil) -(defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") +(defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$") (defvar gnus-uu-end-string "^end[ \t]*$") (defvar gnus-uu-body-line "^M") @@ -335,7 +336,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-shar-file-name nil) (defvar gnus-uu-shar-name-marker - "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") + "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)") (defvar gnus-uu-postscript-begin-string "^%!PS-") (defvar gnus-uu-postscript-end-string "^%%EOF$") @@ -352,56 +353,6 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-digest-from-subject nil) (defvar gnus-uu-digest-buffer nil) -;; Keymaps - -(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) - "p" gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "s" gnus-uu-mark-series - "r" gnus-uu-mark-region - "g" gnus-uu-unmark-region - "R" gnus-uu-mark-by-regexp - "G" gnus-uu-unmark-by-regexp - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "a" gnus-uu-mark-all - "b" gnus-uu-mark-buffer - "S" gnus-uu-mark-sparse - "k" gnus-summary-kill-process-mark - "y" gnus-summary-yank-process-mark - "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) - -(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) - ;;"x" gnus-uu-extract-any - "m" gnus-summary-save-parts - "u" gnus-uu-decode-uu - "U" gnus-uu-decode-uu-and-save - "s" gnus-uu-decode-unshar - "S" gnus-uu-decode-unshar-and-save - "o" gnus-uu-decode-save - "O" gnus-uu-decode-save - "b" gnus-uu-decode-binhex - "B" gnus-uu-decode-binhex - "p" gnus-uu-decode-postscript - "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) - - ;; Commands. (defun gnus-uu-decode-uu (&optional n) @@ -456,7 +407,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." gnus-uu-default-dir gnus-uu-default-dir)))) (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) + (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-uu-view (&optional n) @@ -509,7 +460,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-file-name "Unbinhex, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir))) (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) + (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) @@ -520,48 +471,52 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Digests and forwards all articles in this series." (interactive "P") (let ((gnus-uu-save-in-digest t) - (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward"))) + (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward"))) + (message-forward-as-mime message-forward-as-mime) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) 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) - (set-buffer gnus-uu-digest-buffer) - (let ((fs gnus-uu-digest-from-subject)) - (when fs - (setq from (caar fs) - subject (gnus-simplify-subject-fuzzy (cdar fs)) - fs (cdr fs)) - (while (and fs (or from subject)) - (when from - (unless (string= from (caar fs)) - (setq from nil))) - (when subject - (unless (string= (gnus-simplify-subject-fuzzy (cdar fs)) - subject) - (setq subject nil))) - (setq fs (cdr fs)))) - (unless subject - (setq subject "Digested Articles")) - (unless from - (setq from - (if (gnus-news-group-p gnus-newsgroup-name) - gnus-newsgroup-name - "Various")))) - (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)) + (if (and n (not (numberp n))) + (setq message-forward-as-mime (not message-forward-as-mime) + n nil)) + (let ((gnus-article-reply (gnus-summary-work-articles n))) + (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) + (switch-to-buffer gnus-uu-digest-buffer) + (let ((fs gnus-uu-digest-from-subject)) + (when fs + (setq from (caar fs) + subject (gnus-simplify-subject-fuzzy (cdar fs)) + fs (cdr fs)) + (while (and fs (or from subject)) + (when from + (unless (string= from (caar fs)) + (setq from nil))) + (when subject + (unless (string= (gnus-simplify-subject-fuzzy (cdar fs)) + subject) + (setq subject nil))) + (setq fs (cdr fs)))) + (unless subject + (setq subject "Digested Articles")) + (unless from + (setq from + (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)) + (let ((message-forward-decoded-p t)) + (message-forward post)))) (setq gnus-uu-digest-from-subject nil))) (defun gnus-uu-digest-post-forward (&optional n) @@ -571,17 +526,40 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; Process marking. +(defun gnus-message-process-mark (unmarkp new-marked) + (let ((old (- (length gnus-newsgroup-processable) (length new-marked)))) + (message "%d mark%s %s%s" + (length new-marked) + (if (= (length new-marked) 1) "" "s") + (if unmarkp "removed" "added") + (cond + ((and (zerop old) + (not unmarkp)) + "") + (unmarkp + (format ", %d remain marked" + (length gnus-newsgroup-processable))) + (t + (format ", %d already marked" old)))))) + +(defun gnus-new-processable (unmarkp articles) + (if unmarkp + (gnus-intersection gnus-newsgroup-processable articles) + (gnus-set-difference articles gnus-newsgroup-processable))) + (defun gnus-uu-mark-by-regexp (regexp &optional unmark) "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 - (gnus-summary-remove-process-mark (pop articles)) - (gnus-summary-set-process-mark (pop articles)))) - (message "")) + (save-excursion + (let* ((articles (gnus-uu-find-articles-matching regexp)) + (new-marked (gnus-new-processable unmark articles))) + (while articles + (if unmark + (gnus-summary-remove-process-mark (pop articles)) + (gnus-summary-set-process-mark (pop articles)))) + (gnus-message-process-mark unmark new-marked))) (gnus-summary-position-point)) (defun gnus-uu-unmark-by-regexp (regexp) @@ -593,11 +571,12 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-series () "Mark the current series with the process mark." (interactive) - (let ((articles (gnus-uu-find-articles-matching))) + (let* ((articles (gnus-uu-find-articles-matching)) + (l (length articles))) (while articles (gnus-summary-set-process-mark (car articles)) (setq articles (cdr articles))) - (message "")) + (message "Marked %d articles" l)) (gnus-summary-position-point)) (defun gnus-uu-mark-region (beg end &optional unmark) @@ -854,8 +833,9 @@ When called interactively, prompt for REGEXP." (save-excursion (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*")) (erase-buffer) - (unless gnus-uu-digest-buffer - (insert (format "From: %s\nSubject: %s Digest\n\n" name name))) + (insert (format + "Date: %s\nFrom: %s\nSubject: %s Digest\n\n" + (current-time-string) name name)) (insert "Topics:\n"))) (when (not (eq in-state 'end)) (setq state (list 'middle)))) @@ -882,7 +862,7 @@ When called interactively, prompt for REGEXP." (setq body (buffer-substring (1- (point)) (point-max))) (narrow-to-region (point-min) (point)) (if (not (setq headers gnus-uu-digest-headers)) - (setq sorthead (buffer-substring (point-min) (point-max))) + (setq sorthead (buffer-string)) (while headers (setq headline (car headers)) (setq headers (cdr headers)) @@ -902,7 +882,8 @@ When called interactively, prompt for REGEXP." (goto-char beg) (when (re-search-forward "^Subject:" nil t) (setq subj (nnheader-decode-subject - (buffer-substring (match-end 0) (std11-field-end)))) + (buffer-substring (match-end 0) (std11-field-end))))) + (when subj (save-excursion (set-buffer "*gnus-uu-pre*") (insert (format " %s\n" subj))))) @@ -972,7 +953,8 @@ When called interactively, prompt for REGEXP." (if (looking-at gnus-uu-binhex-begin-line) (progn (setq state (list 'begin)) - (write-region 1 1 gnus-uu-binhex-article-name)) + (write-region (point-min) (point-min) + gnus-uu-binhex-article-name)) (setq state (list 'middle))) (goto-char (point-max)) (re-search-backward (concat gnus-uu-binhex-body-line "\\|" @@ -1085,7 +1067,7 @@ When called interactively, prompt for REGEXP." (while (re-search-forward "[ \t]+" nil t) (replace-match "[ \t]+" t t)) - (buffer-substring 1 (point-max)))) + (buffer-string))) (defun gnus-uu-get-list-of-articles (n) ;; If N is non-nil, the article numbers of the N next articles @@ -1177,10 +1159,11 @@ When called interactively, prompt for REGEXP." ;; Expand numbers. (goto-char (point-min)) (while (re-search-forward "[0-9]+" nil t) - (replace-match - (format "%06d" - (string-to-int (buffer-substring - (match-beginning 0) (match-end 0)))))) + (ignore-errors + (replace-match + (format "%06d" + (string-to-int (buffer-substring + (match-beginning 0) (match-end 0))))))) (setq string (buffer-substring 1 (point-max))) (setcar (car string-list) string) (setq string-list (cdr string-list)))) @@ -1364,6 +1347,9 @@ When called interactively, prompt for REGEXP." (while article-series (gnus-summary-tick-article (pop article-series) t))))) + ;; The original article buffer is hosed, shoot it down. + (gnus-kill-buffer gnus-original-article-buffer) + (setq gnus-current-article nil) result-files)) (defun gnus-uu-grab-view (file) @@ -1435,7 +1421,7 @@ When called interactively, prompt for REGEXP." (let ((nnheader-file-name-translation-alist '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 1)))) - (replace-match (concat "begin 644 " gnus-uu-file-name) t t) + (replace-match (concat "begin 644 " gnus-uu-file-name) t t) ;; Remove any non gnus-uu-body-line right after start. (forward-line 1) @@ -1544,7 +1530,7 @@ Gnus might fail to display all of it.") (unless (unwind-protect (with-current-buffer buffer - (insert (substitute-command-keys + (insert (substitute-command-keys gnus-uu-unshar-warning)) (goto-char (point-min)) (display-buffer buffer) @@ -1749,8 +1735,7 @@ Gnus might fail to display all of it.") gnus-uu-tmp-dir))) (setq gnus-uu-work-dir - (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) - (gnus-make-directory gnus-uu-work-dir) + (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) (set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (push (cons gnus-newsgroup-name gnus-uu-work-dir) @@ -1776,7 +1761,7 @@ Gnus might fail to display all of it.") (push (list (aref arg new-pos)) accum) (setq pos (1+ new-pos))) (if (= pos 0) - arg + arg (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) ;; Inputs an action and a filename and returns a full command, making sure @@ -1802,9 +1787,13 @@ Gnus might fail to display all of it.") (if (file-directory-p file) (gnus-uu-delete-work-dir file) (gnus-message 9 "Deleting file %s..." file) - (delete-file file)))) - (delete-directory dir))) - (gnus-message 7 "")) + (condition-case err + (delete-file file) + (error (gnus-message 3 "Deleting file %s failed... %s" file err)))))) + (condition-case err + (delete-directory dir) + (error (gnus-message 3 "Deleting directory %s failed... %s" file err)))) + (gnus-message 7 ""))) ;; Initializing @@ -1932,7 +1921,7 @@ The user will be asked for a file name." (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line -1) - (narrow-to-region 1 (point)) + (narrow-to-region (point-min) (point)) (unless (mail-fetch-field "mime-version") (widen) (insert "MIME-Version: 1.0\n")) @@ -2022,7 +2011,7 @@ If no file has been included, the user will be asked for a file." (erase-buffer) (insert-buffer-substring post-buf beg-binary end-binary) (goto-char (point-min)) - (setq length (count-lines 1 (point-max))) + (setq length (count-lines (point-min) (point-max))) (setq parts (/ length gnus-uu-post-length)) (unless (< (% length gnus-uu-post-length) 4) (incf parts))) @@ -2035,7 +2024,7 @@ If no file has been included, the user will be asked for a file." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) - (setq header (buffer-substring 1 (point))) + (setq header (buffer-substring (point-min) (point))) (goto-char (point-min)) (when gnus-uu-post-separate-description @@ -2116,4 +2105,4 @@ If no file has been included, the user will be asked for a file." (provide 'gnus-uu) -;; gnus-uu.el ends here +;;; gnus-uu.el ends here diff --git a/lisp/gnus-vers.el b/lisp/gnus-vers.el index c77bae4..cdd5bef 100644 --- a/lisp/gnus-vers.el +++ b/lisp/gnus-vers.el @@ -1,6 +1,6 @@ -;;; gnus-vers.el --- Declare gnus version. +;;; gnus-vers.el --- Declare gnus version -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Keiichi Suzuki ;; Katsumi Yamaoka @@ -34,21 +34,21 @@ (require 'product) (provide 'gnus-vers) -(defconst gnus-revision-number "04" +(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 14 6 + (list 6 15 24 (string-to-number gnus-revision-number)))) -(defconst gnus-original-version-number "5.8.8" +(defconst gnus-original-version-number "0.24" "Version number for this version of Gnus.") (provide 'running-pterodactyl-gnus-0_73-or-later) -(defconst gnus-original-product-name "Gnus" +(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)) @@ -62,7 +62,7 @@ "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)" + (format "%s %s r%s (based on %s v%s ; for SEMI 1.14 FLIM 1.14)" gnus-product-name gnus-version-number gnus-revision-number gnus-original-product-name gnus-original-version-number) "Version string for this version of gnus.") diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index a7f6934..2737151 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, 2001 +;; Free Software Foundation, Inc. ;; Author: Per Persson ;; Katsumi Yamaoka @@ -47,7 +49,7 @@ (defvar vm-folder-history) (defvar vm-primary-inbox) (defvar vm-use-toolbar) - + (defun gnus-vm-make-folder (&optional buffer) (let ((article (or buffer (current-buffer))) (tmp-folder (generate-new-buffer " *tmp-folder*")) @@ -162,4 +164,4 @@ save those articles instead." (provide 'gnus-vm) -;;; gnus-vm.el ends here. +;;; gnus-vm.el ends here diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 51934fd..0d578d7 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -1,5 +1,5 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -29,6 +29,7 @@ (eval-when-compile (require 'cl)) (require 'gnus) +(require 'gnus-util) (defgroup gnus-windows nil "Window configuration." @@ -57,6 +58,13 @@ :group 'gnus-windows :type 'boolean) +(defcustom gnus-use-frames-on-any-display nil + "*If non-nil, frames on all displays will be considered useable by Gnus. +When nil, only frames on the same display as the selected frame will be +used to display Gnus windows." + :group 'gnus-windows + :type 'boolean) + (defvar gnus-buffer-configuration '((group (vertical 1.0 @@ -68,17 +76,6 @@ (if gnus-carpal '(summary-carpal 4)))) (article (cond - ((and gnus-use-picons - (eq gnus-picons-display-where 'picons)) - '(frame 1.0 - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0)) - (vertical ((height . 5) (width . 15) - (user-position . t) - (left . -1) (top . 1)) - (picons 1.0)))) (gnus-use-trees '(vertical 1.0 (summary 0.25 point) @@ -126,7 +123,7 @@ (post 1.0 point))) (reply (vertical 1.0 - (article-copy 0.5) + (article 0.5) (message 1.0 point))) (forward (vertical 1.0 @@ -145,7 +142,7 @@ ("*Shell Command Output*" 1.0))) (bug (vertical 1.0 - ("*Gnus Help Bug*" 0.5) + (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) ("*Gnus Bug*" 1.0 point))) (score-trace (vertical 1.0 @@ -165,7 +162,10 @@ (compose-bounce (vertical 1.0 (article 0.5) - (message 1.0 point)))) + (message 1.0 point))) + (display-term + (vertical 1.0 + ("*display*" 1.0)))) "Window configuration for all possible Gnus buffers. See the Gnus manual for an explanation of the syntax used.") @@ -187,7 +187,6 @@ See the Gnus manual for an explanation of the syntax used.") (mail . gnus-message-buffer) (post-news . gnus-message-buffer) (faq . gnus-faq-buffer) - (picons . gnus-picons-buffer-name) (tree . gnus-tree-buffer) (score-trace . "*Score Trace*") (split-trace . "*Split Trace*") @@ -197,6 +196,11 @@ See the Gnus manual for an explanation of the syntax used.") (draft . gnus-draft-buffer)) "Mapping from short symbols to buffer names or buffer variables.") +(defcustom gnus-configure-windows-hook nil + "*A hook called when configuring windows." + :group 'gnus-windows + :type 'hook) + ;;; Internal variables. (defvar gnus-current-window-configuration nil @@ -291,7 +295,7 @@ See the Gnus manual for an explanation of the syntax used.") (unless window (setq window current-window)) (select-window window) - ;; This might be an old-stylee buffer config. + ;; This might be an old-style buffer config. (when (vectorp split) (setq split (append split nil))) (when (or (consp (car split)) @@ -301,7 +305,7 @@ See the Gnus manual for an explanation of the syntax used.") ;; 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))) + (functionp (car split))) (setq split (eval split))) (let* ((type (car split)) (subs (cddr split)) @@ -364,7 +368,7 @@ See the Gnus manual for an explanation of the syntax used.") (while subs (setq sub (append (pop subs) nil)) (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) + (functionp (car sub))) (setq sub (eval sub))) (when sub (push sub comp-subs) @@ -433,7 +437,7 @@ 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)) @@ -447,17 +451,22 @@ See the Gnus manual for an explanation of the syntax used.") ;; This is not a `frame' split, so we ignore the ;; other frames. (delete-other-windows) - ;; This is a `frame' split, so we delete all windows + ;; This is a `frame' split, so we delete all windows ;; on all frames. (gnus-delete-windows-in-gnusey-frames)) ;; Just remove some windows. (gnus-remove-some-windows) - (set-buffer nntp-server-buffer)) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer))) (select-frame frame))) (let (gnus-window-frame-focus) - (set-buffer nntp-server-buffer) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer)) (gnus-configure-frame split) + (run-hooks 'gnus-configure-windows-hook) (when gnus-window-frame-focus (select-frame (window-frame gnus-window-frame-focus)))))))) @@ -498,7 +507,7 @@ should have point." ;; 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))) + (functionp (car split))) (setq split (eval split))) (setq type (elt split 0)) @@ -512,7 +521,7 @@ should have point." (unless buffer (error "Invalid buffer type: %s" type)) (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer))) - (setq win (get-buffer-window buf t))) + (setq win (gnus-get-buffer-window buf t))) (if (memq 'point split) (setq all-visible win)) (setq all-visible nil))) @@ -541,8 +550,32 @@ should have point." lowest-buf buf)))) (when lowest-buf (pop-to-buffer lowest-buf) - (set-buffer nntp-server-buffer)) - (mapcar (lambda (b) (delete-windows-on b t)) bufs)))) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer))) + (mapcar (lambda (b) (delete-windows-on b t)) + (delq lowest-buf bufs))))) + +(eval-and-compile + (cond + ((fboundp 'frames-on-display-list) + (defalias 'gnus-frames-on-display-list 'frames-on-display-list)) + ((and (featurep 'xemacs) (fboundp 'frame-device)) + (defun gnus-frames-on-display-list () + (apply 'filtered-frame-list 'identity (list (frame-device nil))))) + (t + (defalias 'gnus-frames-on-display-list 'frame-list)))) + +(defun gnus-get-buffer-window (buffer &optional frame) + (cond ((and (null gnus-use-frames-on-any-display) + (memq frame '(t 0 visible))) + (car + (let ((frames (gnus-frames-on-display-list))) + (gnus-remove-if (lambda (win) (not (memq (window-frame win) + frames))) + (get-buffer-window-list buffer nil frame))))) + (t + (get-buffer-window buffer frame)))) (provide 'gnus-win) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 84dc234..7fa13d7 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -1,7 +1,7 @@ ;;; gnus-xmas.el --- Gnus functions for XEmacs -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 -;; Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Katsumi Yamaoka @@ -45,55 +45,16 @@ automatically." directory) :group 'gnus-xmas) -;;(format "%02x%02x%02x" 114 66 20) "724214" - -(defvar gnus-xmas-logo-color-alist - '((flame "#cc3300" "#ff2200") - (pine "#c0cc93" "#f8ffb8") - (moss "#a1cc93" "#d2ffb8") - (irish "#04cc90" "#05ff97") - (sky "#049acc" "#05deff") - (tin "#6886cc" "#82b6ff") - (velvet "#7c68cc" "#8c82ff") - (grape "#b264cc" "#cf7df") - (labia "#cc64c2" "#fd7dff") - (berry "#cc6485" "#ff7db5") - (dino "#724214" "#1e3f03") - (neutral "#b4b4b4" "#878787") - (september "#bf9900" "#ffcc00")) - "Color alist used for the Gnus logo.") - -(defcustom gnus-xmas-logo-color-style 'dino - "*Color styles used for the Gnus logo." - :type '(choice (const flame) (const pine) (const moss) - (const irish) (const sky) (const tin) - (const velvet) (const grape) (const labia) - (const berry) (const neutral) (const september) - (const dino)) - :group 'gnus-xmas) - -(defvar gnus-xmas-logo-colors - (cdr (assq gnus-xmas-logo-color-style gnus-xmas-logo-color-alist)) - "Colors used for the Gnus logo.") - -(defcustom gnus-article-x-face-command - (if (or (featurep 'xface) - (featurep 'xpm)) - 'gnus-xmas-article-display-xface - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -") - "*String or function to be executed to display an X-Face header. -If it is a string, the command will be executed in a sub-shell -asynchronously. The compressed face will be piped to this command." - :type '(choice string function)) +(unless gnus-xmas-glyph-directory + (unless (setq gnus-xmas-glyph-directory + (message-xmas-find-glyph-directory "gnus")) + (error "Can't find glyph directory. \ +Possibly the `etc' directory has not been installed."))) ;;; Internal variables. ;; Don't warn about these undefined variables. -(defvar gnus-group-mode-hook) -(defvar gnus-summary-mode-hook) -(defvar gnus-article-mode-hook) - ;;defined in gnus.el (defvar gnus-active-hashtb) (defvar gnus-article-buffer) @@ -141,12 +102,12 @@ It is provided only to ease porting of broken FSF Emacs programs." (if (stringp buffer) nil (map-extents (lambda (extent ignored) - (remove-text-properties - start end - (list (extent-property extent 'text-prop) nil) - buffer) + (remove-text-properties + start end + (list (extent-property extent 'text-prop) nil) + buffer) nil) - buffer start end nil nil 'text-prop) + buffer start end nil nil 'text-prop) (gnus-add-text-properties start end props buffer))) (defun gnus-xmas-highlight-selected-summary () @@ -198,7 +159,7 @@ displayed, no centering will be performed." ;; whichever is the least. ;; NOFORCE parameter suggested by Daniel Pittman . (set-window-start - window (min bottom (save-excursion (forward-line (- top)) (point))) + window (min bottom (save-excursion (forward-line (- top)) (point))) t)) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) @@ -291,19 +252,19 @@ call it with the value of the `gnus-data' text property." (defun gnus-xmas-appt-select-lowest-window () (let* ((lowest-window (selected-window)) (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) - (last-window (previous-window)) - (window-search t)) + (last-window (previous-window)) + (window-search t)) (while window-search (let* ((this-window (next-window)) - (next-bottom-edge (car (cdr (cdr (cdr - (window-pixel-edges + (next-bottom-edge (car (cdr (cdr (cdr + (window-pixel-edges this-window))))))) - (when (< bottom-edge next-bottom-edge) + (when (< bottom-edge next-bottom-edge) (setq bottom-edge next-bottom-edge) (setq lowest-window this-window)) - (select-window this-window) - (when (eq last-window this-window) + (select-window this-window) + (when (eq last-window this-window) (select-window lowest-window) (setq window-search nil)))))) @@ -329,7 +290,8 @@ call it with the value of the `gnus-data' text property." (defun gnus-xmas-article-menu-add () (gnus-xmas-menu-add article - gnus-article-article-menu gnus-article-treatment-menu)) + gnus-article-article-menu gnus-article-treatment-menu + gnus-article-post-menu gnus-article-commands-menu)) (defun gnus-xmas-score-menu-add () (gnus-xmas-menu-add score @@ -379,8 +341,10 @@ call it with the value of the `gnus-data' text property." (gnus-xmas-menu-add grouplens gnus-grouplens-menu)) -(defun gnus-xmas-read-event-char () +(defun gnus-xmas-read-event-char (&optional prompt) "Get the next event." + (when prompt + (message "%s" prompt)) (let ((event (next-command-event))) (sit-for 0) ;; We junk all non-key events. Is this naughty? @@ -429,12 +393,9 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-window-edges 'window-pixel-edges) (if (and (<= emacs-major-version 19) - (< emacs-minor-version 14)) + (< emacs-minor-version 14)) (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)) - (unless (boundp 'standard-display-table) (setq standard-display-table nil)) @@ -466,40 +427,37 @@ call it with the value of the `gnus-data' text property." (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) + 'gnus-xmas-appt-select-lowest-window) (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) + 'gnus-xmas-mode-line-buffer-identification) (defalias 'gnus-key-press-event-p 'key-press-event-p) (defalias 'gnus-region-active-p 'region-active-p) + (defalias 'gnus-mark-active-p 'region-exists-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) - (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) + (defalias 'gnus-image-type-available-p 'gnus-xmas-image-type-available-p) + (defalias 'gnus-put-image 'gnus-xmas-put-image) + (defalias 'gnus-create-image 'gnus-xmas-create-image) + (defalias 'gnus-remove-image 'gnus-xmas-remove-image) + + (when (or (< emacs-major-version 21) + (and (= emacs-major-version 21) + (< emacs-minor-version 3))) + (defalias 'gnus-completing-read 'gnus-xmas-completing-read)) + + ;; These ones are not defcutom'ed, sometimes not even defvar'ed. They + ;; probably should. If that is done, the code below should then be moved + ;; where each variable is defined, in order not to mess with user settings. + ;; -- didier (add-hook 'gnus-score-mode-hook 'gnus-xmas-score-menu-add) - - (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add) - (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add) (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add) (add-hook 'gnus-server-mode-hook 'gnus-xmas-server-menu-add) (add-hook 'gnus-browse-mode-hook 'gnus-xmas-browse-menu-add) - - (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) - - (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add) - (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add) - (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add) - (add-hook 'gnus-draft-mode-hook 'gnus-xmas-draft-menu-add) - (add-hook 'gnus-summary-mode-hook - 'gnus-xmas-switch-horizontal-scrollbar-off) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off) + (add-hook 'gnus-mailing-list-mode-hook 'gnus-xmas-mailing-list-menu-add) (when (featurep 'mule) (defun gnus-truncate-string (str end-column &optional start-column padding) @@ -554,36 +512,13 @@ the resulting string may be narrower than END-COLUMN. (setq str (substring str from-idx idx)) (if padding (concat head-padding str tail-padding) - str)))) - - (defun gnus-tilde-pad-form (el pad-width) - "Return a form that pads EL to PAD-WIDTH." - (let ((pad (abs pad-width))) - (if (symbolp el) - (if (< pad-width 0) - `(let ((val (format "%s" ,el))) - (concat val (make-string - (max 0 (- ,pad (string-width val))) ?\ ))) - `(let ((val (format "%s" ,el))) - (concat (make-string - (max 0 (- ,pad (string-width val))) ?\ ) - val))) - (if (< pad-width 0) - `(let ((val (eval ,el))) - (concat val (make-string - (max 0 (- ,pad (string-width val))) ?\ ))) - `(let ((val (eval ,el))) - (concat (make-string - (max 0 (- ,pad (string-width val))) ?\ ) - val)))))) - )) + str)))))) ;;; XEmacs logo and toolbar. (defun gnus-xmas-group-startup-message (&optional x y) "Insert startup message in current buffer." ;; Insert the message. - (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (erase-buffer) (cond ((and (console-on-window-system-p) @@ -596,8 +531,9 @@ the resulting string may be narrower than END-COLUMN. `[xpm :file ,logo-xpm :color-symbols - (("thing" . ,(car gnus-xmas-logo-colors)) - ("shadow" . ,(cadr gnus-xmas-logo-colors)) + (("thing" . ,(car gnus-logo-colors)) + ("shadow" . ,(cadr gnus-logo-colors)) + ("oort" . "#eeeeee") ("background" . ,(face-background 'default)))]) ((featurep 'xbm) `[xbm :file ,logo-xbm]) @@ -631,23 +567,23 @@ the resulting string may be narrower than END-COLUMN. (set-window-start (selected-window) (point-min)))) (t (insert " - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ " ) @@ -673,6 +609,7 @@ the resulting string may be narrower than END-COLUMN. (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Paint it. (put-text-property (point-min) (point-max) 'face 'gnus-splash-face))) + (goto-char (point-min)) (setq modeline-buffer-identification (list (concat gnus-version ": *Group*"))) (set-buffer-modified-p t)) @@ -704,6 +641,8 @@ If it is non-nil, it must be a toolbar. The five valid values are [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"] [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"] [gnus-group-kill-group gnus-group-kill-group t "Kill group"] + [gnus-summary-mail-save + gnus-group-save-newsrc t "Save .newsrc files"] ; borrowed icon. [gnus-group-exit gnus-group-exit t "Exit Gnus"]) "The group buffer toolbar.") @@ -761,6 +700,8 @@ If it is non-nil, it must be a toolbar. The five valid values are gnus-summary-save-article-file t "Save article in file"] [gnus-summary-save-article gnus-summary-save-article t "Save article"] + [gnus-summary-cancel-article ; usenet : cancellation :: mail : deletion. + gnus-summary-delete-article t "Delete message"] [gnus-summary-catchup gnus-summary-catchup t "Catchup"] [gnus-summary-catchup-and-exit @@ -783,7 +724,7 @@ If it is non-nil, it must be a toolbar. The five valid values are (cons (current-buffer) bar))))) (defun gnus-xmas-mail-strip-quoted-names (address) - "Protect mail-strip-quoted-names from NIL input. + "Protect mail-strip-quoted-names from nil input. XEmacs compatibility workaround." (if (null address) nil @@ -794,42 +735,6 @@ XEmacs compatibility workaround." 'call-process-region (point-min) (point-max) command t '(t nil) nil args)) -(defface gnus-x-face '((t (:foreground "black" :background "white"))) - "Face to show X face" - :group 'gnus-xmas) - -(defun gnus-xmas-article-display-xface (beg end) - "Display any XFace headers in the current article." - (save-excursion - (let ((xface-glyph - (cond - ((featurep 'xface) - (make-glyph (vector 'xface :data - (concat "X-Face: " - (buffer-substring beg end))))) - ((featurep 'xpm) - (let ((cur (current-buffer))) - (save-excursion - (gnus-set-work-buffer) - (insert-buffer-substring cur beg end) - (gnus-xmas-call-region "uncompface") - (goto-char (point-min)) - (insert "/* Width=48, Height=48 */\n") - (gnus-xmas-call-region "icontopbm") - (gnus-xmas-call-region "ppmtoxpm") - (make-glyph - (vector 'xpm :data (buffer-string)))))) - (t - (make-glyph [nothing])))) - (ext (make-extent (progn - (goto-char (point-min)) - (re-search-forward "^From:" nil t) - (point)) - (1+ (point))))) - (set-glyph-face xface-glyph 'gnus-x-face) - (set-extent-begin-glyph ext xface-glyph) - (set-extent-property ext 'duplicable t)))) - (defvar gnus-xmas-modeline-left-extent (let ((ext (copy-extent modeline-buffer-id-left-extent))) ext)) @@ -840,7 +745,6 @@ XEmacs compatibility workaround." (defvar gnus-xmas-modeline-glyph (progn - (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (let* ((file-xpm (expand-file-name "gnus-pointer.xpm" gnus-xmas-glyph-directory)) (file-xbm (expand-file-name "gnus-pointer.xbm" @@ -887,9 +791,9 @@ XEmacs compatibility workaround." (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) (text-property-any b e 'gnus-undeletable t)))) -(defun gnus-xmas-mime-button-menu (event) +(defun gnus-xmas-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." - (interactive "e") + (interactive "e\nP") (let ((response (get-popup-menu-response `("MIME Part" ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t]) @@ -901,7 +805,7 @@ XEmacs compatibility workaround." (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))) + (end (gnus-point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point)))) (save-restriction @@ -968,9 +872,95 @@ XEmacs compatibility workaround." (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) + gnus-mailing-list-menu)) + +(defun gnus-xmas-image-type-available-p (type) + (and window-system + (featurep (if (eq type 'pbm) 'xbm type)))) + +(defun gnus-xmas-create-image (file &optional type data-p &rest props) + (let ((type (if type + (symbol-name type) + (car (last (split-string file "[.]"))))) + (face (plist-get props :face)) + glyph) + (when (equal type "pbm") + (with-temp-buffer + (if data-p + (insert file) + (insert-file-contents file)) + (shell-command-on-region (point-min) (point-max) + "ppmtoxpm 2>/dev/null" t) + (setq file (buffer-string) + type "xpm" + data-p t))) + (setq glyph + (if (equal type "xbm") + (make-glyph (list (cons 'x file))) + (with-temp-buffer + (if data-p + (insert file) + (insert-file-contents file)) + (make-glyph + (vector + (or (intern type) + (mm-image-type-from-buffer)) + :data (buffer-string)))))) + (when face + (set-glyph-face glyph face)) + glyph)) + +(defun gnus-xmas-put-image (glyph &optional string) + "Insert STRING, but display GLYPH. +Warning: Don't insert text immediately after the image." + (let ((begin (point)) + extent) + (if (and (bobp) (not string)) + (setq string " ")) + (if string + (insert string) + (setq begin (1- begin))) + (setq extent (make-extent begin (point))) + (set-extent-property extent 'gnus-image t) + (set-extent-property extent 'duplicable t) + (if string + (set-extent-property extent 'invisible t)) + (set-extent-property extent 'end-glyph glyph)) + glyph) + +(defun gnus-xmas-remove-image (image) + (map-extents + (lambda (ext unused) + (when (equal (extent-end-glyph ext) image) + (set-extent-property ext 'invisible nil) + (set-extent-property ext 'end-glyph nil)) + nil) + nil nil nil nil nil 'gnus-image)) + +(defun gnus-xmas-completing-read (prompt table &optional + predicate require-match history) + (when (and history + (not (boundp history))) + (set history nil)) + (completing-read + (if (symbol-value history) + (concat prompt " (" (car (symbol-value history)) "): ") + (concat prompt ": ")) + table + predicate + require-match + nil + history)) + +;; This macro is because XEmacs versions prior to 21.2 do not have the +;; PROTOCOL argument to `open-network-stream'. +(defmacro gnus-xmas-open-network-stream (name buffer host service &optional protocol) + "Like `open-network-stream' but take into account older XEmacs versions." + (if (and (featurep 'xemacs) + (fboundp 'open-network-stream) + (emacs-version>= 21 2)) + `(open-network-stream ,name ,buffer ,host ,service ,protocol) + `(open-network-stream ,name ,buffer ,host ,service))) (provide 'gnus-xmas) diff --git a/lisp/gnus.el b/lisp/gnus.el index 4f320a9..336c361 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,6 +1,7 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000 Free Software Foundation, Inc. + +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, +;; 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -34,6 +35,9 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) +(require 'wid-edit) +(require 'nnheader) + (require 'gnus-vers) (defgroup gnus nil @@ -41,13 +45,23 @@ :group 'news :group 'mail) +(defgroup gnus-format nil + "Dealing with formatting issues." + :group 'gnus) + (defgroup gnus-charset nil "Group character set issues." :link '(custom-manual "(gnus)Charsets") + :version "21.1" :group 'gnus) (defgroup gnus-cache nil "Cache interface." + :link '(custom-manual "(gnus)Article Caching") + :group 'gnus) + +(defgroup gnus-registry nil + "Article Registry." :group 'gnus) (defgroup gnus-start nil @@ -135,6 +149,10 @@ :link '(custom-manual "(gnus)Summary Maneuvering") :group 'gnus-summary) +(defgroup gnus-picon nil + "Show pictures of people, domains, and newsgroups." + :group 'gnus-visual) + (defgroup gnus-summary-mail nil "Mail group commands." :link '(custom-manual "(gnus)Mail Group Commands") @@ -210,7 +228,7 @@ ;; Other (defgroup gnus-visual nil - "Options controling the visual fluff." + "Options controlling the visual fluff." :group 'gnus :group 'faces) @@ -235,12 +253,17 @@ "Options related to newsservers and other servers used by Gnus." :group 'gnus) +(defgroup gnus-server-visual nil + "Highlighting and menus in the server buffer." + :group 'gnus-visual + :group 'gnus-server) + (defgroup gnus-message '((message custom-group)) "Composing replies and followups in Gnus." :group 'gnus) (defgroup gnus-meta nil - "Meta variables controling major portions of Gnus. + "Meta variables controlling major portions of Gnus. In general, modifying these variables does not take affect until Gnus is restarted, and sometimes reloaded." :group 'gnus) @@ -259,6 +282,11 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) +(defgroup gnus-fun nil + "Frivolous Gnus extensions." + :link '(custom-manual "(gnus)Exiting Gnus") + :group '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 @@ -305,9 +333,9 @@ be set in `.emacs' instead." (setq gnus-mode-line-image-cache (find-image '((:type xpm :file "gnus-pointer.xpm" - :ascent 80) + :ascent center) (:type xbm :file "gnus-pointer.xbm" - :ascent 80)))) + :ascent center)))) gnus-mode-line-image-cache) 'help-echo "This is Gnus") str) @@ -643,6 +671,33 @@ be set in `.emacs' instead." ())) "Face used for normal interest ancient articles.") +(defface gnus-summary-high-undownloaded-face + '((((class color) + (background light)) + (:bold t :foreground "cyan4")) + (((class color) (background dark)) + (:bold t :foreground "LightGray")) + (t (:inverse-video t :bold t))) + "Face used for high interest uncached articles.") + +(defface gnus-summary-low-undownloaded-face + '((((class color) + (background light)) + (:italic t :foreground "cyan4" :bold nil)) + (((class color) (background dark)) + (:italic t :foreground "LightGray" :bold nil)) + (t (:inverse-video t :italic t))) + "Face used for low interest uncached articles.") + +(defface gnus-summary-normal-undownloaded-face + '((((class color) + (background light)) + (:foreground "cyan4" :bold nil)) + (((class color) (background dark)) + (:foreground "LightGray" :bold nil)) + (t (:inverse-video t))) + "Face used for normal interest uncached articles.") + (defface gnus-summary-high-unread-face '((t (:bold t))) @@ -716,6 +771,13 @@ be set in `.emacs' instead." "Add the current buffer to the list of Gnus buffers." (push (current-buffer) gnus-buffers)) +(defmacro gnus-kill-buffer (buffer) + "Kill BUFFER and remove from the list of Gnus buffers." + `(let ((buf ,buffer)) + (when (gnus-buffer-exists-p buf) + (setq gnus-buffers (delete (get-buffer buf) gnus-buffers)) + (kill-buffer buf)))) + (defun gnus-buffers () "Return a list of live Gnus buffers." (while (and gnus-buffers @@ -738,13 +800,13 @@ be set in `.emacs' instead." (defface gnus-splash-face '((((class color) (background dark)) - (:foreground "Brown")) + (:foreground "#888888")) (((class color) (background light)) - (:foreground "Brown")) + (:foreground "#888888")) (t ())) - "Face of the splash screen.") + "Face for the splash screen.") (defun gnus-splash () (save-excursion @@ -772,6 +834,38 @@ be set in `.emacs' instead." (defvar gnus-simple-splash nil) +;;(format "%02x%02x%02x" 114 66 20) "724214" + +(defvar gnus-logo-color-alist + '((flame "#cc3300" "#ff2200") + (pine "#c0cc93" "#f8ffb8") + (moss "#a1cc93" "#d2ffb8") + (irish "#04cc90" "#05ff97") + (sky "#049acc" "#05deff") + (tin "#6886cc" "#82b6ff") + (velvet "#7c68cc" "#8c82ff") + (grape "#b264cc" "#cf7df") + (labia "#cc64c2" "#fd7dff") + (berry "#cc6485" "#ff7db5") + (dino "#724214" "#1e3f03") + (oort "#cccccc" "#888888") + (storm "#666699" "#99ccff") + (pdino "#9999cc" "#99ccff") + (purp "#9999cc" "#666699") + (neutral "#b4b4b4" "#878787") + (september "#bf9900" "#ffcc00")) + "Color alist used for the Gnus logo.") + +(defcustom gnus-logo-color-style 'oort + "*Color styles used for the Gnus logo." + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + gnus-logo-color-alist)) + :group 'gnus-xmas) + +(defvar gnus-logo-colors + (cdr (assq gnus-logo-color-style gnus-logo-color-alist)) + "Colors used for the Gnus logo.") + (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." ;; Insert the message. @@ -781,12 +875,19 @@ be set in `.emacs' instead." (display-graphic-p) (let* ((bg (face-background 'default)) (fg (face-foreground 'gnus-splash-face)) + (data-directory (nnheader-find-etc-directory "gnus")) (image (find-image `((:type xpm :file "gnus.xpm" - :color-symbols (("thing" . "#724214") - ("shadow" . "#1e3f03") - ("background" . ,bg))) + :color-symbols + (("thing" . ,(car gnus-logo-colors)) + ("shadow" . ,(cadr gnus-logo-colors)) + ("oort" . "#eeeeee") + ("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 @@ -813,23 +914,23 @@ be set in `.emacs' instead." t)))) (t (insert " - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ " ) @@ -872,9 +973,116 @@ be set in `.emacs' instead." (require 'gnus-util) (require 'nnheader) +(defcustom gnus-parameters nil + "Alist of group parameters. + +For example: + ((\"mail\\\\..*\" (gnus-show-threads nil) + (gnus-use-scoring nil) + (gnus-summary-line-format + \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\") + (gcc-self . t) + (display . all)) + (\"mail\\\\.me\" (gnus-use-scoring t)) + (\"list\\\\..*\" (total-expire . t) + (broken-reply-to . t)))" + :group 'gnus-group-various + :type '(repeat (cons regexp + (repeat sexp)))) + +(defvar gnus-group-parameters-more nil) + +(defvar gnus-colon-keywords + (eval-when-compile + (when (boundp 'dgnushack-colon-keywords) + (symbol-value 'dgnushack-colon-keywords))) + "List of the colon keywords should be bound at run-time. This variable +defaults to a proper value only if this file is byte-compiled by make.") + +(dolist (keyword gnus-colon-keywords) + (set keyword keyword)) + +(defmacro gnus-define-group-parameter (param &rest rest) + "Define a group parameter PARAM. +REST is a plist of following: +:type One of `bool', `list' or nil. +:function The name of the function. +:function-document The documentation of the function. +:parameter-type The type for customizing the parameter. +:parameter-document The documentation for the parameter. +:variable The name of the variable. +:variable-document The documentation for the variable. +:variable-group The group for customizing the variable. +:variable-type The type for customizing the variable. +:variable-default The default value of the variable." + (let* ((type (plist-get rest :type)) + (parameter-type (plist-get rest :parameter-type)) + (parameter-document (plist-get rest :parameter-document)) + (function (or (plist-get rest :function) + (intern (format "gnus-parameter-%s" param)))) + (function-document (or (plist-get rest :function-document) "")) + (variable (or (plist-get rest :variable) + (intern (format "gnus-parameter-%s-alist" param)))) + (variable-document (or (plist-get rest :variable-document) "")) + (variable-group (plist-get rest :variable-group)) + (variable-type (or (plist-get rest :variable-type) + `(quote (repeat + (list (regexp :tag "Group") + ,(car (cdr parameter-type))))))) + (variable-default (plist-get rest :variable-default))) + (list + 'progn + `(defcustom ,variable ,variable-default + ,variable-document + :group 'gnus-group-parameter + :group ',variable-group + :type ,variable-type) + `(setq gnus-group-parameters-more + (delq (assq ',param gnus-group-parameters-more) + gnus-group-parameters-more)) + `(add-to-list 'gnus-group-parameters-more + (list ',param + ,parameter-type + ,parameter-document)) + (if (eq type 'bool) + `(defun ,function (name) + ,function-document + (let ((params (gnus-group-find-parameter name)) + val) + (cond + ((memq ',param params) + t) + ((setq val (assq ',param params)) + (cdr val)) + ((stringp ,variable) + (string-match ,variable name)) + (,variable + (let ((alist ,variable) + elem value) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + value (cdr elem)))) + (if (consp value) (car value) value)))))) + `(defun ,function (name) + ,function-document + (and name + (or (gnus-group-find-parameter name ',param ,(and type t)) + (let ((alist ,variable) + elem value) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + value (cdr elem)))) + ,(if type + 'value + '(if (consp value) (car value) value)))))))))) + (defcustom gnus-home-directory "~/" "Directory variable that specifies the \"home\" directory. -All other Gnus path variables are initialized from this variable." +All other Gnus file and directory variables are initialized from this variable." :group 'gnus-files :type 'directory) @@ -955,8 +1163,8 @@ used to 899, you would say something along these lines: This variable should be a list, where the first element is how the news is to be fetched, the second is the address. -For instance, if you want to get your news via NNTP from -\"flab.flab.edu\", you could say: +For instance, if you want to get your news via \"flab.flab.edu\" using +NNTP, you could say: \(setq gnus-select-method '(nntp \"flab.flab.edu\")) @@ -971,23 +1179,9 @@ see the manual for details." :group 'gnus-server :type 'gnus-select-method) -(defcustom gnus-message-archive-method - (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))) +(defcustom gnus-message-archive-method "archive" "*Method used for archiving messages you've sent. -This should be a mail method. - -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." +This should be a mail method." :group 'gnus-server :group 'gnus-message :type 'gnus-select-method) @@ -1003,9 +1197,9 @@ If you want to save your mail in one group and the news articles you write in another group, you could say something like: \(setq gnus-message-archive-group - '((if (message-news-p) - \"misc-news\" - \"misc-mail\"))) + '((if (message-news-p) + \"misc-news\" + \"misc-mail\"))) Normally the group names returned by this variable should be unprefixed -- which implicitly means \"store on the archive server\". @@ -1038,7 +1232,7 @@ variable instead." This is a list where each element is a complete select method (see `gnus-select-method'). -If, for instance, you want to read your mail with the nnml backend, +If, for instance, you want to read your mail with the nnml back end, you could set this variable: \(setq gnus-secondary-select-methods '((nnml \"\")))" @@ -1053,7 +1247,7 @@ Should be set in paths.el, and shouldn't be touched by the user.") (defcustom gnus-local-domain nil "Local domain name without a host name. The DOMAINNAME environment variable is used instead if it is defined. -If the `system-name' function returns the full Internet name, there is +If the function `system-name' returns the full Internet name, there is no need to set this variable." :group 'gnus-message :type '(choice (const :tag "default" nil) @@ -1079,23 +1273,23 @@ It can also be a list of select methods, as well as the special symbol list, Gnus will try all the methods in the list until it finds a match." :group 'gnus-server :type '(choice (const :tag "default" nil) - (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews))) + (const :tag "Google" (nnweb "refer" (nnweb-type google))) gnus-select-method (repeat :menu-tag "Try multiple" :tag "Multiple" - :value (current (nnweb "refer" (nnweb-type dejanews))) + :value (current (nnweb "refer" (nnweb-type google))) (choice :tag "Method" (const current) - (const :tag "DejaNews" - (nnweb "refer" (nnweb-type dejanews))) + (const :tag "Google" + (nnweb "refer" (nnweb-type google))) gnus-select-method)))) (defcustom gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.auc.dk:/pub/usenet/" "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" + "/ftp@ftp.pasteur.fr:/pub/FAQ/" "/ftp@rtfm.mit.edu:/pub/usenet/" "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" "/ftp@ftp.sunet.se:/pub/usenet/" @@ -1120,9 +1314,9 @@ If the default site is too slow, try one of these: ftp.seas.gwu.edu /pub/rtfm rtfm.mit.edu /pub/usenet Europe: ftp.uni-paderborn.de /pub/FAQ - src.doc.ic.ac.uk /usenet/news-FAQS + src.doc.ic.ac.uk /usenet/news-FAQS ftp.sunet.se /pub/usenet - sunsite.auc.dk /pub/usenet + ftp.pasteur.fr /pub/FAQ Asia: nctuccca.edu.tw /USENET/FAQ hwarang.postech.ac.kr /pub/usenet ftp.hk.super.net /mirror/faqs" @@ -1130,6 +1324,41 @@ If the default site is too slow, try one of these: :type '(choice directory (repeat directory))) +(defcustom gnus-group-charter-alist + '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt")) + ("de" . (concat "http://purl.net/charta/" name ".html")) + ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name)) + ("england" . (concat "http://england.news-admin.org/charters/" name)) + ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html")) + ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" + (gnus-replace-in-string name "europa\\." "") ".html")) + ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name)) + ("aus" . (concat "http://aus.news-admin.org/groupinfo.php/" name)) + ("pl" . (concat "http://www.usenet.pl/opisy/" name)) + ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name)) + ("at" . (concat "http://www.usenet.at/chartas/" name "/charta")) + ("uk" . (concat "http://www.usenet.org.uk/" name ".html")) + ("wales" . (concat "http://www.wales-usenet.org/english/groups/" name ".html")) + ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html")) + ("se" . (concat "http://www.usenet-se.net/Reglementen/" + (gnus-replace-in-string name "\\." "_") ".html")) + ("milw" . (concat "http://usenet.mil.wi.us/" + (gnus-replace-in-string name "milw\\." "") "-charter")) + ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html")) + ("netins" . (concat "http://www.netins.net/usenet/charter/" + (gnus-replace-in-string name "\\." "-") "-charter.html"))) + "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. +When FORM is evaluated `name' is bound to the name of the group." + :group 'gnus-group-various + :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) + +(defcustom gnus-group-fetch-control-use-browse-url nil + "*Non-nil means that control messages are displayed using `browse-url'. +Otherwise they are fetched with ange-ftp and displayed in an ephemeral +group." + :group 'gnus-group-various + :type 'boolean) + (defcustom gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in @@ -1150,9 +1379,11 @@ newsgroups." (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, -confirmation is required for selecting the newsgroup." +confirmation is required for selecting the newsgroup. +If it is nil, no confirmation is required." :group 'gnus-group-select - :type 'integer) + :type '(choice (const :tag "No limit" nil) + integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) "*Non-nil means that the default name of a file to save articles in is the group name. @@ -1217,7 +1448,7 @@ cache to the full extent of the law." :group 'gnus-meta :type 'boolean) -(defcustom gnus-keep-backlog nil +(defcustom gnus-keep-backlog 20 "*If non-nil, Gnus will keep read articles for later re-retrieval. If it is a number N, then Gnus will only keep the last N articles read. If it is neither nil nor a number, Gnus will keep all read @@ -1243,11 +1474,6 @@ articles. This is not a good idea." :group 'gnus-meta :type 'boolean) -(defcustom gnus-use-picons nil - "*If non-nil, display picons in a frame of their own." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-summary-prepare-exit-hook '(gnus-summary-expire-articles) "*A hook called when preparing to exit from the summary buffer. @@ -1280,11 +1506,11 @@ commands will still require prompting." :type 'boolean) (defcustom gnus-extract-address-components 'gnus-extract-address-components - "*Function for extracting address components from a From header. -Two pre-defined function exist: `gnus-extract-address-components', -which is the default, quite fast, and too simplistic solution, and + "Function for extracting address components from a From header. +Three pre-defined functions exist: `gnus-extract-address-components', +which is the default, quite fast, and too simplistic solution, `mail-extract-address-components', which works much better, but is -slower." +slower, and `std11-extract-address-components'." :group 'gnus-summary-format :type '(radio (function-item gnus-extract-address-components) (function-item mail-extract-address-components) @@ -1297,7 +1523,7 @@ slower." :type 'boolean) (defcustom gnus-shell-command-separator ";" - "String used to separate to shell commands." + "String used to separate shell commands." :group 'gnus-files :type 'string) @@ -1306,7 +1532,7 @@ slower." ("nnspool" post address) ("nnvirtual" post-mail virtual prompt-address) ("nnmbox" mail respool address) - ("nnml" mail respool address) + ("nnml" post-mail respool address) ("nnmh" mail respool address) ("nndir" post-mail prompt-address physical-address) ("nneething" none address prompt-address physical-address) @@ -1318,13 +1544,17 @@ slower." ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) + ("nngoogle" post) ("nnslashdot" post) ("nnultimate" none) + ("nnrss" none) ("nnwfm" none) ("nnwarchive" none) ("nnlistserv" none) ("nnagent" post-mail) - ("nnimap" post-mail address prompt-address physical-address)) + ("nnimap" post-mail address prompt-address physical-address) + ("nnmaildir" mail respool address) + ("nnnil" none)) "*An alist of valid select methods. The first element of each list lists should be a string with the name of the select method. The other elements may be the category of @@ -1389,23 +1619,416 @@ to be desirable; see the manual for further details." :type '(choice (const nil) integer)) -(defcustom gnus-auto-expirable-newsgroups nil - "*Groups in which to automatically mark read articles as expirable. +;; There should be special validation for this. +(define-widget 'gnus-email-address 'string + "An email address.") + +(gnus-define-group-parameter + to-address + :function-document + "Return GROUP's to-address." + :variable-document + "*Alist of group regexps and correspondent to-addresses." + :parameter-type '(gnus-email-address :tag "To Address") + :parameter-document "\ +This will be used when doing followups and posts. + +This is primarily useful in mail groups that represent closed +mailing lists--mailing lists where it's expected that everybody that +writes to the mailing list is subscribed to it. Since using this +parameter ensures that the mail only goes to the mailing list itself, +it means that members won't receive two copies of your followups. + +Using `to-address' will actually work whether the group is foreign or +not. Let's say there's a group on the server that is called +`fa.4ad-l'. This is a real newsgroup, but the server has gotten the +articles from a mail-to-news gateway. Posting directly to this group +is therefore impossible--you have to send mail to the mailing list +address instead. + +The gnus-group-split mail splitting mechanism will behave as if this +address was listed in gnus-group-split Addresses (see below).") + +(gnus-define-group-parameter + to-list + :function-document + "Return GROUP's to-list." + :variable-document + "*Alist of group regexps and correspondent to-lists." + :parameter-type '(gnus-email-address :tag "To List") + :parameter-document "\ +This address will be used when doing a `a' in the group. + +It is totally ignored when doing a followup--except that if it is +present in a news group, you'll get mail group semantics when doing +`f'. + +The gnus-group-split mail splitting mechanism will behave as if this +address was listed in gnus-group-split Addresses (see below).") + +(gnus-define-group-parameter + subscribed + :type bool + :function-document + "Return GROUP's subscription status." + :variable-document + "*Groups which are automatically considered subscribed." + :parameter-type '(const :tag "Subscribed" t) + :parameter-document "\ +Gnus assumed that you are subscribed to the To/List address. + +When constructing a list of subscribed groups using +`gnus-find-subscribed-addresses', Gnus includes the To address given +above, or the list address (if the To address has not been set).") + +(gnus-define-group-parameter + auto-expire + :type bool + :function gnus-group-auto-expirable-p + :function-document + "Check whether GROUP is auto-expirable or not." + :variable gnus-auto-expirable-newsgroups + :variable-default nil + :variable-document + "*Groups in which to automatically mark read articles as expirable. If non-nil, this should be a regexp that should match all groups in which to perform auto-expiry. This only makes sense for mail groups." - :group 'nnmail-expire - :type '(choice (const nil) - regexp)) - -(defcustom gnus-total-expirable-newsgroups nil - "*Groups in which to perform expiry of all read articles. + :variable-group nnmail-expire + :variable-type '(choice (const nil) + regexp) + :parameter-type '(const :tag "Automatic Expire" t) + :parameter-document + "All articles that are read will be marked as expirable.") + +(gnus-define-group-parameter + total-expire + :type bool + :function gnus-group-total-expirable-p + :function-document + "Check whether GROUP is total-expirable or not." + :variable gnus-total-expirable-newsgroups + :variable-default nil + :variable-document + "*Groups in which to perform expiry of all read articles. Use with extreme caution. All groups that match this regexp will be expiring - which means that all read articles will be deleted after \(say) one week. (This only goes for mail groups and the like, of course.)" - :group 'nnmail-expire - :type '(choice (const nil) - regexp)) + :variable-group nnmail-expire + :variable-type '(choice (const nil) + regexp) + :parameter-type '(const :tag "Total Expire" t) + :parameter-document + "All read articles will be put through the expiry process + +This happens even if they are not marked as expirable. +Use with caution.") + +(gnus-define-group-parameter + charset + :function-document + "Return the default charset of GROUP." + :variable gnus-group-charset-alist + :variable-default + '(("\\(^\\|:\\)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)) + :variable-document + "Alist of regexps (to match group names) and default charsets to be used when reading." + :variable-group gnus-charset + :variable-type '(repeat (list (regexp :tag "Group") + (symbol :tag "Charset"))) + :parameter-type '(symbol :tag "Charset") + :parameter-document "\ +The default charset to use in the group.") + +(gnus-define-group-parameter + post-method + :type list + :function-document + "Return a posting method for GROUP." + :variable gnus-post-method-alist + :variable-document + "Alist of regexps (to match group names) and method to be used when +posting an article." + :variable-group gnus-group-foreign + :parameter-type + '(choice :tag "Posting Method" + (const :tag "Use native server" native) + (const :tag "Use current server" current) + (list :convert-widget + (lambda (widget) + (list 'sexp :tag "Methods" + :value gnus-select-method)))) + :parameter-document + "Posting method for this group.") + +(gnus-define-group-parameter + large-newsgroup-initial + :type integer + :function-document + "Return GROUP's initial input of the number of articles." + :variable-document + "*Alist of group regexps and its initial input of the number of articles." + :parameter-type '(choice :tag "Initial Input for Large Newsgroup" + (const :tag "All" nil) + (integer)) + :parameter-document "\ + +This number will be prompted as the initial value of the number of +articles to list when the group is a large newsgroup (see +`gnus-large-newsgroup'). If it is nil, the default value is the +total number of articles in the group.") + +;; group parameters for spam processing added by Ted Zlatanov +(defcustom gnus-install-group-spam-parameters t + "*Disable the group parameters for spam detection. +Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." + :type 'boolean + :group 'gnus-start) + +(when gnus-install-group-spam-parameters + (defvar gnus-group-spam-classification-spam t + "Spam group classification (requires spam.el). +This group contains spam messages. On summary entry, unread messages +will be marked as spam. On summary exit, the specified spam +processors will be invoked on spam-marked messages, then those +messages will be expired, so the spam processor will only see a +spam-marked message once.") + + (defvar gnus-group-spam-classification-ham 'ask + "The ham value for the spam group parameter (requires spam.el). +On summary exit, the specified ham processors will be invoked on +ham-marked messages. Exercise caution, since the ham processor will +see the same message more than once because there is no ham message +registry.") + + (gnus-define-group-parameter + spam-contents + :type list + :function-document + "The spam type (spam, ham, or neither) of the group." + :variable gnus-spam-newsgroup-contents + :variable-default nil + :variable-document + "*Groups in which to automatically mark new articles as spam on +summary entry. If non-nil, this should be a list of group name +regexps that should match all groups in which to do automatic spam +tagging, associated with a classification (spam, ham, or neither). +This only makes sense for mail groups." + :variable-group spam + :variable-type '(repeat + (list :tag "Group contents spam/ham classification" + (regexp :tag "Group") + (choice + (variable-item gnus-group-spam-classification-spam) + (variable-item gnus-group-spam-classification-ham) + (const :tag "Unclassified" nil)))) + + :parameter-type '(list :tag "Group contents spam/ham classification" + (choice :tag "Group contents classification for spam sorting" + (variable-item gnus-group-spam-classification-spam) + (variable-item gnus-group-spam-classification-ham) + (const :tag "Unclassified" nil))) + :parameter-document + "The spam classification (spam, ham, or neither) of this group. +When a spam group is entered, all unread articles are marked as spam.") + + (defvar gnus-group-spam-exit-processor-ifile "ifile" + "The ifile summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-stat "stat" + "The spam-stat summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter" + "The Bogofilter summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-blacklist "blacklist" + "The Blacklist summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane" + "The Gmane reporting summary exit spam processor. +Only applicable to NNTP groups with articles from Gmane. See spam-report.el") + + (defvar gnus-group-ham-exit-processor-ifile "ifile-ham" + "The ifile summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham" + "The Bogofilter summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-stat "stat-ham" + "The spam-stat summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-whitelist "whitelist" + "The whitelist summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-BBDB "bbdb" + "The BBDB summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-copy "copy" + "The ham copy exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (gnus-define-group-parameter + spam-process + :type list + :parameter-type '(choice :tag "Spam Summary Exit Processor" + :value nil + (list :tag "Spam Summary Exit Processor Choices" + (set + (variable-item gnus-group-spam-exit-processor-ifile) + (variable-item gnus-group-spam-exit-processor-stat) + (variable-item gnus-group-spam-exit-processor-bogofilter) + (variable-item gnus-group-spam-exit-processor-blacklist) + (variable-item gnus-group-spam-exit-processor-report-gmane) + (variable-item gnus-group-ham-exit-processor-bogofilter) + (variable-item gnus-group-ham-exit-processor-ifile) + (variable-item gnus-group-ham-exit-processor-stat) + (variable-item gnus-group-ham-exit-processor-whitelist) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-copy)))) + :function-document + "Which spam or ham processors will be applied to the GROUP articles at summary exit." + :variable gnus-spam-process-newsgroups + :variable-default nil + :variable-document + "*Groups in which to automatically process spam or ham articles with +a backend on summary exit. If non-nil, this should be a list of group +name regexps that should match all groups in which to do automatic +spam processing, associated with the appropriate processor. This only makes sense +for mail groups." + :variable-group spam + :variable-type '(repeat :tag "Spam/Ham Processors" + (list :tag "Spam Summary Exit Processor Choices" + (regexp :tag "Group Regexp") + (set :tag "Spam/Ham Summary Exit Processor" + (variable-item gnus-group-spam-exit-processor-ifile) + (variable-item gnus-group-spam-exit-processor-stat) + (variable-item gnus-group-spam-exit-processor-bogofilter) + (variable-item gnus-group-spam-exit-processor-blacklist) + (variable-item gnus-group-spam-exit-processor-report-gmane) + (variable-item gnus-group-ham-exit-processor-bogofilter) + (variable-item gnus-group-ham-exit-processor-ifile) + (variable-item gnus-group-ham-exit-processor-stat) + (variable-item gnus-group-ham-exit-processor-whitelist) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-copy)))) + :parameter-document + "Which spam processors will be applied to the spam or ham GROUP articles at summary exit.") + + (gnus-define-group-parameter + spam-process-destination + :parameter-type '(choice :tag "Destination for spam-processed articles at summary exit" + (string :tag "Move to a group") + (const :tag "Expire" nil)) + :function-document + "Where spam-processed articles will go at summary exit." + :variable gnus-spam-process-destinations + :variable-default nil + :variable-document + "*Groups in which to explicitly send spam-processed articles to +another group, or expire them (the default). If non-nil, this should +be a list of group name regexps that should match all groups in which +to do spam-processed article moving, associated with the destination +group or nil for explicit expiration. This only makes sense for +mail groups." + :variable-group spam + :variable-type '(repeat + :tag "Spam-processed articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for spam-processed articles at summary exit" + (string :tag "Move to a group") + (const :tag "Expire" nil)))) + :parameter-document + "Where spam-processed articles will go at summary exit.") + + (gnus-define-group-parameter + ham-process-destination + :parameter-type '(choice + :tag "Destination for ham articles at summary exit from a spam group" + (string :tag "Move to a group") + (const :tag "Do nothing" nil)) + :function-document + "Where ham articles will go at summary exit from a spam group." + :variable gnus-ham-process-destinations + :variable-default nil + :variable-document + "*Groups in which to explicitly send ham articles to +another group, or do nothing (the default). If non-nil, this should +be a list of group name regexps that should match all groups in which +to do ham article moving, associated with the destination +group or nil for explicit ignoring. This only makes sense for +mail groups, and only works in spam groups." + :variable-group spam + :variable-type '(repeat + :tag "Ham articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for ham articles at summary exit from spam group" + (string :tag "Move to a group") + (const :tag "Expire" nil)))) + :parameter-document + "Where ham articles will go at summary exit from a spam group.") + + (gnus-define-group-parameter + ham-marks + :type 'list + :parameter-type '(list :tag "Ham mark choices" + (set + (variable-item gnus-del-mark) + (variable-item gnus-read-mark) + (variable-item gnus-killed-mark) + (variable-item gnus-kill-file-mark) + (variable-item gnus-low-score-mark))) + + :parameter-document + "Marks considered ham (positively not spam). Such articles will be +processed as ham (non-spam) on group exit. When nil, the global +spam-ham-marks variable takes precedence." + :variable-default '((".*" ((gnus-del-mark + gnus-read-mark + gnus-killed-mark + gnus-kill-file-mark + gnus-low-score-mark)))) + :variable-group spam + :variable-document + "*Groups in which to explicitly set the ham marks to some value.") + + (gnus-define-group-parameter + spam-marks + :type 'list + :parameter-type '(list :tag "Spam mark choices" + (set + (variable-item gnus-spam-mark) + (variable-item gnus-killed-mark) + (variable-item gnus-kill-file-mark) + (variable-item gnus-low-score-mark))) + + :parameter-document + "Marks considered spam. +Such articles will be processed as spam on group exit. When nil, the global +spam-spam-marks variable takes precedence." + :variable-default '((".*" ((gnus-spam-mark)))) + :variable-group spam + :variable-document + "*Groups in which to explicitly set the spam marks to some value.")) (defcustom gnus-group-uncollapsed-levels 1 "Number of group name elements to leave alone when making a short group name." @@ -1496,6 +2119,18 @@ and `grouplens-menu'." (const pick-menu) (const grouplens-menu))) +;; Byte-compiler warning. +(defvar gnus-visual) +;; Find out whether the gnus-visual TYPE is wanted. +(defun gnus-visual-p (&optional type class) + (and gnus-visual ; Has to be non-nil, at least. + (if (not type) ; We don't care about type. + gnus-visual + (if (listp gnus-visual) ; It's a list, so we check it. + (or (memq type gnus-visual) + (memq class gnus-visual)) + t)))) + (defcustom gnus-mouse-face (condition-case () (if (gnus-visual-p 'mouse-face 'highlight) @@ -1518,41 +2153,69 @@ face." (defvar gnus-plugged t "Whether Gnus is plugged or not.") +(defcustom gnus-agent-cache t + "Controls use of the agent cache while plugged. When set, Gnus will prefer +using the locally stored content rather than re-fetching it from the server. +You also need to enable `gnus-agent' for this to have any affect." + :version "21.3" + :group 'gnus-agent + :type 'boolean) + (defcustom gnus-default-charset 'iso-8859-1 "Default charset assumed to be used when viewing non-ASCII characters. This variable is overridden on a group-to-group basis by the -gnus-group-charset-alist variable and is only used on groups not +`gnus-group-charset-alist' variable and is only used on groups not covered by that variable." :type 'symbol :group 'gnus-charset) -(defcustom gnus-default-posting-charset nil - "Default charset assumed to be used when posting non-ASCII characters. -This variable is overridden on a group-to-group basis by the -gnus-group-posting-charset-alist variable and is only used on groups not -covered by that variable. -If nil, no default charset is assumed when posting." - :type 'symbol - :group 'gnus-charset) +(defcustom gnus-agent t + "Whether we want to use the Gnus agent or not. +Putting (gnus-agentize) in ~/.gnus is obsolete by (setq gnus-agent t)." + :version "21.3" + :group 'gnus-agent + :type 'boolean) + +(defcustom gnus-other-frame-function 'gnus + "Function called by the command `gnus-other-frame'." + :group 'gnus-start + :type '(choice (function-item gnus) + (function-item gnus-no-server) + (function-item gnus-slave) + (function-item gnus-slave-no-server))) + +(defcustom gnus-other-frame-parameters nil + "Frame parameters used by `gnus-other-frame' to create a Gnus frame. +This should be an alist for Emacs, or a plist for XEmacs." + :group 'gnus-start + :type (if (featurep 'xemacs) + '(repeat (list :inline t :format "%v" + (symbol :tag "Property") + (sexp :tag "Value"))) + '(repeat (cons :format "%v" + (symbol :tag "Parameter") + (sexp :tag "Value"))))) ;;; Internal variables (defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") +(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To") +(defvar gnus-draft-meta-information-header "X-Draft-From") (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) (defvar gnus-original-article-buffer " *Original Article*") (defvar gnus-newsgroup-name nil) (defvar gnus-ephemeral-servers nil) - -(defvar gnus-agent nil - "Whether we want to use the Gnus agent or not.") +(defvar gnus-server-method-cache nil) (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") +(defvar gnus-agent-covered-methods nil) + (defvar gnus-command-method nil - "Dynamically bound variable that says what the current backend is.") + "Dynamically bound variable that says what the current back end is.") (defvar gnus-current-select-method nil "The current method for selecting a newsgroup.") @@ -1598,7 +2261,28 @@ If nil, no default charset is assumed when posting." (bookmarks . bookmark) (dormant . dormant) (scored . score) (saved . save) (cached . cache) (downloadable . download) - (unsendable . unsend))) + (unsendable . unsend) (forwarded . forward) + (recent . recent) (seen . seen))) + +(defconst gnus-article-special-mark-lists + '((seen range) + (killed range) + (bookmark tuple) + (score tuple))) + +;; Propagate flags to server, with the following exceptions: +;; `seen' is private to each gnus installation +;; `cache' is a internal gnus flag for each gnus installation +;; `download' is a agent flag private to each gnus installation +;; `unsend' are for nndraft groups only +;; `score' is not a proper mark +;; `bookmark': don't propagated it, or fix the bug in update-mark. +(defconst gnus-article-unpropagated-mark-lists + '(seen cache download unsend score bookmark) + "Marks that shouldn't be propagated to back ends. +Typical marks are those that make no sense in a standalone back end, +such as a mark that says whether an article is stored in the cache +\(which doesn't make sense in a standalone back end).") (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) @@ -1625,10 +2309,10 @@ This variable can be nil, gnus or gnus-ja." (const :tag "Japanese" gnus-ja))) (defvar gnus-info-nodes - '((gnus-group-mode "The Group Buffer") - (gnus-summary-mode "The Summary Buffer") - (gnus-article-mode "The Article Buffer") - (gnus-server-mode "The Server Buffer") + '((gnus-group-mode "Group Buffer") + (gnus-summary-mode "Summary Buffer") + (gnus-article-mode "Article Buffer") + (gnus-server-mode "Server Buffer") (gnus-browse-mode "Browse Foreign Server") (gnus-tree-mode "Tree Display")) "Alist of major modes and related Info nodes.") @@ -1648,20 +2332,39 @@ This variable can be nil, gnus or gnus-ja." '(gnus-newsrc-options gnus-newsrc-options-n gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist + gnus-registry-alist + gnus-registry-headers-alist gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist) + gnus-topic-topology gnus-topic-alist + gnus-agent-covered-methods) "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)) + `(("strict-cache" + ((product-version ,version) + (emacs-version) + (correct-string-widths)) binary gnus-format-specs-compiled) - ("cache" ((product-version ,version) (emacs-version)) + ("cache" + ((product-version ,version) + (emacs-version) + (correct-string-widths)) ,codesys gnus-format-specs))) - "Gnus variables are saved in the produce depend quick startup files.") + "Alist of the methods for checking whether the contents of the T-gnus +quick startup files are valid. One is for the byte-compiled format +specifications, the other is for the source form. Each element should +be a list which looks like follows: + +\(\"FILE_NAME\" + ((VARIABLE EXPECTED_VALUE_or_NIL) + (VARIABLE EXPECTED_VALUE_or_NIL) + ...) + CODING-SYSTEM_FOR_READING_FILE + SYMBOL_OF_FORMAT_SPECS)") (defcustom gnus-compile-user-specs t "If non-nil, the user-defined format specs will be byte-compiled @@ -1674,6 +2377,14 @@ It has an effect on the values of `gnus-*-line-format-spec'." "Assoc list of read articles. gnus-newsrc-hashtb should be kept so that both hold the same information.") +(defvar gnus-registry-alist nil + "Assoc list of registry data. +gnus-registry.el will populate this if it's loaded.") + +(defvar gnus-registry-headers-alist nil + "Assoc list of registry header data. +gnus-registry.el will populate this if it's loaded.") + (defvar gnus-newsrc-hashtb nil "Hashtable of gnus-newsrc-alist.") @@ -1711,6 +2422,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$" "Regexp matching invalid groups.") +(defvar gnus-other-frame-object nil + "A frame object which will be created by `gnus-other-frame'.") + ;;; End of variables. ;; Define some autoload functions Gnus might use. @@ -1733,9 +2447,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (nthcdr 3 package) (cdr package))))) '(("info" :interactive t Info-goto-node) - ("pp" pp pp-to-string pp-eval-expression) + ("pp" pp-to-string) ("ps-print" ps-print-preprint) - ("browse-url" :interactive t browse-url) ("message" :interactive t message-send-and-exit message-yank-original) ("babel" babel-as-string) @@ -1761,6 +2474,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-demon-remove-handler) ("gnus-demon" :interactive t gnus-demon-init gnus-demon-cancel) + ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from + gnus-convert-image-to-gray-x-face gnus-convert-face-to-png + gnus-face-from-file) ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close @@ -1821,7 +2537,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("gnus-msg" (gnus-summary-send-map keymap) 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-group-post-news gnus-group-mail gnus-group-news + gnus-summary-post-news gnus-summary-news-other-window gnus-summary-followup gnus-summary-followup-with-original gnus-summary-cancel-article gnus-summary-supersede-article gnus-post-news gnus-summary-reply gnus-summary-reply-with-original @@ -1831,12 +2548,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-summary-followup-to-mail-with-original gnus-bug gnus-summary-wide-reply-with-original gnus-summary-post-forward gnus-summary-digest-mail-forward gnus-summary-digest-post-forward) - ("gnus-picon" :interactive t gnus-article-display-picons - gnus-group-display-picons) - ("gnus-picon" gnus-picons-buffer-name) + ("gnus-picon" :interactive t gnus-treat-from-picon) ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) - ("smiley" :interactive t gnus-smiley-display) + ("smiley" :interactive t smiley-region) ("gnus-win" gnus-configure-windows gnus-add-configuration) ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group gnus-list-of-unread-articles gnus-list-of-read-articles @@ -1865,15 +2580,15 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-display-x-face gnus-article-decode-HZ gnus-article-wash-html - gnus-article-hide-pgp + gnus-article-unsplit-urls gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed - gnus-article-show-all-headers gnus-article-show-all + gnus-article-show-all-headers + ;; gnus-article-show-all gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done article-decode-encoded-words - gnus-start-date-timer gnus-stop-date-timer - gnus-article-toggle-headers) + gnus-start-date-timer gnus-stop-date-timer) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch) @@ -1905,28 +2620,48 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("gnus-agent" gnus-open-agent gnus-agent-get-function gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p gnus-agent-get-undownloaded-list gnus-agent-fetch-session - gnus-summary-set-agent-mark gnus-agent-save-group-info) + gnus-summary-set-agent-mark gnus-agent-save-group-info + gnus-agent-request-article gnus-agent-retrieve-headers) ("gnus-agent" :interactive t gnus-unplugged gnus-agentize gnus-agent-batch) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm) - ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts) + ("compface" uncompface) + ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue) ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) ("gnus-mlspl" :interactive t gnus-group-split-setup - gnus-group-split-update)))) + gnus-group-split-update) + ("gnus-delay" gnus-delay-initialize)))) (eval-and-compile (unless (featurep 'xemacs) (if (>= emacs-major-version 21) (autoload 'x-face-decode-message-header "x-face-e21") - (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")))) +(unless (and (fboundp 'base64-encode-string) + (subrp (symbol-function 'base64-encode-string))) + (require 'base64)) + +;; To search articles with Namazu. +(autoload 'gnus-namazu-search "gnus-namazu" nil t) +(autoload 'gnus-namazu-create-index "gnus-namazu" nil t) +(autoload 'gnus-namazu-update-index "gnus-namazu" nil t) +(autoload 'gnus-namazu-update-all-indices "gnus-namazu" nil t) + +;; To make nnir groups. +(autoload 'gnus-group-make-nnir-group "nnir" nil t) + +;; To make shimbun groups. +(autoload 'gnus-group-make-shimbun-group "nnshimbun" nil t) + +;; A tool for the developers. +(autoload 'find-cl-run-time-functions "gnus-clfns" nil t) + ;;; gnus-sum.el thingies -(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" +(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" "*The format specification of the lines in the summary buffer. It works along the same lines as a normal formatting string, @@ -1943,11 +2678,16 @@ with some simple extensions. %x Contents of the Xref: header (string) %D Date of the article (string) %d Date of the article (string) in DD-MMM format +%o Date of the article (string) in YYYYMMDD`T'HHMMSS format %M Message-id of the article (string) %r References of the article (string) %c Number of characters in the article (integer) +%k Pretty-printed version of the above (string) + For example, \"1.2k\" or \"0.4M\". %L Number of lines in the article (integer) %I Indentation based on thread level (a string of spaces) +%B A complex trn-style thread tree (string) + The variables `gnus-sum-thread-*' can be used for customization. %T A string with two possible values: 80 spaces if the article is on thread level two or larger and 0 spaces on level one %R \"A\" if this article has been replied to, \" \" otherwise (character) @@ -1964,6 +2704,8 @@ with some simple extensions. %V Total thread score (number). %P The line number (number). %O Download mark (character). +%* If present, indicates desired cursor position + (instead of after first colon). %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 @@ -1971,10 +2713,6 @@ with some simple extensions. will be inserted into the summary just like information from any other summary specifier. -Text between %( and %) will be highlighted with `gnus-mouse-face' -when the mouse point is placed inside the area. There can only be one -such area. - The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and \"hard-code\" that. This means that @@ -1982,10 +2720,14 @@ it is invalid to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. -The smart choice is to have these specs as for to the left as +The smart choice is to have these specs as far to the left as possible. -This restriction may disappear in later versions of Gnus." +This restriction may disappear in later versions of Gnus. + +General format specifiers can also be used. +See Info node `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :type 'string :group 'gnus-summary-format) @@ -2029,6 +2771,12 @@ This restriction may disappear in later versions of Gnus." "Get hash value of STRING in HASHTABLE." `(symbol-value (intern-soft ,string ,hashtable))) +(defmacro gnus-gethash-safe (string hashtable) + "Get hash value of STRING in HASHTABLE. +Return nil if not defined." + `(let ((sym (intern-soft ,string ,hashtable))) + (and (boundp sym) (symbol-value sym)))) + (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(set (intern ,string ,hashtable) ,value)) @@ -2114,19 +2862,7 @@ This restriction may disappear in later versions of Gnus." (defmacro gnus-get-info (group) `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) -;; Byte-compiler warning. -(defvar gnus-visual) -;; Find out whether the gnus-visual TYPE is wanted. -(defun gnus-visual-p (&optional type class) - (and gnus-visual ; Has to be non-nil, at least. - (if (not type) ; We don't care about type. - gnus-visual - (if (listp gnus-visual) ; It's a list, so we check it. - (or (memq type gnus-visual) - (memq class gnus-visual)) - t)))) - -;;; Load the compatability functions. +;;; Load the compatibility functions. (require 'gnus-ems) @@ -2154,6 +2890,21 @@ This restriction may disappear in later versions of Gnus." ;;; Gnus Utility Functions ;;; +(defun gnus-find-subscribed-addresses () + "Return a regexp matching the addresses of all subscribed mail groups. +It consists of the `to-address' or `to-list' parameter of all groups +with a `subscribed' parameter." + (let (group address addresses) + (dolist (entry (cdr gnus-newsrc-alist)) + (setq group (car entry)) + (when (gnus-parameter-subscribed group) + (setq address (mail-strip-quoted-names + (or (gnus-group-fast-parameter group 'to-address) + (gnus-group-fast-parameter group 'to-list)))) + (when address + (add-to-list 'addresses address)))) + (when addresses + (list (mapconcat 'regexp-quote addresses "\\|"))))) (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. @@ -2169,7 +2920,7 @@ STRINGS will be evaluated in normal `or' order." (setq strings nil))) string)) -(defun gnus-info-find-node () +(defun gnus-info-find-node (&optional nodename) "Find Info documentation of Gnus." (interactive) ;; Enlarge info window if needed. @@ -2179,7 +2930,8 @@ STRINGS will be evaluated in normal `or' order." (or gnus-info-filename (get-language-info current-language-environment 'gnus-info) "gnus") - (or (cadr (assq major-mode gnus-info-nodes)) + (or nodename + (cadr (assq major-mode gnus-info-nodes)) (and (eq (current-buffer) (get-buffer gnus-article-buffer)) (cadr (assq 'gnus-article-mode gnus-info-nodes)))))) (setq gnus-info-buffer (current-buffer)) @@ -2323,30 +3075,6 @@ that that variable is buffer-local to the summary buffers." (let ((group (or group gnus-newsgroup-name))) (not (gnus-check-backend-function 'request-replace-article group)))) -(defun gnus-group-total-expirable-p (group) - "Check whether GROUP is total-expirable or not." - (let ((params (gnus-group-find-parameter group)) - val) - (cond - ((memq 'total-expire params) - t) - ((setq val (assq 'total-expire params)) ; (auto-expire . t) - (cdr val)) - (gnus-total-expirable-newsgroups ; Check var. - (string-match gnus-total-expirable-newsgroups group))))) - -(defun gnus-group-auto-expirable-p (group) - "Check whether GROUP is auto-expirable or not." - (let ((params (gnus-group-find-parameter group)) - val) - (cond - ((memq 'auto-expire params) - t) - ((setq val (assq 'auto-expire params)) ; (auto-expire . t) - (cdr val)) - (gnus-auto-expirable-newsgroups ; Check var. - (string-match gnus-auto-expirable-newsgroups group))))) - (defun gnus-virtual-group-p (group) "Say whether GROUP is virtual or not." (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) @@ -2354,16 +3082,18 @@ that that variable is buffer-local to the summary buffers." (defun gnus-news-group-p (group &optional article) "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. - (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)))))) + (cond ((gnus-member-of-valid 'post group) ;Ordinary news group + t) ;is news of course. + ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined. + nil) ;must be mail then. + ((vectorp article) ;Has header info. + (eq (gnus-request-type group (mail-header-id article)) 'news)) + ((null article) ;Hasn't header info + (eq (gnus-request-type group) 'news)) ;(unknown ==> mail) + ((< article 0) ;Virtual message + nil) ;we don't know, guess mail. + (t ;Has positive number + (eq (gnus-request-type group article) 'news)))) ;use it. ;; Returns a list of writable groups. (defun gnus-writable-groups () @@ -2425,6 +3155,36 @@ that that variable is buffer-local to the summary buffers." (nth 1 method)))) method))) +(defsubst gnus-server-to-method (server) + "Map virtual server names to select methods." + (or (and server (listp server) server) + (cdr (assoc server gnus-server-method-cache)) + (let ((result + (or + ;; Perhaps this is the native server? + (and (equal server "native") gnus-select-method) + ;; It should be in the server alist. + (cdr (assoc server gnus-server-alist)) + ;; It could be in the predefined server alist. + (cdr (assoc server gnus-predefined-server-alist)) + ;; If not, we look through all the opened server + ;; to see whether we can find it there. + (let ((opened gnus-opened-servers)) + (while (and opened + (not (equal server (format "%s:%s" (caaar opened) + (cadaar opened))))) + (pop opened)) + (caar opened)) + ;; It could be a named method, search all servers + (let ((servers gnus-secondary-select-methods)) + (while (and servers + (not (equal server (format "%s:%s" (caar servers) + (cadar servers))))) + (pop servers)) + (car servers))))) + (push (cons server result) gnus-server-method-cache) + result))) + (defsubst gnus-server-get-method (group method) ;; Input either a server name, and extended server name, or a ;; select method, and return a select method. @@ -2442,33 +3202,6 @@ that that variable is buffer-local to the summary buffers." (t (gnus-server-add-address method)))) -(defun gnus-server-to-method (server) - "Map virtual server names to select methods." - (or - ;; Is this a method, perhaps? - (and server (listp server) server) - ;; Perhaps this is the native server? - (and (equal server "native") gnus-select-method) - ;; It should be in the server alist. - (cdr (assoc server gnus-server-alist)) - ;; It could be in the predefined server alist. - (cdr (assoc server gnus-predefined-server-alist)) - ;; If not, we look through all the opened server - ;; to see whether we can find it there. - (let ((opened gnus-opened-servers)) - (while (and opened - (not (equal server (format "%s:%s" (caaar opened) - (cadaar opened))))) - (pop opened)) - (caar opened)) - ;; It could be a named method, search all servers - (let ((servers gnus-secondary-select-methods)) - (while (and servers - (not (equal server (format "%s:%s" (caar servers) - (cadar servers))))) - (pop servers)) - (car servers)))) - (defmacro gnus-method-equal (ss1 ss2) "Say whether two servers are equal." `(let ((s1 ,ss1) @@ -2523,21 +3256,49 @@ that that variable is buffer-local to the summary buffers." (and active (file-exists-p active)))))) -(defun gnus-group-prefixed-name (group method) - "Return the whole name from GROUP and METHOD." - (and (stringp method) (setq method (gnus-server-to-method method))) +(defsubst gnus-method-to-server-name (method) + (concat + (format "%s" (car method)) + (when (and + (or (assoc (format "%s" (car method)) + (gnus-methods-using 'address)) + (gnus-server-equal method gnus-message-archive-method)) + (nth 1 method) + (not (string= (nth 1 method) ""))) + (concat "+" (nth 1 method))))) + +(defsubst gnus-method-to-full-server-name (method) + (format "%s+%s" (car method) (nth 1 method))) + +(defun gnus-group-prefixed-name (group method &optional full) + "Return the whole name from GROUP and METHOD. +Call with full set to get the fully qualified group name (even if the +server is native)." + (when (stringp method) + (setq method (gnus-server-to-method method))) (if (or (not method) - (gnus-server-equal method "native")) + (and (not full) (gnus-server-equal method "native")) + ;;;!!! This might not be right. We'll see... + ;(string-match ":" group) + ) group - (concat (format "%s" (car method)) - (when (and - (or (assoc (format "%s" (car method)) - (gnus-methods-using 'address)) - (gnus-server-equal method gnus-message-archive-method)) - (nth 1 method) - (not (string= (nth 1 method) ""))) - (concat "+" (nth 1 method))) - ":" group))) + (concat (gnus-method-to-server-name method) ":" group))) + +(defun gnus-group-guess-prefixed-name (group) + "Guess the whole name from GROUP and METHOD." + (gnus-group-prefixed-name group (gnus-find-method-for-group + group))) + +(defun gnus-group-full-name (group method) + "Return the full name from GROUP and METHOD, even if the method is +native." + (gnus-group-prefixed-name group method t)) + +(defun gnus-group-guess-full-name (group) + "Guess the full name from GROUP, even if the method is native." + (if (gnus-group-prefixed-p group) + group + (gnus-group-full-name group (gnus-find-method-for-group group)))) (defun gnus-group-real-prefix (group) "Return the prefix of the current group name." @@ -2545,6 +3306,21 @@ that that variable is buffer-local to the summary buffers." (substring group 0 (match-end 0)) "")) +(defun gnus-group-short-name (group) + "Return the short group name." + (let ((prefix (gnus-group-real-prefix group))) + (if (< 0 (length prefix)) + (substring group (length prefix) nil) + group))) + +(defun gnus-group-prefixed-p (group) + "Return the prefix of the current group name." + (< 0 (length (gnus-group-real-prefix group)))) + +(defun gnus-summary-buffer-name (group) + "Return the summary buffer name of GROUP." + (concat "*Summary " (gnus-group-decoded-name group) "*")) + (defun gnus-group-method (group) "Return the server or method used for selecting GROUP. You should probably use `gnus-find-method-for-group' instead." @@ -2618,15 +3394,88 @@ You should probably use `gnus-find-method-for-group' instead." "Say whether the group is secondary or not." (gnus-secondary-method-p (gnus-find-method-for-group group))) +(defun gnus-parameters-get-parameter (group) + "Return the group parameters for GROUP from `gnus-parameters'." + (let (params-list) + (dolist (elem gnus-parameters) + (when (string-match (car elem) group) + (setq params-list + (nconc (gnus-expand-group-parameters + (car elem) (cdr elem) group) + params-list)))) + params-list)) + +(defun gnus-expand-group-parameter (match value group) + "Use MATCH to expand VALUE in GROUP." + (with-temp-buffer + (insert group) + (goto-char (point-min)) + (while (re-search-forward match nil t) + (replace-match value)) + (buffer-string))) + +(defun gnus-expand-group-parameters (match parameters group) + "Go through PARAMETERS and expand them according to the match data." + (let (new) + (dolist (elem parameters) + (if (and (stringp (cdr elem)) + (string-match "\\\\[0-9&]" (cdr elem))) + (push (cons (car elem) + (gnus-expand-group-parameter match (cdr elem) group)) + new) + (push elem new))) + new)) + +(defun gnus-group-fast-parameter (group symbol &optional allow-list) + "For GROUP, return the value of SYMBOL. + +You should call this in the `gnus-group-buffer' buffer. +The function `gnus-group-find-parameter' will do that for you." + ;; The speed trick: No cons'ing and quit early. + (let* ((params (funcall gnus-group-get-parameter-function group)) + ;; Start easy, check the "real" group parameters. + (simple-results + (gnus-group-parameter-value params symbol allow-list t))) + (if simple-results + ;; Found results; return them. + (car simple-results) + ;; We didn't found it there, try `gnus-parameters'. + (let ((result nil) + (head nil) + (tail gnus-parameters)) + ;; A good old-fashioned non-cl loop. + (while tail + (setq head (car tail) + tail (cdr tail)) + ;; The car is regexp matching for matching the group name. + (when (string-match (car head) group) + ;; The cdr is the parameters. + (setq result (gnus-group-parameter-value (cdr head) + symbol allow-list)) + (when result + ;; Expand if necessary. + (if (and (stringp result) (string-match "\\\\[0-9&]" result)) + (setq result (gnus-expand-group-parameter (car head) + result group))) + ;; Exit the loop early. + (setq tail nil)))) + ;; Done. + result)))) + (defun gnus-group-find-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters." +If SYMBOL, return the value of that symbol in the group parameters. + +If you call this function inside a loop, consider using the faster +`gnus-group-fast-parameter' instead." (save-excursion (set-buffer gnus-group-buffer) - (let ((parameters (funcall gnus-group-get-parameter-function group))) - (if symbol - (gnus-group-parameter-value parameters symbol allow-list) - parameters)))) + (if symbol + (gnus-group-fast-parameter group symbol allow-list) + (nconc + (copy-sequence + (funcall gnus-group-get-parameter-function group)) + (gnus-parameters-get-parameter group))))) (defun gnus-group-get-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. @@ -2638,7 +3487,8 @@ also examines the topic parameters." (gnus-group-parameter-value params symbol allow-list) params))) -(defun gnus-group-parameter-value (params symbol &optional allow-list) +(defun gnus-group-parameter-value (params symbol &optional + allow-list present-p) "Return the value of SYMBOL in group PARAMS." ;; We only wish to return group parameters (dotted lists) and ;; not local variables, which may have the same names. @@ -2652,7 +3502,8 @@ also examines the topic parameters." (eq (car elem) symbol) (or allow-list (atom (cdr elem)))) - (throw 'found (cdr elem)))))))) + (throw 'found (if present-p (list (cdr elem)) + (cdr elem))))))))) (defun gnus-group-add-parameter (group param) "Add parameter PARAM to GROUP." @@ -2858,6 +3709,15 @@ If NEWSGROUP is nil, return the global kill file name instead." (list (intern server) ""))) gnus-select-method)) +(defun gnus-server-string (server) + "Return a readable string that describes SERVER." + (let* ((server (gnus-server-to-method server)) + (address (nth 1 server))) + (if (and address + (not (zerop (length address)))) + (format "%s using %s" address (car server)) + (format "%s" (car server))))) + (defun gnus-find-method-for-group (group &optional info) "Find the select method that GROUP uses." (or gnus-override-method @@ -2901,7 +3761,7 @@ 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) @@ -2913,11 +3773,19 @@ Disallow invalid group names." (defun gnus-read-method (prompt) "Prompt the user for a method. Allow completion over sensible values." - (let* ((servers - (append gnus-valid-select-methods - (mapcar (lambda (i) (list (format "%s:%s" (caar i) - (cadar i)))) - gnus-opened-servers) + (let* ((open-servers + (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i)) + gnus-opened-servers)) + (valid-methods + (let (methods) + (dolist (method gnus-valid-select-methods) + (if (or (memq 'prompt-address method) + (not (assoc (format "%s:" (car method)) open-servers))) + (push method methods))) + methods)) + (servers + (append valid-methods + open-servers gnus-predefined-server-alist gnus-server-alist)) (method @@ -2932,35 +3800,42 @@ Allow completion over sensible values." (assoc method gnus-valid-select-methods)) (read-string "Address: ") ""))) - (or (let ((opened gnus-opened-servers)) - (while (and opened - (not (equal (format "%s:%s" method address) - (format "%s:%s" (caaar opened) - (cadaar opened))))) - (pop opened)) - (caar opened)) + (or (cadr (assoc (format "%s:%s" method address) open-servers)) (list (intern method) address)))) ((assoc method servers) method) (t (list (intern method) ""))))) +;;; Agent functions + +(defun gnus-agent-method-p (method) + "Say whether METHOD is covered by the agent." + (member method gnus-agent-covered-methods)) + +(defun gnus-online (method) + (not + (if gnus-plugged + (eq (cadr (assoc method gnus-opened-servers)) 'offline) + (gnus-agent-method-p method)))) + ;;; User-level commands. ;;;###autoload (defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to local server." + "Read network news as a slave, without connecting to the local server." (interactive "P") (gnus-no-server arg t)) ;;;###autoload (defun gnus-no-server (&optional arg slave) "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." +If ARG is a positive number, Gnus will use that as the startup +level. If ARG is nil, Gnus will be started at level 2. If ARG is +non-nil and not a positive number, Gnus will prompt the user for the +name of an NNTP server to use. +As opposed to `gnus', this command will not connect to the local +server." (interactive "P") (gnus-no-server-1 arg slave)) @@ -2978,34 +3853,52 @@ the variable `toolbar-news-frame-plist' will be refered instead." (sexp :tag "Value"))) :group 'gnus) -(defvar gnus-frame nil - "The frame in which gnus is displayed. It is not used under XEmacs.") - ;;;###autoload -(defun gnus-other-frame (&optional arg) - "Pop up a frame to read news." +(defun gnus-other-frame (&optional arg display) + "Pop up a frame to read news. +This will call one of the Gnus commands which is specified by the user +option `gnus-other-frame-function' (default `gnus') with the argument +ARG if Gnus is not running, otherwise just pop up a Gnus frame. The +optional second argument DISPLAY should be a standard display string +such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is +omitted or the function `make-frame-on-display' is not available, the +current display is used." (interactive "P") - (static-if (featurep 'xemacs) - (let ((toolbar-news-use-separate-frame t)) - (toolbar-gnus)) - (if (frame-live-p gnus-frame) - (raise-frame gnus-frame) - (setq gnus-frame (make-frame gnus-frame-properties)) - (if (and (gnus-buffer-live-p gnus-group-buffer) - (save-current-buffer - (set-buffer gnus-group-buffer) - (eq 'gnus-group-mode major-mode))) - (progn - (select-frame gnus-frame) - (switch-to-buffer gnus-group-buffer)) + (if (fboundp 'make-frame-on-display) + (unless display + (setq display (gnus-frame-or-window-display-name (selected-frame)))) + (setq display nil)) + (let ((alive (gnus-alive-p))) + (unless (and alive + (catch 'found + (walk-windows + (lambda (window) + (when (and (or (not display) + (equal display + (gnus-frame-or-window-display-name + window))) + (with-current-buffer (window-buffer window) + (string-match "\\`gnus-" + (symbol-name major-mode)))) + (gnus-select-frame-set-input-focus + (setq gnus-other-frame-object (window-frame window))) + (select-window window) + (throw 'found t))) + 'ignore t))) + (gnus-select-frame-set-input-focus + (setq gnus-other-frame-object + (if display + (make-frame-on-display display gnus-other-frame-parameters) + (make-frame gnus-other-frame-parameters)))) + (if alive + (switch-to-buffer gnus-group-buffer) + (funcall gnus-other-frame-function arg) (add-hook 'gnus-exit-gnus-hook - (lambda () - (when (and (frame-live-p gnus-frame) + (lambda nil + (when (and (frame-live-p gnus-other-frame-object) (cdr (frame-list))) - (delete-frame gnus-frame)) - (setq gnus-frame nil))) - (select-frame gnus-frame) - (gnus arg))))) + (delete-frame gnus-other-frame-object)) + (setq gnus-other-frame-object nil))))))) ;;;###autoload (defun gnus (&optional arg dont-connect slave) @@ -3014,6 +3907,9 @@ If ARG is non-nil and a positive number, Gnus will use that as the startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") + (unless (byte-code-function-p (symbol-function 'gnus)) + (message "You should byte-compile Gnus") + (sit-for 2)) (gnus-1 arg dont-connect slave)) ;; Allow redefinition of Gnus functions. diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index b39decb..aa48c3a 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -1,5 +1,5 @@ ;;; ietf-drums.el --- Functions for parsing RFC822bis headers -;; Copyright (C) 1998, 1999, 2000 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,7 +36,7 @@ (defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177" "US-ASCII control characters excluding CR, LF and white space.") (defvar ietf-drums-text-token "\001-\011\013\014\016-\177" - "US-ASCII characters exlcuding CR and LF.") + "US-ASCII characters excluding CR and LF.") (defvar ietf-drums-specials-token "()<>[]:;@\\,.\"" "Special characters.") (defvar ietf-drums-quote-token "\\" @@ -52,7 +52,8 @@ "Textual token including full stop.") (defvar ietf-drums-qtext-token (concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177") - "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.") + "Non-white-space control characters, plus the rest of ASCII excluding +backslash and doublequote.") (defvar ietf-drums-tspecials "][()<>@,;:\\\"/?=" "Tspecials.") @@ -67,6 +68,11 @@ (modify-syntax-entry ?* " " table) (modify-syntax-entry ?\; " " table) (modify-syntax-entry ?\' " " table) + (if (featurep 'xemacs) + (let ((i 128)) + (while (< i 256) + (modify-syntax-entry i "w" table) + (setq i (1+ i))))) table)) (defun ietf-drums-token-to-list (token) @@ -199,25 +205,38 @@ (defun ietf-drums-parse-addresses (string) "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." - (with-temp-buffer - (ietf-drums-init string) - (let ((beg (point)) - pairs c) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((memq c '(?\" ?< ?\()) - (forward-sexp 1)) - ((eq c ?,) - (push (ietf-drums-parse-address (buffer-substring beg (point))) - pairs) - (forward-char 1) - (setq beg (point))) - (t - (forward-char 1)))) - (push (ietf-drums-parse-address (buffer-substring beg (point))) - pairs) - (nreverse pairs)))) + (if (null string) + nil + (with-temp-buffer + (ietf-drums-init string) + (let ((beg (point)) + pairs c address) + (while (not (eobp)) + (setq c (char-after)) + (cond + ((memq c '(?\" ?< ?\()) + (condition-case nil + (forward-sexp 1) + (error + (skip-chars-forward "^,")))) + ((eq c ?,) + (setq address + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil))) + (if address (push address pairs)) + (forward-char 1) + (setq beg (point))) + (t + (forward-char 1)))) + (setq address + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil))) + (if address (push address pairs)) + (nreverse pairs))))) (defun ietf-drums-unfold-fws () "Unfold folding white space in the current buffer." diff --git a/lisp/imap.el b/lisp/imap.el index 489fecf..88dda14 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -1,5 +1,5 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998, 1999, 2000 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson @@ -44,7 +44,7 @@ ;; ;; Mailbox commands: ;; -;; imap-mailbox-get, imap-mailbox-map, imap-current-mailbox, +;; imap-mailbox-get, imap-mailbox-map, imap-current-mailbox, ;; imap-current-mailbox-p, imap-search, imap-mailbox-select, ;; imap-mailbox-examine, imap-mailbox-unselect, imap-mailbox-expunge ;; imap-mailbox-close, imap-mailbox-create, imap-mailbox-delete @@ -57,7 +57,7 @@ ;; imap-fetch-asynch, imap-fetch, ;; imap-current-message, imap-list-to-message-set, ;; imap-message-get, imap-message-map -;; imap-message-envelope-date, imap-message-envelope-subject, +;; imap-message-envelope-date, imap-message-envelope-subject, ;; imap-message-envelope-from, imap-message-envelope-sender, ;; imap-message-envelope-reply-to, imap-message-envelope-to, ;; imap-message-envelope-cc, imap-message-envelope-bcc @@ -120,7 +120,7 @@ ;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: ^M\r...." ;; ;; Todo: -;; +;; ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow. ;; o Don't use `read' at all (important places already fixed) ;; o Accept list of articles instead of message set string in most @@ -142,7 +142,6 @@ (require 'base64) (eval-and-compile - (autoload 'open-ssl-stream "ssl") (autoload 'starttls-open-stream "starttls") (autoload 'starttls-negotiate "starttls") (autoload 'rfc2104-hash "rfc2104") @@ -151,6 +150,7 @@ (autoload 'utf7-decode "utf7") (autoload 'format-spec "format-spec") (autoload 'format-spec-make "format-spec") + (autoload 'open-tls-stream "tls") ;; 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) @@ -165,6 +165,7 @@ (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" @@ -177,7 +178,12 @@ 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") +(defcustom imap-gssapi-program (list + (concat "gsasl --client --connect %s:%p " + "--imap --application-data " + "--mechanism GSSAPI " + "--authentication-id %l") + "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 @@ -186,10 +192,10 @@ 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") +(defcustom imap-ssl-program '("openssl s_client -quiet -ssl3 -connect %s:%p" + "openssl s_client -quiet -ssl2 -connect %s:%p" + "s_client -quiet -ssl3 -connect %s:%p" + "s_client -quiet -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 @@ -212,26 +218,61 @@ until a successful connection is made." :group 'imap :type '(repeat string)) -(defvar imap-shell-host "gateway" - "Hostname of rlogin proxy.") +(defcustom imap-process-connection-type nil + "*Value for `process-connection-type' to use for Kerberos4 and GSSAPI." + :group 'imap + :type 'boolean) -(defvar imap-default-user (user-login-name) - "Default username to use.") +(defcustom 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." + :group 'imap + :type 'boolean) -(defvar imap-error nil - "Error codes from the last command.") +(defcustom imap-log nil + "If non-nil, a imap session trace is placed in *imap-log* buffer." + :group 'imap + :type 'boolean) + +(defcustom imap-debug nil + "If non-nil, random debug spews are placed in *imap-debug* buffer." + :group 'imap + :type 'boolean) + +(defcustom imap-shell-host "gateway" + "Hostname of rlogin proxy." + :group 'imap + :type 'string) + +(defcustom imap-default-user (user-login-name) + "Default username to use." + :group 'imap + :type 'string) + +(defcustom imap-read-timeout (if (string-match + "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + 1.0 + 0.1) + "*How long to wait between checking for the end of output. +Shorter values mean quicker response, but is more CPU intensive." + :type 'number + :group 'imap) ;; Various variables. (defvar imap-fetch-data-hook nil "Hooks called after receiving each FETCH response.") -(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell) +(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell) "Priority of streams to consider when opening connection to server.") (defvar imap-stream-alist '((gssapi imap-gssapi-stream-p imap-gssapi-open) (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open) + (tls imap-tls-p imap-tls-open) (ssl imap-ssl-p imap-ssl-open) (network imap-network-p imap-network-open) (shell imap-shell-p imap-shell-open) @@ -244,7 +285,7 @@ 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 '(gssapi +(defvar imap-authenticators '(gssapi kerberos4 digest-md5 cram-md5 @@ -252,7 +293,7 @@ stream.") anonymous) "Priority of authenticators to consider when authenticating to server.") -(defvar imap-authenticator-alist +(defvar imap-authenticator-alist '((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) @@ -265,18 +306,16 @@ stream.") 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.") +for doing the actual authentication.") -(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.") +(defvar imap-error nil + "Error codes from the last command.") ;; Internal constants. Change theese and die. (defconst imap-default-port 143) (defconst imap-default-ssl-port 993) +(defconst imap-default-tls-port 993) (defconst imap-default-stream 'network) (defconst imap-local-variables '(imap-server imap-port @@ -298,6 +337,8 @@ encoded mailboxes which doesn't translate into ISO-8859-1.") imap-process imap-calculate-literal-size-first imap-mailbox-data)) +(defconst imap-log-buffer "*imap-log*") +(defconst imap-debug-buffer "*imap-debug*") ;; Internal variables. @@ -308,7 +349,7 @@ encoded mailboxes which doesn't translate into ISO-8859-1.") (defvar imap-username nil) (defvar imap-password nil) (defvar imap-calculate-literal-size-first nil) -(defvar imap-state 'closed +(defvar imap-state 'closed "IMAP state. Valid states are `closed', `initial', `nonauth', `auth', `selected' and `examine'.") @@ -349,7 +390,7 @@ and `examine'.") (defvar imap-reached-tag 0 "Lower limit on command tags that have been parsed.") -(defvar imap-failed-tags nil +(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 @@ -363,41 +404,34 @@ human readable response text (a string).") (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.") - -(defvar imap-log nil - "Name of buffer for imap session trace. -For example: (setq imap-log \"*imap-log*\")") +The actual value is really the text on the continuation line.") -(defvar imap-debug nil ;"*imap-debug*" - "Name of buffer for random debug spew. -For example: (setq imap-debug \"*imap-debug*\")") +(defvar imap-callbacks nil + "List of response tags and callbacks, on the form `(number . function)'. +The function should take two arguments, the first the IMAP tag and the +second the status (OK, NO, BAD etc) of the command.") ;; Utility functions: -(defun imap-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt (if args - (apply 'format prompt args) - prompt))) - (funcall (if (or (fboundp 'read-passwd) - (and (load "subr" t) - (fboundp 'read-passwd)) - (and (load "passwd" t) - (fboundp 'read-passwd))) - 'read-passwd - (autoload 'ange-ftp-read-passwd "ange-ftp") - 'ange-ftp-read-passwd) - prompt))) +(defun imap-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 +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'." + (when alist + (if (equal key (caar alist)) + (cdr alist) + (setcdr alist (imap-remassoc key (cdr alist))) + alist))) (defsubst imap-utf7-encode (string) (if imap-use-utf7 (and string (condition-case () (utf7-encode string t) - (error (message + (error (message "imap: Could not UTF7 encode `%s', using it unencoded..." string) string))) @@ -437,6 +471,7 @@ If ARGS, PROMPT is used as an argument to `format'." (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd) (erase-buffer) (let* ((port (or port imap-default-port)) + (process-connection-type imap-process-connection-type) (process (as-binary-process (start-process name buffer shell-file-name shell-command-switch @@ -452,9 +487,10 @@ If ARGS, PROMPT is used as an argument to `format'." (setq imap-client-eol "\n" imap-calculate-literal-size-first t) (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug (goto-char (point-min)) - ;; cyrus 1.6.x (13? < x <= 22) queries capabilities - (or (while (looking-at "^C:") + ;; 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 @@ -472,7 +508,7 @@ If ARGS, PROMPT is used as an argument to `format'." (accept-process-output process 1) (sit-for 1)) (and imap-log - (with-current-buffer (get-buffer-create imap-log) + (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer))) @@ -483,11 +519,11 @@ If ARGS, PROMPT is used as an argument to `format'." (not (string-match "failed" response)))) (setq done process) (if (memq (process-status process) '(open run)) - (imap-send-command-wait "LOGOUT")) + (imap-send-command "LOGOUT")) (delete-process process) nil))))) done)) - + (defun imap-gssapi-stream-p (buffer) (imap-capability 'AUTH=GSSAPI buffer)) @@ -496,7 +532,9 @@ If ARGS, PROMPT is used as an argument to `format'." cmd done) (while (and (not done) (setq cmd (pop cmds))) (message "Opening GSSAPI IMAP connection with `%s'..." cmd) + (erase-buffer) (let* ((port (or port imap-default-port)) + (process-connection-type imap-process-connection-type) (process (as-binary-process (start-process name buffer shell-file-name shell-command-switch @@ -509,11 +547,13 @@ If ARGS, PROMPT is used as an argument to `format'." response) (when process (with-current-buffer buffer - (setq imap-client-eol "\n") + (setq imap-client-eol "\n" + imap-calculate-literal-size-first t) (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug (goto-char (point-min)) - ;; cyrus 1.6.x (13? < x <= 22) queries capabilities - (or (while (looking-at "^C:") + ;; 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 @@ -523,12 +563,15 @@ If ARGS, PROMPT is used as an argument to `format'." (not (and (imap-parse-greeting) ;; success in imtest 1.6: (re-search-forward - "^\\(Authenticat.*\\)" nil t) + (concat "^\\(\\(Authenticat.*\\)\\|\\(" + "Client authentication " + "finished.*\\)\\)") + 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) + (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer))) @@ -538,7 +581,7 @@ If ARGS, PROMPT is used as an argument to `format'." (not (string-match "failed" response)))) (setq done process) (if (memq (process-status process) '(open run)) - (imap-send-command-wait "LOGOUT")) + (imap-send-command "LOGOUT")) (delete-process process) nil))))) done)) @@ -553,36 +596,31 @@ If ARGS, PROMPT is used as an argument to `format'." 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)))))) + (erase-buffer) + (let ((port (or port imap-default-ssl-port)) + (process-connection-type nil) + process) + (when (prog1 + (setq 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)))))) + (process-kill-without-query process)) (with-current-buffer buffer (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug (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) + (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer))) @@ -593,9 +631,32 @@ If ARGS, PROMPT is used as an argument to `format'." (progn (message "imap: Opening SSL connection with `%s'...done" cmd) done) - (message "imap: Opening SSL connection with `%s'...failed" cmd) + (message "imap: Opening SSL connection with `%s'...failed" cmd) nil))) +(defun imap-tls-p (buffer) + nil) + +(defun imap-tls-open (name buffer server port) + (let* ((port (or port imap-default-tls-port)) + (process (open-tls-stream name buffer server port))) + (when process + (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug + (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) + (set-buffer-multibyte nil) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer))) + (when (memq (process-status process) '(open run)) + process)))) + (defun imap-network-p (buffer) t) @@ -604,12 +665,13 @@ If ARGS, PROMPT is used as an argument to `format'." (process (open-network-stream-as-binary name buffer server port))) (when process (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug (goto-char (point-min)) (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) (and imap-log - (with-current-buffer (get-buffer-create imap-log) + (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer))) @@ -620,7 +682,8 @@ If ARGS, PROMPT is used as an argument to `format'." nil) (defun imap-shell-open (name buffer server port) - (let ((cmds imap-shell-program) + (let ((cmds (if (listp imap-shell-program) imap-shell-program + (list imap-shell-program))) cmd done) (while (and (not done) (setq cmd (pop cmds))) (message "imap: Opening IMAP connection with `%s'..." cmd) @@ -638,16 +701,18 @@ If ARGS, PROMPT is used as an argument to `format'." ?l imap-default-user)))))) (when process (while (and (memq (process-status process) '(open run)) - (goto-char (point-min)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug + (goto-char (point-max)) + (forward-line -1) (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) + (with-current-buffer (get-buffer-create imap-log-buffer) (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 @@ -658,12 +723,7 @@ If ARGS, PROMPT is used as an argument to `format'." nil))) (defun imap-starttls-p (buffer) - (and (imap-capability 'STARTTLS buffer) - (condition-case () - (progn - (require 'starttls) - (call-process "starttls")) - (error nil)))) + (imap-capability 'STARTTLS buffer)) (defun imap-starttls-open (name buffer server port) (let* ((port (or port imap-default-port)) @@ -673,12 +733,13 @@ If ARGS, PROMPT is used as an argument to `format'." (message "imap: Connecting with STARTTLS...") (when process (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug (goto-char (point-min)) (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) (and imap-log - (with-current-buffer (get-buffer-create imap-log) + (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer))) @@ -698,28 +759,31 @@ If ARGS, PROMPT is used as an argument to `format'." 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. +it where successful 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) + (make-local-variable 'imap-username) + (make-local-variable '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 ": ") + (read-from-minibuffer + (concat "IMAP username for " imap-server + " (using stream `" (symbol-name imap-stream) + "'): ") (or user imap-default-user)))) (setq passwd (or imap-password - (imap-read-passwd - (concat "IMAP password for " user "@" - imap-server ": ")))) + (read-passwd + (concat "IMAP password for " user "@" + imap-server " (using authenticator `" + (symbol-name imap-auth) "'): ")))) (when (and user passwd) (if (funcall loginfunc user passwd) (progn @@ -740,7 +804,8 @@ Returns t if login was successful, nil otherwise." ret))) (defun imap-gssapi-auth-p (buffer) - (imap-capability 'AUTH=GSSAPI buffer)) + (and (imap-capability 'AUTH=GSSAPI buffer) + (eq imap-stream 'gssapi))) (defun imap-gssapi-auth (buffer) (message "imap: Authenticating using GSSAPI...%s" @@ -748,7 +813,8 @@ Returns t if login was successful, nil otherwise." (eq imap-stream 'gssapi)) (defun imap-kerberos4-auth-p (buffer) - (imap-capability 'AUTH=KERBEROS_V4 buffer)) + (and (imap-capability 'AUTH=KERBEROS_V4 buffer) + (eq imap-stream 'kerberos4))) (defun imap-kerberos4-auth (buffer) (message "imap: Authenticating using Kerberos 4...%s" @@ -792,20 +858,20 @@ Returns t if login was successful, nil otherwise." (defun imap-login-auth (buffer) "Login to server using the LOGIN command." (message "imap: Plaintext authentication...") - (imap-interactive-login buffer + (imap-interactive-login buffer (lambda (user passwd) - (imap-ok-p (imap-send-command-wait - (concat "LOGIN \"" user "\" \"" + (imap-ok-p (imap-send-command-wait + (concat "LOGIN \"" user "\" \"" passwd "\"")))))) (defun imap-anonymous-p (buffer) t) (defun imap-anonymous-auth (buffer) - (message "imap: Loging in anonymously...") + (message "imap: Logging in anonymously...") (with-current-buffer buffer (imap-ok-p (imap-send-command-wait - (concat "LOGIN anonymous \"" (concat (user-login-name) "@" + (concat "LOGIN anonymous \"" (concat (user-login-name) "@" (system-name)) "\""))))) (defun imap-digest-md5-p (buffer) @@ -820,7 +886,7 @@ Returns t if login was successful, nil otherwise." (imap-interactive-login buffer (lambda (user passwd) - (let ((tag + (let ((tag (imap-send-command (list "AUTHENTICATE DIGEST-MD5" @@ -845,7 +911,7 @@ Returns t if login was successful, nil otherwise." imap-current-message nil imap-state 'initial imap-process (condition-case () - (funcall (nth 2 (assq imap-stream + (funcall (nth 2 (assq imap-stream imap-stream-alist)) "imap" buffer imap-server imap-port) ((error quit) nil))) @@ -870,12 +936,12 @@ AUTH indicates authenticator to use, see `imap-authenticators' for 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." +necessary. 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)) - (mapcar 'make-variable-buffer-local imap-local-variables) + (mapcar 'make-local-variable imap-local-variables) (set-buffer-multibyte nil) (buffer-disable-undo) (setq imap-server (or server imap-server)) @@ -883,46 +949,53 @@ necessery. If nil, the buffer name is generated." (setq imap-auth (or auth imap-auth)) (setq imap-stream (or stream imap-stream)) (message "imap: Connecting to %s..." imap-server) - (if (let ((imap-stream (or imap-stream imap-default-stream))) - (imap-open-1 buffer)) - ;; Choose stream. - (let (stream-changed) - (message "imap: Connecting to %s...done" imap-server) - (when (null imap-stream) - (let ((streams imap-streams)) - (while (setq stream (pop streams)) - (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer) - (setq stream-changed (not (eq (or imap-stream - imap-default-stream) - stream)) - imap-stream stream - streams nil))) - (unless imap-stream - (error "Couldn't figure out a stream for server")))) - (when stream-changed - (message "imap: Reconnecting with stream `%s'..." imap-stream) - (imap-close buffer) - (if (imap-open-1 buffer) - (message "imap: Reconnecting with stream `%s'...done" - imap-stream) - (message "imap: Reconnecting with stream `%s'...failed" - imap-stream)) - (setq imap-capability nil)) - (if (imap-opened buffer) - ;; Choose authenticator - (when (and (null imap-auth) (not (eq imap-state 'auth))) - (let ((auths imap-authenticators)) - (while (setq auth (pop auths)) - (if (funcall (nth 1 (assq auth imap-authenticator-alist)) - buffer) - (setq imap-auth auth - auths nil))) - (unless imap-auth - (error "Couldn't figure out authenticator for server")))))) - (message "imap: Connecting to %s...failed" imap-server)) - (when (imap-opened buffer) - (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)) - buffer))) + (if (null (let ((imap-stream (or imap-stream imap-default-stream))) + (imap-open-1 buffer))) + (progn + (message "imap: Connecting to %s...failed" imap-server) + nil) + (when (null imap-stream) + ;; Need to choose stream. + (let ((streams imap-streams)) + (while (setq stream (pop streams)) + ;; OK to use this stream? + (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer) + ;; Stream changed? + (if (not (eq imap-default-stream stream)) + (with-current-buffer (get-buffer-create + (generate-new-buffer-name " *temp*")) + (mapcar 'make-local-variable imap-local-variables) + (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)) + (message "imap: Reconnecting with stream `%s'..." stream) + (if (null (let ((imap-stream stream)) + (imap-open-1 (current-buffer)))) + (progn + (kill-buffer (current-buffer)) + (message + "imap: Reconnecting with stream `%s'...failed" + stream)) + ;; We're done, kill the first connection + (imap-close buffer) + (kill-buffer buffer) + (rename-buffer buffer) + (message "imap: Reconnecting with stream `%s'...done" + stream) + (setq imap-stream stream) + (setq imap-capability nil) + (setq streams nil))) + ;; We're done + (message "imap: Connecting to %s...done" imap-server) + (setq imap-stream stream) + (setq imap-capability nil) + (setq streams nil)))))) + (when (imap-opened buffer) + (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) + (when imap-stream + buffer)))) (defun imap-opened (&optional buffer) "Return non-nil if connection to imap server in BUFFER is open. @@ -945,20 +1018,40 @@ password is remembered in the buffer." (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) + (make-local-variable 'imap-username) + (make-local-variable 'imap-password) (if user (setq imap-username user)) (if passwd (setq imap-password passwd)) - (if (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer) - (setq imap-state 'auth))))) + (if imap-auth + (and (funcall (nth 2 (assq imap-auth + imap-authenticator-alist)) buffer) + (setq imap-state 'auth)) + ;; Choose authenticator. + (let ((auths imap-authenticators) + auth) + (while (setq auth (pop auths)) + ;; OK to use authenticator? + (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer) + (message "imap: Authenticating to `%s' using `%s'..." + imap-server auth) + (setq imap-auth auth) + (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer) + (progn + (message "imap: Authenticating to `%s' using `%s'...done" + imap-server auth) + (setq auths nil)) + (message "imap: Authenticating to `%s' using `%s'...failed" + imap-server auth))))) + imap-state)))) (defun imap-close (&optional buffer) "Close connection to server in BUFFER. If BUFFER is nil, the current buffer is used." (with-current-buffer (or buffer (current-buffer)) - (and (imap-opened) - (not (imap-ok-p (imap-send-command-wait "LOGOUT"))) - (message "Server %s didn't let me log out" imap-server)) + (when (imap-opened) + (condition-case nil + (imap-send-command-wait "LOGOUT") + (quit nil))) (when (and imap-process (memq (process-status imap-process) '(open run))) (delete-process imap-process)) @@ -1016,7 +1109,7 @@ If BUFFER is nil, the current buffer is assumed." (defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer) (with-current-buffer (or buffer (current-buffer)) (let (result) - (mapatoms + (mapatoms (lambda (s) (push (funcall func (if mailbox-decoder (funcall mailbox-decoder (symbol-name s)) @@ -1052,7 +1145,7 @@ If EXAMINE is non-nil, do a read-only select." imap-current-mailbox (setq imap-current-mailbox mailbox) (if (imap-ok-p (imap-send-command-wait - (concat (if examine "EXAMINE" "SELECT") " \"" + (concat (if examine "EXAMINE" "SELECT") " \"" mailbox "\""))) (progn (setq imap-message-data (make-vector imap-message-prime 0) @@ -1061,18 +1154,18 @@ If EXAMINE is non-nil, do a read-only select." ;; Failed SELECT/EXAMINE unselects current mailbox (setq imap-current-mailbox nil)))) -(defun imap-mailbox-select (mailbox &optional examine buffer) +(defun imap-mailbox-select (mailbox &optional examine buffer) (with-current-buffer (or buffer (current-buffer)) - (imap-utf7-decode + (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))) + (imap-mailbox-select-1 mailbox 'examine))) (defun imap-mailbox-examine (mailbox &optional buffer) "Examine MAILBOX on server in BUFFER." - (imap-mailbox-select mailbox 'exmine buffer)) + (imap-mailbox-select mailbox 'examine buffer)) (defun imap-mailbox-unselect (&optional buffer) "Close current folder in BUFFER, without expunging articles." @@ -1080,7 +1173,7 @@ If EXAMINE is non-nil, do a read-only select." (when (or (eq imap-state 'auth) (and (imap-capability 'UNSELECT) (imap-ok-p (imap-send-command-wait "UNSELECT"))) - (and (imap-ok-p + (and (imap-ok-p (imap-send-command-wait (concat "EXAMINE \"" imap-current-mailbox "\""))) @@ -1090,22 +1183,38 @@ If EXAMINE is non-nil, do a read-only select." imap-state 'auth) t))) -(defun imap-mailbox-expunge (&optional buffer) +(defun imap-mailbox-expunge (&optional asynch buffer) "Expunge articles in current folder in BUFFER. +If ASYNCH, do not wait for succesful completion of the command. 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"))))) + (if asynch + (imap-send-command "EXPUNGE") + (imap-ok-p (imap-send-command-wait "EXPUNGE")))))) -(defun imap-mailbox-close (&optional buffer) +(defun imap-mailbox-close (&optional asynch buffer) "Expunge articles and close current folder in BUFFER. +If ASYNCH, do not wait for succesful completion of the command. 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) + (when imap-current-mailbox + (if asynch + (imap-add-callback (imap-send-command "CLOSE") + `(lambda (tag status) + (message "IMAP mailbox `%s' closed... %s" + imap-current-mailbox status) + (when (eq ,imap-current-mailbox + imap-current-mailbox) + ;; Don't wipe out data if another mailbox + ;; was selected... + (setq imap-current-mailbox nil + imap-message-data nil + imap-state 'auth)))) + (when (imap-ok-p (imap-send-command-wait "CLOSE")) + (setq imap-current-mailbox nil + imap-message-data nil + imap-state 'auth))) t))) (defun imap-mailbox-create-1 (mailbox) @@ -1135,7 +1244,7 @@ If BUFFER is nil the current buffer is assumed." (imap-send-command-wait (list "RENAME \"" oldname "\" " "\"" newname "\"")))))) -(defun imap-mailbox-lsub (&optional root reference add-delimiter buffer) +(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 @@ -1149,7 +1258,7 @@ implementation-specific string that has to be passed to lsub command." (imap-mailbox-map-1 (lambda (mailbox) (imap-mailbox-put 'lsub nil mailbox))) (when (imap-ok-p - (imap-send-command-wait + (imap-send-command-wait (concat "LSUB \"" reference "\" \"" (imap-utf7-encode root) (and add-delimiter (imap-mailbox-get-1 'delimiter root)) "%\""))) @@ -1173,7 +1282,7 @@ passed to list command." (imap-mailbox-map-1 (lambda (mailbox) (imap-mailbox-put 'list nil mailbox))) (when (imap-ok-p - (imap-send-command-wait + (imap-send-command-wait (concat "LIST \"" reference "\" \"" (imap-utf7-encode root) (and add-delimiter (imap-mailbox-get-1 'delimiter root)) "%\""))) @@ -1187,7 +1296,7 @@ passed to list command." "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-ok-p (imap-send-command-wait (concat "SUBSCRIBE \"" (imap-utf7-encode mailbox) "\""))))) @@ -1195,7 +1304,7 @@ 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-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " (imap-utf7-encode mailbox) "\""))))) @@ -1204,15 +1313,15 @@ Returns non-nil if successful." 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." +returned, if ITEMS is a symbol only its value is returned." (with-current-buffer (or buffer (current-buffer)) - (when (imap-ok-p + (when (imap-ok-p (imap-send-command-wait (list "STATUS \"" (imap-utf7-encode mailbox) "\" " (format "%s" (if (listp items) - items + items (list items)))))) (if (listp items) (mapcar (lambda (item) @@ -1220,6 +1329,20 @@ returned, if ITEMS is a symbol only it's value is returned." items) (imap-mailbox-get items mailbox))))) +(defun imap-mailbox-status-asynch (mailbox items &optional buffer) + "Send status item request ITEM on MAILBOX to 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. The IMAP command tag is returned." + (with-current-buffer (or buffer (current-buffer)) + (imap-send-command (list "STATUS \"" + (imap-utf7-encode mailbox) + "\" " + (format "%s" + (if (listp items) + items + (list items))))))) + (defun imap-mailbox-acl-get (&optional mailbox buffer) "Get ACL on mailbox from server in BUFFER." (let ((mailbox (imap-utf7-encode mailbox))) @@ -1271,8 +1394,8 @@ returned, if ITEMS is a symbol only it's value is returned." (mapconcat (lambda (item) (if (consp item) - (format "%d:%d" - (car item) (cdr 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)) @@ -1292,7 +1415,7 @@ returned, if ITEMS is a symbol only it's value is returned." 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 + (when (imap-ok-p (imap-send-command-wait (format "%sFETCH %s %s" (if nouidfetch "" "UID ") (if (listp uids) (imap-list-to-message-set uids) @@ -1309,7 +1432,7 @@ is non-nil return theese properties." (imap-message-get uid receive))) uids) (imap-message-get uids receive)))))) - + (defun imap-message-put (uid propname value &optional buffer) (with-current-buffer (or buffer (current-buffer)) (if imap-message-data @@ -1383,7 +1506,9 @@ is non-nil return theese properties." (imap-mailbox-put 'search 'dummy) (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate))) (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy) - (error "Missing SEARCH response to a SEARCH command") + (progn + (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...") + nil) (imap-mailbox-get-1 'search imap-current-mailbox))))) (defun imap-message-flag-permanent-p (flag &optional mailbox buffer) @@ -1449,12 +1574,15 @@ first element, rest of list contain the saved articles' UIDs." (if (imap-ok-p (imap-send-command-wait cmd)) t (when (and (not dont-create) - (imap-mailbox-get-1 'trycreate mailbox)) - (imap-mailbox-create-1 mailbox) + ;; removed because of buggy Oracle server + ;; that doesn't send TRYCREATE tags (which + ;; is a MUST according to specifications): + ;;(imap-mailbox-get-1 'trycreate mailbox) + (imap-mailbox-create-1 mailbox)) (imap-ok-p (imap-send-command-wait cmd))))) (or no-copyuid (imap-message-copyuid-1 mailbox))))))) - + (defun imap-message-appenduid-1 (mailbox) (if (imap-capability 'UIDPLUS) (imap-mailbox-get-1 'appenduid mailbox) @@ -1483,11 +1611,11 @@ on failure." (let ((mailbox (imap-utf7-encode mailbox))) (with-current-buffer (or buffer (current-buffer)) (and (let ((imap-current-target-mailbox mailbox)) - (imap-ok-p - (imap-send-command-wait + (imap-ok-p + (imap-send-command-wait (list "APPEND \"" mailbox "\" " article)))) (imap-message-appenduid-1 mailbox))))) - + (defun imap-body-lines (body) "Return number of lines in article by looking at the mime bodystructure BODY." (if (listp body) @@ -1507,18 +1635,21 @@ on failure." (and from (concat (aref from 0) (if (aref from 0) " <") - (aref from 2) - "@" + (aref from 2) + "@" (aref from 3) (if (aref from 0) ">")))) ;; Internal functions. +(defun imap-add-callback (tag func) + (setq imap-callbacks (append (list (cons tag func)) imap-callbacks))) + (defun imap-send-command-1 (cmdstr) (setq cmdstr (concat cmdstr imap-client-eol)) (and imap-log - (with-current-buffer (get-buffer-create imap-log) + (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert cmdstr))) @@ -1547,7 +1678,7 @@ on failure." (replace-match eol))) (if (not calcfirst) (setq size (buffer-size)))) - (setq cmdstr + (setq cmdstr (concat cmdstr (format "{%d}" size)))) (unwind-protect (progn @@ -1561,7 +1692,7 @@ on failure." (with-current-buffer cmd (and imap-log (with-current-buffer (get-buffer-create - imap-log) + imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring cmd))) @@ -1586,20 +1717,27 @@ on failure." (defun imap-wait-for-tag (tag &optional buffer) (with-current-buffer (or buffer (current-buffer)) - (while (and (null imap-continuation) - (< imap-reached-tag tag)) - (or (and (not (memq (process-status imap-process) '(open run))) - (sit-for 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 - 'OK)))) + (let (imap-have-messaged) + (while (and (null imap-continuation) + (memq (process-status imap-process) '(open run)) + (< imap-reached-tag tag)) + (let ((len (/ (point-max) 1024)) + message-log-max) + (unless (< len 10) + (setq imap-have-messaged t) + (message "imap read: %dk" len)) + (accept-process-output imap-process + (truncate imap-read-timeout) + (truncate (* (- imap-read-timeout + (truncate imap-read-timeout)) + 1000))))) + (when imap-have-messaged + (message "")) + (and (memq (process-status imap-process) '(open run)) + (or (assq tag imap-failed-tags) + (if imap-continuation + 'INCOMPLETE + 'OK)))))) (defun imap-sentinel (process string) (delete-process process)) @@ -1623,7 +1761,7 @@ Return nil if no complete line has arrived." (goto-char (point-max)) (insert string) (and imap-log - (with-current-buffer (get-buffer-create imap-log) + (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert string))) @@ -1643,7 +1781,7 @@ Return nil if no complete line has arrived." (eq imap-state 'examine)) (imap-parse-response)) (t - (message "Unknown state %s in arrival filter" + (message "Unknown state %s in arrival filter" imap-state))) (delete-region (point-min) (point-max)))))))) @@ -1730,7 +1868,7 @@ Return nil if no complete line has arrived." (defsubst imap-parse-astring () (or (imap-parse-string) - (buffer-substring (point) + (buffer-substring (point) (if (re-search-forward "[(){ \r\n%*\"\\]" nil t) (goto-char (1- (match-end 0))) (end-of-line) @@ -1741,21 +1879,21 @@ Return nil if no complete line has arrived." ;; ;; addr-adl = nstring ;; ; Holds route from [RFC-822] route-addr if -;; ; non-NIL +;; ; non-nil ;; ;; addr-host = nstring -;; ; NIL indicates [RFC-822] group syntax. +;; ; nil indicates [RFC-822] group syntax. ;; ; Otherwise, holds [RFC-822] domain name ;; ;; addr-mailbox = nstring -;; ; NIL indicates end of [RFC-822] group; if -;; ; non-NIL and addr-host is NIL, holds +;; ; nil indicates end of [RFC-822] group; if +;; ; non-nil and addr-host is nil, holds ;; ; [RFC-822] group name. ;; ; Otherwise, holds [RFC-822] local-part ;; ; after removing [RFC-822] quoting ;; ;; addr-name = nstring -;; ; If non-NIL, holds phrase from [RFC-822] +;; ; If non-nil, holds phrase from [RFC-822] ;; ; mailbox after removing [RFC-822] quoting ;; @@ -1790,7 +1928,7 @@ Return nil if no complete line has arrived." (when (eq (char-after) ?\)) (imap-forward) (nreverse addresses))) - (assert (imap-parse-nil)))) + (assert (imap-parse-nil) t "In imap-parse-address-list"))) ;; mailbox = "INBOX" / astring ;; ; INBOX is case-insensitive. All case variants of @@ -1843,13 +1981,13 @@ Return nil if no complete line has arrived." ;; resp-cond-bye = "BYE" SP resp-text ;; ;; mailbox-data = "FLAGS" SP flag-list / -;; "LIST" SP mailbox-list / +;; "LIST" SP mailbox-list / ;; "LSUB" SP mailbox-list / -;; "SEARCH" *(SP nz-number) / +;; "SEARCH" *(SP nz-number) / ;; "STATUS" SP mailbox SP "(" -;; [status-att SP number *(SP status-att SP number)] ")" / +;; [status-att SP number *(SP status-att SP number)] ")" / ;; number SP "EXISTS" / -;; number SP "RECENT" +;; number SP "RECENT" ;; ;; message-data = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att)) ;; @@ -1876,14 +2014,14 @@ Return nil if no complete line has arrived." (FLAGS (imap-mailbox-put 'flags (imap-parse-flag-list))) (LIST (imap-parse-data-list 'list)) (LSUB (imap-parse-data-list 'lsub)) - (SEARCH (imap-mailbox-put - 'search + (SEARCH (imap-mailbox-put + 'search (read (concat "(" (buffer-substring (point) (point-max)) ")")))) (STATUS (imap-parse-status)) - (CAPABILITY (setq imap-capability - (read (concat "(" (upcase (buffer-substring - (point) (point-max))) - ")")))) + (CAPABILITY (setq imap-capability + (read (concat "(" (upcase (buffer-substring + (point) (point-max))) + ")")))) (ACL (imap-parse-acl)) (t (case (prog1 (read (current-buffer)) (imap-forward)) @@ -1910,7 +2048,7 @@ Return nil if no complete line has arrived." (search-forward "]"))) (imap-forward)) (setq text (buffer-substring (point) (point-max))) - (push (list token status code text) + (push (list token status code text) imap-failed-tags)))) (BAD (progn (setq imap-reached-tag (max imap-reached-tag token)) @@ -1925,7 +2063,11 @@ Return nil if no complete line has arrived." (push (list token status code text) imap-failed-tags) (error "Internal error, tag %s status %s code %s text %s" token status code text)))) - (t (message "Garbage: %s" (buffer-string)))))))))) + (t (message "Garbage: %s" (buffer-string)))) + (when (assq token imap-callbacks) + (funcall (cdr (assq token imap-callbacks)) token status) + (setq imap-callbacks + (imap-remassoc token imap-callbacks))))))))) ;; resp-text = ["[" resp-text-code "]" SP] text ;; @@ -1938,15 +2080,15 @@ Return nil if no complete line has arrived." ;; resp-text-code = "ALERT" / ;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] / -;; "NEWNAME" SP string SP string / -;; "PARSE" / -;; "PERMANENTFLAGS" SP "(" +;; "NEWNAME" SP string SP string / +;; "PARSE" / +;; "PERMANENTFLAGS" SP "(" ;; [flag-perm *(SP flag-perm)] ")" / -;; "READ-ONLY" / -;; "READ-WRITE" / -;; "TRYCREATE" / -;; "UIDNEXT" SP nz-number / -;; "UIDVALIDITY" SP nz-number / +;; "READ-ONLY" / +;; "READ-WRITE" / +;; "TRYCREATE" / +;; "UIDNEXT" SP nz-number / +;; "UIDVALIDITY" SP nz-number / ;; "UNSEEN" SP nz-number / ;; resp-text-atom [SP 1*] ;; @@ -1964,7 +2106,7 @@ Return nil if no complete line has arrived." ;; ; delimits between two numbers inclusive. ;; ; Example: 2,4:7,9,12:* is 2,4,5,6,7,9,12,13, ;; ; 14,15 for a mailbox with 15 messages. -;; +;; ;; sequence-num = nz-number / "*" ;; ; * is the largest number in use. For message ;; ; sequence numbers, it is the number of messages @@ -1998,10 +2140,10 @@ Return nil if no complete line has arrived." (imap-forward) (cond ((search-forward "PERMANENTFLAGS " nil t) (imap-mailbox-put 'permanentflags (imap-parse-flag-list))) - ((search-forward "UIDNEXT " nil t) - (imap-mailbox-put 'uidnext (read (current-buffer)))) + ((search-forward "UIDNEXT \\([0-9]+\\)" nil t) + (imap-mailbox-put 'uidnext (match-string 1))) ((search-forward "UNSEEN " nil t) - (imap-mailbox-put 'unseen (read (current-buffer)))) + (imap-mailbox-put 'first-unseen (read (current-buffer)))) ((looking-at "UIDVALIDITY \\([0-9]+\\)") (imap-mailbox-put 'uidvalidity (match-string 1))) ((search-forward "READ-ONLY" nil t) @@ -2065,18 +2207,18 @@ Return nil if no complete line has arrived." ;; "BODY" ["STRUCTURE"] SPACE body / ;; "BODY" section ["<" number ">"] SPACE nstring / ;; "UID" SPACE uniqueid) ")" -;; +;; ;; date_time ::= <"> date_day_fixed "-" date_month "-" date_year ;; SPACE time SPACE zone <"> -;; +;; ;; section ::= "[" [section_text / (nz_number *["." nz_number] ;; ["." (section_text / "MIME")])] "]" -;; +;; ;; section_text ::= "HEADER" / "HEADER.FIELDS" [".NOT"] ;; SPACE header_list / "TEXT" -;; +;; ;; header_fld_name ::= astring -;; +;; ;; header_list ::= "(" 1#header_fld_name ")" (defsubst imap-parse-header-list () @@ -2089,7 +2231,7 @@ Return nil if no complete line has arrived." (nreverse strlist)))) (defsubst imap-parse-fetch-body-section () - (let ((section + (let ((section (buffer-substring (point) (1- (re-search-forward "[] ]" nil t))))) (if (eq (char-before) ? ) (prog1 @@ -2099,16 +2241,20 @@ Return nil if no complete line has arrived." (defun imap-parse-fetch (response) (when (eq (char-after) ?\() - (let (uid flags envelope internaldate rfc822 rfc822header rfc822text - rfc822size body bodydetail bodystructure) + (let (uid flags envelope internaldate rfc822 rfc822header rfc822text + rfc822size body bodydetail bodystructure flags-empty) (while (not (eq (char-after) ?\))) (imap-forward) (let ((token (read (current-buffer)))) (imap-forward) (cond ((eq token 'UID) - (setq uid (ignore-errors (read (current-buffer))))) + (setq uid (condition-case () + (read (current-buffer)) + (error)))) ((eq token 'FLAGS) - (setq flags (imap-parse-flag-list))) + (setq flags (imap-parse-flag-list)) + (if (not flags) + (setq flags-empty 't))) ((eq token 'ENVELOPE) (setq envelope (imap-parse-envelope))) ((eq token 'INTERNALDATE) @@ -2137,7 +2283,7 @@ Return nil if no complete line has arrived." (when uid (setq imap-current-message uid) (imap-message-put uid 'UID uid) - (and flags (imap-message-put uid 'FLAGS flags)) + (and (or flags flags-empty) (imap-message-put uid 'FLAGS flags)) (and envelope (imap-message-put uid 'ENVELOPE envelope)) (and internaldate (imap-message-put uid 'INTERNALDATE internaldate)) (and rfc822 (imap-message-put uid 'RFC822 rfc822)) @@ -2151,7 +2297,7 @@ Return nil if no complete line has arrived." ;; mailbox-data = ... ;; "STATUS" SP mailbox SP "(" -;; [status-att SP number +;; [status-att SP number ;; *(SP status-att SP number)] ")" ;; ... ;; @@ -2160,24 +2306,32 @@ Return nil if no complete line has arrived." (defun imap-parse-status () (let ((mailbox (imap-parse-mailbox))) - (when (and mailbox (search-forward "(" nil t)) - (while (not (eq (char-after) ?\))) - (let ((token (read (current-buffer)))) - (cond ((eq token 'MESSAGES) + (if (eq (char-after) ? ) + (forward-char)) + (when (and mailbox (eq (char-after) ?\()) + (while (and (not (eq (char-after) ?\))) + (or (forward-char) t) + (looking-at "\\([A-Za-z]+\\) ")) + (let ((token (match-string 1))) + (goto-char (match-end 0)) + (cond ((string= token "MESSAGES") (imap-mailbox-put 'messages (read (current-buffer)) mailbox)) - ((eq token 'RECENT) + ((string= token "RECENT") (imap-mailbox-put 'recent (read (current-buffer)) mailbox)) - ((eq token 'UIDNEXT) - (imap-mailbox-put 'uidnext (read (current-buffer)) mailbox)) - ((eq token 'UIDVALIDITY) - (and (looking-at " \\([0-9]+\\)") - (imap-mailbox-put 'uidvalidity (match-string 1) mailbox) - (goto-char (match-end 1)))) - ((eq token 'UNSEEN) + ((string= token "UIDNEXT") + (and (looking-at "[0-9]+") + (imap-mailbox-put 'uidnext (match-string 0) mailbox) + (goto-char (match-end 0)))) + ((string= token "UIDVALIDITY") + (and (looking-at "[0-9]+") + (imap-mailbox-put 'uidvalidity (match-string 0) mailbox) + (goto-char (match-end 0)))) + ((string= token "UNSEEN") (imap-mailbox-put 'unseen (read (current-buffer)) mailbox)) (t - (message "Unknown status data %s in mailbox %s ignored" - token mailbox)))))))) + (message "Unknown status data %s in mailbox %s ignored" + token mailbox) + (read (current-buffer))))))))) ;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE ;; rights) @@ -2215,12 +2369,16 @@ Return nil if no complete line has arrived." (defun imap-parse-flag-list () (let (flag-list start) - (assert (eq (char-after) ?\()) + (assert (eq (char-after) ?\() t "In imap-parse-flag-list") (while (and (not (eq (char-after) ?\))) - (setq start (progn (imap-forward) (point))) + (setq start (progn + (imap-forward) + ;; next line for Courier IMAP bug. + (skip-chars-forward " ") + (point))) (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0)) (push (buffer-substring start (point)) flag-list)) - (assert (eq (char-after) ?\))) + (assert (eq (char-after) ?\)) t "In imap-parse-flag-list") (imap-forward) (nreverse flag-list))) @@ -2305,7 +2463,7 @@ Return nil if no complete line has arrived." (while (eq (char-after) ?\ ) (imap-forward) (push (imap-parse-body-extension) b-e)) - (assert (eq (char-after) ?\))) + (assert (eq (char-after) ?\)) t "In imap-parse-body-extension") (imap-forward) (nreverse b-e)) (or (imap-parse-number) @@ -2333,7 +2491,7 @@ Return nil if no complete line has arrived." (imap-forward) (push (imap-parse-string-list) dsp) (imap-forward)) - (assert (imap-parse-nil))) + (assert (imap-parse-nil) t "In imap-parse-body-ext")) (push (nreverse dsp) ext)) (when (eq (char-after) ?\ );; body-fld-lang (imap-forward) @@ -2429,7 +2587,7 @@ Return nil if no complete line has arrived." (push (and (imap-parse-nil) nil) body)) (setq body (append (imap-parse-body-ext) body)));; body-ext-... - (assert (eq (char-after) ?\))) + (assert (eq (char-after) ?\)) t "In imap-parse-body") (imap-forward) (nreverse body)) @@ -2448,7 +2606,7 @@ Return nil if no complete line has arrived." (push (imap-parse-nstring) body);; body-fld-desc (imap-forward) ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a - ;; nstring and return NIL instead of defaulting back to 7BIT + ;; 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) @@ -2488,17 +2646,16 @@ Return nil if no complete line has arrived." (imap-forward) (push (imap-parse-nstring) body);; body-fld-md5 (setq body (append (imap-parse-body-ext) body)));; body-ext-1part.. - - (assert (eq (char-after) ?\))) + + (assert (eq (char-after) ?\)) t "In imap-parse-body 2") (imap-forward) (nreverse body))))) (when imap-debug ; (untrace-all) (require 'trace) - (buffer-disable-undo (get-buffer-create imap-debug)) - (mapcar (lambda (f) (trace-function-background f imap-debug)) + (buffer-disable-undo (get-buffer-create imap-debug-buffer)) + (mapcar (lambda (f) (trace-function-background f imap-debug-buffer)) '( - imap-read-passwd imap-utf7-encode imap-utf7-decode imap-error-text @@ -2590,7 +2747,7 @@ Return nil if no complete line has arrived." imap-parse-body-extension imap-parse-body ))) - + (provide 'imap) ;;; imap.el ends here diff --git a/lisp/lpath.el b/lisp/lpath.el index 324563a..fc48c59 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -1,7 +1,5 @@ ;; Shut up. -(defvar byte-compile-default-warnings) - (defun maybe-fbind (args) (while args (or (fboundp (car args)) @@ -11,103 +9,114 @@ (defun maybe-bind (args) (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) -(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 +(maybe-fbind '(Info-directory + Info-menu bbdb-create-internal bbdb-records create-image + display-graphic-p display-time-event-handler find-image image-size image-type-available-p insert-image - make-temp-file message-xmas-redefine - mail-aliases-setup mm-copy-tree - mule-write-region-no-coding-system put-image - rmail-select-summary rmail-summary-exists rmail-update-summary - sc-cite-regexp set-font-family set-font-size temp-directory - 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)) + make-mode-line-mouse-map make-temp-file open-ssl-stream + propertize put-image replace-regexp-in-string + rmail-msg-is-pruned rmail-msg-restore-non-pruned-header + sort-coding-systems spam-BBDB-register-routine + spam-enter-ham-BBDB string-to-multibyte tool-bar-add-item + tool-bar-add-item-from-menu tool-bar-local-item-from-menu + url-http-file-exists-p vcard-pretty-print w32-focus-frame + w3m-charset-to-coding-system x-focus-frame)) +(maybe-bind '(filladapt-mode + mc-pgp-always-sign mm-w3m-mode-map rmail-enable-mime-composing + rmail-insert-mime-forwarded-message-function + w3m-cid-retrieve-function-alist w3m-current-buffer + w3m-display-inline-images w3m-meta-content-type-charset-regexp + w3m-minor-mode-map)) (if (featurep 'xemacs) (progn - (defvar track-mouse nil) - (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 + (maybe-fbind '(Info-directory + Info-menu ccl-execute-on-string char-charset charsetp + coding-system-get coding-system-list coding-system-p + decode-coding-region decode-coding-string + define-ccl-program delete-overlay detect-coding-region + encode-coding-region encode-coding-string + event-click-count event-end event-start 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 - gnus-newsgroup-name mark-active - mouse-selection-click-count - mouse-selection-click-count-buffer + find-coding-systems-region find-coding-systems-string + get-charset-property mail-abbrevs-setup + mouse-minibuffer-check mouse-movement-p mouse-scroll-subr + overlay-lists pgg-parse-crc24-string posn-point + posn-window read-event set-buffer-multibyte track-mouse + window-edges w3m-region)) + (maybe-bind '(adaptive-fill-first-line-regexp + buffer-display-table buffer-file-coding-system + current-language-environment + default-enable-multibyte-characters + enable-multibyte-characters gnus-agent-expire-current-dirs + language-info-alist mark-active mouse-selection-click-count + mouse-selection-click-count-buffer pgg-parse-crc24 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))) + w3-meta-content-type-charset-regexp + w3-meta-charset-content-type-regexp))) + (maybe-fbind '(bbdb-complete-name + delete-annotation device-connection dfw-device + events-to-keys font-lock-set-defaults frame-device + glyph-height glyph-width mail-aliases-setup make-annotation + make-event make-glyph make-network-process map-extents + message-xmas-redefine set-extent-property temp-directory + url-generic-parse-url url-insert-file-contents + valid-image-instantiator-format-p + w3-coding-system-for-mime-charset w3-do-setup + w3-prepare-buffer w3-region w3m-region window-pixel-height + window-pixel-width)) + (maybe-bind '(help-echo-owns-message + mail-mode-hook + url-current-object url-package-name url-package-version + w3-meta-charset-content-type-regexp + w3-meta-content-type-charset-regexp))) ;; 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 - file-name-extension find-coding-systems-region - get-charset-property)) - (maybe-bind '(mh-lib-progs))))) +(let ((functions + (cond + ((featurep 'xemacs) + '(frame-char-height frame-char-width)) + ((>= emacs-major-version 21) + '(function-max-args smiley-encode-buffer)) + ((boundp 'MULE) + '(charsetp + coding-system-base coding-system-get coding-system-list + coding-system-to-mime-charset compose-mail + file-name-extension find-coding-systems-for-charsets + find-coding-systems-region function-max-args get-charset-property + smiley-encode-buffer smtpmail-send-it)) + (t + '(function-max-args smiley-encode-buffer)))) + (common-fns + nil) + (variables + (cond + ((featurep 'xemacs) + '(font-lock-defaults)) + ((>= emacs-major-version 21) + nil) + ((boundp 'MULE) + '(adaptive-fill-first-line-regexp + default-enable-multibyte-characters enable-multibyte-characters)) + (t + nil))) + (common-vars + '(default-mime-charset-unlimited navi2ch-mona-font))) + (maybe-fbind functions) + (maybe-fbind common-fns) + (maybe-bind variables) + (maybe-bind common-vars)) + +(when (and (featurep 'xemacs) + (not (featurep 'mule))) + (progn + (maybe-fbind '(coding-system-base find-charset-string)))) -(require 'custom) (defun nnkiboze-score-file (a) ) +(defun split-line (&optional arg) + ) + (provide 'lpath) diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el index 95a3359..a5de09b 100644 --- a/lisp/mail-parse.el +++ b/lisp/mail-parse.el @@ -59,7 +59,11 @@ (defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header) (defalias 'mail-quote-string 'ietf-drums-quote-string) +(defalias 'mail-header-fold-field 'rfc2047-fold-field) +(defalias 'mail-header-unfold-field 'rfc2047-unfold-field) (defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field) +(defalias 'mail-header-field-value 'rfc2047-field-value) + (defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region) (defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header) (defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 7b5f50e..e84f79c 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, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -28,17 +28,18 @@ (eval-when-compile (require 'cl) (require 'imap) - (eval-when-compile (defvar display-time-mail-function))) -(eval-and-compile - (defvar pop3-leave-mail-on-server) + (defvar display-time-mail-function) (autoload 'pop3-movemail "pop3") - (autoload 'pop3-get-message-count "pop3") + (autoload 'pop3-get-message-count "pop3")) +(eval-and-compile (autoload 'nnheader-cancel-timer "nnheader") (autoload 'nnheader-run-at-time "nnheader")) (require 'format-spec) +(require 'message) ;; for `message-directory' (defgroup mail-source nil "The mail-fetching library." + :version "21.1" :group 'gnus) ;; Define these at compile time to avoid dragging in imap always. @@ -46,18 +47,19 @@ (eval-when-compile (mapcar (lambda (a) (list 'const (car a))) - imap-authenticator-alist))) + imap-authenticator-alist))) (defconst mail-source-imap-streams (eval-when-compile (mapcar (lambda (a) (list 'const (car a))) - imap-stream-alist))) + 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. See Info node `(gnus)Mail Source Specifiers'." :group 'mail-source + :link '(custom-manual "(gnus)Mail Source Specifiers") :type `(repeat (choice :format "%[Value Menu%] %v" :value (file) @@ -81,10 +83,16 @@ See Info node `(gnus)Mail Source Specifiers'." (function :tag "Predicate")) (group :inline t (const :format "" :value :prescript) - (string :tag "Prescript")) + (choice :tag "Prescript" + :value nil + (string :format "%v") + (function :format "%v"))) (group :inline t (const :format "" :value :postscript) - (string :tag "Postscript")) + (choice :tag "Postscript" + :value nil + (string :format "%v") + (function :format "%v"))) (group :inline t (const :format "" :value :plugged) (boolean :tag "Plugged")))) @@ -92,12 +100,12 @@ See Info node `(gnus)Mail Source Specifiers'." (const :format "" pop) (checklist :tag "Options" :greedy t (group :inline t - (const :format "" :value :server) + (const :format "" :value :server) (string :tag "Server")) (group :inline t - (const :format "" :value :port) + (const :format "" :value :port) (choice :tag "Port" - :value "pop3" + :value "pop3" (number :format "%v") (string :format "%v"))) (group :inline t @@ -111,15 +119,21 @@ See Info node `(gnus)Mail Source Specifiers'." (string :tag "Program")) (group :inline t (const :format "" :value :prescript) - (string :tag "Prescript")) + (choice :tag "Prescript" + :value nil + (string :format "%v") + (function :format "%v"))) (group :inline t (const :format "" :value :postscript) - (string :tag "Postscript")) + (choice :tag "Postscript" + :value nil + (string :format "%v") + (function :format "%v"))) (group :inline t (const :format "" :value :function) (function :tag "Function")) (group :inline t - (const :format "" + (const :format "" :value :authentication) (choice :tag "Authentication" :value apop @@ -145,8 +159,8 @@ See Info node `(gnus)Mail Source Specifiers'." (string :tag "Server")) (group :inline t (const :format "" :value :port) - (choice :tag "Port" - :value 143 + (choice :tag "Port" + :value 143 number string)) (group :inline t (const :format "" :value :user) @@ -160,6 +174,9 @@ See Info node `(gnus)Mail Source Specifiers'." :value network ,@mail-source-imap-streams)) (group :inline t + (const :format "" :value :program) + (string :tag "Program")) + (group :inline t (const :format "" :value :authenticator) (choice :tag "Authenticator" @@ -171,7 +188,7 @@ See Info node `(gnus)Mail Source Specifiers'." :value "INBOX")) (group :inline t (const :format "" :value :predicate) - (string :tag "Predicate" + (string :tag "Predicate" :value "UNSEEN UNDELETED")) (group :inline t (const :format "" :value :fetchflag) @@ -187,18 +204,18 @@ See Info node `(gnus)Mail Source Specifiers'." (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 :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")) @@ -213,18 +230,28 @@ See Info node `(gnus)Mail Source Specifiers'." (const :format "" :value :plugged) (boolean :tag "Plugged"))))))) +(defcustom mail-source-ignore-errors nil + "*Ignore errors when querying mail sources. +If nil, the user will be prompted when an error occurs. If non-nil, +the error will be ignored.") + (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) +(defcustom mail-source-flash t + "*If non-nil, flash periodically when mail is available." + :group 'mail-source + :type 'boolean) + (defcustom mail-source-crash-box "~/.emacs-mail-crash-box" "File where mail will be stored while processing it." :group 'mail-source :type 'file) -(defcustom mail-source-directory "~/Mail/" +(defcustom mail-source-directory message-directory "Directory where files (if any) will be stored." :group 'mail-source :type 'directory) @@ -234,8 +261,24 @@ If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'integer) -(defcustom mail-source-delete-incoming t - "*If non-nil, delete incoming files after handling." +(defcustom mail-source-delete-incoming nil + "*If non-nil, delete incoming files after handling. +If t, delete immediately, if nil, never delete. If a positive number, delete +files older than number of days." + ;; Note: The removing happens in `mail-source-callback', i.e. no old + ;; incoming files will be deleted, unless you receive new mail. + ;; + ;; You may also set this to `nil' and call `mail-source-delete-old-incoming' + ;; from a hook or interactively. + :group 'mail-source + :type '(choice (const :tag "immediately" t) + (const :tag "never" nil) + (integer :tag "days"))) + +(defcustom mail-source-delete-old-incoming-confirm t + "*If non-nil, ask for for confirmation before deleting old incoming files. +This variable only applies when `mail-source-delete-incoming' is a positive +number." :group 'mail-source :type 'boolean) @@ -254,6 +297,11 @@ If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'number) +(defcustom mail-source-movemail-program nil + "If non-nil, name of program for fetching new mail." + :group 'mail-source + :type '(choice (const nil) string)) + ;;; Internal variables. (defvar mail-source-string "" @@ -276,6 +324,9 @@ Common keywords should be listed here.") (:path (or (getenv "MAIL") (expand-file-name (user-login-name) rmail-spool-directory)))) (directory + (:prescript) + (:prescript-delay) + (:postscript) (:path) (:suffix ".spool") (:predicate identity)) @@ -300,6 +351,7 @@ Common keywords should be listed here.") (:server (getenv "MAILHOST")) (:port) (:stream) + (:program) (:authentication) (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) (:password) @@ -364,7 +416,7 @@ the `mail-source-keyword-map' variable." ,@body)) (put 'mail-source-bind 'lisp-indent-function 1) -(put 'mail-source-bind 'edebug-form-spec '(form body)) +(put 'mail-source-bind 'edebug-form-spec '(sexp body)) (defun mail-source-set-1 (source) (let* ((type (pop source)) @@ -407,7 +459,7 @@ See `mail-source-bind'." ,@body)) (put 'mail-source-bind-common 'lisp-indent-function 1) -(put 'mail-source-bind-common 'edebug-form-spec '(form body)) +(put 'mail-source-bind-common 'edebug-form-spec '(sexp body)) (defun mail-source-value (value) "Return the value of VALUE." @@ -441,21 +493,63 @@ Return the number of files that were found." (setq found (mail-source-callback callback mail-source-crash-box))) (+ found - (condition-case err + (if (or debug-on-quit debug-on-error) (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)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)) + (condition-case err + (funcall function source callback) + (error + (if (and (not mail-source-ignore-errors) + (not + (yes-or-no-p + (format "Mail source %s error (%s). Continue? " + (if (memq ':password source) + (let ((s (copy-sequence source))) + (setcar (cdr (memq ':password s)) + "********") + s) + source) + (cadr err))))) + (error "Cannot get new mail")) + 0))))))))) + +(eval-and-compile + (if (fboundp 'make-temp-file) + (defalias 'mail-source-make-complex-temp-name 'make-temp-file) + (defun mail-source-make-complex-temp-name (prefix) + (let ((newname (make-temp-name prefix)) + (newprefix prefix)) + (while (file-exists-p newname) + (setq newprefix (concat newprefix "x")) + (setq newname (make-temp-name newprefix))) + newname)))) + +(defun mail-source-delete-old-incoming (&optional age confirm) + "Remove incoming files older than AGE days. +If CONFIRM is non-nil, ask for confirmation before removing a file." + (interactive "P") + (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days + (low2days (/ 1.0 65536.0)) ;; convert low bits to days + (diff (if (natnump age) age 30));; fallback, if no valid AGE given + currday files) + (setq files (directory-files + mail-source-directory t + (concat mail-source-incoming-file-prefix "*")) + currday (* (car (current-time)) high2days) + currday (+ currday (* low2days (nth 1 (current-time))))) + (while files + (let* ((ffile (car files)) + (bfile (gnus-replace-in-string + ffile "\\`.*/\\([^/]+\\)\\'" "\\1")) + (filetime (nth 5 (file-attributes ffile))) + (fileday (* (car filetime) high2days)) + (fileday (+ fileday (* low2days (nth 1 filetime))))) + (setq files (cdr files)) + (when (and (> (- currday fileday) diff) + (gnus-message 8 "File `%s' is older than %s day(s)" + bfile diff) + (or (not confirm) + (y-or-n-p (concat "Remove file `" bfile "'? ")))) + (delete-file ffile)))))) (defun mail-source-callback (callback info) "Call CALLBACK on the mail file, and then remove the mail file. @@ -470,7 +564,7 @@ Pass INFO on to CALLBACK." (funcall callback mail-source-crash-box info) (when (file-exists-p mail-source-crash-box) ;; Delete or move the incoming mail out of the way. - (if mail-source-delete-incoming + (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming (mail-source-make-complex-temp-name @@ -479,7 +573,12 @@ Pass INFO on to CALLBACK." 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))))))) + (rename-file mail-source-crash-box incoming t) + ;; remove old incoming files? + (when (natnump mail-source-delete-incoming) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm)))))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." @@ -514,11 +613,13 @@ Pass INFO on to CALLBACK." 'call-process (append (list - (expand-file-name "movemail" exec-directory) + (or mail-source-movemail-program + (expand-file-name "movemail" exec-directory)) nil errors nil from to))))) (when (file-exists-p to) (set-file-modes to mail-source-default-file-modes)) - (if (and (not (buffer-modified-p errors)) + (if (and (or (not (buffer-modified-p errors)) + (zerop (buffer-size errors))) (zerop result)) ;; No output => movemail won. t @@ -536,8 +637,9 @@ Pass INFO on to CALLBACK." (goto-char (point-min)) (when (looking-at "movemail: ") (delete-region (point-min) (match-end 0))) + ;; Result may be a signal description string. (unless (yes-or-no-p - (format "movemail: %s (%d return). Continue? " + (format "movemail: %s (%s return). Continue? " (buffer-string) result)) (error "%s" (buffer-string))) (setq to nil))))))) @@ -553,29 +655,13 @@ Pass INFO on to CALLBACK." (not (zerop (nth 7 (file-attributes from)))) (delete-file from))) -(defvar mail-source-read-passwd nil) -(defun mail-source-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt - (if args - (apply 'format prompt args) - prompt))) - (unless mail-source-read-passwd - (if (or (fboundp 'read-passwd) (load "passwd" t)) - (setq mail-source-read-passwd 'read-passwd) - (unless (fboundp 'ange-ftp-read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp")) - (setq mail-source-read-passwd 'ange-ftp-read-passwd))) - (funcall mail-source-read-passwd prompt))) - (defun mail-source-fetch-with-program (program) (zerop (call-process shell-file-name nil nil nil shell-command-switch program))) (defun mail-source-run-script (script spec &optional delay) (when script - (if (and (symbolp script) (fboundp script)) + (if (functionp script) (funcall script) (mail-source-call-script (format-spec script spec)))) @@ -611,6 +697,8 @@ If ARGS, PROMPT is used as an argument to `format'." (defun mail-source-fetch-directory (source callback) "Fetcher for directory sources." (mail-source-bind (directory source) + (mail-source-run-script + prescript (format-spec-make ?t path) prescript-delay) (let ((found 0) (mail-source-string (format "directory:%s" path))) (dolist (file (directory-files @@ -619,6 +707,7 @@ If ARGS, PROMPT is used as an argument to `format'." (funcall predicate file) (mail-source-movemail file mail-source-crash-box)) (incf found (mail-source-callback callback file)))) + (mail-source-run-script postscript (format-spec-make ?t path)) found))) (defun mail-source-fetch-pop (source callback) @@ -636,7 +725,7 @@ If ARGS, PROMPT is used as an argument to `format'." (setq password (or password (cdr (assoc from mail-source-password-cache)) - (mail-source-read-passwd + (read-passwd (format "Password for %s at %s: " user server))))) (when server (setenv "MAILHOST" server)) @@ -652,6 +741,7 @@ If ARGS, PROMPT is used as an argument to `format'." (funcall function mail-source-crash-box)) ;; The default is to use pop3.el. (t + (require 'pop3) (let ((pop3-password password) (pop3-maildrop user) (pop3-mailhost server) @@ -662,16 +752,18 @@ If ARGS, PROMPT is used as an argument to `format'." (pop3-leave-mail-on-server (or leave (and (boundp 'pop3-leave-mail-on-server) - pop3-leave-mail-on-server)))) - (condition-case err + (symbol-value 'pop3-leave-mail-on-server))))) + (if (or debug-on-quit debug-on-error) (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)))))))) + (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) @@ -703,7 +795,7 @@ If ARGS, PROMPT is used as an argument to `format'." (setq password (or password (cdr (assoc from mail-source-password-cache)) - (mail-source-read-passwd + (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))) @@ -716,21 +808,24 @@ If ARGS, PROMPT is used as an argument to `format'." (function) ;; The default is to use pop3.el. (t + (require 'pop3) (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 + (if (or debug-on-quit debug-on-error) (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)))))))) + (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)) @@ -741,8 +836,30 @@ If ARGS, PROMPT is used as an argument to `format'." mail-source-password-cache))) result))) +(defun mail-source-touch-pop () + "Open and close a POP connection shortly. +POP server should be defined in `mail-source-primary-source' (which is +preferred) or `mail-sources'. You may use it for the POP-before-SMTP +authentication. To do that, you need to set the option +`message-send-mail-function' to `message-send-mail-with-smtp' or +`message-smtpmail-send-it' and put the following line in .gnus file: + +\(add-hook 'message-send-mail-hook 'mail-source-touch-pop) +" + (let ((sources (if mail-source-primary-source + (list mail-source-primary-source) + mail-sources))) + (while sources + (if (eq 'pop (car (car sources))) + (mail-source-check-pop (car sources))) + (setq sources (cdr sources))))) + (defun mail-source-new-mail-p () "Handler for `display-time' to indicate when new mail is available." + ;; Flash (ie. ring the visible bell) if mail is available. + (if (and mail-source-flash mail-source-new-mail-available) + (let ((visible-bell t)) + (ding))) ;; Only report flag setting; flag is updated on a different schedule. mail-source-new-mail-available) @@ -751,7 +868,7 @@ If ARGS, PROMPT is used as an argument to `format'." (defvar mail-source-report-new-mail-timer nil) (defvar mail-source-report-new-mail-idle-timer nil) -(eval-when-compile +(eval-when-compile (if (featurep 'xemacs) (require 'itimer) (require 'timer))) @@ -765,8 +882,9 @@ If ARGS, PROMPT is used as an argument to `format'." mail-source-idle-time-delay nil (lambda () - (mail-source-check-pop mail-source-primary-source) - (setq mail-source-report-new-mail-idle-timer nil)))) + (unwind-protect + (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 @@ -779,7 +897,7 @@ If ARGS, PROMPT is used as an argument to `format'." 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.")) + (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)))) @@ -835,13 +953,13 @@ This only works when `display-time' is enabled." (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)) +;;; ;; 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")) @@ -861,8 +979,7 @@ This only works when `display-time' is enabled." (autoload 'imap-error-text "imap") (autoload 'imap-message-flags-add "imap") (autoload 'imap-list-to-message-set "imap") - (autoload 'imap-range-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'.") @@ -870,13 +987,14 @@ This only works when `display-time' is enabled." (defun mail-source-fetch-imap (source callback) "Fetcher for imap sources." (mail-source-bind (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) + (let* ((from (format "%s:%s:%s" server user port)) + (found 0) + (buffer-name " *imap source*") + (buf (get-buffer-create (generate-new-buffer-name buffer-name))) + (mail-source-string (format "imap:%s:%s" server mailbox)) + (imap-shell-program (or (list program) imap-shell-program)) + remove) + (if (and (imap-open server port stream authentication buffer-name) (imap-authenticate user (or (cdr (assoc from mail-source-password-cache)) password) buf) @@ -895,7 +1013,11 @@ This only works when `display-time' is enabled." (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)) + (when (setq str + (if (imap-capability 'IMAP4rev1 buf) + (caddar (imap-fetch uid "BODY.PEEK[]" + 'BODYDETAIL nil buf)) + (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))) (push uid remove) (insert "From imap " (current-time-string) "\n") (save-excursion @@ -911,7 +1033,7 @@ This only works when `display-time' is enabled." fetchflag nil buf)) (if dontexpunge (imap-mailbox-unselect buf) - (imap-mailbox-close buf)) + (imap-mailbox-close nil buf)) (imap-close buf)) (imap-close buf) ;; We nix out the password in case the error @@ -935,14 +1057,14 @@ This only works when `display-time' is enabled." (when (eq authentication 'password) (setq password (or password - (cdr (assoc (format "webmail:%s:%s" subtype user) + (cdr (assoc (format "webmail:%s:%s" subtype user) mail-source-password-cache)) - (mail-source-read-passwd + (read-passwd (format "Password for %s at %s: " user subtype)))) (when (and password - (not (assoc (format "webmail:%s:%s" subtype user) + (not (assoc (format "webmail:%s:%s" subtype user) mail-source-password-cache))) - (push (cons (format "webmail:%s:%s" subtype user) password) + (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))))) diff --git a/lisp/md5.el b/lisp/md5.el index a246b1a..2f85d70 100644 --- a/lisp/md5.el +++ b/lisp/md5.el @@ -148,7 +148,7 @@ Returns a vector of 16 bytes containing the message digest." (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)))) + (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 @@ -172,16 +172,16 @@ Returns a vector of 16 bytes containing the message digest." (` (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))))))) + ((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) @@ -203,8 +203,8 @@ Returns a vector of 16 bytes containing the message digest." (defun md5-update (string) "Update the current MD5 state with STRING (an array of bytes)." (let ((len (length string)) - (i 0) - (j 0)) + (i 0) + (j 0)) (while (< i len) ;; Compute number of bytes modulo 64 (setq j (% (/ (aref md5-bits 0) 8) 64)) @@ -214,11 +214,11 @@ Returns a vector of 16 bytes containing the message digest." ;; 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))))) + (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)) @@ -226,32 +226,32 @@ Returns a vector of 16 bytes containing the message digest." ;; 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)))))) + (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))))) + (+ (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))))) + ((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)) + (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))) @@ -268,18 +268,18 @@ Returns a vector of 16 bytes containing the message digest." ;; 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)))) + (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)))) + (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)) @@ -291,9 +291,9 @@ Returns a vector of 16 bytes containing the message digest." (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))) + (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)) @@ -375,9 +375,9 @@ 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. -The optional CODING and NOERROR arguments are ignored. They are only -placeholders to ensure the compatibility with XEmacsen with file-coding or -Mule support." +The optional CODING and NOERROR arguments are ignored. They are no +more than placeholders to ensure the compatibility with XEmacsen with +file-coding or Mule support." (let ((buffer nil)) (unwind-protect (save-excursion @@ -410,4 +410,4 @@ Mule support." (provide 'md5) -;;; md5.el ends here ---------------------------------------------------------- +;;; md5.el ends here diff --git a/lisp/message.el b/lisp/message.el index 7448fc8..25355f8 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,5 @@ -;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*- -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;;; message.el --- composing mail and news messages +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -9,7 +9,7 @@ ;; Tatsuya Ichikawa ;; Katsumi Yamaoka ;; Kiyokazu SUTO -;; Keywords: mail, news +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -39,13 +39,21 @@ (eval-when-compile (require 'cl) (require 'smtp) - (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary - + (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary +(eval-and-compile + (if (boundp 'MULE) + (progn + (require 'base64) + (require 'canlock-om)) + (require 'canlock))) (require 'mailheader) (require 'nnheader) -;; This is apparently necessary even though things are autoloaded: +;; This is apparently necessary even though things are autoloaded. +;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better +;; require mailabbrev here. (if (featurep 'xemacs) - (require 'mail-abbrevs)) + (require 'mail-abbrevs) + (require 'mailabbrev)) (require 'mime-edit) (eval-when-compile (require 'static)) @@ -54,6 +62,11 @@ (require 'mail-parse) (require 'mml)) +(require 'rfc822) +(eval-and-compile + (autoload 'sha1 "sha1-el") + (autoload 'customize-save-variable "cus-edit"));; for Mule 2. + (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) "Mail and news message composing." @@ -129,7 +142,7 @@ (defcustom message-send-rename-function nil "Function called to rename the buffer after sending it." :group 'message-buffers - :type 'function) + :type '(choice function (const nil))) (defcustom message-fcc-handler-function 'message-output "*A function called to save outgoing articles. @@ -150,6 +163,11 @@ mailbox format." :group 'message-sending :type '(repeat (symbol :tag "Type"))) +(defcustom message-fcc-externalize-attachments nil + "If non-nil, attachments are included as external parts in Fcc copies." + :type 'boolean + :group 'message-sending) + (defcustom message-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" "*This is inserted at the start of a mailed copy of a posted message. @@ -169,11 +187,126 @@ If this variable is nil, no such courtesy message will be added." :group 'message-sending :type 'function) +;;; Start of variables adopted from `message-utils.el'. + +(defcustom message-subject-trailing-was-query 'ask + ;; should it default to nil or ask? + "*What to do with trailing \"(was: )\" in subject lines. +If nil, leave the subject unchanged. If it is the symbol `ask', query +the user what do do. In this case, the subject is matched against +`message-subject-trailing-was-ask-regexp'. If +`message-subject-trailing-was-query' is t, always strip the trailing +old subject. In this case, `message-subject-trailing-was-regexp' is +used." + :type '(choice (const :tag "never" nil) + (const :tag "always strip" t) + (const ask)) + :group 'message-various) + +(defcustom message-subject-trailing-was-ask-regexp + "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)" + "*Regexp matching \"(was: )\" in the subject line. + +The function `message-strip-subject-trailing-was' uses this regexp if +`message-subject-trailing-was-query' is set to the symbol `ask'. If +the variable is t instead of `ask', use +`message-subject-trailing-was-regexp' instead. + +It is okay to create some false positives here, as the user is asked." + :group 'message-various + :type 'regexp) + +(defcustom message-subject-trailing-was-regexp + "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)" + "*Regexp matching \"(was: )\" in the subject line. + +If `message-subject-trailing-was-query' is set to t, the subject is +matched against `message-subject-trailing-was-regexp' in +`message-strip-subject-trailing-was'. You should use a regexp creating very +few false positives here." + :group 'message-various + :type 'regexp) + +;;; marking inserted text + +;;;###autoload +(defcustom message-mark-insert-begin + "--8<---------------cut here---------------start------------->8---\n" + "How to mark the beginning of some inserted text." + :type 'string + :group 'message-various) + +;;;###autoload +(defcustom message-mark-insert-end + "--8<---------------cut here---------------end--------------->8---\n" + "How to mark the end of some inserted text." + :type 'string + :group 'message-various) + +;;;###autoload +(defcustom message-archive-header + "X-No-Archive: Yes\n" + "Header to insert when you don't want your article to be archived. +Archives \(such as groups.googgle.com\) respect this header." + :type 'string + :group 'message-various) + +;;;###autoload +(defcustom message-archive-note + "X-No-Archive: Yes - save http://groups.google.com/" + "Note to insert why you wouldn't want this posting archived. +If nil, don't insert any text in the body." + :type 'string + :group 'message-various) + +;;; Crossposts and Followups +;; inspired by JoH-followup-to by Jochem Huhman +;; new suggestions by R. Weikusat + +(defvar message-cross-post-old-target nil + "Old target for cross-posts or follow-ups.") +(make-variable-buffer-local 'message-cross-post-old-target) + +;;;###autoload +(defcustom message-cross-post-default t + "When non-nil `message-cross-post-followup-to' will perform a crosspost. +If nil, `message-cross-post-followup-to' will only do a followup. Note that +you can explicitly override this setting by calling +`message-cross-post-followup-to' with a prefix." + :type 'boolean + :group 'message-various) + +;;;###autoload +(defcustom message-cross-post-note + "Crosspost & Followup-To: " + "Note to insert before signature to notify of xpost and follow-up." + :type 'string + :group 'message-various) + +;;;###autoload +(defcustom message-followup-to-note + "Followup-To: " + "Note to insert before signature to notify of follow-up only." + :type 'string + :group 'message-various) + +;;;###autoload +(defcustom message-cross-post-note-function + 'message-cross-post-insert-note + "Function to use to insert note about Crosspost or Followup-To. +The function will be called with four arguments. The function should not only +insert a note, but also ensure old notes are deleted. See the documentation +for `message-cross-post-insert-note'." + :type 'function + :group 'message-various) + +;;; End of variables adopted from `message-utils.el'. + ;;;###autoload (defcustom message-from-style 'default "*Specifies how \"From\" headers look. -If `nil', they contain just the return address like: +If nil, they contain just the return address like: king@grassland.com If `parens', they look like: king@grassland.com (Elvis Parsley) @@ -188,7 +321,14 @@ Otherwise, most addresses look like `angles', but they look like (const default)) :group 'message-headers) -(defcustom message-syntax-checks nil +(defcustom message-insert-canlock t + "Whether to insert a Cancel-Lock header in news postings." + :version "21.3" + :group 'message-headers + :type 'boolean) + +(defcustom message-syntax-checks + (if message-insert-canlock '((sender . disabled)) nil) ;; 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 @@ -196,17 +336,34 @@ 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 quoting-style -redirected-followup signature approved sender empty empty-headers -message-id from subject shorten-followup-to existing-newsgroups -buffer-file-name unchanged newsgroups." +Checks include `subject-cmsg', `multiple-headers', `sendsys', +`message-id', `from', `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', `reply-to', +'continuation-headers', and `long-header-lines'." :group 'message-news + :type '(repeat sexp)) ; Fixme: improve this + +(defcustom message-required-headers '((optional . References) + From) + "*Headers to be generated or prompted for when sending a message. +Also see `message-required-news-headers' and +`message-required-mail-headers'." + :group 'message-news + :group 'message-headers + :type '(repeat sexp)) + +(defcustom message-draft-headers '(References From) + "*Headers to be generated when saving a draft message." + :group 'message-news + :group 'message-headers :type '(repeat sexp)) (defcustom message-required-news-headers '(From Newsgroups Subject Date Message-ID - (optional . Organization) Lines + (optional . Organization) (optional . User-Agent)) "*Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, @@ -218,11 +375,11 @@ header, remove it from this list." :type '(repeat sexp)) (defcustom message-required-mail-headers - '(From Subject Date (optional . In-Reply-To) Message-ID Lines + '(From Subject Date (optional . In-Reply-To) Message-ID (optional . User-Agent)) "*Headers to be generated or prompted for when mailing a message. -RFC822 required that From, Date, To, Subject and Message-ID be -included. Organization, Lines and User-Agent are optional." +It is recommended that From, Date, To, Subject and Message-ID be +included. Organization and User-Agent are optional." :group 'message-mail :group 'message-headers :type '(repeat sexp)) @@ -233,19 +390,20 @@ included. Organization, Lines and User-Agent are optional." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers :type 'regexp) -(defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:" +(defcustom message-ignored-mail-headers + "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers :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:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:" "*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." @@ -258,7 +416,8 @@ any confusion." :group 'message-sending :type 'function) -(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*" +(defcustom message-subject-re-regexp + "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" "*Regexp matching \"Re: \" in the subject line." :group 'message-various :type 'regexp) @@ -301,8 +460,8 @@ and add a new \"Re: \". If it is nil, use the subject \"as-is\". If it is the symbol `guess', try to detect \"Re: \" within an encoded-word." :group 'message-various :type '(choice (const :tag "off" nil) - (const :tag "on" t) - (const guess))) + (const :tag "on" t) + (const guess))) ;;;###autoload (defcustom message-signature-separator "^-- *$" @@ -310,12 +469,19 @@ is the symbol `guess', try to detect \"Re: \" within an encoded-word." :type 'regexp :group 'message-various) +(defcustom message-signature-separator-for-insertion "-- \n" + "*Signature separator. This value will be inserted as signature separator +when composing message. Default value is \"-- \\n\". Notice: Changing this +value may go against RFC-1036 and draft-ietf-usefor-article-05.txt. " + :type 'string + :group 'message-insertion) + (defcustom message-elide-ellipsis "\n[...]\n\n" "*The string which is inserted for elided text." :type 'string :group 'message-various) -(defcustom message-interactive nil +(defcustom message-interactive t "Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors." :group 'message-sending @@ -323,7 +489,7 @@ nil means let mailer mail back a message to report errors." :type 'boolean) (defcustom message-generate-new-buffers 'unique - "*Non-nil means that a new message buffer will be created whenever `message-setup' is called. + "*Non-nil means create a new message buffer whenever `message-setup' is called. If this is a function, call that function with three parameters: The type, the to address and the group name. (Any of these may be nil.) The function should return the new buffer name." @@ -339,15 +505,23 @@ should return the new buffer name." :type 'boolean) (defcustom message-kill-buffer-query-function 'yes-or-no-p - "*A function called to query the user whether to kill buffer anyway or not. -If it is t, the buffer will be killed peremptorily." + "*Function used to prompt user whether to kill the message buffer. If +it is t, the buffer will be killed unconditionally." :type '(radio (function-item yes-or-no-p) (function-item y-or-n-p) (function-item nnheader-Y-or-n-p) (function :tag "Other" t)) :group 'message-buffers) -(defvar gnus-local-organization) +(defcustom message-kill-buffer-and-remove-file t + "*Non-nil means that the associated file will be removed before +removing the message buffer. However, it is treated as nil when the +command `message-mimic-kill-buffer' is used." + :group 'message-buffers + :type 'boolean) + +(eval-when-compile + (defvar gnus-local-organization)) (defcustom message-user-organization (or (and (boundp 'gnus-local-organization) (stringp gnus-local-organization) @@ -385,28 +559,33 @@ If t, use `message-user-organization-file'." :type 'regexp) (defcustom message-make-forward-subject-function - 'message-forward-subject-author-subject - "*A list of functions that are called to generate a subject header for forwarded messages. + 'message-forward-subject-name-subject + "*List of functions called to generate subject headers for forwarded messages. The subject generated by the previous function is passed into each successive function. The provided functions are: -* message-forward-subject-author-subject (Source of article (author or +* `message-forward-subject-author-subject' (Source of article (author or newsgroup)), in brackets followed by the subject -* message-forward-subject-fwd (Subject of article with 'Fwd:' prepended +* `message-forward-subject-name-subject' (Source of article (name of author + or newsgroup)), in brackets followed by the subject +* `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended to it." :group 'message-forwarding :type '(radio (function-item message-forward-subject-author-subject) - (function-item message-forward-subject-fwd))) + (function-item message-forward-subject-fwd) + (repeat :tag "List of functions" function))) (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) @@ -420,13 +599,14 @@ The provided functions are: :group 'message-forwarding :type 'boolean) -(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:" +(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From " "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) (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)) @@ -436,6 +616,28 @@ The provided functions are: :group 'message-insertion :type 'regexp) +(defcustom message-cite-prefix-regexp + (if (string-match "[[:digit:]]" "1") ;; support POSIX? + "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+" + ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. + (let ((old-table (syntax-table)) + non-word-constituents) + (set-syntax-table text-mode-syntax-table) + (setq non-word-constituents + (concat + (if (string-match "\\w" "-") "" "-") + (if (string-match "\\w" "_") "" "_") + (if (string-match "\\w" ".") "" "."))) + (set-syntax-table old-table) + (if (equal non-word-constituents "") + "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+" + (concat "\\([ \t]*\\(\\w\\|[" + non-word-constituents + "]\\)+>+\\|[ \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 @@ -449,12 +651,18 @@ The headers should be delimited by a line whose contents match the variable `mail-header-separator'. Valid values include `message-send-mail-with-sendmail' (the default), -`message-send-mail-with-mh', `message-send-mail-with-qmail' and -`message-send-mail-with-smtp'." +`message-send-mail-with-mh', `message-send-mail-with-qmail', +`message-send-mail-with-smtp', `message-smtpmail-send-it', +`smtpmail-send-it' and `feedmail-send-it'. + +See also `send-mail-function'." :type '(radio (function-item message-send-mail-with-sendmail) (function-item message-send-mail-with-mh) (function-item message-send-mail-with-qmail) (function-item message-send-mail-with-smtp) + (function-item message-smtpmail-send-it) + (function-item smtpmail-send-it) + (function-item feedmail-send-it) (function :tag "Other")) :group 'message-sending :group 'message-mail) @@ -469,25 +677,25 @@ variable `mail-header-separator'." :type 'function) (defcustom message-reply-to-function nil - "Function that should return a list of headers. + "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface - :type 'function) + :type '(choice function (const nil))) (defcustom message-wide-reply-to-function nil - "Function that should return a list of headers. + "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface - :type 'function) + :type '(choice function (const nil))) (defcustom message-followup-to-function nil - "Function that should return a list of headers. + "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface - :type 'function) + :type '(choice function (const nil))) (defcustom message-use-followup-to 'ask "*Specifies what to do with Followup-To header. @@ -497,6 +705,7 @@ always query the user whether to use the value. If it is the symbol `use', always use the value." :group 'message-interface :type '(choice (const :tag "ignore" nil) + (const :tag "use & query" t) (const :tag "maybe" t) (const :tag "always" use) (const :tag "ask" ask))) @@ -513,17 +722,6 @@ the value. If it is the symbol `use', always use the value." (const :tag "always" use) (const :tag "ask" ask))) -(defcustom message-use-mail-followup-to 'ask - "*Specifies what to do with Mail-Followup-To header. -If nil, always ignore the header. If it is the symbol `ask', always -query the user whether to use the value. If it is t or the symbol -`use', always use the value." - :group 'message-interface - :type '(choice (const :tag "ignore" nil) - (const :tag "maybe" t) - (const :tag "always" use) - (const :tag "ask" ask))) - ;;; XXX: 'ask and 'use are not implemented yet. (defcustom message-use-mail-reply-to 'ask "*Specifies what to do with Mail-Reply-To/Reply-To header. @@ -537,12 +735,75 @@ is never used." (const :tag "always" use) (const :tag "ask" ask))) +(defcustom message-use-mail-followup-to 'use + "*Specifies what to do with Mail-Followup-To header. +If nil, always ignore the header. If it is the symbol `ask', always +query the user whether to use the value. If it is t or the symbol +`use', always use the value." + :group 'message-interface + :type '(choice (const :tag "ignore" nil) + (const :tag "maybe" t) + (const :tag "always" use) + (const :tag "ask" ask))) + +(defcustom message-subscribed-address-functions nil + "*Specifies functions for determining list subscription. +If nil, do not attempt to determine list subscribtion with functions. +If non-nil, this variable contains a list of functions which return +regular expressions to match lists. These functions can be used in +conjunction with `message-subscribed-regexps' and +`message-subscribed-addresses'." + :group 'message-interface + :type '(repeat sexp)) + +(defcustom message-subscribed-address-file nil + "*A file containing addresses the user is subscribed to. +If nil, do not look at any files to determine list subscriptions. If +non-nil, each line of this file should be a mailing list address." + :group 'message-interface + :type 'string) + +(defcustom message-subscribed-addresses nil + "*Specifies a list of addresses the user is subscribed to. +If nil, do not use any predefined list subscriptions. This list of +addresses can be used in conjuction with +`message-subscribed-address-functions' and `message-subscribed-regexps'." + :group 'message-interface + :type '(repeat string)) + +(defcustom message-subscribed-regexps nil + "*Specifies a list of addresses the user is subscribed to. +If nil, do not use any predefined list subscriptions. This list of +regular expressions can be used in conjuction with +`message-subscribed-address-functions' and `message-subscribed-addresses'." + :group 'message-interface + :type '(repeat regexp)) + +(defcustom message-allow-no-recipients 'ask + "Specifies what to do when there are no recipients other than Gcc/Fcc. +If it is the symbol `always', the posting is allowed. If it is the +symbol `never', the posting is not allowed. If it is the symbol +`ask', you are prompted." + :group 'message-interface + :type '(choice (const always) + (const never) + (const ask))) + (defcustom message-sendmail-f-is-evil nil - "*Non-nil means that \"-f username\" should not be added to the sendmail command line. + "*Non-nil means don't add \"-f username\" to the sendmail command line. Doing so would be even more evil than leaving it out." :group 'message-sending :type 'boolean) +(defcustom message-sendmail-envelope-from nil + "*Envelope-from when sending mail with sendmail. +If this is nil, use `user-mail-address'. If it is the symbol +`header', use the From: header of the message." + :type '(choice (string :tag "From name") + (const :tag "Use From: header from message" header) + (const :tag "Use `user-mail-address'" nil)) + :group 'message-sending) + ;; qmail-related stuff (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" "Location of the qmail-inject program." @@ -551,21 +812,24 @@ Doing so would be even more evil than leaving it out." (defcustom message-qmail-inject-args nil "Arguments passed to qmail-inject programs. -This should be a list of strings, one string for each argument. +This should be a list of strings, one string for each argument. It +may also be a function. For e.g., if you wish to set the envelope sender address so that bounces go to the right place or to deal with listserv's usage of that address, you might set this variable to '(\"-f\" \"you@some.where\")." :group 'message-sending - :type '(repeat string)) + :type '(choice (function) + (repeat string))) (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.") -(defvar gnus-post-method) -(defvar gnus-select-method) +(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) @@ -583,10 +847,25 @@ variable isn't used." ;; create a dependence to `gnus.el'. :type 'sexp) -(defcustom message-generate-headers-first nil - "*If non-nil, generate all possible headers before composing." +;; FIXME: This should be a temporary workaround until someone implements a +;; proper solution. If a crash happens while replying, the auto-save file +;; will *not* have a `References:' header if `message-generate-headers-first' +;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 +(defcustom message-generate-headers-first '(references) + "*If non-nil, generate all required headers before composing. +The variables `message-required-news-headers' and +`message-required-mail-headers' specify which headers to generate. +This can also be a list of headers that should be generated before +composing. + +Note that the variable `message-deletable-headers' specifies headers which +are to be deleted and then re-generated before sending, so this variable +will not have a visible effect for those headers." :group 'message-headers - :type 'boolean) + :type '(choice (const :tag "None" nil) + (const :tag "References" '(references)) + (const :tag "All" t) + (repeat (sexp :tag "Header")))) (defcustom message-setup-hook '(turn-on-mime-edit) "Normal hook, run each time a new outgoing message is initialized. @@ -623,7 +902,7 @@ The function `message-supersede' runs this hook." :group 'message-various :type 'hook) -(defcustom message-header-hook '((lambda () (eword-encode-header t))) +(defcustom message-header-hook '((lambda () (mime-encode-header-in-buffer t))) "Hook run in a message mode buffer narrowed to the headers." :group 'message-various :type 'hook) @@ -633,15 +912,28 @@ The function `message-supersede' runs this hook." :group 'message-various :type 'hook) +(defcustom message-minibuffer-local-map + (let ((map (make-sparse-keymap 'message-minibuffer-local-map))) + (set-keymap-parent map minibuffer-local-map) + map) + "Keymap for `message-read-from-minibuffer'.") + ;;;###autoload (defcustom message-citation-line-function 'message-insert-citation-line - "*Function called to insert the \"Whomever writes:\" line." + "*Function called to insert the \"Whomever writes:\" line. + +Note that Gnus provides a feature where the reader can click on +`writes:' to hide the cited text. If you change this line too much, +people who read your message will have to change their Gnus +configuration. See the variable `gnus-cite-attribution-suffix'." :type 'function :group 'message-insertion) ;;;###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. +See also `message-yank-cited-prefix'." :type 'string :group 'message-insertion) @@ -663,6 +955,13 @@ an article is yanked by the command `message-yank-original' interactively." (integer :tag "Position from last ID")) :group 'message-insertion) +(defcustom message-yank-cited-prefix ">" + "*Prefix inserted on cited or empty lines of yanked messages. +Fix `message-cite-prefix-regexp' if it is set to an abnormal value. +See also `message-yank-prefix'." + :type 'string + :group 'message-insertion) + (defcustom message-indentation-spaces 3 "*Number of spaces to insert at the beginning of each cited line. Used by `message-yank-original' via `message-yank-cite'." @@ -683,6 +982,17 @@ Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." :group 'message-insertion) ;;;###autoload +(defcustom message-suspend-font-lock-when-citing nil + "Non-nil means suspend font-lock'ing while citing an original message. +Some lazy demand-driven fontification tools (or Emacs itself) have a +bug that they often miss a buffer to be fontified. It will mostly +occur when Emacs prompts user for any inputs in the minibuffer. +Setting this option to non-nil may help you to avoid unpleasant errors +even if it is an add-hoc expedient." + :type 'boolean + :group 'message-insertion) + +;;;###autoload (defcustom message-indent-citation-function 'message-indent-citation "*Function for modifying a citation just inserted in the mail buffer. This can also be a list of functions. Each function can find the @@ -691,8 +1001,6 @@ point and mark around the citation text as modified." :type 'function :group 'message-insertion) -(defvar message-abbrevs-loaded nil) - ;;;###autoload (defcustom message-signature t "*String to be inserted at the end of the message buffer. @@ -704,15 +1012,23 @@ If a form, the result from the form will be used instead." ;;;###autoload (defcustom message-signature-file "~/.signature" - "*File containing the text inserted at end of message buffer." - :type 'file + "*Name of file containing the text inserted at end of message buffer. +Ignored if the named file doesn't exist. +If nil, don't insert a signature." + :type '(choice file (const :tags "None" nil)) + :group 'message-insertion) + +;;;###autoload +(defcustom message-signature-insert-empty-line t + "*If non-nil, insert an empty line before the signature separator." + :type 'boolean :group 'message-insertion) (defcustom message-distribution-function nil "*Function called to return a Distribution header." :group 'message-news :group 'message-headers - :type 'function) + :type '(choice function (const nil))) (defcustom message-expires 14 "Number of days before your article expires." @@ -732,7 +1048,10 @@ If stringp, use this; if non-nil, use no host name (user name only)." (sexp :tag "none" :format "%t" t))) (defvar message-reply-buffer nil) -(defvar message-reply-headers nil) +(defvar message-reply-headers nil + "The headers of the current replied article. +It is a vector of the following headers: +\[number subject from date id references chars lines xref extra].") (defvar message-sent-message-via nil) (defvar message-checksum nil) (defvar message-send-actions nil @@ -749,7 +1068,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") @@ -828,53 +1147,61 @@ 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 - :type 'directory) - -(defcustom message-buffer-naming-style 'unique - "*The way new message buffers are named. -Valid valued are `unique' and `unsent'." - :group 'message-buffers - :type '(choice (const :tag "unique" unique) - (const :tag "unsent" unsent))) + :type '(choice directory (const :tag "Don't auto-save" 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 (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." + "*A regexp specifying addresses to prune when doing wide replies. +A value of nil means exclude your own user 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. + "*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 +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.") +`multiple-copies' Allow you to post multiple copies; +`cancel-messages' Allow you to cancel or supersede messages from + your other email addresses.") (defsubst message-gnksa-enable-p (feature) (or (not (listp message-shoot-gnksa-feet)) (memq feature message-shoot-gnksa-feet))) +(defcustom message-hidden-headers nil + "Regexp of headers to be hidden when composing new messages. +This can also be a list of regexps to match headers. Or a list +starting with `not' and followed by regexps.." + :group 'message + :type '(repeat regexp)) + ;;; Internal variables. ;;; Well, not really internal. @@ -886,14 +1213,6 @@ candidates: table) "Syntax table used while in Message mode.") -(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) (background dark)) @@ -1014,198 +1333,71 @@ Defaults to `text-mode-abbrev-table'.") "Face used for displaying MML." :group 'message-faces) -(defvar message-font-lock-fence-open-regexp "[+|]" - "*Regexp that matches fence open string.") - -(defvar message-font-lock-fence-close-regexp "|" - "*Regexp that matches fence close string.") - -(defvar message-font-lock-fence-open-position nil - "*Cons of SYMBOL of a function or a variable and a number of OFFSET that -indicate the fence open position. If it is non-nil, -`message-font-lock-fence-open-regexp' is not used for searching for the -fence open position. If SYMBOL is a function, it is called with one argument -last cursor position and should return the fence open position as a number -or a marker. If SYMBOL is a variable symbol, the value is examined with -`symbol-value'. OFFSET is added to the position to compensate the value. -For example, the following combinations of variable symbol and offset value -can be used: - -Egg v3: '(egg:*region-start* . -1) -Canna: '(canna:*region-start* . 0) -") - -(defvar message-font-lock-fence-close-position nil - "*Cons of SYMBOL of a function or a variable and a number of OFFSET that -indicate the fence close position. If it is non-nil, -`message-font-lock-fence-close-regexp' is not used for searching for the -fence close position. If SYMBOL is a function, it is called with one argument -last cursor position and should return the fence close position as a number -or a marker. If SYMBOL is a variable symbol, the value is examined with -`symbol-value'. OFFSET is added to the position to compensate the value. -For example, the following combinations of variable symbol and offset value -can be used: - -Egg v3: '(egg:*region-end* . 0) -Canna: '(canna:*region-end* . 0) -") - -(defvar message-font-lock-cited-text-regexp - "^[\t ]*\\([^\000- :>|}\177]*\\)[:>|}].*" - "*Regexp that matches cited text. It should have a grouping for the -citation prefix which is ended at the beginning of citation mark string.") - -(defvar message-font-lock-citation-name-max-column 10 - "*Maximun number of column for citation name for fontifying.") - -(defvar message-font-lock-last-position nil - "Internal buffer local variable to save the last cursor position -before fontifying.") - -(eval-after-load "font-lock" - '(defadvice font-lock-after-change-function - (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))))) - -(defun message-font-lock-cited-text-matcher (limit) - "Search for a cited text containing `message-font-lock-cited-text-regexp' -forward. Argument LIMIT bounds the search. If a cited text is found, it -returns t and sets match data 1 and 2, otherwise it returns nil. Normally, -match data 2 has zero length, but if the FENCE (for input method) is detected -in matched text, result is divided into match data 1 and 2 across the FENCE. -See also the documentations for the following variables: - `message-font-lock-fence-open-regexp' - `message-font-lock-fence-close-regexp' - `message-font-lock-fence-open-position' - `message-font-lock-fence-close-position' -" - (prog1 - (when (re-search-forward message-font-lock-cited-text-regexp limit t) - (let* ((start0 (match-beginning 0)) - (end0 (match-end 0)) - (cite-mark (match-end 1)) - (should-fontify - (progn - (goto-char cite-mark) - (<= (current-column) - message-font-lock-citation-name-max-column))) - end1 start2) - (and - should-fontify - message-font-lock-last-position - (>= message-font-lock-last-position start0) - (<= message-font-lock-last-position end0) - (cond - (message-font-lock-fence-open-position - (let* ((symbol (car message-font-lock-fence-open-position)) - (open - (cond ((functionp symbol) - (funcall symbol message-font-lock-last-position)) - ((and (symbolp symbol) - (boundp symbol)) - (symbol-value symbol))))) - (when (markerp open) - (setq open (marker-position open))) - (and (numberp open) - (setq open - (+ open - (cdr message-font-lock-fence-open-position))) - (>= message-font-lock-last-position open) - (goto-char open) - (or (not message-font-lock-fence-open-regexp) - (looking-at message-font-lock-fence-open-regexp)) - (setq end1 open)))) - (message-font-lock-fence-open-regexp - (goto-char message-font-lock-last-position) - (when (re-search-backward - message-font-lock-fence-open-regexp start0 t) - (setq end1 (match-beginning 0))))) - (setq should-fontify - (and message-font-lock-fence-open-position - (not (eq cite-mark end1)))) - (cond - (message-font-lock-fence-close-position - (let* ((symbol (car message-font-lock-fence-close-position)) - (close - (cond ((functionp symbol) - (funcall symbol message-font-lock-last-position)) - ((and (symbolp symbol) - (boundp symbol)) - (symbol-value symbol))))) - (when (markerp close) - (setq close (marker-position close))) - (and (numberp close) - (setq close - (+ close - (cdr message-font-lock-fence-close-position))) - (<= message-font-lock-last-position close) - (setq start2 close)))) - (message-font-lock-fence-close-regexp - (goto-char message-font-lock-last-position) - (when (looking-at message-font-lock-fence-close-regexp) - (setq start2 (match-end 0))))) - (setq should-fontify - (and (not (and (not message-font-lock-fence-open-position) - (eq cite-mark end1))) - (not (eq cite-mark start2))))) - (goto-char end0) - (when should-fontify - (if start2 - (store-match-data (list start0 end0 start0 end1 start2 end0)) - (store-match-data (list start0 end0 start0 end0 end0 end0))) - t))) - (setq message-font-lock-last-position nil))) - -(defvar message-font-lock-keywords-1 +(defun message-font-lock-make-header-matcher (regexp) + (let ((form + `(lambda (limit) + (let ((start (point))) + (save-restriction + (widen) + (goto-char (point-min)) + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (setq limit (min limit (match-beginning 0)))) + (goto-char start)) + (and (< start limit) + (re-search-forward ,regexp limit t)))))) + (if (featurep 'bytecomp) + (byte-compile form) + form))) + +(defvar message-font-lock-keywords (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) - `((,(concat "^\\([Tt]o:\\)" content) + `((,(message-font-lock-make-header-matcher + (concat "^\\([Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-to-face nil t)) - (,(concat "^\\([GBF]?[Cc][Cc]:\\|[Rr]eply-[Tt]o:\\|" - "[Mm]ail-[Cc]opies-[Tt]o:\\|" - "[Mm]ail-[Rr]eply-[Tt]o:\\|" - "[Mm]ail-[Ff]ollowup-[Tt]o:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([GBF]?[Cc][Cc]:\\|[Rr]eply-[Tt]o:\\|" + "[Mm]ail-[Cc]opies-[Tt]o:\\|" + "[Mm]ail-[Rr]eply-[Tt]o:\\|" + "[Mm]ail-[Ff]ollowup-[Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-cc-face nil t)) - (,(concat "^\\([Ss]ubject:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([Ss]ubject:\\)" content)) (1 'message-header-name-face) (2 'message-header-subject-face nil t)) - (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-newsgroups-face nil t)) - (,(concat "^\\([A-Z][^: \n\t]+:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([A-Z][^: \n\t]+:\\)" content)) (1 'message-header-name-face) (2 'message-header-other-face nil t)) - (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) + (,(message-font-lock-make-header-matcher + (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) (1 'message-header-name-face) (2 'message-header-name-face)) ,@(if (and mail-header-separator (not (equal mail-header-separator ""))) `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") 1 'message-separator-face)) - nil)))) - -(defvar message-font-lock-keywords-2 - (append message-font-lock-keywords-1 - '((message-font-lock-cited-text-matcher - (1 'message-cited-text-face) - (2 'message-cited-text-face)) - ("<#/?\\(multipart\\|part\\|external\\).*>" - (0 'message-mml-face))))) - -(defvar message-font-lock-keywords message-font-lock-keywords-2 + nil) + ((lambda (limit) + (re-search-forward (concat "^\\(" + message-cite-prefix-regexp + "\\).*") + limit t)) + (0 'message-cited-text-face)) + (,mime-edit-tag-regexp + (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") ;; XEmacs does it like this. For Emacs, we have to set the ;; `font-lock-defaults' buffer-local variable. -(put 'message-mode '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))) +(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) (defvar message-face-alist '((bold . bold-region) @@ -1214,21 +1406,26 @@ See also the documentations for the following variables: (unbold-region b e) (ununderline-region b e)))) "Alist of mail and news faces for facemenu. -The cdr of ech entry is a function for applying the face to a region.") +The cdr of each entry is a function for applying the face to a region.") (defcustom message-send-hook nil - "Hook run before sending messages." + "Hook run before sending messages. +This hook is run quite early when sending." :group 'message-various :options '(ispell-message) :type 'hook) (defcustom message-send-mail-hook nil - "Hook run before sending mail messages." + "Hook run before sending mail messages. +This hook is run very late -- just before the message is sent as +mail." :group 'message-various :type 'hook) (defcustom message-send-news-hook nil - "Hook run before sending news messages." + "Hook run before sending news messages. +This hook is run very late -- just before the message is sent as +news." :group 'message-various :type 'hook) @@ -1250,21 +1447,17 @@ The cdr of ech entry is a function for applying the face to a region.") (const :tag "ask" ask))) (defvar message-draft-coding-system - (cond - ((boundp 'MULE) '*junet*) - ((not (fboundp 'find-coding-system)) nil) - ((find-coding-system 'emacs-mule) - (if (memq system-type '(windows-nt ms-dos ms-windows)) - 'emacs-mule-dos 'emacs-mule)) - ((find-coding-system 'escape-quoted) 'escape-quoted) - ((find-coding-system 'no-conversion) 'no-conversion) - (t nil)) - "Coding system to compose mail.") + nnheader-auto-save-coding-system + "*Coding system to compose mail. +If you'd like to make it possible to share draft files between XEmacs +and Emacs, you may use `iso-2022-7bit' for this value at your own risk. +Note that the coding-system `iso-2022-7bit' isn't suitable to all data.") (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." +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))) @@ -1276,6 +1469,67 @@ The first matched address (not primary one) is used in the From field." :type '(choice (const :tag "Always use primary" nil) regexp)) +(defcustom message-hierarchical-addresses nil + "A list of hierarchical mail address definitions. + +Inside each entry, the first address is the \"top\" address, and +subsequent addresses are subaddresses; this is used to indicate that +mail sent to the first address will automatically be delivered to the +subaddresses. So if the first address appears in the recipient list +for a message, the subaddresses will be removed (if present) before +the mail is sent. All addresses in this structure should be +downcased." + :group 'message-headers + :type '(repeat (repeat string))) + +(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) + +(defcustom message-wide-reply-confirm-recipients nil + "Whether to confirm a wide reply to multiple email recipients. +If this variable is nil, don't ask whether to reply to all recipients. +If this variable is non-nil, pose the question \"Reply to all +recipients?\" before a wide reply to multiple recipients. If the user +answers yes, reply to all recipients as usual. If the user answers +no, only reply back to the author." + :version "21.3" + :group 'message-headers + :type 'boolean) + +(defcustom message-user-fqdn nil + "*Domain part of Messsage-Ids." + :group 'message-headers + :link '(custom-manual "(message)News Headers") + :type 'string) + +(defcustom message-use-idna (and (condition-case nil (require 'idna) + (file-error)) + (fboundp 'coding-system-p) + (coding-system-p 'utf-8) + 'ask) + "Whether to encode non-ASCII in domain names into ASCII according to IDNA." + :group 'message-headers + :type '(choice (const :tag "Ask" ask) + (const :tag "Never" nil) + (const :tag "Always" t))) + ;;; Internal variables. (defvar message-sending-message "Sending...") @@ -1287,8 +1541,9 @@ The first matched address (not primary one) is used in the From field." (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 @@ -1309,7 +1564,7 @@ The first matched address (not primary one) is used in the From field." ;; can be removed, e.g. ;; From: joe@y.z (Joe K ;; User) - ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and + ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and ;; From: Joe User ;; ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. @@ -1321,7 +1576,7 @@ The first matched address (not primary one) is used in the From field." ;; We want to match the results of any of these manglings. ;; The following regexp rejects names whose first characters are ;; obviously bogus, but after that anything goes. - "\\([^\0-\b\n-\r\^?].*\\)? " + "\\([^\0-\b\n-\r\^?].*\\)?" ;; The time the message was sent. "\\([^\0-\r \^?]+\\) +" ; day of the week @@ -1377,6 +1632,25 @@ The first matched address (not primary one) is used in the From field." (defvar message-options nil "Some saved answers when sending message.") +(defvar message-send-mail-real-function nil + "Internal send mail function.") + +(defvar message-bogus-system-names "^localhost\\." + "The regexp of bogus system names.") + +(defcustom message-valid-fqdn-regexp + (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain. + ;; valid TLDs: + "\\([a-z][a-z]" ;; two letter country TDLs + "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org" + "\\|aero\\|coop\\|info\\|name\\|museum" + "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style? + "\\)") + "Regular expression that matches a valid FQDN." + ;; see also: gnus-button-valid-fqdn-regexp + :group 'message-headers + :type 'regexp) + (eval-and-compile (autoload 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") @@ -1385,15 +1659,19 @@ The first matched address (not primary one) is used in the From field." (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") (autoload 'nndraft-request-expire-articles "nndraft") (autoload 'gnus-open-server "gnus-int") (autoload 'gnus-request-post "gnus-int") (autoload 'gnus-copy-article-buffer "gnus-msg") (autoload 'gnus-alive-p "gnus-util") + (autoload 'gnus-server-string "gnus") (autoload 'gnus-group-name-charset "gnus-group") - (autoload 'rmail-output "rmail") + (autoload 'gnus-group-name-decode "gnus-group") + (autoload 'gnus-groups-from-server "gnus") + (autoload 'rmail-output "rmailout") + (autoload 'gnus-delay-article "gnus-delay") + (autoload 'gnus-make-local-hook "gnus-util") (autoload 'mu-cite-original "mu-cite")) @@ -1419,22 +1697,26 @@ The first matched address (not primary one) is used in the From field." `(message-eval-parameter (message-get-parameter ,key ,alist))) (defmacro message-y-or-n-p (question show &rest text) - "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW" + "Ask QUESTION, displaying remaining args in a temporary buffer if SHOW." `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) -;; Delete the current line (and the next N lines.); (defmacro message-delete-line (&optional n) + "Delete the current line (and the next N lines)." `(delete-region (progn (beginning-of-line) (point)) (progn (forward-line ,(or n 1)) (point)))) +(defun message-mark-active-p () + "Non-nil means the mark and region are currently active in this buffer." + mark-active) + (defun message-unquote-tokens (elems) - "Remove double quotes (\") from strings in list." + "Remove double quotes (\") from strings in list ELEMS." (mapcar (lambda (item) - (while (string-match "^\\(.*\\)\"\\(.*\\)$" item) - (setq item (concat (match-string 1 item) - (match-string 2 item)))) - item) - elems)) + (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. @@ -1469,7 +1751,7 @@ is used by default." ((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." @@ -1516,18 +1798,30 @@ is used by default." (save-restriction (message-narrow-to-headers) (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) - (insert (car headers) ?\n)))) + (goto-char (point-max)) + (if (string-match "\n$" (car headers)) + (insert (car headers)) + (insert (car headers) ?\n))))) (setq headers (cdr headers)))) +(defmacro message-with-reply-buffer (&rest forms) + "Evaluate FORMS in the reply buffer, if it exists." + `(let ((buffer (message-eval-parameter message-reply-buffer))) + (when (and buffer + (buffer-name buffer)) + (save-excursion + (set-buffer buffer) + ,@forms)))) + +(put 'message-with-reply-buffer 'lisp-indent-function 0) +(put 'message-with-reply-buffer 'edebug-form-spec '(body)) (defun message-fetch-reply-field (header) - "Fetch FIELD from the message we're replying to." - (let ((buffer (message-eval-parameter message-reply-buffer))) - (when (and buffer - (buffer-name buffer)) - (save-excursion - (set-buffer buffer) - (message-fetch-field header))))) + "Fetch field HEADER from the message we're replying to." + (message-with-reply-buffer + (save-restriction + (mail-narrow-to-head) + (message-fetch-field header)))) (defun message-set-work-buffer () (if (get-buffer " *message work*") @@ -1544,13 +1838,13 @@ is used by default." (byte-code-function-p form))) (defun message-strip-list-identifiers (subject) - "Remove list identifiers in `gnus-list-identifiers'." + "Remove list identifiers in `gnus-list-identifiers' from string SUBJECT." (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) + " *\\)\\)+\\(Re: +\\)?\\)") subject) (concat (substring subject 0 (match-beginning 1)) (or (match-string 3 subject) (match-string 5 subject)) @@ -1559,14 +1853,262 @@ is used by default." subject))) (defun message-strip-subject-re (subject) - "Remove \"Re:\" from subject lines." + "Remove \"Re:\" from subject lines in string SUBJECT." (if (string-match message-subject-re-regexp subject) (substring subject (match-end 0)) subject)) +;;; Start of functions adopted from `message-utils.el'. + +(defun message-strip-subject-trailing-was (subject) + "Remove trailing \"(Was: )\" from SUBJECT lines. +Leading \"Re: \" is not stripped by this function. Use the function +`message-strip-subject-re' for this." + (let* ((query message-subject-trailing-was-query) + (new) (found)) + (setq found + (string-match + (if (eq query 'ask) + message-subject-trailing-was-ask-regexp + message-subject-trailing-was-regexp) + subject)) + (if found + (setq new (substring subject 0 (match-beginning 0)))) + (if (or (not found) (eq query nil)) + subject + (if (eq query 'ask) + (if (message-y-or-n-p + "Strip `(was: )' in subject? " t + (concat + "Strip `(was: )' in subject " + "and use the new one instead?\n\n" + "Current subject is: \"" + subject "\"\n\n" + "New subject would be: \"" + new "\"\n\n" + "See the variable `message-subject-trailing-was-query' " + "to get rid of this query." + )) + new subject) + new)))) + +;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/ + +;;;###autoload +(defun message-change-subject (new-subject) + "Ask for NEW-SUBJECT header, append (was: )." + (interactive + (list + (read-from-minibuffer "New subject: "))) + (cond ((and (not (or (null new-subject) ; new subject not empty + (zerop (string-width new-subject)) + (string-match "^[ \t]*$" new-subject)))) + (save-excursion + (let ((old-subject (message-fetch-field "Subject"))) + (cond ((not old-subject) + (error "No current subject")) + ((not (string-match + (concat "^[ \t]*" + (regexp-quote new-subject) + " \t]*$") + old-subject)) ; yes, it really is a new subject + ;; delete eventual Re: prefix + (setq old-subject + (message-strip-subject-re old-subject)) + (message-goto-subject) + (message-delete-line) + (insert (concat "Subject: " + new-subject + " (was: " + old-subject ")\n"))))))))) + +;;;###autoload +(defun message-mark-inserted-region (beg end) + "Mark some region in the current article with enclosing tags. +See `message-mark-insert-begin' and `message-mark-insert-end'." + (interactive "r") + (save-excursion + ; add to the end of the region first, otherwise end would be invalid + (goto-char end) + (insert message-mark-insert-end) + (goto-char beg) + (insert message-mark-insert-begin))) + +;;;###autoload +(defun message-mark-insert-file (file) + "Insert FILE at point, marking it with enclosing tags. +See `message-mark-insert-begin' and `message-mark-insert-end'." + (interactive "fFile to insert: ") + ;; reverse insertion to get correct result. + (let ((p (point))) + (insert message-mark-insert-end) + (goto-char p) + (insert-file-contents file) + (goto-char p) + (insert message-mark-insert-begin))) + +;;;###autoload +(defun message-add-archive-header () + "Insert \"X-No-Archive: Yes\" in the header and a note in the body. +The note can be customized using `message-archive-note'. When called with a +prefix argument, ask for a text to insert. If you don't want the note in the +body, set `message-archive-note' to nil." + (interactive) + (if current-prefix-arg + (setq message-archive-note + (read-from-minibuffer "Reason for No-Archive: " + (cons message-archive-note 0)))) + (save-excursion + (if (message-goto-signature) + (re-search-backward message-signature-separator)) + (when message-archive-note + (insert message-archive-note) + (newline)) + (message-add-header message-archive-header) + (message-sort-headers))) + +;;;###autoload +(defun message-cross-post-followup-to-header (target-group) + "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP. +With prefix-argument just set Follow-Up, don't cross-post." + (interactive + (list ; Completion based on Gnus + (completing-read "Followup To: " + (if (boundp 'gnus-newsrc-alist) + gnus-newsrc-alist) + nil nil '("poster" . 0) + (if (boundp 'gnus-group-history) + 'gnus-group-history)))) + (message-remove-header "Follow[Uu]p-[Tt]o" t) + (message-goto-newsgroups) + (beginning-of-line) + ;; if we already did a crosspost before, kill old target + (if (and message-cross-post-old-target + (re-search-forward + (regexp-quote (concat "," message-cross-post-old-target)) + nil t)) + (replace-match "")) + ;; unless (followup is to poster or user explicitly asked not + ;; to cross-post, or target-group is already in Newsgroups) + ;; add target-group to Newsgroups line. + (cond ((and (or + ;; def: cross-post, req:no + (and message-cross-post-default (not current-prefix-arg)) + ;; def: no-cross-post, req:yes + (and (not message-cross-post-default) current-prefix-arg)) + (not (string-match "poster" target-group)) + (not (string-match (regexp-quote target-group) + (message-fetch-field "Newsgroups")))) + (end-of-line) + (insert (concat "," target-group)))) + (end-of-line) ; ensure Followup: comes after Newsgroups: + ;; unless new followup would be identical to Newsgroups line + ;; make a new Followup-To line + (if (not (string-match (concat "^[ \t]*" + target-group + "[ \t]*$") + (message-fetch-field "Newsgroups"))) + (insert (concat "\nFollowup-To: " target-group))) + (setq message-cross-post-old-target target-group)) + +;;;###autoload +(defun message-cross-post-insert-note (target-group cross-post in-old + old-groups) + "Insert a in message body note about a set Followup or Crosspost. +If there have been previous notes, delete them. TARGET-GROUP specifies the +group to Followup-To. When CROSS-POST is t, insert note about +crossposting. IN-OLD specifies whether TARGET-GROUP is a member of +OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have +been made to before the user asked for a Crosspost." + ;; start scanning body for previous uses + (message-goto-signature) + (let ((head (re-search-backward + (concat "^" mail-header-separator) + nil t))) ; just search in body + (message-goto-signature) + (while (re-search-backward + (concat "^" (regexp-quote message-cross-post-note) ".*") + head t) + (message-delete-line)) + (message-goto-signature) + (while (re-search-backward + (concat "^" (regexp-quote message-followup-to-note) ".*") + head t) + (message-delete-line)) + ;; insert new note + (if (message-goto-signature) + (re-search-backward message-signature-separator)) + (if (or in-old + (not cross-post) + (string-match "^[ \t]*poster[ \t]*$" target-group)) + (insert (concat message-followup-to-note target-group "\n")) + (insert (concat message-cross-post-note target-group "\n"))))) + +;;;###autoload +(defun message-cross-post-followup-to (target-group) + "Crossposts message and set Followup-To to TARGET-GROUP. +With prefix-argument just set Follow-Up, don't cross-post." + (interactive + (list ; Completion based on Gnus + (completing-read "Followup To: " + (if (boundp 'gnus-newsrc-alist) + gnus-newsrc-alist) + nil nil '("poster" . 0) + (if (boundp 'gnus-group-history) + 'gnus-group-history)))) + (cond ((not (or (null target-group) ; new subject not empty + (zerop (string-width target-group)) + (string-match "^[ \t]*$" target-group))) + (save-excursion + (let* ((old-groups (message-fetch-field "Newsgroups")) + (in-old (string-match + (regexp-quote target-group) + (or old-groups "")))) + ;; check whether target exactly matches old Newsgroups + (cond ((not old-groups) + (error "No current newsgroup")) + ((or (not in-old) + (not (string-match + (concat "^[ \t]*" + (regexp-quote target-group) + "[ \t]*$") + old-groups))) + ;; yes, Newsgroups line must change + (message-cross-post-followup-to-header target-group) + ;; insert note whether we do cross-post or followup-to + (funcall message-cross-post-note-function + target-group + (if (or (and message-cross-post-default + (not current-prefix-arg)) + (and (not message-cross-post-default) + current-prefix-arg)) t) + in-old old-groups)))))))) + +;;; Reduce To: to Cc: or Bcc: header + +;;;###autoload +(defun message-reduce-to-to-cc () + "Replace contents of To: header with contents of Cc: or Bcc: header." + (interactive) + (let ((cc-content (message-fetch-field "cc")) + (bcc nil)) + (if (and (not cc-content) + (setq cc-content (message-fetch-field "bcc"))) + (setq bcc t)) + (cond (cc-content + (save-excursion + (message-goto-to) + (message-delete-line) + (insert (concat "To: " cc-content "\n")) + (message-remove-header (if bcc + "bcc" + "cc"))))))) + +;;; End of functions adopted from `message-utils.el'. + (defun message-remove-header (header &optional is-regexp first reverse) "Remove HEADER in the narrowed buffer. -If REGEXP, HEADER is a regular expression. +If IS-REGEXP, HEADER is a regular expression. If FIRST, only remove the first instance of the header. Return the number of headers removed." (goto-char (point-min)) @@ -1621,10 +2163,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) @@ -1632,6 +2172,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) @@ -1668,6 +2214,13 @@ Point is left at the beginning of the narrowed-to region." (message-fetch-field "cc") (message-fetch-field "bcc"))))))) +(defun message-subscribed-p () + "Say whether we need to insert a MFT header." + (or message-subscribed-regexps + message-subscribed-addresses + message-subscribed-address-file + message-subscribed-address-functions)) + (defun message-next-header () "Go to the beginning of the next header." (beginning-of-line) @@ -1727,6 +2280,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) + (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) @@ -1737,14 +2291,37 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) + (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) + (define-key message-mode-map "\C-c\C-f\C-i" + 'message-insert-or-toggle-importance) + (define-key message-mode-map "\C-c\C-f\C-a" + 'message-generate-unsubscribed-mail-followup-to) + + ;; modify headers (and insert notes in body) + (define-key message-mode-map "\C-c\C-fs" 'message-change-subject) + ;; + (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) + ;; prefix+message-cross-post-followup-to = same w/o cross-post + (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc) + (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header) + ;; mark inserted text + (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region) + (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file) + (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-fw" 'message-insert-wide-reply) (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) + (define-key message-mode-map "\C-c\C-l" 'message-to-list-only) + + (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) + (define-key message-mode-map "\C-c\M-n" + 'message-insert-disposition-notification-to) (define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) @@ -1759,115 +2336,237 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-s" 'message-send) (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) (define-key message-mode-map "\C-c\C-d" 'message-dont-send) + (define-key message-mode-map "\C-c\n" 'gnus-delay-article) (define-key message-mode-map "\C-c\C-e" 'message-elide-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 [remap split-line] 'message-split-line) + (define-key message-mode-map "\C-a" 'message-beginning-of-line) (define-key message-mode-map "\t" 'message-tab) + (define-key message-mode-map "\M-;" 'comment-region) - (define-key message-mode-map "\C-x\C-s" 'message-save-drafts) (define-key message-mode-map "\C-xk" 'message-mimic-kill-buffer)) (easy-menu-define message-mode-menu message-mode-map "Message Menu." - '("Message" - ["Sort Headers" message-sort-headers t] + `("Message" ["Yank Original" message-yank-original t] ["Fill Yanked Message" message-fill-yanked-message t] ["Insert Signature" message-insert-signature t] ["Caesar (rot13) Message" message-caesar-buffer-body t] - ["Caesar (rot13) Region" message-caesar-region (mark t)] - ["Elide Region" message-elide-region (mark t)] - ["Delete Outside Region" message-delete-not-region (mark t)] + ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] + ["Elide Region" message-elide-region + :active (message-mark-active-p) + ,@(if (featurep 'xemacs) nil + '(:help "Replace text in region with an ellipsis"))] + ["Delete Outside Region" message-delete-not-region + :active (message-mark-active-p) + ,@(if (featurep 'xemacs) nil + '(:help "Delete all quoted text outside 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) '(t) + '(:help "Spellcheck this message"))] + ["Attach file as MIME" mime-edit-insert-file + ,@(if (featurep 'xemacs) '(t) + '(: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])) + ["Insert Region Marked" message-mark-inserted-region + :active (message-mark-active-p) + ,@(if (featurep 'xemacs) nil + '(:help "Mark region with enclosing tags"))] + ["Insert File Marked..." message-mark-insert-file + ,@(if (featurep 'xemacs) '(t) + '(:help "Insert file at point marked with enclosing tags"))] + "----" + ["Send Message" message-send-and-exit + ,@(if (featurep 'xemacs) '(t) + '(:help "Send this message"))] + ["Postpone Message" message-dont-send + ,@(if (featurep 'xemacs) '(t) + '(:help "File this draft message and exit"))] + ["Send at Specific Time..." gnus-delay-article + ,@(if (featurep 'xemacs) '(t) + '(:help "Ask, then arrange to send message at that time"))] + ["Kill Message" message-kill-buffer + ,@(if (featurep 'xemacs) '(t) + '(:help "Delete this message without sending"))])) (easy-menu-define message-mode-field-menu message-mode-map "" - '("Field" + `("Field" ["Fetch To" message-insert-to t] ["Fetch Newsgroups" message-insert-newsgroups t] "----" ["To" message-goto-to t] + ["From" message-goto-from t] ["Subject" message-goto-subject t] + ["Change subject..." message-change-subject t] ["Cc" message-goto-cc t] + ["Bcc" message-goto-bcc t] + ["Fcc" message-goto-fcc t] ["Reply-To" message-goto-reply-to t] - ["Mail-Reply-To" message-goto-mail-reply-to t] - ["Mail-Followup-To" message-goto-mail-followup-to t] - ["Mail-Copies-To" message-goto-mail-copies-to t] + ["Flag As Important" message-insert-importance-high + ,@(if (featurep 'xemacs) '(t) + '(:help "Mark this message as important"))] + ["Flag As Unimportant" message-insert-importance-low + ,@(if (featurep 'xemacs) '(t) + '(:help "Mark this message as unimportant"))] + ["Request Receipt" + message-insert-disposition-notification-to + ,@(if (featurep 'xemacs) '(t) + '(:help "Request a receipt notification"))] + "----" + ;; (typical) news stuff ["Summary" message-goto-summary t] ["Keywords" message-goto-keywords t] ["Newsgroups" message-goto-newsgroups t] ["Followup-To" message-goto-followup-to t] + ;; ["Followup-To (with note in body)" message-cross-post-followup-to t] + ["Crosspost / Followup-To..." message-cross-post-followup-to t] ["Distribution" message-goto-distribution t] - ["Body" message-goto-body t] - ["Signature" message-goto-signature t])) + ["X-No-Archive:" message-add-archive-header t ] + "----" + ;; (typical) mailing-lists stuff + ["Send to list only" message-to-list-only t] + ["Mail-Followup-To" message-goto-mail-followup-to t] + ["Mail-Reply-To" message-goto-mail-reply-to t] + ["Mail-Copies-To" message-goto-mail-copies-to t] + ["Reduce To: to Cc:" message-reduce-to-to-cc t] + "----" + ["Sort Headers" message-sort-headers t] + ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t] + ["Goto Body" message-goto-body t] + ["Goto Signature" message-goto-signature t])) + +(defvar message-tool-bar-map nil) + +(eval-when-compile + (defvar facemenu-add-face-function) + (defvar facemenu-remove-face-function)) + +;;; Forbidden properties +;; +;; We use `after-change-functions' to keep special text properties +;; that interfer with the normal function of message mode out of the +;; buffer. + +(defcustom message-strip-special-text-properties t + "Strip special properties from the message buffer. + +Emacs has a number of special text properties which can break message +composing in various ways. If this option is set, message will strip +these properties from the message composition buffer. However, some +packages requires these properties to be present in order to work. +If you use one of these packages, turn this option off, and hope the +message composition doesn't break too bad." + :group 'message-various + :type 'boolean) -(defvar facemenu-add-face-function) -(defvar facemenu-remove-face-function) +(defconst message-forbidden-properties + ;; No reason this should be clutter up customize. We make it a + ;; property list (rather than a list of property symbols), to be + ;; directly useful for `remove-text-properties'. + '(field nil read-only nil invisible nil intangible nil + mouse-face nil modification-hooks nil insert-in-front-hooks nil + insert-behind-hooks nil point-entered nil point-left nil) + ;; Other special properties: + ;; category, face, display: probably doesn't do any harm. + ;; fontified: is used by font-lock. + ;; syntax-table, local-map: I dunno. + ;; We need to add XEmacs names to the list. + "Property list of with properties.forbidden in message buffers. +The values of the properties are ignored, only the property names are used.") + +(defun message-tamago-not-in-use-p (pos) + "Return t when tamago version 4 is not in use at the cursor position. +Tamago version 4 is a popular input method for writing Japanese text. +It uses the properties `intangible', `invisible', `modification-hooks' +and `read-only' when translating ascii or kana text to kanji text. +These properties are essential to work, so we should never strip them." + (not (and (boundp 'egg-modefull-mode) + (symbol-value 'egg-modefull-mode) + (or (memq (get-text-property pos 'intangible) + '(its-part-1 its-part-2)) + (get-text-property pos 'egg-end) + (get-text-property pos 'egg-lang) + (get-text-property pos 'egg-start))))) + +(defun message-strip-forbidden-properties (begin end &optional old-length) + "Strip forbidden properties between BEGIN and END, ignoring the third arg. +This function is intended to be called from `after-change-functions'. +See also `message-forbidden-properties'." + (when (and message-strip-special-text-properties + (message-tamago-not-in-use-p begin) + ;; Check whether the invisible MIME part is not inserted. + (not (text-property-any begin end 'mime-edit-invisible t))) + (while (not (= begin end)) + (when (not (get-text-property begin 'message-hidden)) + (remove-text-properties begin (1+ begin) + message-forbidden-properties)) + (incf begin)))) ;;;###autoload -(defun message-mode () +(define-derived-mode message-mode text-mode "Message" "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 +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 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 C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-m move to Mail-Followup-To + C-c C-f C-o move to From (\"Originator\") C-c C-f C-f move to Followup-To -C-c C-t message-insert-to (add a To header to a news followup) -C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply) -C-c C-b message-goto-body (move to beginning of message text). -C-c C-i message-goto-signature (move to the beginning of the signature). -C-c C-w message-insert-signature (insert `message-signature-file' file). -C-c C-y message-yank-original (insert current message, if any). -C-c C-q message-fill-yanked-message (fill what was yanked). -C-c C-e message-elide-region (elide the text between point and mark). -C-c C-v message-delete-not-region (remove the text outside the region). -C-c C-z message-kill-to-signature (kill the text up to the signature). -C-c C-r message-caesar-buffer-body (rot13 the message body). -M-RET message-newline-and-reformat (break the line and reformat)." - (interactive) - (kill-all-local-variables) + C-c C-f C-m move to Mail-Followup-To + C-c C-f c move to Mail-Copies-To + C-c C-f C-i cycle through Importance values + C-c C-f s change subject and append \"(was: )\" + C-c C-f x crossposting with FollowUp-To header and note in body + C-c C-f t replace To: header with contents of Cc: or Bcc: + C-c C-f a Insert X-No-Archive: header and a note in the body +C-c C-t `message-insert-to' (add a To header to a news followup) +C-c C-l `message-to-list-only' (removes all but list address in to/cc) +C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) +C-c C-b `message-goto-body' (move to beginning of message text). +C-c C-i `message-goto-signature' (move to the beginning of the signature). +C-c C-w `message-insert-signature' (insert `message-signature-file' file). +C-c C-y `message-yank-original' (insert current message, if any). +C-c C-q `message-fill-yanked-message' (fill what was yanked). +C-c C-e `message-elide-region' (elide the text between point and mark). +C-c C-v `message-delete-not-region' (remove the text outside the region). +C-c C-z `message-kill-to-signature' (kill the text up to the signature). +C-c C-r `message-caesar-buffer-body' (rot13 the message body). +C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance). +C-c M-n `message-insert-disposition-notification-to' (request receipt). +C-c M-m `message-mark-inserted-region' (mark region with enclosing tags). +C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags). +M-RET `message-newline-and-reformat' (break the line and reformat)." + (setq local-abbrev-table text-mode-abbrev-table) (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) (make-local-variable 'message-exit-actions) (make-local-variable 'message-kill-actions) (make-local-variable 'message-postpone-actions) (make-local-variable 'message-draft-article) - (make-local-hook 'kill-buffer-hook) - (set-syntax-table message-mode-syntax-table) - (use-local-map message-mode-map) - (setq local-abbrev-table message-mode-abbrev-table) - (setq major-mode 'message-mode) - (setq mode-name "Message") (setq buffer-offer-save t) - (make-local-variable 'facemenu-add-face-function) - (make-local-variable 'facemenu-remove-face-function) - (setq facemenu-add-face-function - (lambda (face end) - (let ((face-fun (cdr (assq face message-face-alist)))) - (if face-fun - (funcall face-fun (point) end) - (error "Face %s not configured for %s mode" face mode-name))) - "") - facemenu-remove-face-function t) - (make-local-variable 'message-reply-headers) - (setq message-reply-headers nil) + (set (make-local-variable 'facemenu-add-face-function) + (lambda (face end) + (let ((face-fun (cdr (assq face message-face-alist)))) + (if face-fun + (funcall face-fun (point) end) + (error "Face %s not configured for %s mode" face mode-name))) + "")) + (set (make-local-variable 'facemenu-remove-face-function) t) + (set (make-local-variable 'message-reply-headers) nil) (make-local-variable 'message-user-agent) (make-local-variable 'message-post-method) (set (make-local-variable 'message-sent-message-via) nil) @@ -1876,45 +2575,48 @@ M-RET message-newline-and-reformat (break the line and reformat)." (setq message-parameter-alist (copy-sequence message-startup-parameter-alist)) (message-setup-fill-variables) - ;;(when (fboundp 'mail-hist-define-keys) - ;; (mail-hist-define-keys)) + (set + (make-local-variable 'paragraph-separate) + (format "\\(%s\\)\\|\\(%s\\)" + paragraph-separate + "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) + ;; Allow using comment commands to add/remove quoting. + (set (make-local-variable 'comment-start) message-yank-prefix) (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)))) - (set (make-local-variable 'message-font-lock-last-position) nil) + '(message-font-lock-keywords t)) + (if (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) (message-tool-bar-map)))) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) + (gnus-make-local-hook 'after-change-functions) + ;; Mmmm... Forbidden properties... + (add-hook 'after-change-functions 'message-strip-forbidden-properties + nil 'local) ;; Allow mail alias things. (when (eq message-mail-alias-type 'abbrev) (if (fboundp 'mail-abbrevs-setup) (mail-abbrevs-setup) (mail-aliases-setup))) - (message-set-auto-save-file-name) - (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. - (setq indent-tabs-mode nil) - (run-hooks 'text-mode-hook 'message-mode-hook)) + (unless buffer-file-name + (message-set-auto-save-file-name)) + (set (make-local-variable 'indent-tabs-mode) nil)) ;No tabs for indentation. (defun message-setup-fill-variables () "Setup message fill variables." + (set (make-local-variable 'fill-paragraph-function) + 'message-fill-paragraph) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-start) (make-local-variable '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) - (make-local-variable 'auto-fill-inhibit-regexp) (let ((quote-prefix-regexp - (concat - "[ \t]*" ; possible initial space - "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix - "\\w+>\\|" ; supercite-style prefix - "[|:>]" ; standard prefix - "\\)[ \t]*\\)+"))) ; possible space after each prefix + ;; 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) "$\\|" @@ -1929,8 +2631,19 @@ M-RET message-newline-and-reformat (break the line and reformat)." (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]+:"))) + adaptive-fill-first-line-regexp))) + (make-local-variable 'auto-fill-inhibit-regexp) + ;;(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:") + (setq auto-fill-inhibit-regexp nil) + (make-local-variable 'normal-auto-fill-function) + (setq normal-auto-fill-function 'message-do-auto-fill) + ;; KLUDGE: auto fill might already be turned on in `text-mode-hook'. + ;; In that case, ensure that it uses the right function. The real + ;; solution would be not to use `define-derived-mode', and run + ;; `text-mode-hook' ourself at the end of the mode. + ;; -- Per Abrahamsen Date: 2001-10-19. + (when auto-fill-function + (setq auto-fill-function normal-auto-fill-function))) @@ -1945,6 +2658,11 @@ M-RET message-newline-and-reformat (break the line and reformat)." (interactive) (message-position-on-field "To")) +(defun message-goto-from () + "Move point to the From header." + (interactive) + (message-position-on-field "From")) + (defun message-goto-subject () "Move point to the Subject header." (interactive) @@ -1975,23 +2693,6 @@ M-RET message-newline-and-reformat (break the line and reformat)." (interactive) (message-position-on-field "Mail-Reply-To" "Subject")) -(defun message-goto-mail-followup-to () - "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) - (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. If the header is newly created, a string \"never\" is inserted in default." @@ -2015,6 +2716,23 @@ a string \"never\" is inserted in default." (interactive) (message-position-on-field "Followup-To" "Newsgroups")) +(defun message-goto-mail-followup-to () + "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) + (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-keywords () "Move point to the Keywords header." (interactive) @@ -2025,13 +2743,15 @@ a string \"never\" is inserted in default." (interactive) (message-position-on-field "Summary" "Subject")) -(defun message-goto-body () +(defun message-goto-body (&optional interactivep) "Move point to the beginning of the message body." - (interactive) - (if (looking-at "[ \t]*\n") (expand-abbrev)) + (interactive (list t)) + (when (and interactivep + (looking-at "[ \t]*\n")) + (expand-abbrev)) (goto-char (point-min)) (or (search-forward (concat "\n" mail-header-separator "\n") nil t) - (search-forward "\n\n" nil t))) + (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) (defun message-goto-eoh () "Move point to the end of the headers." @@ -2050,6 +2770,26 @@ return nil." (goto-char (point-max)) nil)) +(defun message-generate-unsubscribed-mail-followup-to (&optional include-cc) + "Insert a reasonable MFT header in a post to an unsubscribed list. +When making original posts to a mailing list you are not subscribed to, +you have to type in a MFT header by hand. The contents, usually, are +the addresses of the list and your own address. This function inserts +such a header automatically. It fetches the contents of the To: header +in the current mail buffer, and appends the current `user-mail-address'. + +If the optional argument INCLUDE-CC is non-nil, the addresses in the +Cc: header are also put into the MFT." + + (interactive "P") + (message-remove-header "Mail-Followup-To") + (let* ((cc (and include-cc (message-fetch-field "Cc"))) + (tos (if cc + (concat (message-fetch-field "To") "," cc) + (message-fetch-field "To")))) + (message-goto-mail-followup-to) + (insert (concat tos ", " user-mail-address)))) + (defun message-insert-to (&optional force) @@ -2064,13 +2804,29 @@ With the prefix argument FORCE, insert the header anyway." (or (equal (downcase co) "never") (equal (downcase co) "nobody"))) (error "The user has requested not to have copies sent via mail"))) - (when (and (message-position-on-field "To") - (mail-fetch-field "to") - (not (string-match "\\` *\\'" (mail-fetch-field "to")))) - (insert ", ")) - (insert (or (message-fetch-reply-field "mail-reply-to") - (message-fetch-reply-field "reply-to") - (message-fetch-reply-field "from") ""))) + (message-carefully-insert-headers + (list (cons 'To + (or (message-fetch-reply-field "mail-reply-to") + (message-fetch-reply-field "reply-to") + (message-fetch-reply-field "from") + ""))))) + +(defun message-insert-wide-reply () + "Insert To and Cc headers as if you were doing a wide reply." + (interactive) + (let ((headers (message-with-reply-buffer + (message-get-reply-headers t)))) + (message-carefully-insert-headers headers))) + +(defun message-carefully-insert-headers (headers) + (dolist (header headers) + (let ((header-name (symbol-name (car header)))) + (when (and (message-position-on-field header-name) + (mail-fetch-field header-name) + (not (string-match "\\` *\\'" + (mail-fetch-field header-name)))) + (insert ", ")) + (insert (cdr header))))) (defun message-widen-reply () "Widen the reply to include maximum recipients." @@ -2104,19 +2860,27 @@ With the prefix argument FORCE, insert the header anyway." ;;; Various commands (defun message-delete-not-region (beg end) - "Delete everything in the body of the current message that is outside of the region." + "Delete everything in the body of the current message outside of the region." (interactive "r") - (save-excursion - (goto-char end) - (delete-region (point) (if (not (message-goto-signature)) - (point) - (forward-line -2) - (point))) - (insert "\n") - (goto-char beg) - (delete-region beg (progn (message-goto-body) - (forward-line 2) - (point)))) + (let (citeprefix) + (save-excursion + (goto-char beg) + ;; snarf citation prefix, if appropriate + (unless (eq (point) (progn (beginning-of-line) (point))) + (when (looking-at message-cite-prefix-regexp) + (setq citeprefix (match-string 0)))) + (goto-char end) + (delete-region (point) (if (not (message-goto-signature)) + (point) + (forward-line -2) + (point))) + (insert "\n") + (goto-char beg) + (delete-region beg (progn (message-goto-body) + (forward-line 2) + (point))) + (when citeprefix + (insert citeprefix)))) (when (message-goto-signature) (forward-line -2))) @@ -2131,30 +2895,119 @@ With the prefix argument FORCE, insert the header anyway." (unless (bolp) (insert "\n")))) -(defun message-newline-and-reformat () - "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")) +(defun message-newline-and-reformat (&optional arg not-break) + "Insert four newlines, and then reformat if inside quoted text. +Prefix arg means justify as well." + (interactive (list (if current-prefix-arg 'full))) + (let (quoted point beg end leading-space bolp) (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)) + (setq bolp (= 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) + (not bolp) + (< (- point beg) (length quoted))) + ;; break inside 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) + (if bolp + (newline) + (newline) + (newline)) + (setq point (point)) + ;; (newline 2) doesn't mark both newline's as hard, so call + ;; newline twice. -jas + (newline) + (newline) + (delete-region (point) (re-search-forward "[ \t]*")) + (when (and quoted (not bolp)) + (insert quoted leading-space))) + (undo-boundary) + (if quoted + (let* ((adaptive-fill-regexp + (regexp-quote (concat quoted leading-space))) + (adaptive-fill-first-line-regexp + adaptive-fill-regexp )) + (fill-paragraph arg)) + (fill-paragraph arg)) + (if point (goto-char point))))) + +(defun message-fill-paragraph (&optional arg) + "Like `fill-paragraph'." + (interactive (list (if current-prefix-arg 'full))) + (if (and (boundp 'filladapt-mode) filladapt-mode) + nil + (message-newline-and-reformat arg t) + t)) + +;; Is it better to use `mail-header-end'? +(defun message-point-in-header-p () + "Return t if point is in the header." + (save-excursion + (let ((p (point))) + (goto-char (point-min)) + (not (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") + p t))))) + +(defun message-do-auto-fill () + "Like `do-auto-fill', but don't fill in message header." + (unless (message-point-in-header-p) + (do-auto-fill))) (defun message-insert-signature (&optional force) - "Insert a signature. See documentation for the `message-signature' variable." + "Insert a signature. See documentation for variable `message-signature'." (interactive (list 0)) (let* ((signature (cond @@ -2183,15 +3036,65 @@ With the prefix argument FORCE, insert the header anyway." ;; Insert the signature. (unless (bolp) (insert "\n")) - (insert "\n-- \n") + (when message-signature-insert-empty-line + (insert "\n")) + (insert "\n" message-signature-separator-for-insertion) + (unless (bolp) + (insert "\n")) (if (eq signature t) (insert-file-contents message-signature-file) (insert signature)) (goto-char (point-max)) (or (bolp) (insert "\n"))))) +(defun message-insert-importance-high () + "Insert header to mark message as important." + (interactive) + (save-excursion + (message-remove-header "Importance") + (message-goto-eoh) + (insert "Importance: high\n"))) + +(defun message-insert-importance-low () + "Insert header to mark message as unimportant." + (interactive) + (save-excursion + (message-remove-header "Importance") + (message-goto-eoh) + (insert "Importance: low\n"))) + +(defun message-insert-or-toggle-importance () + "Insert a \"Importance: high\" header, or cycle through the header values. +The three allowed values according to RFC 1327 are `high', `normal' +and `low'." + (interactive) + (save-excursion + (let ((valid '("high" "normal" "low")) + (new "high") + cur) + (when (setq cur (message-fetch-field "Importance")) + (message-remove-header "Importance") + (setq new (cond ((string= cur "high") + "low") + ((string= cur "low") + "normal") + (t + "high")))) + (message-goto-eoh) + (insert (format "Importance: %s\n" new))))) + +(defun message-insert-disposition-notification-to () + "Request a disposition notification (return receipt) to this message. +Note that this should not be used in newsgroups." + (interactive) + (save-excursion + (message-remove-header "Disposition-Notification-To") + (message-goto-eoh) + (insert (format "Disposition-Notification-To: %s\n" + (or (message-fetch-field "From") (message-make-from)))))) + (defun message-elide-region (b e) - "Elide the text between point and mark. + "Elide the text in the region. An ellipsis (from `message-elide-ellipsis') will be inserted where the text was killed." (interactive "r") @@ -2201,7 +3104,7 @@ text was killed." (defvar message-caesar-translation-table nil) (defun message-caesar-region (b e &optional n) - "Caesar rotation of region by N, default 13, for decrypting netnews." + "Caesar rotate region B to E by N, default 13, for decrypting netnews." (interactive (list (min (point) (or (mark t) (point))) @@ -2235,8 +3138,8 @@ text was killed." (substring table (+ ?a 26) 255)))) (defun message-caesar-buffer-body (&optional rotnum) - "Caesar rotates all letters in the current buffer by 13 places. -Used to encode/decode possiblyun offensive messages (commonly in net.jokes). + "Caesar rotate all letters in the current buffer by 13 places. +Used to encode/decode possibly offensive messages (commonly in rec.humor). With prefix arg, specifies the number of places to rotate each letter forward. Mail and USENET news headers are not rotated." (interactive (if current-prefix-arg @@ -2253,7 +3156,7 @@ Mail and USENET news headers are not rotated." (save-excursion (save-restriction (when (message-goto-body) - (narrow-to-region (point) (point-max))) + (narrow-to-region (point) (point-max))) (shell-command-on-region (point-min) (point-max) program nil t)))) @@ -2333,7 +3236,9 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (save-excursion (goto-char start) (while (< (point) (mark t)) - (insert message-yank-prefix) + (if (or (looking-at ">") (looking-at "^$")) + (insert message-yank-cited-prefix) + (insert message-yank-prefix)) (forward-line 1)))) (goto-char start))) @@ -2361,7 +3266,6 @@ to REFS-LIST." (push (pop saved-id) refs-list)) refs-list)) -(defvar gnus-article-copy) (defun message-yank-original (&optional arg) "Insert the message being replied to, if any. Puts point before the text and mark after. @@ -2375,52 +3279,72 @@ 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. -\(See also `message-yank-add-new-references'.)" +be added to the \"References\" field." (interactive "P") - (let ((modified (buffer-modified-p)) - (buffer (message-eval-parameter message-reply-buffer)) - start end refs) - (when (and buffer - message-cite-function) - (delete-windows-on buffer t) - (insert-buffer buffer) ; mark will be set at the end of article. - (setq start (point) - end (mark t)) - - ;; Add new IDs to References field. - (when (and message-yank-add-new-references (interactive-p)) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (setq refs (message-list-references - nil - (message-fetch-field "References"))) - (widen) - (narrow-to-region start end) - (std11-narrow-to-header) - (when (setq refs (message-list-references - refs - (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"))) + (let ((modified (buffer-modified-p))) + (when (let ((buffer (message-eval-parameter message-reply-buffer))) + (and buffer + message-cite-function + (prog1 + t + (delete-windows-on buffer t) + ; The mark will be set at the end of the article. + (insert-buffer buffer)))) + ;; Add new IDs to the References field. + (when (and message-yank-add-new-references + (interactive-p)) + (let ((start (point)) + (end (mark t)) + refs newrefs) + (save-excursion + (save-restriction (widen) - (message-narrow-to-headers) - (goto-char (point-min)) - (let ((case-fold-search t)) - (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t) + (setq refs (message-list-references + nil + (or (message-make-references) + (prog2 + (message-narrow-to-headers) + (message-fetch-field "References") + (widen))))) + (narrow-to-region start end) + (std11-narrow-to-header) + (unless (equal (setq newrefs + (message-list-references + (copy-sequence refs) + (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"))) + refs) + ;; If the References field has been changed, we make it + ;; visible in the header. + (mail-header-set-message-id message-reply-headers nil) + (mail-header-set-references message-reply-headers nil) + (widen) + (message-narrow-to-headers) + (if (let ((case-fold-search t)) + (re-search-forward "^References:\\([\t ]+.+\n\\)+" + nil t)) (replace-match "") - (goto-char (point-max)))) - (mail-header-format - (list (or (assq 'References message-header-format-alist) - '(References . message-fill-references))) - (list (cons 'References - (mapconcat 'identity (nreverse refs) " ")))) - (backward-delete-char 1))))) - - (funcall message-cite-function) + (goto-char (point-max))) + (mail-header-format + (list (or (assq 'References message-header-format-alist) + '(References . message-fill-references))) + (list (cons 'References (mapconcat 'identity + (nreverse newrefs) " ")))) + (backward-delete-char 1)))))) + (unless arg + (if (and message-suspend-font-lock-when-citing + (boundp 'font-lock-mode) + (symbol-value 'font-lock-mode)) + (unwind-protect + (progn + (sit-for 0) + (font-lock-mode 0) + (funcall message-cite-function)) + (font-lock-mode 1)) + (funcall message-cite-function))) (message-exchange-point-and-mark) (unless (bolp) (insert ?\n)) @@ -2474,7 +3398,10 @@ be added to \"References\" field. (while (looking-at "^[ \t]*$") (forward-line -1)) (forward-line 1) - (delete-region (point) end)) + (delete-region (point) end) + (unless (search-backward "\n\n" start t) + ;; Insert a blank line if it is peeled off. + (insert "\n"))) (goto-char start) (while functions (funcall (pop functions))) @@ -2483,7 +3410,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) @@ -2516,7 +3443,7 @@ be added to \"References\" field. (funcall message-citation-line-function))))) (defun message-insert-citation-line () - "Function that inserts a simple citation line." + "Insert a simple citation line." (when message-reply-headers (insert (mail-header-from message-reply-headers) " writes:\n\n"))) @@ -2600,9 +3527,11 @@ The text will also be indented the normal way." t))) (defun message-dont-send () - "Don't send the message you have been editing." + "Don't send the message you have been editing. +Instead, just auto-save the buffer and then bury it." (interactive) - (message-save-drafts) + (set-buffer-modified-p t) + (save-buffer) (let ((actions message-postpone-actions) (frame (selected-frame)) (org-frame message-original-frame)) @@ -2618,27 +3547,40 @@ The text will also be indented the normal way." (funcall message-kill-buffer-query-function "The buffer modified; kill anyway? ")) (let ((actions message-kill-actions) + (draft-article message-draft-article) + (auto-save-file-name buffer-auto-save-file-name) + (file-name buffer-file-name) + (modified (buffer-modified-p)) (frame (selected-frame)) (org-frame message-original-frame)) (setq buffer-file-name nil) (kill-buffer (current-buffer)) + (when (and message-kill-buffer-and-remove-file + (or (and auto-save-file-name + (file-exists-p auto-save-file-name)) + (and file-name + (file-exists-p file-name))) + (yes-or-no-p (format "Remove the backup file%s? " + (if modified " too" "")))) + (ignore-errors + (delete-file auto-save-file-name)) + (let ((message-draft-article draft-article)) + (message-disassociate-draft))) (message-do-actions actions) (message-delete-frame frame org-frame))) (message "")) (defun message-mimic-kill-buffer () - "Kill the current buffer with query." + "Kill the current buffer with query. This is an imitation for +`kill-buffer', but it will delete a message frame." (interactive) - (unless (eq 'message-mode major-mode) - (error "%s must be invoked from a message buffer." this-command)) - (let ((command this-command) - (bufname (read-buffer (format "Kill buffer: (default %s) " - (buffer-name))))) - (if (or (not bufname) - (string-equal bufname "") - (string-equal bufname (buffer-name))) - (message-kill-buffer) - (message "%s must be invoked only for the current buffer." command)))) + (let ((bufname (read-buffer (format "Kill buffer: (default %s) " + (buffer-name)))) + message-kill-buffer-and-remove-file) + (when (or (not bufname) + (string-equal bufname "") + (string-equal bufname (buffer-name))) + (message-kill-buffer)))) (defun message-delete-frame (frame org-frame) "Delete frame for editing message." @@ -2660,7 +3602,7 @@ The text will also be indented the normal way." (delete-frame frame))) (defun message-bury (buffer) - "Bury this mail buffer." + "Bury this mail BUFFER." (let ((newbuf (other-buffer buffer))) (bury-buffer buffer) (if (and (fboundp 'frame-parameters) @@ -2695,54 +3637,67 @@ It should typically alter the sending method in some way or other." (message-mime-mode mime-edit-mode-flag) (alist message-send-method-alist) (success t) - elem sent + elem sent dont-barf-on-no-method (message-options message-options)) - (message-options-set-recipient) - (save-excursion - (set-buffer message-encoding-buffer) - (erase-buffer) - ;; Avoid copying text props. - (let (message-invisibles) - (insert - (with-current-buffer message-edit-buffer - (setq message-invisibles (message-find-invisible-regions)) - (buffer-substring-no-properties (point-min) (point-max)))) - ;; Inherit the invisible property of texts to make MIME-Edit - ;; find the MIME part boundaries. - (dolist (region message-invisibles) - (put-text-property (car region) (cdr region) 'invisible t))) - (funcall message-encode-function) - (while (and success - (setq elem (pop alist))) - (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 - (when (and success sent) - (message-do-fcc) + (unwind-protect + (progn + (message-options-set-recipient) (save-excursion - (run-hooks 'message-sent-hook)) - (message "Sending...done") - ;; Mark the buffer as unmodified and delete auto-save. - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t) - (message-disassociate-draft) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t) + (set-buffer message-encoding-buffer) + (erase-buffer) + ;; ;; Avoid copying text props (except hard newlines). + ;; T-gnus change: copy all text props from the editing buffer + ;; into the encoding buffer. + (insert-buffer-substring message-edit-buffer) + (funcall message-encode-function) + (while (and success + (setq elem (pop alist))) + (when (funcall (cadr elem)) + (when (and + (or (not (memq (car elem) + message-sent-message-via)) + (not (message-fetch-field "supersedes")) + (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) + (let ((fcc (message-fetch-field "Fcc")) + (gcc (message-fetch-field "Gcc"))) + (when (or fcc gcc) + (or + (eq message-allow-no-recipients 'always) + (and (not (eq message-allow-no-recipients 'never)) + (setq dont-barf-on-no-method + (gnus-y-or-n-p + (format "No receiver, perform %s anyway? " + (cond ((and fcc gcc) "Fcc and Gcc") + (fcc "Fcc") + (t "Gcc")))))))))) + (error "No methods specified to send by")) + (when (or dont-barf-on-no-method + (and success sent)) + (message-do-fcc) + (save-excursion + (run-hooks 'message-sent-hook)) + (message "Sending...done") + ;; Mark the buffer as unmodified and delete auto-save. + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t) + (message-disassociate-draft) + ;; Delete other mail buffers and stuff. + (message-do-send-housekeeping) + (message-do-actions message-send-actions) + ;; Return success. + t)) (kill-buffer message-encoding-buffer))))) (defun message-send-via-mail (arg) @@ -2762,37 +3717,36 @@ It should typically alter the sending method in some way or other." (put 'message-check 'lisp-indent-function 1) (put 'message-check 'edebug-form-spec '(form body)) -;; 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-find-invisible-regions () - "Find invisible texts with the property `message-invisible' and -return a list of points." - (let (from - (to (point-min)) - regions) - (while (setq from (text-property-any to (point-max) - 'message-invisible t)) - (setq to (or (text-property-not-all from (point-max) - 'message-invisible t) - (point-max))) - (push (cons from to) regions)) - regions)) +;; Advise the function `invisible-region'. +(let (current-load-list) + (eval + `(defadvice invisible-region (around add-mime-edit-invisible (start end) + activate) + "Advised by T-gnus Message. +Add the text property `mime-edit-invisible' to an invisible text when +the buffer's major mode is `message-mode'. The added property will be +used to distinguish whether the invisible text is a MIME part or not." + ,(if (featurep 'xemacs) + '(if (eq ?\n (char-after start)) + (setq start (1+ start))) + '(if (eq ?\n (char-after (1- end))) + (setq end (1- end)))) + (setq ad-return-value + (if (eq 'message-mode major-mode) + (add-text-properties start end + '(invisible t mime-edit-invisible t)) + (put-text-property start end 'invisible t)))))) + +(defun message-text-with-property (prop) + "Return a list of all points where the text has PROP." + (let ((points nil) + (point (point-min))) + (save-excursion + (while (< point (point-max)) + (when (get-text-property point prop) + (push point points)) + (incf point))) + (nreverse points))) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -2801,29 +3755,101 @@ return a list of points." (goto-char (point-max)) (unless (bolp) (insert "\n")) - ;; Expose all invisible text with the property `message-invisible'. - ;; We should believe that the things might be created by MIME-Edit. - (let ((message-invisibles (message-find-invisible-regions))) - (dolist (region message-invisibles) - (put-text-property (car region) (cdr region) '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) + ;; Make the hidden headers visible. + (let ((points (message-text-with-property 'message-hidden))) + (when points + (goto-char (car points)) + (dolist (point points) + (add-text-properties point (1+ point) + '(invisible nil intangible nil))))) + ;; Delete all invisible text except for the mime parts which might + ;; be inserted by the MIME-Edit. + (message-check 'invisible-text + (let (from + (to (point-min)) + mime-from mime-to hidden-start) + (while (setq from (text-property-any to (point-max) 'invisible t)) + (setq to (or (text-property-not-all from (point-max) 'invisible t) + (point-max)) + mime-to from) + (while (setq mime-from (text-property-any mime-to to + 'mime-edit-invisible t)) + (when (> mime-from mime-to) + (setq hidden-start (or hidden-start mime-to)) + (add-text-properties mime-to mime-from + '(invisible nil face highlight + font-lock-face highlight))) + (setq mime-to (or (text-property-not-all mime-from to + 'mime-edit-invisible t) + to))) + (when (< mime-to to) + (setq hidden-start (or hidden-start mime-to)) + (add-text-properties mime-to to + '(invisible nil face highlight + font-lock-face highlight)))) + (when hidden-start + (goto-char hidden-start) + (set-window-start (selected-window) (gnus-point-at-bol)) (unless (yes-or-no-p "Invisible text found and made visible; continue posting? ") - (error "Invisible text found and made visible")))) - ;; Hide again all text with the property `message-invisible'. - ;; It is needed to make MIME-Edit find the MIME part boundaries. - (dolist (region message-invisibles) - (put-text-property (car region) (cdr region) 'invisible t)))) + (error "Invisible text found and made visible"))))) + (message-check 'illegible-text + (let ((mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f\x1b") + found choice) + (message-goto-body) + (skip-chars-forward mm-7bit-chars) + (while (not (eobp)) + (when (let ((char (char-after))) + (or (< (mm-char-int char) 128) + (and (mm-multibyte-p) + (memq (char-charset char) + '(eight-bit-control eight-bit-graphic + control-1))))) + (add-text-properties (point) (1+ (point)) + '(font-lock-face highlight face highlight)) + (setq found t)) + (forward-char) + (skip-chars-forward mm-7bit-chars)) + (when found + (setq choice + (gnus-multiple-choice + "Illegible text found. Continue posting?" + '((?d "Remove and continue posting") + (?r "Replace with dots and continue posting") + (?i "Ignore and continue posting") + (?e "Continue editing")))) + (if (eq choice ?e) + (error "Illegible text found")) + (message-goto-body) + (skip-chars-forward mm-7bit-chars) + (while (not (eobp)) + (when (let ((char (char-after))) + (or (< (mm-char-int char) 128) + (and (mm-multibyte-p) + (memq (char-charset char) + '(eight-bit-control eight-bit-graphic + control-1))))) + (if (eq choice ?i) + (remove-text-properties (point) (1+ (point)) + '(font-lock-face highlight face highlight)) + (delete-char 1) + (when (eq choice ?r) + (insert ".")))) + (forward-char) + (skip-chars-forward mm-7bit-chars)))))) (defun message-add-action (action &rest types) "Add ACTION to be performed when doing an exit of type TYPES." + (while types + (add-to-list (intern (format "message-%s-actions" (pop types))) + action))) + +(defun message-delete-action (action &rest types) + "Delete ACTION from lists of actions performed when doing an exit of type TYPES." (let (var) (while types (set (setq var (intern (format "message-%s-actions" (pop types)))) - (nconc (symbol-value var) (list action)))))) + (delq action (symbol-value var)))))) (defun message-do-actions (actions) "Perform all actions in ACTIONS." @@ -2869,13 +3895,15 @@ This sub function is for exclusive use of `message-send-mail'." (delete-region (match-end 0) (std11-field-end)) (insert " " (message-make-message-id)))) (condition-case err - (funcall message-send-mail-function) + (funcall (or message-send-mail-real-function + message-send-mail-function)) (error (throw 'message-sending-mail-failure err)))))) nil) (condition-case err (progn - (funcall message-send-mail-function) + (funcall (or message-send-mail-real-function + message-send-mail-function)) nil) (error err)))) (when failure @@ -2884,7 +3912,7 @@ This sub function is for exclusive use of `message-send-mail'." (prin1-to-string failure))))) (defun message-send-mail-partially () - "Sendmail as message/partial." + "Send mail as message/partial." ;; replace the header delimiter with a blank line (goto-char (point-min)) (re-search-forward @@ -2932,24 +3960,23 @@ This sub function is for exclusive use of `message-send-mail'." (message-remove-header "Lines") (goto-char (point-max)) (insert "Mime-Version: 1.0\n") - (setq header (buffer-substring (point-min) (point-max)))) + (setq header (buffer-string))) (goto-char (point-max)) - (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n" + (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n" id n total)) + (forward-char -1) (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"))) + (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))) + (funcall (or message-send-mail-real-function + message-send-mail-function)))) (setq n (+ n 1)) (setq p (pop plist)) (erase-buffer))) @@ -2961,13 +3988,24 @@ This sub function is for exclusive use of `message-send-mail'." (case-fold-search nil) (news (message-news-p)) (message-this-is-mail t) + (headers message-required-mail-headers) failure) (save-restriction (message-narrow-to-headers) + ;; Generate the Mail-Followup-To header if the header is not there... + (if (and (message-subscribed-p) + (not (mail-fetch-field "mail-followup-to"))) + (setq headers + (cons + (cons "Mail-Followup-To" (message-make-mail-followup-to)) + message-required-mail-headers)) + ;; otherwise, delete the MFT header if the field is empty + (when (equal "" (mail-fetch-field "mail-followup-to")) + (message-remove-header "^Mail-Followup-To:"))) ;; Insert some headers. (let ((message-deletable-headers (if news nil message-deletable-headers))) - (message-generate-headers message-required-mail-headers)) + (message-generate-headers headers)) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (if (not (message-check-mail-syntax)) @@ -2978,7 +4016,10 @@ This sub function is for exclusive use of `message-send-mail'." (save-excursion (set-buffer tembuf) (erase-buffer) - (insert-buffer message-encoding-buffer) + ;; ;; Avoid copying text props (except hard newlines). + ;; T-gnus change: copy all text props from the editing buffer + ;; into the encoding buffer. + (insert-buffer-substring message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -2986,21 +4027,23 @@ This sub function is for exclusive use of `message-send-mail'." ;; ;; We (re)generate the Lines header. ;; (when (memq 'Lines message-required-mail-headers) ;; (message-generate-headers '(Lines))) - ;; Remove some headers. (message-remove-header message-ignored-mail-headers t)) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) + (message-cleanup-headers) (when (save-restriction (message-narrow-to-headers) (and news (or (message-fetch-field "cc") + (message-fetch-field "bcc") (message-fetch-field "to")) (let ((ct (mime-read-Content-Type))) - (and (eq 'text (cdr (assq 'type ct))) - (eq 'plain (cdr (assq 'subtype ct))))))) + (or (not ct) + (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)) @@ -3018,61 +4061,67 @@ This sub function is for exclusive use of `message-send-mail'." " sendmail errors") 0)) resend-to-addresses delimline) - (let ((case-fold-search t)) - (save-restriction - (message-narrow-to-headers) - (setq resend-to-addresses (message-fetch-field "resent-to"))) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - (run-hooks 'message-send-mail-hook) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - (let ((default-directory "/")) - (as-binary-process - (apply 'call-process-region - (append (list (point-min) (point-max) - (if (boundp 'sendmail-program) - sendmail-program - "/usr/lib/sendmail") - nil errbuf nil "-oi") - ;; Always specify who from, - ;; since some systems have broken sendmails. - ;; But some systems are more broken with -f, so - ;; we'll let users override this. - (if (null message-sendmail-f-is-evil) - (list "-f" (message-make-address))) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null message-interactive) '("-oem" "-odb")) - ;; Get the addresses from the message - ;; unless this is a resend. - ;; We must not do that for a resend - ;; because we would find the original addresses. - ;; For a resend, include the specific addresses. - (if resend-to-addresses - (list resend-to-addresses) - '("-t")))))) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (goto-char (point-min)) - (while (re-search-forward "\n\n* *" nil t) - (replace-match "; ")) - (if (not (zerop (buffer-size))) - (error "Sending...failed to %s" - (buffer-substring (point-min) (point-max))))) + (unwind-protect + (progn + (let ((case-fold-search t)) + (save-restriction + (message-narrow-to-headers) + (setq resend-to-addresses (message-fetch-field "resent-to"))) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + (run-hooks 'message-send-mail-hook) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (when (eval message-mailer-swallows-blank-line) + (newline)) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + (let* ((default-directory "/") + (cpr (as-binary-process + (apply + 'call-process-region + (append + (list (point-min) (point-max) + (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail") + nil errbuf nil "-oi") + ;; Always specify who from, + ;; since some systems have broken sendmails. + ;; But some systems are more broken with -f, so + ;; we'll let users override this. + (if (null message-sendmail-f-is-evil) + (list "-f" (message-sendmail-envelope-from))) + ;; These mean "report errors by mail" + ;; and "deliver in background". + (if (null message-interactive) '("-oem" "-odb")) + ;; Get the addresses from the message + ;; unless this is a resend. + ;; We must not do that for a resend + ;; because we would find the original addresses. + ;; For a resend, include the specific addresses. + (if resend-to-addresses + (list resend-to-addresses) + '("-t"))))))) + (unless (or (null cpr) (zerop cpr)) + (error "Sending...failed with exit value %d" cpr))) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (goto-char (point-min)) + (while (re-search-forward "\n\n* *" nil t) + (replace-match "; ")) + (if (not (zerop (buffer-size))) + (error "Sending...failed to %s" + (buffer-string)))))) (when (bufferp errbuf) (kill-buffer errbuf))))) @@ -3110,11 +4159,13 @@ to find out how to use this." ;; free for -inject-arguments -- a big win for the user and for us ;; since we don't have to play that double-guessing game and the user ;; gets full control (no gestapo'ish -f's, for instance). --sj - message-qmail-inject-args)) + (if (functionp message-qmail-inject-args) + (funcall message-qmail-inject-args) + message-qmail-inject-args))) ;; qmail-inject doesn't say anything on it's stdout/stderr, ;; we have to look at the retval instead (0 nil) - (1 (error "qmail-inject reported permanent failure")) + (100 (error "qmail-inject reported permanent failure")) (111 (error "qmail-inject reported transient failure")) ;; should never happen (t (error "qmail-inject reported unknown failure")))) @@ -3158,13 +4209,7 @@ to find out how to use this." (backward-char 1) (run-hooks 'message-send-mail-hook) (if recipients - (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)))) + (smtp-send-buffer user-mail-address recipients (current-buffer)) (error "Sending failed; no recipients")))) (defsubst message-maybe-split-and-send-news (method) @@ -3199,15 +4244,67 @@ This sub function is for exclusive use of `message-send-news'." nil) (not (funcall message-send-news-function method))))) +(defun message-smtpmail-send-it () + "Send the prepared message buffer with `smtpmail-send-it'. +This only differs from `smtpmail-send-it' that this command evaluates +`message-send-mail-hook' just before sending a message. It is useful +if your ISP requires the POP-before-SMTP authentication. See the +documentation for the function `mail-source-touch-pop'." + (run-hooks 'message-send-mail-hook) + (smtpmail-send-it)) + +(defun message-canlock-generate () + "Return a string that is non-trival to guess. +Do not use this for anything important, it is cryptographically weak." + (let (sha1-maximum-internal-length) + (sha1 (concat (message-unique-id) + (format "%x%x%x" (random) (random t) (random)) + (prin1-to-string (recent-keys)) + (prin1-to-string (garbage-collect)))))) + +(defun message-canlock-password () + "The password used by message for cancel locks. +This is the value of `canlock-password', if that option is non-nil. +Otherwise, generate and save a value for `canlock-password' first." + (unless canlock-password + (customize-save-variable 'canlock-password (message-canlock-generate)) + (setq canlock-password-for-verify canlock-password)) + canlock-password) + +(defun message-insert-canlock () + (when message-insert-canlock + (message-canlock-password) + (canlock-insert-header))) + (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)) - (group-name-charset (gnus-group-name-charset method "")) + (newsgroups-field (save-restriction + (message-narrow-to-headers-or-head) + (message-fetch-field "Newsgroups"))) + (followup-field (save-restriction + (message-narrow-to-headers-or-head) + (message-fetch-field "Followup-To"))) + ;; BUG: We really need to get the charset for each name in the + ;; Newsgroups and Followup-To lines to allow crossposting + ;; between group namess with incompatible character sets. + ;; -- Per Abrahamsen 2001-10-08. + (group-field-charset + (gnus-group-name-charset method newsgroups-field)) + (followup-field-charset + (gnus-group-name-charset method (or followup-field ""))) + (mime-field-encoding-method-alist + (append (when group-field-charset + (list (cons "Newsgroups" group-field-charset))) + (when followup-field-charset + (list (cons "Followup-To" followup-field-charset))) + mime-field-encoding-method-alist)) (message-syntax-checks - (if arg + (if (and arg + (listp message-syntax-checks)) (cons '(existing-newsgroups . disabled) message-syntax-checks) message-syntax-checks)) @@ -3217,21 +4314,26 @@ This sub function is for exclusive use of `message-send-news'." (message-narrow-to-headers) ;; Insert some headers. (message-generate-headers message-required-news-headers) + (message-insert-canlock) ;; 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))) + ;; Note: This check will be disabled by the ".*" default value for + ;; gnus-group-name-charset-group-alist. -- Pa 2001-10-07. + (when (and group-field-charset + (listp message-syntax-checks)) + (setq message-syntax-checks + (cons '(valid-newsgroups . disabled) + message-syntax-checks))) (message-cleanup-headers) - (if (not (message-check-news-syntax)) + (if (not (let ((message-post-method method)) + (message-check-news-syntax))) nil (unwind-protect (save-excursion (set-buffer tembuf) (buffer-disable-undo) (erase-buffer) - (insert-buffer message-encoding-buffer) + (insert-buffer-substring message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -3266,6 +4368,7 @@ This sub function is for exclusive use of `message-send-news'." (backward-char 1) (run-hooks 'message-send-news-hook) (gnus-open-server method) + (message "Sending news via %s..." (gnus-server-string method)) (gnus-request-post method) )) @@ -3274,7 +4377,7 @@ This sub function is for exclusive use of `message-send-news'." ;;; (defun message-check-element (type) - "Returns non-nil if this type is not to be checked." + "Return non-nil if this TYPE is not to be checked." (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) t (let ((able (assq type message-syntax-checks))) @@ -3324,6 +4427,24 @@ This sub function is for exclusive use of `message-send-news'." (y-or-n-p "The control code \"cmsg\" is in the subject. Really post? ") t)) + ;; Check long header lines. + (message-check 'long-header-lines + (let ((start (point)) + (header nil) + (length 0) + found) + (while (and (not found) + (re-search-forward "^\\([^ \t:]+\\): " nil t)) + (if (> (- (point) (match-beginning 0)) 998) + (setq found t + length (- (point) (match-beginning 0))) + (setq header (match-string-no-properties 1))) + (setq start (match-beginning 0)) + (forward-line 1)) + (if found + (y-or-n-p (format "Your %s header is too long (%d). Really post? " + header length)) + t))) ;; Check for multiple identical headers. (message-check 'multiple-headers (let (found) @@ -3362,7 +4483,7 @@ This sub function is for exclusive use of `message-send-news'." (zerop (length (setq to (completing-read - "Followups to: (default all groups) " + "Followups to (default: no Followup-To header) " (mapcar (lambda (g) (list g)) (cons "poster" (message-tokenize-header @@ -3373,7 +4494,7 @@ This sub function is for exclusive use of `message-send-news'." ;; Check "Shoot me". (message-check 'shoot (if (re-search-forward - "Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t) + "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t) (y-or-n-p "You appear to have a misconfigured system. Really post? ") t)) ;; Check for Approved. @@ -3404,27 +4525,72 @@ This sub function is for exclusive use of `message-send-news'." (if followup-to (concat newsgroups "," followup-to) newsgroups))) - (hashtb (and (boundp 'gnus-active-hashtb) - gnus-active-hashtb)) + (post-method (if (message-functionp message-post-method) + (funcall message-post-method) + message-post-method)) + ;; KLUDGE to handle nnvirtual groups. Doing this right + ;; would probably involve a new nnoo function. + ;; -- Per Abrahamsen , 2001-10-17. + (method (if (and (consp post-method) + (eq (car post-method) 'nnvirtual) + gnus-message-group-art) + (let ((group (car (nnvirtual-find-group-art + (car gnus-message-group-art) + (cdr gnus-message-group-art))))) + (gnus-find-method-for-group group)) + post-method)) + (known-groups + (mapcar (lambda (n) + (gnus-group-name-decode + (gnus-group-real-name n) + (gnus-group-name-charset method n))) + (gnus-groups-from-server method))) errors) - (if (or (not hashtb) - (not (boundp 'gnus-read-active-file)) - (not gnus-read-active-file) - (eq gnus-read-active-file 'some)) - t - (while groups - (when (and (not (boundp (intern (car groups) hashtb))) - (not (equal (car groups) "poster"))) - (push (car groups) errors)) - (pop groups)) - (if (not errors) - t - (y-or-n-p - (format - "Really post to %s unknown group%s: %s " - (if (= (length errors) 1) "this" "these") - (if (= (length errors) 1) "" "s") - (mapconcat 'identity errors ", "))))))) + (while groups + (when (and (not (equal (car groups) "poster")) + (not (member (car groups) known-groups)) + (not (member (car groups) errors))) + (push (car groups) errors)) + (pop groups)) + (cond + ;; Gnus is not running. + ((or (not (and (boundp 'gnus-active-hashtb) + gnus-active-hashtb)) + (not (boundp 'gnus-read-active-file))) + t) + ;; We don't have all the group names. + ((and (or (not gnus-read-active-file) + (eq gnus-read-active-file 'some)) + errors) + (y-or-n-p + (format + "Really use %s possibly unknown group%s: %s? " + (if (= (length errors) 1) "this" "these") + (if (= (length errors) 1) "" "s") + (mapconcat 'identity errors ", ")))) + ;; There were no errors. + ((not errors) + t) + ;; There are unknown groups. + (t + (y-or-n-p + (format + "Really post to %s unknown group%s: %s? " + (if (= (length errors) 1) "this" "these") + (if (= (length errors) 1) "" "s") + (mapconcat 'identity errors ", "))))))) + ;; Check continuation headers. + (message-check 'continuation-headers + (goto-char (point-min)) + (let ((do-posting t)) + (while (re-search-forward "^[^ \t\n][^:\n]*$" nil t) + (if (y-or-n-p "Fix continuation lines? ") + (progn + (goto-char (match-beginning 0)) + (insert " ")) + (unless (y-or-n-p "Send anyway? ") + (setq do-posting nil)))) + do-posting)) ;; Check the Newsgroups & Followup-To headers for syntax errors. (message-check 'valid-newsgroups (let ((case-fold-search t) @@ -3487,6 +4653,40 @@ This sub function is for exclusive use of `message-send-news'." (message "Denied posting -- the From looks strange: \"%s\"." from) nil) + ((let ((addresses (rfc822-addresses from))) + (while (and addresses + (not (eq (string-to-char (car addresses)) ?\())) + (setq addresses (cdr addresses))) + addresses) + (message + "Denied posting -- bad From address: \"%s\"." from) + nil) + (t t)))) + ;; Check the Reply-To header. + (message-check 'reply-to + (let* ((case-fold-search t) + (reply-to (message-fetch-field "reply-to")) + ad) + (cond + ((not reply-to) + t) + ((string-match "," reply-to) + (y-or-n-p + (format "Multiple Reply-To addresses: \"%s\". Really post? " + reply-to))) + ((or (not (string-match + "@[^\\.]*\\." + (setq ad (nth 1 (mail-extract-address-components + reply-to))))) ;larsi@ifi + (string-match "\\.\\." ad) ;larsi@ifi..uio + (string-match "@\\." ad) ;larsi@.ifi.uio + (string-match "\\.$" ad) ;larsi@ifi.uio. + (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio + (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars) + (y-or-n-p + (format + "The Reply-To looks strange: \"%s\". Really post? " + reply-to))) (t t)))))) (defun message-check-news-body-syntax () @@ -3496,10 +4696,13 @@ This sub function is for exclusive use of `message-send-news'." (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1) (while (and - (progn - (end-of-line) - (< (current-column) 80)) + (or (looking-at + mime-edit-tag-regexp) + (let ((p (point))) + (end-of-line) + (< (- (point) p) 80))) (zerop (forward-line 1)))) (or (bolp) (eobp) @@ -3615,7 +4818,7 @@ This sub function is for exclusive use of `message-send-news'." (erase-buffer) (goto-char (point-min)) (set-buffer-multibyte nil) - (insert-buffer message-encoding-buffer) + (insert-buffer-substring message-encoding-buffer) (goto-char (point-min)) (if (re-search-forward "[^\x00-\x7f]" nil t) (y-or-n-p @@ -3631,8 +4834,8 @@ This sub function is for exclusive use of `message-send-news'." (concat "^" (regexp-quote mail-header-separator) "$")) (while (not (eobp)) (when (not (looking-at "[ \t\n]")) - (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) - (char-after)))) + (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) + (char-after)))) (forward-char 1))) sum)) @@ -3641,42 +4844,49 @@ This sub function is for exclusive use of `message-send-news'." (let ((case-fold-search t) (coding-system-for-write 'raw-text) (output-coding-system 'raw-text) - list file) + list file + (mml-externalize-attachments message-fcc-externalize-attachments)) (save-excursion - (set-buffer (get-buffer-create " *message temp*")) - (erase-buffer) - (insert-buffer-substring message-encoding-buffer) (save-restriction (message-narrow-to-headers) - (while (setq file (message-fetch-field "fcc")) - (push file list) - (message-remove-header "fcc" nil t))) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (replace-match "" t t) - ;; Process FCC operations. - (while list - (setq file (pop list)) - (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) - ;; Pipe the article to the program in question. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil shell-command-switch - (match-string 1 file)) - ;; Save the article. - (setq file (expand-file-name file)) - (unless (file-exists-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (if (and message-fcc-handler-function - (not (eq message-fcc-handler-function 'rmail-output))) - (funcall message-fcc-handler-function file) - (if (and (file-readable-p file) (mail-file-babyl-p file)) - (rmail-output file 1 nil t) - (let ((mail-use-rfc822 t)) - (rmail-output file 1 t t)))))) - (kill-buffer (current-buffer))))) + (setq file (message-fetch-field "fcc" t))) + (when file + (set-buffer (get-buffer-create " *message temp*")) + (erase-buffer) + (insert-buffer-substring message-encoding-buffer) + (save-restriction + (message-narrow-to-headers) + (while (setq file (message-fetch-field "fcc")) + (push file list) + (message-remove-header "fcc" nil t))) + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (replace-match "" t t)) + ;; Process FCC operations. + (while list + (setq file (pop list)) + (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) + ;; Pipe the article to the program in question. + (call-process-region (point-min) (point-max) shell-file-name + nil nil nil shell-command-switch + (match-string 1 file)) + ;; Save the article. + (setq file (expand-file-name file)) + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (if (and message-fcc-handler-function + (not (eq message-fcc-handler-function 'rmail-output))) + (funcall message-fcc-handler-function file) + (if (and (file-readable-p file) (mail-file-babyl-p file)) + (rmail-output file 1 nil t) + (let ((mail-use-rfc822 t)) + (rmail-output file 1 t t)))))) + (kill-buffer (current-buffer)))))) (defun message-output (filename) - "Append this article to Unix/babyl mail file.." + "Append this article to Unix/babyl mail file FILENAME." (if (and (file-readable-p filename) (mail-file-babyl-p filename)) (gnus-output-to-rmail filename t) @@ -3724,6 +4934,9 @@ If NOW, use that time instead." (setq sign "-") (setq zone (- zone))) (concat + ;; The day name of the %a spec is locale-specific. Pfff. + (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now)) + parse-time-weekdays)))) (format-time-string "%d" now) ;; The month name of the %b spec is locale-specific. Pfff. (format " %s " @@ -3737,7 +4950,7 @@ If NOW, use that time instead." "Make a followup Subject." (cond ((and (eq message-use-subject-re 'guess) - (string-match message-subject-encoded-re-regexp subject)) + (string-match message-subject-encoded-re-regexp subject)) subject) (message-use-subject-re (concat "Re: " (message-strip-subject-re subject))) @@ -3785,13 +4998,13 @@ If NOW, use that time instead." (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) + (message-number-base36 (+ (car tm) (lsh (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) (lsh (/ message-unique-id-char 25) 16)) 4) - ;; Append the newsreader name, because while the generated - ;; ID is unique to this newsreader, other newsreaders might - ;; otherwise generate the same ID via another algorithm. + ;; Append a given name, because while the generated ID is unique + ;; to this newsreader, other newsreaders might otherwise generate + ;; the same ID via another algorithm. ".fsf"))) (defun message-number-base36 (num len) @@ -3829,28 +5042,35 @@ If NOW, use that time instead." (save-excursion (save-restriction (widen) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) + (message-goto-body) (int-to-string (count-lines (point) (point-max)))))) +(defun message-make-references () + "Return the References header for this message." + (when message-reply-headers + (let ((message-id (mail-header-message-id message-reply-headers)) + (references (mail-header-references message-reply-headers)) + new-references) + (if (or references message-id) + (concat (or references "") (and references " ") + (or message-id "")) + nil)))) + (defun message-make-in-reply-to () "Return the In-Reply-To header for this message." (when message-reply-headers - (let ((mid (mail-header-message-id message-reply-headers)) - (from (mail-header-from message-reply-headers)) - (date (mail-header-date message-reply-headers))) - (when mid - (concat mid - (when from - (let ((pair (std11-extract-address-components from))) - (concat "\n (" - (or (car pair) (cadr pair)) - "'s message of \"" - (if (or (not date) (string= date "")) - "(unknown date)" date) - "\")")))))))) + (let ((from (mail-header-from message-reply-headers)) + (date (mail-header-date message-reply-headers)) + (msg-id (mail-header-message-id message-reply-headers))) + (when from + (let ((name (std11-extract-address-components from))) + (concat msg-id (if msg-id " (") + (or (car name) + (nth 1 name)) + "'s message of \"" + (if (or (not date) (string= date "")) + "(unknown date)" date) + "\"" (if msg-id ")"))))))) (defun message-make-distribution () "Make a Distribution header." @@ -3905,16 +5125,6 @@ If NOW, use that time instead." (aset tmp (1- (match-end 0)) ?-)) (string-match "[\\()]" tmp))))) (insert fullname) - (goto-char (point-min)) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) - ;; Quote fullname, escaping specials. - (goto-char (point-min)) - (insert "\"") - (while (re-search-forward "[\"\\]" nil 1) - (replace-match "\\\\\\&" t)) - (insert "\"")) (insert " <" login ">")) (t ; 'parens or default (insert login " (") @@ -3950,32 +5160,56 @@ give as trustworthy answer as possible." (defun message-user-mail-address () "Return the pertinent part of `user-mail-address'." - (when user-mail-address + (when (and user-mail-address + (string-match "@.*\\." user-mail-address)) (if (string-match " " user-mail-address) (nth 1 (std11-extract-address-components user-mail-address)) user-mail-address))) +(defun message-sendmail-envelope-from () + "Return the envelope from." + (cond ((eq message-sendmail-envelope-from 'header) + (nth 1 (mail-extract-address-components + (message-fetch-field "from")))) + ((stringp message-sendmail-envelope-from) + message-sendmail-envelope-from) + (t + (message-make-address)))) + (defun message-make-fqdn () "Return user's fully qualified domain name." - (let ((system-name (system-name)) - (user-mail (message-user-mail-address))) + (let* ((system-name (system-name)) + (user-mail (message-user-mail-address)) + (user-domain + (if (and user-mail + (string-match "@\\(.*\\)\\'" user-mail)) + (match-string 1 user-mail)))) (cond - ((string-match "[^.]\\.[^.]" system-name) + ((and message-user-fqdn + (stringp message-user-fqdn) + (string-match message-valid-fqdn-regexp message-user-fqdn) + (not (string-match message-bogus-system-names message-user-fqdn))) + message-user-fqdn) + ;; `message-user-fqdn' seems to be valid + ((and (string-match message-valid-fqdn-regexp system-name) + (not (string-match message-bogus-system-names system-name))) ;; `system-name' returned the right result. system-name) ;; Try `mail-host-address'. ((and (boundp 'mail-host-address) (stringp mail-host-address) - (string-match "\\." mail-host-address)) + (string-match message-valid-fqdn-regexp mail-host-address) + (not (string-match message-bogus-system-names mail-host-address))) mail-host-address) ;; We try `user-mail-address' as a backup. - ((and user-mail - (string-match "\\." user-mail) - (string-match "@\\(.*\\)\\'" user-mail)) - (match-string 1 user-mail)) + ((and user-domain + (stringp user-domain) + (string-match message-valid-fqdn-regexp user-domain) + (not (string-match message-bogus-system-names user-domain))) + user-domain) ;; Default to this bogus thing. (t - (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me"))))) + (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me"))))) (defun message-make-host-name () "Return the name of the host." @@ -3988,6 +5222,62 @@ give as trustworthy answer as possible." (or mail-host-address (message-make-fqdn))) +(defun message-to-list-only () + "Send a message to the list only. +Remove all addresses but the list address from To and Cc headers." + (interactive) + (let ((listaddr (message-make-mail-followup-to t))) + (when listaddr + (save-excursion + (message-remove-header "to") + (message-remove-header "cc") + (message-position-on-field "To" "X-Draft-From") + (insert listaddr))))) + +(defun message-make-mail-followup-to (&optional only-show-subscribed) + "Return the Mail-Followup-To header. +If passed the optional argument ONLY-SHOW-SUBSCRIBED only return the +subscribed address (and not the additional To and Cc header contents)." + (let* ((case-fold-search t) + (to (message-fetch-field "To")) + (cc (message-fetch-field "cc")) + (msg-recipients (concat to (and to cc ", ") cc)) + (recipients + (mapcar 'mail-strip-quoted-names + (message-tokenize-header msg-recipients))) + (file-regexps + (if message-subscribed-address-file + (let (begin end item re) + (save-excursion + (with-temp-buffer + (insert-file-contents message-subscribed-address-file) + (while (not (eobp)) + (setq begin (point)) + (forward-line 1) + (setq end (point)) + (if (bolp) (setq end (1- end))) + (setq item (regexp-quote (buffer-substring begin end))) + (if re (setq re (concat re "\\|" item)) + (setq re (concat "\\`\\(" item)))) + (and re (list (concat re "\\)\\'")))))))) + (mft-regexps (apply 'append message-subscribed-regexps + (mapcar 'regexp-quote + message-subscribed-addresses) + file-regexps + (mapcar 'funcall + message-subscribed-address-functions)))) + (save-match-data + (let ((subscribed-lists nil) + (list + (loop for recipient in recipients + when (loop for regexp in mft-regexps + when (string-match regexp recipient) return t) + return recipient))) + (when list + (if only-show-subscribed + list + msg-recipients)))))) + ;; Dummy to avoid byte-compile warning. (defvar mule-version) (defvar emacs-beta-version) @@ -4003,7 +5293,11 @@ string." (goto-char (point-min)) (let ((case-fold-search t) user-agent start p end) - (if (re-search-forward "^User-Agent:[\t ]*" nil t) + (if (re-search-forward + (concat "^User-Agent:[\t ]*\\(" + (regexp-quote gnus-product-name) + "/[0-9.]+\\([ \t\r\n]*([^)]+)\\)*\\)?[\t ]*") + nil t) (progn (setq start (match-beginning 0) p (match-end 0) @@ -4013,9 +5307,74 @@ string." (concat message-user-agent " " user-agent)) message-user-agent))))) +(defun message-idna-inside-rhs-p () + "Return t iff point is inside a RHS (heuristically). +Only works properly if header contains mailbox-list or address-list. +I.e., calling it on a Subject: header is useless." + (save-restriction + (narrow-to-region (save-excursion (or (re-search-backward "^[^ \t]" nil t) + (point-min))) + (save-excursion (or (re-search-forward "^[^ \t]" nil t) + (point-max)))) + (if (re-search-backward "[\\\n\r\t ]" + (save-excursion (search-backward "@" nil t)) t) + ;; whitespace between @ and point + nil + (let ((dquote 1) (paren 1)) + (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote)) + (incf dquote)) + (while (save-excursion (re-search-backward "[^\\]\(" nil t paren)) + (incf paren)) + (and (= (% dquote 2) 1) (= (% paren 2) 1)))))) + +(autoload 'idna-to-ascii "idna") + +(defun message-idna-to-ascii-rhs-1 (header) + "Interactively potentially IDNA encode domain names in HEADER." + (let (rhs ace start startpos endpos ovl) + (goto-char (point-min)) + (while (re-search-forward (concat "^" header) nil t) + (while (re-search-forward "@\\([^ \t\r\n>]+\\)" + (or (save-excursion + (re-search-forward "^[^ \t]" nil t)) + (point-max)) + t) + (setq rhs (match-string-no-properties 1) + startpos (match-beginning 1) + endpos (match-end 1)) + (when (save-match-data + (and (message-idna-inside-rhs-p) + (setq ace (idna-to-ascii rhs)) + (not (string= rhs ace)) + (if (eq message-use-idna 'ask) + (unwind-protect + (progn + (setq ovl (message-make-overlay startpos + endpos)) + (message-overlay-put ovl 'face 'highlight) + (y-or-n-p + (format "Replace with `%s'? " ace))) + (message "") + (message-delete-overlay ovl)) + message-use-idna))) + (replace-match (concat "@" ace))))))) + +(defun message-idna-to-ascii-rhs () + "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. +See `message-idna-encode'." + (interactive) + (when message-use-idna + (save-excursion + (save-restriction + (message-narrow-to-head) + (message-idna-to-ascii-rhs-1 "From") + (message-idna-to-ascii-rhs-1 "To") + (message-idna-to-ascii-rhs-1 "Cc"))))) + (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." + (setq headers (append headers message-required-headers)) (save-restriction (message-narrow-to-headers) (let* ((Date (message-make-date)) @@ -4026,12 +5385,14 @@ Headers already prepared in the buffer are not modified." (Subject nil) (Newsgroups nil) (In-Reply-To (message-make-in-reply-to)) + (References (message-make-references)) (To nil) (Distribution (message-make-distribution)) (Lines (message-make-lines)) (User-Agent (message-make-user-agent)) (Expires (message-make-expires)) (case-fold-search t) + (optionalp nil) header value elem) ;; First we remove any old generated headers. (let ((headers message-deletable-headers)) @@ -4053,7 +5414,8 @@ Headers already prepared in the buffer are not modified." (setq elem (pop headers)) (if (consp elem) (if (eq (car elem) 'optional) - (setq header (cdr elem)) + (setq header (cdr elem) + optionalp t) (setq header (car elem))) (setq header elem)) (when (or (not (re-search-forward @@ -4069,26 +5431,32 @@ Headers already prepared in the buffer are not modified." ;; The header was found. We insert a space after the ;; colon, if there is none. (if (/= (char-after) ? ) (insert " ") (forward-char 1)) - ;; Find out whether the header is empty... + ;; Find out whether the header is empty. (looking-at "[ \t]*\n[^ \t]"))) ;; So we find out what value we should insert. (setq value (cond - ((and (consp elem) (eq (car elem) 'optional)) + ((and (consp elem) + (eq (car elem) 'optional)) ;; This is an optional header. If the cdr of this ;; is something that is nil, then we do not insert ;; this header. (setq header (cdr elem)) - (or (and (fboundp (cdr elem)) (funcall (cdr elem))) - (and (boundp (cdr elem)) (symbol-value (cdr elem))))) + (or (and (message-functionp (cdr elem)) + (funcall (cdr elem))) + (and (boundp (cdr elem)) + (symbol-value (cdr elem))))) ((consp elem) ;; The element is a cons. Either the cdr is a ;; string to be inserted verbatim, or it is a ;; function, and we insert the value returned from ;; this function. - (or (and (stringp (cdr elem)) (cdr elem)) - (and (fboundp (cdr elem)) (funcall (cdr elem))))) - ((and (boundp header) (symbol-value header)) + (or (and (stringp (cdr elem)) + (cdr elem)) + (and (message-functionp (cdr elem)) + (funcall (cdr elem))))) + ((and (boundp header) + (symbol-value header)) ;; The element is a symbol. We insert the value ;; of this symbol, if any. (symbol-value header)) @@ -4105,17 +5473,27 @@ Headers already prepared in the buffer are not modified." (progn ;; This header didn't exist, so we insert it. (goto-char (point-max)) - (insert (if (stringp header) header (symbol-name header)) - ": " value) - (unless (bolp) - (insert "\n")) - (forward-line -1)) + (let ((formatter + (cdr (assq header message-header-format-alist)))) + (if formatter + (funcall formatter header value) + (insert (if (stringp header) + header (symbol-name header)) + ": " value)) + ;; We check whether the value was ended by a + ;; newline. If now, we insert one. + (unless (bolp) + (insert "\n")) + (forward-line -1))) ;; The value of this header was empty, so we clear ;; totally and insert the new value. (delete-region (point) (gnus-point-at-eol)) - (insert value) - (when (bolp) - (delete-char -1))) + ;; If the header is optional, and the header was + ;; empty, we can't insert it anyway. + (unless optionalp + (insert value) + (when (bolp) + (delete-char -1)))) ;; Add the deletable property to the headers that require it. (and (memq header message-deletable-headers) (progn (beginning-of-line) (looking-at "[^:]+: ")) @@ -4146,7 +5524,9 @@ Headers already prepared in the buffer are not modified." (beginning-of-line)) (when (or (message-news-p) (string-match "@.+\\.." secure-sender)) - (insert "Sender: " secure-sender "\n"))))))) + (insert "Sender: " secure-sender "\n")))) + ;; Check for IDNA + (message-idna-to-ascii-rhs)))) (defun message-insert-courtesy-copy () "Insert a courtesy message in mail copies of combined messages." @@ -4186,11 +5566,11 @@ Headers already prepared in the buffer are not modified." (when (not quoted) (if (and (> (current-column) 78) last) - (save-excursion - (goto-char last) + (save-excursion + (goto-char last) (looking-at "[ \t]*") - (replace-match "\n " t t))) - (setq last (1+ (point)))) + (replace-match "\n " t t))) + (setq last (1+ (point)))) (setq quoted (not quoted))) (unless (eobp) (forward-char 1)))) @@ -4202,9 +5582,19 @@ Headers already prepared in the buffer are not modified." (insert (capitalize (symbol-name header)) ": " (std11-fill-msg-id-list-string - (if (consp value) (car value) value)) + (if (consp value) (car value) value)) "\n")) +(defun message-split-line () + "Split current line, moving portion beyond point vertically down. +If the current line has `message-yank-prefix', insert it on the new line." + (interactive "*") + (condition-case nil + (split-line message-yank-prefix) ;; Emacs 21.3.50+ supports arg. + (error + (split-line)))) + + (defun message-fill-header (header value) (let ((begin (point)) (fill-column 78) @@ -4227,17 +5617,17 @@ Headers already prepared in the buffer are not modified." (goto-char (point-max))))) (defun message-shorten-1 (list cut surplus) - ;; Cut SURPLUS elements out of LIST, beginning with CUTth one. + "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) - "Trim REFERENCES to be less than 31 Message-ID long, and fold them. + "Trim REFERENCES to be 21 Message-ID long or less, 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) + (let ((maxcount 21) (count 0) - (cut 6) + (cut 2) refs) (with-temp-buffer (insert references) @@ -4303,6 +5693,28 @@ than 988 characters long, and if they are not, trim them until they are." (forward-line 2))) (sit-for 0))) +(defcustom message-beginning-of-line t + "Whether C-a goes to beginning of header values." + :group 'message-buffers + :type 'boolean) + +(defun message-beginning-of-line (&optional n) + "Move point to beginning of header value or to beginning of line." + (interactive "p") + (let ((zrs 'zmacs-region-stays)) + (when (and (interactive-p) (boundp zrs)) + (set zrs t))) + (if (and message-beginning-of-line + (message-point-in-header-p)) + (let* ((here (point)) + (bol (progn (beginning-of-line n) (point))) + (eol (gnus-point-at-eol)) + (eoh (re-search-forward ": *" eol t))) + (if (or (not eoh) (equal here eoh)) + (goto-char bol) + (goto-char eoh))) + (beginning-of-line n))) + (defun message-buffer-name (type &optional to group) "Return a new (unique) buffer name based on TYPE and TO." (cond @@ -4372,7 +5784,7 @@ than 988 characters long, and if they are not, trim them until they are." ;; list of buffers. (setq message-buffer-list (delq (current-buffer) message-buffer-list)) (while (and message-max-buffers - message-buffer-list + message-buffer-list (>= (length message-buffer-list) message-max-buffers)) ;; Kill the oldest buffer -- unless it has been changed. (let ((buffer (pop message-buffer-list))) @@ -4382,23 +5794,99 @@ than 988 characters long, and if they are not, trim them until they are." ;; Rename the buffer. (if message-send-rename-function (funcall message-send-rename-function) - (when (string-match "\\`\\*\\(unsent \\)?" (buffer-name)) - (rename-buffer - (concat "*sent " (substring (buffer-name) (match-end 0))) t))) + ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus. + (when (string-match + "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to " + (buffer-name)) + (let ((name (match-string 2 (buffer-name))) + to group) + (if (not (or (null name) + (string-equal name "mail") + (string-equal name "posting"))) + (setq name (concat "*sent " name "*")) + (message-narrow-to-headers) + (setq to (message-fetch-field "to")) + (setq group (message-fetch-field "newsgroups")) + (widen) + (setq name + (cond + (to (concat "*sent mail to " + (or (car (mail-extract-address-components to)) + to) "*")) + ((and group (not (string= group ""))) + (concat "*sent posting on " group "*")) + (t "*sent mail*")))) + (unless (string-equal name (buffer-name)) + (rename-buffer name t))))) ;; Push the current buffer onto the list. (when message-max-buffers (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)) - (when actions - (setq message-send-actions actions)) +(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))))) + +(defun message-headers-to-generate (headers included-headers excluded-headers) + "Return a list that includes all headers from HEADERS. +If INCLUDED-HEADERS is a list, just include those headers. If if is +t, include all headers. In any case, headers from EXCLUDED-HEADERS +are not included." + (let ((result nil) + header-name) + (dolist (header headers) + (setq header-name (cond + ((and (consp header) + (eq (car header) 'optional)) + ;; On the form (optional . Header) + (cdr header)) + ((consp header) + ;; On the form (Header . function) + (car header)) + (t + ;; Just a Header. + header))) + (when (and (not (memq header-name excluded-headers)) + (or (eq included-headers t) + (memq header-name included-headers))) + (push header result))) + (nreverse result))) + +(defun message-setup-1 (headers &optional replybuffer actions) + (dolist (action actions) + (condition-case nil + (add-to-list 'message-send-actions + `(apply ',(car action) ',(cdr action))))) (setq message-reply-buffer (or (message-get-parameter 'reply-buffer) replybuffer)) @@ -4430,23 +5918,28 @@ than 988 characters long, and if they are not, trim them until they are." (or (bolp) (insert ?\n))) (when message-generate-headers-first (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-news-headers)))))) + (message-headers-to-generate + (append message-required-news-headers + message-required-headers) + message-generate-headers-first + '(Lines Subject))))) (when (message-mail-p) (when message-default-mail-headers (insert message-default-mail-headers) (or (bolp) (insert ?\n))) (when message-generate-headers-first (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-mail-headers)))))) + (message-headers-to-generate + (append message-required-mail-headers + message-required-headers) + message-generate-headers-first + '(Lines Subject))))) (run-hooks 'message-signature-setup-hook) (message-insert-signature) (save-restriction (message-narrow-to-headers) - (if message-alternative-emails + (if (and replybuffer + message-alternative-emails) (message-use-alternative-email-as-from)) (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) @@ -4458,11 +5951,20 @@ than 988 characters long, and if they are not, trim them until they are." (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)) + (make-directory message-auto-save-directory t)) (if (gnus-alive-p) (setq message-draft-article (nndraft-request-associate-buffer "drafts")) - (setq buffer-file-name (expand-file-name "*message*" - message-auto-save-directory)) + (setq buffer-file-name (expand-file-name + (if (memq system-type + '(ms-dos ms-windows windows-nt + cygwin cygwin32 win32 w32 + mswindows)) + "message" + "*message*") + message-auto-save-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) (clear-visited-file-modtime) (static-if (boundp 'MULE) @@ -4505,106 +6007,97 @@ than 988 characters long, and if they are not, trim them until they are." "Start editing a mail message to be sent. OTHER-HEADERS is an alist of header/value pairs." (interactive) - (let ((message-this-is-mail t)) - (message-pop-to-buffer (message-buffer-name "mail" to)) + (let ((message-this-is-mail t) replybuffer) + (unless (message-mail-user-agent) + (message-pop-to-buffer (message-buffer-name "mail" to))) + ;; FIXME: message-mail should do something if YANK-ACTION is not + ;; insert-buffer. + (and (consp yank-action) (eq (car yank-action) 'insert-buffer) + (setq replybuffer (nth 1 yank-action))) (message-setup (nconc `((To . ,(or to "")) (Subject . ,(or subject ""))) - (when other-headers other-headers))))) + (when other-headers other-headers)) + replybuffer send-actions) + ;; FIXME: Should return nil if failure. + t)) ;;;###autoload (defun message-news (&optional newsgroups subject) "Start editing a news article to be sent." (interactive) (let ((message-this-is-news t)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) -(defun message-get-reply-headers (wide &optional to-address) - (let (follow-to mct never-mct from to cc reply-to mrt mft) +(defun message-get-reply-headers (wide &optional to-address address-headers) + (let (follow-to mct never-mct to cc author mft recipients) ;; 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 - (cond - ((and (or (equal (downcase mct) "never") - (equal (downcase mct) "nobody"))) - (when (or (not (eq message-use-mail-copies-to 'ask)) - (message-y-or-n-p - (concat "Obey Mail-Copies-To: never? ") t "\ + (let ((mrt (when message-use-mail-reply-to + (message-fetch-field "mail-reply-to"))) + (reply-to (message-fetch-field "reply-to"))) + (setq to (message-fetch-field "to") + cc (message-fetch-field "cc") + mct (when message-use-mail-copies-to + (message-fetch-field "mail-copies-to")) + author (or mrt + reply-to + (message-fetch-field "from") + "") + mft (when (and (not (or to-address mrt reply-to)) + message-use-mail-followup-to) + (message-fetch-field "mail-followup-to")))) + + (save-match-data + ;; Handle special values of Mail-Copies-To. + (when mct + (cond ((or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")) + (when (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: never? ") t "\ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: " mct "' directs you not to send your response to the author.")) - (setq never-mct t)) - (setq mct nil)) - ((and (or (equal (downcase mct) "always") - (equal (downcase mct) "poster"))) - (if (or (not (eq message-use-mail-copies-to 'ask)) - (message-y-or-n-p - (concat "Obey Mail-Copies-To: always? ") t "\ + (setq never-mct t)) + (setq mct nil)) + ((or (equal (downcase mct) "always") + (equal (downcase mct) "poster")) + (if (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: always? ") t "\ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: " mct "' sends a copy of your response to the author.")) - (setq mct (or mrt reply-to from)) - (setq mct nil))) - ((and (eq message-use-mail-copies-to 'ask) - (not (message-y-or-n-p - (concat "Obey Mail-Copies-To: " mct " ? ") t "\ + (setq mct author) + (setq mct nil))) + ((and (eq message-use-mail-copies-to 'ask) + (not (message-y-or-n-p + (concat "Obey Mail-Copies-To: " mct " ? ") t "\ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: " mct "' sends a copy of your response to " (if (string-match "," mct) "the specified addresses" "that address") "."))) - (setq mct nil)))) - - ;; 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 "' -directs your response to " (if (string-match "," mft) - "the specified addresses" - "that address only") ". - -A typical situation where Mail-Followup-To is used is when the author thinks -that further discussion should take place only in " - (if (string-match "," mft) - "the specified mailing lists" - "that mailing list") "."))) - (setq mft nil)) + (setq mct 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 "\ + ;; Build (textual) list of new recipient addresses. + (cond + ((not wide) + (setq recipients (concat ", " author))) + (address-headers + (dolist (header address-headers) + (let ((value (message-fetch-field header))) + (when value + (setq recipients (concat recipients ", " value)))))) + ((and mft + (string-match "[^ \t,]" mft) + (or (not (eq message-use-mail-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 @@ -4614,45 +6107,78 @@ 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, +Most commonly, Mail-Followup-To is used by a mailing list poster to +express that responses should be sent to just the list, and not the +poster as well. + +If a message is posted to several mailing lists, Mail-Followup-To may +also be used to direct the following discussion to one list only, because discussions that are spread over several lists tend to be fragmented and very difficult to follow. -Also, some source/announcement lists are not indented for discussion; +Also, some source/announcement lists are not intended for discussion; responses here are directed to other addresses."))) - (insert mft) - (unless never-mct - (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 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))))) + (setq recipients (concat ", " mft))) + (to-address + (setq recipients (concat ", " to-address)) + ;; If the author explicitly asked for a copy, we don't deny it to them. + (if mct (setq recipients (concat recipients ", " mct)))) + (t + (setq recipients (if never-mct "" (concat ", " author))) + (if to (setq recipients (concat recipients ", " to))) + (if cc (setq recipients (concat recipients ", " cc))) + (if mct (setq recipients (concat recipients ", " mct))))) + (if (>= (length recipients) 2) + ;; Strip the leading ", ". + (setq recipients (substring recipients 2))) + ;; Squeeze whitespace. + (while (string-match "[ \t][ \t]+" recipients) + (setq recipients (replace-match " " t t recipients))) + ;; Remove addresses that match `rmail-dont-reply-to-names'. + (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) + (setq recipients (rmail-dont-reply-to recipients))) + ;; Perhaps "Mail-Copies-To: never" removed the only address? + (if (string-equal recipients "") + (setq recipients author)) + ;; Convert string to a list of (("foo@bar" . "Name ") ...). + (setq recipients + (mapcar + (lambda (addr) + (cons (downcase (mail-strip-quoted-names addr)) addr)) + (message-tokenize-header recipients))) + ;; Remove first duplicates. (Why not all duplicates? Is this a bug?) + (let ((s recipients)) + (while s + (setq recipients (delq (assoc (car (pop s)) s) recipients)))) + + ;; Remove hierarchical lists that are contained within each other, + ;; if message-hierarchical-addresses is defined. + (when message-hierarchical-addresses + (let ((plain-addrs (mapcar 'car recipients)) + subaddrs recip) + (while plain-addrs + (setq subaddrs (assoc (car plain-addrs) + message-hierarchical-addresses) + plain-addrs (cdr plain-addrs)) + (when subaddrs + (setq subaddrs (cdr subaddrs)) + (while subaddrs + (setq recip (assoc (car subaddrs) recipients) + subaddrs (cdr subaddrs)) + (if recip + (setq recipients (delq recip recipients)))))))) + + ;; Build the header alist. Allow the user to be asked whether + ;; or not to reply to all recipients in a wide reply. + (setq follow-to (list (cons 'To (cdr (pop recipients))))) + (when (and recipients + (or (not message-wide-reply-confirm-recipients) + (y-or-n-p "Reply to all recipients? "))) + (setq recipients (mapconcat + (lambda (addr) (cdr addr)) recipients ", ")) + (if (string-match "^ +" recipients) + (setq recipients (substring recipients (match-end 0)))) + (push (cons 'Cc recipients) follow-to))) follow-to)) ;;;###autoload @@ -4667,25 +6193,28 @@ responses here are directed to other addresses."))) (message-this-is-mail t) gnus-warning in-reply-to) (save-restriction - (message-narrow-to-head) + (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) + (when (message-functionp message-reply-to-function) (save-excursion - (setq follow-to - (funcall message-wide-reply-to-function))))) + (setq follow-to (funcall message-reply-to-function)))) + ;; This is a followup. + (when (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))) + (when gnus-list-identifiers + (setq subject (message-strip-list-identifiers subject))) (setq subject (message-make-followup-subject subject)) + (when message-subject-trailing-was-query + (setq subject (message-strip-subject-trailing-was subject))) (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) @@ -4701,10 +6230,11 @@ responses here are directed to other addresses."))) (string-match "<[^>]+>" in-reply-to)) (setq references (match-string 0 in-reply-to))))) - (message-pop-to-buffer - (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil))) + (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 @@ -4712,11 +6242,7 @@ responses here are directed to other addresses."))) (message-setup `((Subject . ,subject) - ,@follow-to - ,@(if (or references message-id) - `((References . ,(concat (or references "") (and references " ") - (or message-id "")))) - nil)) + ,@follow-to) cur))) ;;;###autoload @@ -4769,6 +6295,8 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (if gnus-list-identifiers (setq subject (message-strip-list-identifiers subject))) (setq subject (message-make-followup-subject subject)) + (when message-subject-trailing-was-query + (setq subject (message-strip-subject-trailing-was subject))) (widen)) ;; Handle special values of Mail-Copies-To. @@ -4837,7 +6365,7 @@ used to direct the following discussion to one newsgroup only, because discussions that are spread over several newsgroup tend to be fragmented and very difficult to follow. -Also, some source/announcement newsgroups are not indented for discussion; +Also, some source/announcement newsgroups are not intended for discussion; responses here are directed to other newsgroups.")) (setq follow-to (list (cons 'Newsgroups followup-to))) (setq follow-to (list (cons 'Newsgroups newsgroups))))))) @@ -4867,19 +6395,16 @@ 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 ,@(and mct (list (cons 'Cc mct))) - ,@(and distribution (list (cons 'Distribution distribution))) - ,@(if (or references message-id) - `((References . ,(concat (or references "") (and references " ") - (or message-id "")))))) - cur) - - (setq message-reply-headers - (make-full-mail-header-from-decoded-header - 0 subject from date message-id references 0 0 "")))) + ,@(and distribution (list (cons 'Distribution distribution)))) + cur))) ;;;###autoload (defun message-cancel-news (&optional arg) @@ -4888,35 +6413,51 @@ 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. - (save-restriction - (message-narrow-to-head) - (setq from (message-fetch-field "from") - sender (message-fetch-field "sender") - newsgroups (message-fetch-field "newsgroups") - message-id (message-fetch-field "message-id" t) - distribution (message-fetch-field "distribution"))) - ;; Make sure that this article was written by the user. - (unless (or (and sender - (string-equal - (downcase sender) - (downcase (message-make-sender)))) - (string-equal - (downcase (cadr (std11-extract-address-components - from))) - (downcase (cadr (std11-extract-address-components - (message-make-from)))))) - (error "This article is not yours")) + (let (from newsgroups message-id distribution buf sender) + (save-excursion + ;; Get header info from original article. + (save-restriction + (message-narrow-to-head-1) + (setq from (message-fetch-field "from") + sender (message-fetch-field "sender") + newsgroups (message-fetch-field "newsgroups") + message-id (message-fetch-field "message-id" t) + distribution (message-fetch-field "distribution"))) + ;; Make sure that this article was written by the user. + (unless (or + ;; Canlock-logic as suggested by Per Abrahamsen + ;; + ;; + ;; IF article has cancel-lock THEN + ;; IF we can verify it THEN + ;; issue cancel + ;; ELSE + ;; error: cancellock: article is not yours + ;; ELSE + ;; Use old rules, comparing sender... + (if (message-fetch-field "Cancel-Lock") + (if (null (canlock-verify)) + t + (error "Failed to verify Cancel-lock: This article is not yours")) + nil) + (message-gnksa-enable-p 'cancel-messages) + (and sender + (string-equal + (downcase sender) + (downcase (message-make-sender)))) + (string-equal + (downcase (cadr (std11-extract-address-components from))) + (downcase (cadr (std11-extract-address-components + (message-make-from)))))) + (error "This article is not yours")) + (when (yes-or-no-p "Do you really want to cancel this article? ") ;; Make control message. (if arg (message-news) (setq buf (set-buffer (get-buffer-create " *message cancel*")))) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" - "From: " from "\n" + "From: " from "\n" "Subject: cmsg cancel " message-id "\n" "Control: cancel " message-id "\n" (if distribution @@ -4925,8 +6466,8 @@ If ARG, allow editing of the cancellation message." mail-header-separator "\n" message-cancel-message) (run-hooks 'message-cancel-hook) - (message "Canceling your article...") (unless arg + (message "Canceling your article...") (if (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me) (message-encoding-buffer (current-buffer)) @@ -4949,19 +6490,36 @@ header line with the old Message-ID." (sender (message-fetch-field "sender")) (from (message-fetch-field "from"))) ;; Check whether the user owns the article that is to be superseded. - (unless (or (and sender - (string-equal - (downcase sender) - (downcase (message-make-sender)))) - (string-equal - (downcase (cadr (std11-extract-address-components from))) - (downcase (cadr (std11-extract-address-components - (message-make-from)))))) + (unless (or + ;; Canlock-logic as suggested by Per Abrahamsen + ;; + ;; + ;; IF article has cancel-lock THEN + ;; IF we can verify it THEN + ;; issue cancel + ;; ELSE + ;; error: cancellock: article is not yours + ;; ELSE + ;; Use old rules, comparing sender... + (if (message-fetch-field "Cancel-Lock") + (if (null (canlock-verify)) + t + (error "Failed to verify Cancel-lock: This article is not yours")) + nil) + (message-gnksa-enable-p 'cancel-messages) + (and sender + (string-equal + (downcase sender) + (downcase (message-make-sender)))) + (string-equal + (downcase (cadr (std11-extract-address-components from))) + (downcase (cadr (std11-extract-address-components + (message-make-from)))))) (error "This article is not yours")) ;; Get a normal message buffer. (message-pop-to-buffer (message-buffer-name "supersede")) (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)) @@ -5001,9 +6559,10 @@ header line with the old Message-ID." ;;; Washing Subject: (defun message-wash-subject (subject) - "Remove junk like \"Re:\", \"(fwd)\", etc. that was added to the subject by previous forwarders, replyers, etc." + "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT. +Previous forwarders, replyers, etc. may add it." (with-temp-buffer - (insert-string subject) + (insert subject) (goto-char (point-min)) ;; strip Re/Fwd stuff off the beginning (while (re-search-forward @@ -5032,23 +6591,38 @@ header line with the old Message-ID." ;;; Forwarding messages. +(defvar message-forward-decoded-p nil + "Non-nil means the original message is decoded.") + (defun message-forward-subject-author-subject (subject) - "Generate a subject for a forwarded message. + "Generate a SUBJECT for a forwarded message. The form is: [Source] Subject, where if the original message was mail, Source is the sender, and if the original message was news, Source is the list of newsgroups is was posted to." (concat "[" - (if (message-news-p) - (or (message-fetch-field "newsgroups") - "(nowhere)") - (let ((from (message-fetch-field "from"))) - (if from - (nnheader-decode-from from) - "(nobody)"))) + (let ((prefix (message-fetch-field "newsgroups"))) + (or prefix + (and (setq prefix (message-fetch-field "from")) + (nnheader-decode-from prefix)) + "(nowhere)")) + "] " subject)) + +(defun message-forward-subject-name-subject (subject) + "Generate a SUBJECT for a forwarded message. +The form is: [Source] Subject, where if the original message was mail, +Source is the name of the sender, and if the original message was +news, Source is the list of newsgroups is was posted to." + (concat "[" + (let ((prefix (message-fetch-field "newsgroups"))) + (or prefix + (and (setq prefix (message-fetch-field "from")) + (car (std11-extract-address-components + (nnheader-decode-from prefix)))) + "(nowhere)")) "] " subject)) (defun message-forward-subject-fwd (subject) - "Generate a subject for a forwarded message. + "Generate a SUBJECT for a forwarded message. The form is: Fwd: Subject, where Subject is the original subject of the message." (concat "Fwd: " subject)) @@ -5057,16 +6631,17 @@ the message." "Return a Subject header suitable for the message in the current buffer." (save-excursion (save-restriction - (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)) + (if message-forward-decoded-p + subject (nnheader-decode-subject subject)) - "(none)")) + "")) + (if message-wash-forwarded-subjects + (setq subject (message-wash-subject subject))) ;; Make sure funcs is a list. (and funcs (not (listp funcs)) @@ -5085,25 +6660,30 @@ the message." Optional NEWS will use news to forward instead of mail." (interactive "P") (let ((cur (current-buffer)) - (subject (message-make-forward-subject)) - art-beg) + (subject (message-make-forward-subject))) (if news (message-news nil subject) (message-mail nil subject)) - ;; Put point where we want it before inserting the forwarded - ;; message. - (if message-forward-before-signature - (message-goto-body) - (goto-char (point-max))) - ;; Make sure we're at the start of the line. - (unless (bolp) - (insert "\n")) - ;; Narrow to the area we are to insert. - (narrow-to-region (point) (point)) - ;; Insert the separators and the forwarded buffer. - (insert message-forward-start-separator) - (setq art-beg (point)) - (insert-buffer-substring cur) + (message-forward-make-body cur))) + +;;;###autoload +(defun message-forward-make-body (forward-buffer) + ;; Put point where we want it before inserting the forwarded + ;; message. + ;; Note that this function definition for T-gnus is totally different + ;; from the original Gnus." + (if message-forward-before-signature + (message-goto-body) + (goto-char (point-max))) + ;; Make sure we're at the start of the line. + (unless (bolp) + (insert "\n")) + ;; Narrow to the area we are to insert. + (narrow-to-region (point) (point)) + ;; Insert the separators and the forwarded buffer. + (insert message-forward-start-separator) + (let ((art-beg (point))) + (insert-buffer-substring forward-buffer) (goto-char (point-max)) (insert message-forward-end-separator) (set-text-properties (point-min) (point-max) nil) @@ -5118,6 +6698,24 @@ Optional NEWS will use news to forward instead of mail." (message-position-point))) ;;;###autoload +(defun message-forward-rmail-make-body (forward-buffer) + (save-window-excursion + (set-buffer forward-buffer) + ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs + ;; 20. FIXIT, or we drop support for rmail in Emacs 20. + (if (rmail-msg-is-pruned) + (rmail-msg-restore-non-pruned-header))) + (message-forward-make-body forward-buffer)) + +;;;###autoload +(defun message-insinuate-rmail () + "Let RMAIL uses message to forward." + (interactive) + (setq rmail-enable-mime-composing t) + (setq rmail-insert-mime-forwarded-message-function + 'message-forward-rmail-make-body)) + +;;;###autoload (defun message-resend (address) "Resend the current article to ADDRESS." (interactive @@ -5127,16 +6725,19 @@ 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) + message-setup-hook) + (message-setup `((To . ,address)))) ;; Insert our usual headers. (message-generate-headers '(From Date To)) (message-narrow-to-headers) + ;; Remove X-Draft-From header etc. + (message-remove-header message-ignored-mail-headers t) ;; Rename them all to "Resent-*". + (goto-char (point-min)) (while (re-search-forward "^[A-Za-z]" nil t) (forward-char -1) (insert "Resent-")) @@ -5164,9 +6765,9 @@ Optional NEWS will use news to forward instead of mail." (replace-match "X-From-Line: ")) ;; Send it. (let ((message-encoding-buffer (current-buffer)) - (message-edit-buffer (current-buffer))) - (let (message-required-mail-headers) - (message-send-mail))) + (message-edit-buffer (current-buffer)) + message-required-mail-headers) + (message-send-mail)) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) @@ -5196,20 +6797,22 @@ you." (widen) (goto-char (point-min)) (search-forward "\n\n" nil t) - (or (and boundary - (re-search-forward boundary nil t) - (forward-line 2)) - (and (re-search-forward message-unsent-separator nil t) - (forward-line 1)) - (re-search-forward "^Return-Path:.*\n" nil t)) - ;; We remove everything before the bounced mail. - (delete-region - (point-min) - (if (re-search-forward "^[^ \n\t]+:" nil t) - (match-beginning 0) - (point))) + (if (or (and boundary + (re-search-forward boundary nil t) + (forward-line 2)) + (and (re-search-forward message-unsent-separator nil t) + (forward-line 1)) + (re-search-forward "^Return-Path:.*\n" nil t)) + ;; We remove everything before the bounced mail. + (delete-region + (point-min) + (if (re-search-forward "^[^ \n\t]+:" nil t) + (match-beginning 0) + (point))) + (when (re-search-backward "^.?From .*\n" nil t) + (delete-region (match-beginning 0) (match-end 0)))) (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)) @@ -5226,27 +6829,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) @@ -5257,7 +6864,7 @@ you." (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5271,7 +6878,7 @@ you." (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5311,27 +6918,112 @@ which specify the range to operate on." (delete-char -2)))))) (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) +(defalias 'message-make-overlay 'make-overlay) +(defalias 'message-delete-overlay 'delete-overlay) +(defalias 'message-overlay-put 'overlay-put) ;; Support for toolbar -(when (featurep 'xemacs) - (require 'messagexmas)) +(eval-when-compile + (defvar tool-bar-map) + (defvar tool-bar-mode)) + +(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) + ;; We need to make tool bar entries in local keymaps with + ;; `tool-bar-local-item-from-menu' in Emacs > 21.3 + (if (fboundp 'tool-bar-local-item-from-menu) + ;; This is for Emacs 21.3 + (tool-bar-local-item-from-menu command icon in-map from-map props) + (tool-bar-add-item-from-menu command icon from-map props))) + +(defun message-tool-bar-map () + (or message-tool-bar-map + (setq message-tool-bar-map + (and + (condition-case nil (require 'tool-bar) (error nil)) + (fboundp 'tool-bar-add-item-from-menu) + tool-bar-mode + (let ((tool-bar-map (copy-keymap tool-bar-map)) + (load-path (mm-image-load-path))) + ;; 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)) + (message-tool-bar-local-item-from-menu + 'message-send-and-exit "mail_send" tool-bar-map message-mode-map) + (message-tool-bar-local-item-from-menu + 'message-kill-buffer "close" tool-bar-map message-mode-map) + (message-tool-bar-local-item-from-menu + 'message-dont-send "cancel" tool-bar-map message-mode-map) +;; (message-tool-bar-local-item-from-menu +;; 'mime-edit-insert-file "attach" +;; tool-bar-map mime-edit-mode-map) + (message-tool-bar-local-item-from-menu + 'ispell-message "spell" tool-bar-map message-mode-map) +;; (message-tool-bar-local-item-from-menu +;; 'mime-edit-preview-message "preview" +;; tool-bar-map mime-edit-mode-map) + (message-tool-bar-local-item-from-menu + 'message-insert-importance-high "important" + tool-bar-map message-mode-map) + (message-tool-bar-local-item-from-menu + 'message-insert-importance-low "unimportant" + tool-bar-map message-mode-map) + (message-tool-bar-local-item-from-menu + 'message-insert-disposition-notification-to "receipt" + tool-bar-map message-mode-map) + tool-bar-map))))) ;;; Group name completion. -(defvar message-newgroups-header-regexp +(defcustom message-newgroups-header-regexp "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups.") + "Regexp that match headers that lists groups." + :group 'message + :type 'regexp) + +(defcustom message-completion-alist + (list (cons message-newgroups-header-regexp 'message-expand-group) + '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name) + '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" + . message-expand-name) + '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" + . message-expand-name)) + "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." + :group 'message + :type '(alist :key-type regexp :value-type function)) + +(defcustom message-expand-name-function + (if (fboundp 'bbdb-complete-name) + 'bbdb-complete-name + (if (fboundp 'lsdb-complete-name) + 'lsdb-complete-name + 'expand-abbrev)) + "*A function called to expand addresses in field body." + :group 'message + :type 'function) + +(defcustom message-tab-body-function nil + "*Function to execute when `message-tab' (TAB) is executed in the body. +If nil, the function bound in `text-mode-map' or `global-map' is executed." + :group 'message + :type 'function) (defun message-tab () - "Expand group names in Newsgroups and Followup-To headers. -Do a `tab-to-tab-stop' if not in those headers." + "Complete names according to `message-completion-alist'. +Execute function specified by `message-tab-body-function' when not in +those headers." (interactive) - (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp)) - (mail-abbrev-in-expansion-header-p)) - (message-expand-group) - (tab-to-tab-stop))) + (let ((alist message-completion-alist)) + (while (and alist + (let ((mail-abbrev-mode-regexp (caar alist))) + (not (mail-abbrev-in-expansion-header-p)))) + (setq alist (cdr alist))) + (funcall (or (cdar alist) message-tab-body-function + (lookup-key text-mode-map "\t") + (lookup-key global-map "\t") + 'indent-relative)))) -(defvar gnus-active-hashtb) (defun message-expand-group () "Expand the group name under point." (let* ((b (save-excursion @@ -5374,6 +7066,9 @@ Do a `tab-to-tab-stop' if not in those headers." (goto-char (point-min)) (delete-region (point) (progn (forward-line 3) (point)))))))))) +(defun message-expand-name () + (funcall message-expand-name-function)) + ;;; Help stuff. (defun message-talkative-question (ask question show &rest text) @@ -5403,7 +7098,7 @@ The following arguments may contain lists of values." (list list)))) (defun message-generate-new-buffer-clone-locals (name &optional varstr) - "Create and return a buffer with a name based on NAME using generate-new-buffer. + "Create and return a buffer with name based on NAME using `generate-new-buffer.' Then clone the local variables and values from the old buffer to the new one, cloning only the locals having a substring matching the regexp varstr." @@ -5446,13 +7141,9 @@ regexp varstr." (if (catch 'mime-edit-error (save-excursion (mime-edit-pgp-enclose-buffer) - (mime-edit-translate-body) - )) - (error "Translation error!") - ) - (end-of-invisible) - (run-hooks 'mime-edit-exit-hook) - )) + (mime-edit-translate-body))) + (error "Translation error!")) + (run-hooks 'mime-edit-exit-hook))) (defun message-mime-insert-article (&optional full-headers) (interactive "P") @@ -5526,34 +7217,38 @@ regexp varstr." (when lines (insert lines)) (setq content-type-p - (re-search-backward "^Content-Type:" nil t))) + (or mml-boundary + (re-search-backward "^Content-Type:" nil t)))) (save-restriction (message-narrow-to-headers-or-head) (message-remove-first-header "Content-Type") (message-remove-first-header "Content-Transfer-Encoding")) - ;; We always make sure that the message has a Content-Type header. - ;; This is because some broken MTAs and MUAs get awfully confused - ;; when confronted with a message with a MIME-Version header and - ;; without a Content-Type header. For instance, Solaris' - ;; /usr/bin/mail. + ;; We always make sure that the message has a Content-Type + ;; header. This is because some broken MTAs and MUAs get + ;; awfully confused when confronted with a message with a + ;; MIME-Version header and without a Content-Type header. For + ;; instance, Solaris' /usr/bin/mail. (unless content-type-p (goto-char (point-min)) - (re-search-forward "^MIME-Version:") - (forward-line 1) - (insert "Content-Type: text/plain; charset=us-ascii\n"))))) + ;; For unknown reason, MIME-Version doesn't exist. + (when (re-search-forward "^MIME-Version:" nil t) + (forward-line 1) + (insert "Content-Type: text/plain; charset=us-ascii\n")))))) -(defun message-read-from-minibuffer (prompt) +(defun message-read-from-minibuffer (prompt &optional initial-contents) "Read from the minibuffer while providing abbrev expansion." (if (fboundp 'mail-abbrevs-setup) (let ((mail-abbrev-mode-regexp "") - (minibuffer-setup-hook 'mail-abbrevs-setup)) - (read-from-minibuffer prompt)) - (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)) - (read-string prompt)))) + (minibuffer-setup-hook 'mail-abbrevs-setup) + (minibuffer-local-map message-minibuffer-local-map)) + (read-from-minibuffer prompt initial-contents)) + (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) + (minibuffer-local-map message-minibuffer-local-map)) + (read-string prompt initial-contents)))) (defun message-use-alternative-email-as-from () (require 'mail-utils) - (let* ((fields '("To" "Cc")) + (let* ((fields '("To" "Cc")) (emails (split-string (mail-strip-quoted-names @@ -5575,7 +7270,7 @@ regexp varstr." (defun message-options-set (symbol value) (let ((the-cons (assq symbol message-options))) (if the-cons - (if value + (if value (setcdr the-cons value) (setq message-options (delq the-cons message-options))) (and value @@ -5586,30 +7281,52 @@ regexp varstr." (save-restriction (message-narrow-to-headers-or-head) (message-options-set 'message-sender - (mail-strip-quoted-names + (mail-strip-quoted-names (message-fetch-field "from"))) (message-options-set 'message-recipients - (mail-strip-quoted-names - (message-fetch-field "to"))))) - -(defun message-save-drafts () - "Postponing the message." - (interactive) - (message "Saving %s..." buffer-file-name) - (let ((reply-headers message-reply-headers) - (msg (buffer-substring-no-properties (point-min) (point-max))) - (message-invisibles (message-find-invisible-regions))) - (with-temp-file buffer-file-name - (insert msg) - ;; Inherit the invisible property of texts to make MIME-Edit - ;; find the MIME part boundaries. - (dolist (region message-invisibles) - (put-text-property (car region) (cdr region) 'invisible t)) - (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)) + (mail-strip-quoted-names + (let ((to (message-fetch-field "to")) + (cc (message-fetch-field "cc")) + (bcc (message-fetch-field "bcc"))) + (concat + (or to "") + (if (and to cc) ", ") + (or cc "") + (if (and (or to cc) bcc) ", ") + (or bcc ""))))))) + +(defun message-hide-headers () + "Hide headers based on the `message-hidden-headers' variable." + (let ((regexps (if (stringp message-hidden-headers) + (list message-hidden-headers) + message-hidden-headers)) + (inhibit-point-motion-hooks t) + (after-change-functions nil)) + (when regexps + (save-excursion + (save-restriction + (message-narrow-to-headers) + (goto-char (point-min)) + (while (not (eobp)) + (if (not (message-hide-header-p regexps)) + (message-next-header) + (let ((begin (point))) + (message-next-header) + (add-text-properties + begin (point) + '(invisible t message-hidden t)))))))))) + +(defun message-hide-header-p (regexps) + (let ((result nil) + (reverse nil)) + (when (eq (car regexps) 'not) + (setq reverse t) + (pop regexps)) + (dolist (regexp regexps) + (setq result (or result (looking-at regexp)))) + (if reverse + (not result) + result))) (when (featurep 'xemacs) (require 'messagexmas) diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el index b3be4ee..d94afa8 100644 --- a/lisp/messagexmas.el +++ b/lisp/messagexmas.el @@ -1,6 +1,6 @@ ;;; messagexmas.el --- XEmacs extensions to message -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -118,12 +118,16 @@ If it is non-nil, it must be a toolbar. The five valid values are (defun message-xmas-redefine () "Redefine message functions for XEmacs." - (defalias 'message-exchange-point-and-mark + (defalias 'message-exchange-point-and-mark 'message-xmas-exchange-point-and-mark) - + (defalias 'message-mark-active-p + 'region-exists-p) (when (>= emacs-major-version 20) (defalias 'message-make-caesar-translation-table - 'message-xmas-make-caesar-translation-table))) + 'message-xmas-make-caesar-translation-table)) + (defalias 'message-make-overlay 'make-extent) + (defalias 'message-delete-overlay 'delete-extent) + (defalias 'message-overlay-put 'set-extent-property)) (message-xmas-redefine) diff --git a/lisp/messcompat.el b/lisp/messcompat.el index e3021ce..ff7520f 100644 --- a/lisp/messcompat.el +++ b/lisp/messcompat.el @@ -1,6 +1,6 @@ ;;; messcompat.el --- making message mode compatible with mail mode -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -25,7 +25,7 @@ ;;; Commentary: -;; This file tries to provide backward compatability with sendmail.el +;; This file tries to provide backward compatibility with sendmail.el ;; for Message mode. It should be used by simply adding ;; ;; (require 'messcompat) @@ -40,7 +40,7 @@ (defvar message-from-style mail-from-style "*Specifies how \"From\" headers look. -If `nil', they contain just the return address like: +If nil, they contain just the return address like: king@grassland.com If `parens', they look like: king@grassland.com (Elvis Parsley) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 5b8874c..ee14049 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -1,5 +1,7 @@ ;;; mm-bodies.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2000, 2001, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -26,13 +28,15 @@ (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 ^_ @@ -40,7 +44,12 @@ (defcustom mm-body-charset-encoding-alist '((iso-2022-jp . 7bit) - (iso-2022-jp-2 . 7bit)) + (iso-2022-jp-2 . 7bit) + ;; We MUST encode UTF-16 because it can contain \0's which is + ;; known to break servers. + (utf-16 . base64) + (utf-16be . base64) + (utf-16le . base64)) "Alist of MIME charsets to encodings. Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." :type '(repeat (cons (symbol :tag "charset") @@ -51,66 +60,81 @@ Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." (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 (mm-multibyte-p)) ;; In the non-Mule case, we search for non-ASCII chars and ;; return the value of `mail-parse-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)) + (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 (mm-charset-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))) - charset))))))) + (goto-char (point-min)) + (let ((charsets (mm-find-mime-charset-region (point-min) (point-max) + mm-hack-charsets))) + (cond + ;; No encoding. + ((null charsets) + nil) + ;; Too many charsets. + ((> (length charsets) 1) + charsets) + ;; We encode. + (t + (prog1 + (setq charset (car charsets)) + (mm-encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)))) + )))))) + +(defun mm-long-lines-p (length) + "Say whether any of the lines in the buffer is longer than LINES." + (save-excursion + (goto-char (point-min)) + (end-of-line) + (while (and (not (eobp)) + (not (> (current-column) length))) + (forward-line 1) + (end-of-line)) + (and (> (current-column) length) + (current-column)))) + +(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))) + (when (stringp encoding) + (setq encoding (intern (downcase encoding)))) + (let ((bits (mm-body-7-or-8)) + (longp (mm-long-lines-p 1000))) + (require 'message) (cond - ((and (not mm-use-ultra-safe-encoding) (eq bits '7bit)) + ((and (not mm-use-ultra-safe-encoding) + (not longp) + (eq bits '7bit)) bits) ((and (not mm-use-ultra-safe-encoding) + (not longp) + (not (cdr (assq charset mm-body-charset-encoding-alist))) (or (eq t (cdr message-posting-charset)) (memq charset (cdr message-posting-charset)) (eq charset mail-parse-charset))) @@ -153,11 +177,14 @@ If no encoding was done, nil is returned." ;;; (defun mm-decode-content-transfer-encoding (encoding &optional type) + "Decodes buffer encoded with ENCODING, returning success status. +If TYPE is `text/plain' CRLF->LF translation may occur." (prog1 (condition-case error (cond ((eq encoding 'quoted-printable) - (quoted-printable-decode-region (point-min) (point-max))) + (quoted-printable-decode-region (point-min) (point-max)) + t) ((eq encoding 'base64) (base64-decode-region (point-min) @@ -172,87 +199,126 @@ If no encoding was done, nil is returned." (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)))) + (forward-line)) + (point)))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. - ) + t) ((null encoding) ;; Do nothing. - ) + t) ((memq encoding '(x-uuencode x-uue)) - (funcall mm-uu-decode-function (point-min) (point-max))) + (require 'mm-uu) + (funcall mm-uu-decode-function (point-min) (point-max)) + t) ((eq encoding 'x-binhex) - (funcall mm-uu-binhex-decode-function (point-min) (point-max))) + (require 'mm-uu) + (funcall mm-uu-binhex-decode-function (point-min) (point-max)) + t) + ((eq encoding 'x-yenc) + (require 'mm-uu) + (funcall mm-uu-yenc-decode-function (point-min) (point-max)) + ) ((functionp encoding) - (funcall encoding (point-min) (point-max))) + (funcall encoding (point-min) (point-max)) + t) (t (message "Unknown encoding %s; defaulting to 8bit" encoding))) (error (message "Error while decoding: %s" error) nil)) (when (and - (memq encoding '(base64 x-uuencode x-uue x-binhex)) + (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc)) (equal type "text/plain")) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) -(defun mm-decode-body (charset &optional encoding type) +(defun mm-decode-body (charset &optional encoding type force) "Decode the current article that has been encoded with ENCODING. -The characters in CHARSET should then be decoded." - (if (stringp charset) +The characters in CHARSET should then be decoded. If FORCE is non-nil +use the supplied charset unconditionally." + (let ((charset-supplied charset)) + (when (stringp charset) (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 (mm-charset-to-coding-system charset))) - (if (and (not mule-charset) - (listp mail-parse-ignored-charsets) - (memq 'gnus-unknown mail-parse-ignored-charsets)) - (setq mule-charset - (mm-charset-to-coding-system mail-parse-charset))) - (when (and charset mule-charset - ;; 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)))))) + (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 + charset-supplied nil)) + (save-excursion + (when encoding + (mm-decode-content-transfer-encoding encoding type)) + (when (featurep 'mule) + (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 coding-system 'ascii)) + (setq coding-system mail-parse-charset)) + (not (eq coding-system 'gnus-decoded))) + (if (or force + ;; If a charset was supplied, then use the + ;; supplied charset unconditionally. + charset-supplied) + (mm-decode-coding-region (point-min) (point-max) + coding-system) + ;; Otherwise allow Emacs to auto-detect the charset. + (mm-decode-coding-region-safely (point-min) (point-max) + coding-system))) + (setq buffer-file-coding-system + (if (boundp 'last-coding-system-used) + (symbol-value 'last-coding-system-used) + coding-system))))))) + +(defun mm-decode-coding-region-safely (start end coding-system) + "Decode region between START and END with CODING-SYSTEM. +If CODING-SYSTEM is not a valid coding system for the text, let Emacs +decide which coding system to use." + (let* ((orig (buffer-substring start end)) + charsets) + (save-restriction + (narrow-to-region start end) + (mm-decode-coding-region (point-min) (point-max) coding-system) + (setq charsets (find-charset-region (point-min) (point-max))) + (when (or (memq 'eight-bit-control charsets) + (memq 'eight-bit-graphic charsets)) + (delete-region (point-min) (point-max)) + (insert orig) + (mm-decode-coding-region (point-min) (point-max) 'undecided))))) (defun mm-decode-string (string charset) "Decode STRING with CHARSET." (when (stringp charset) (setq charset (intern (downcase charset)))) - (when (or (not 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 (mm-charset-to-coding-system charset))) - (if (and (not mule-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 mule-charset + (setq coding-system (mm-charset-to-coding-system mail-parse-charset))) - (when (and charset mule-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) -;; mm-bodies.el ends here +;;; mm-bodies.el ends here diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index e371976..d7b1c73 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,5 +1,6 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, +;; 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -27,14 +28,28 @@ (require 'mail-parse) (require 'gnus-mailcap) (require 'mm-bodies) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl) + (require 'term)) (eval-and-compile - (autoload 'mm-inline-partial "mm-partial")) + (autoload 'executable-find "executable") + (autoload 'mm-inline-partial "mm-partial") + (autoload 'mm-inline-external-body "mm-extern") + (autoload 'mm-insert-inline "mm-view")) + +(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list) (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) @@ -69,12 +84,72 @@ `(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-from (handle) + `(get-text-property 0 'from (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)) +(defcustom mm-text-html-renderer + (cond ((locate-library "w3") 'w3) + ((locate-library "w3m") 'w3m) + ((executable-find "links") 'links) + ((executable-find "lynx") 'lynx) + (t 'html2text)) + "Render of HTML contents. +It is one of defined renderer types, or a rendering function. +The defined renderer types are: +`w3' : using Emacs/W3; +`w3m' : using emacs-w3m; +`links': using links; +`lynx' : using lynx; +`html2text' : using html2text; +nil : using external viewer." + :type '(choice (const w3) + (const w3m) + (const links) + (const lynx) + (const html2text) + (const nil) + (function)) + :version "21.3" + :group 'mime-display) + +(defvar mm-inline-text-html-renderer nil + "Function used for rendering inline HTML contents. +It is suggested to customize `mm-text-html-renderer' instead.") + +(defcustom mm-inline-text-html-with-images nil + "If non-nil, Gnus will allow retrieving images in the HTML contents +with tags. It has no effect on Emacs/w3. See also +the documentation for the option `mm-w3m-safe-url-regexp'." + :type 'boolean + :group 'mime-display) + +(defcustom mm-w3m-safe-url-regexp "\\`cid:" + "Regexp that matches safe url names. Some HTML mails might have a +trick of spammers using tags. It is likely to be intended to +verify whether you have read the mail. You can prevent your personal +informations from leaking by setting this to the regexp which matches +the safe url names. The value of the variable `w3m-safe-url-regexp' +will be bound with this value. You may set this value to nil if you +consider all the urls to be safe." + :type '(choice (regexp :tag "Regexp") + (const :tag "All URLs are safe" nil)) + :group 'mime-display) + +(defcustom mm-inline-text-html-with-w3m-keymap t + "If non-nil, use emacs-w3m command keys in the article buffer." + :type 'boolean + :group 'mime-display) + (defcustom mm-inline-media-tests '(("image/jpeg" mm-inline-image @@ -104,7 +179,7 @@ mm-inline-image (lambda (handle) (mm-valid-and-fit-image-p 'xpm handle))) - ("image/x-pixmap" + ("image/x-xpixmap" mm-inline-image (lambda (handle) (mm-valid-and-fit-image-p 'xpm handle))) @@ -112,6 +187,10 @@ mm-inline-image (lambda (handle) (mm-valid-and-fit-image-p 'bmp handle))) + ("image/x-portable-bitmap" + mm-inline-image + (lambda (handle) + (mm-valid-and-fit-image-p 'pbm handle))) ("text/plain" mm-inline-text identity) ("text/enriched" mm-inline-text identity) ("text/richtext" mm-inline-text identity) @@ -119,18 +198,21 @@ (lambda (handle) (locate-library "diff-mode"))) ("application/emacs-lisp" mm-display-elisp-inline identity) + ("application/x-emacs-lisp" mm-display-elisp-inline identity) ("text/html" - mm-inline-text + mm-inline-text-html (lambda (handle) - (locate-library "w3"))) + (or mm-inline-text-html-renderer + mm-text-html-renderer))) ("text/x-vcard" - mm-inline-text + mm-inline-text-vcard (lambda (handle) (or (featurep 'vcard) (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) @@ -142,9 +224,18 @@ (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) + ("application/x-pkcs7-mime" ignore identity) + ("application/pkcs7-mime" ignore identity) ("multipart/alternative" ignore identity) ("multipart/mixed" ignore identity) - ("multipart/related" ignore identity)) + ("multipart/related" ignore identity) + ;; Disable audio and image + ("audio/.*" ignore ignore) + ("image/.*" ignore ignore) + ;; Default to displaying as text + (".*" mm-inline-text mm-readable-p)) "Alist of media types/tests saying whether types can be displayed inline." :type '(repeat (list (string :tag "MIME type") (function :tag "Display function") @@ -153,22 +244,42 @@ (defcustom mm-inlined-types '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" - "message/partial" "application/emacs-lisp" - "application/pgp-signature") - "List of media types that are to be displayed inline." + "message/partial" "message/external-body" "application/emacs-lisp" + "application/x-emacs-lisp" + "application/pgp-signature" "application/x-pkcs7-signature" + "application/pkcs7-signature" "application/x-pkcs7-mime" + "application/pkcs7-mime") + "List of media types that are to be displayed inline. +See also `mm-inline-media-tests', which says how to display a media +type inline." :type '(repeat string) :group 'mime-display) - + +(defcustom mm-keep-viewer-alive-types + '("application/postscript" "application/msword" "application/vnd.ms-excel" + "application/pdf" "application/x-dvi") + "List of media types for which the external viewer will not be killed +when selecting a different article." + :type '(repeat string) + :group 'mime-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" - "application/emacs-lisp") + "message/rfc822" "text/x-patch" "application/pgp-signature" + "application/emacs-lisp" "application/x-emacs-lisp" + "application/x-pkcs7-signature" + "application/pkcs7-signature" "application/x-pkcs7-mime" + "application/pkcs7-mime") "A list of MIME types to be displayed automatically." :type '(repeat string) :group 'mime-display) -(defcustom mm-attachment-override-types '("text/x-vcard") +(defcustom mm-attachment-override-types '("text/x-vcard" + "application/pkcs7-mime" + "application/x-pkcs7-mime" + "application/pkcs7-signature" + "application/x-pkcs7-signature") "Types to have \"attachment\" ignored if they can be displayed inline." :type '(repeat string) :group 'mime-display) @@ -196,28 +307,108 @@ to: :type '(repeat string) :group 'mime-display) -(defvar mm-tmp-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/")) - "Where mm will store its temporary files.") +(defcustom mm-tmp-directory + (if (fboundp 'temp-directory) + (temp-directory) + (if (boundp 'temporary-file-directory) + temporary-file-directory + "/tmp/")) + "Where mm will store its temporary files." + :type 'directory + :group 'mime-display) (defcustom mm-inline-large-images nil "If non-nil, then all images fit in the buffer." :type 'boolean :group 'mime-display) +(defvar mm-file-name-rewrite-functions nil + "*List of functions used for rewriting file names of MIME parts. +Each function takes a file name as input and returns a file name. + +Ready-made functions include +`mm-file-name-delete-whitespace', +`mm-file-name-trim-whitespace', +`mm-file-name-collapse-whitespace', +`mm-file-name-replace-whitespace', +`capitalize', `downcase', `upcase', and +`upcase-initials'.") + +(defvar mm-path-name-rewrite-functions nil + "*List of functions for rewriting the full file names of MIME parts. +This is used when viewing parts externally, and is meant for +transforming the absolute name so that non-compliant programs can find +the file where it's saved. + +Each function takes a file name as input and returns a file name.") + +(defvar mm-file-name-replace-whitespace nil + "String used for replacing whitespace characters; default is `\"_\"'.") + +(defcustom mm-default-directory nil + "The default directory where mm will save files. +If not set, `default-directory' will be used." + :type '(choice directory (const :tag "Default" nil)) + :group 'mime-display) + +(defcustom mm-external-terminal-program "xterm" + "The program to start an external terminal." + :type 'string + :group 'mime-display) + ;;; Internal variables. -(defvar mm-dissection-list nil) (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) +(defvar mm-postponed-undisplay-list 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) @@ -225,24 +416,84 @@ to: "Keymap for input viewer with completion.") ;; Should we bind other key to minibuffer-complete-word? -(define-key mm-viewer-completion-map " " 'self-insert-command) +(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-dissect-buffer (&optional no-strict-mime) +(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-keep-viewer-alive-p (handle) + "Say whether external viewer for HANDLE should stay alive." + (let ((types mm-keep-viewer-alive-types) + (type (mm-handle-media-type handle)) + ty) + (catch 'found + (while (setq ty (pop types)) + (when (string-match ty type) + (throw 'found t)))))) + +(defun mm-handle-set-external-undisplayer (handle function) + "Set the undisplayer for this handle; postpone undisplaying of viewers +for types in mm-keep-viewer-alive-types." + (if (mm-keep-viewer-alive-p handle) + (let ((new-handle (copy-sequence handle))) + (mm-handle-set-undisplayer new-handle function) + (mm-handle-set-undisplayer handle nil) + (push new-handle mm-postponed-undisplay-list)) + (mm-handle-set-undisplayer handle function))) + +(defun mm-destroy-postponed-undisplay-list () + (when mm-postponed-undisplay-list + (message "Destroying external MIME viewers") + (mm-destroy-parts mm-postponed-undisplay-list))) + +(defun mm-dissect-buffer (&optional no-strict-mime loose-mime) "Dissect the current buffer and return a list of MIME handles." (save-excursion - (let (ct ctl type subtype cte cd description id result) + (let (ct ctl type subtype cte cd description id result from) (save-restriction (mail-narrow-to-head) (when (or no-strict-mime + loose-mime (mail-fetch-field "mime-version")) (setq ct (mail-fetch-field "content-type") ctl (ignore-errors (mail-header-parse-content-type ct)) cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") - id (mail-fetch-field "content-id")))) + from (mail-fetch-field "from") + id (mail-fetch-field "content-id")) + ;; FIXME: In some circumstances, this code is running within + ;; an unibyte macro. mail-extract-address-components + ;; creates unibyte buffers. This `if', though not a perfect + ;; solution, avoids most of them. + (if from + (setq from (cadr (mail-extract-address-components from)))))) (when cte (setq cte (mail-header-strip cte))) (if (or (not ctl) @@ -265,16 +516,33 @@ to: (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)) + (add-text-properties 0 (length (car ctl)) + (list 'from from) + (car ctl)) (cons (car ctl) (mm-dissect-multipart ctl)))) (t - (mm-dissect-singlepart - ctl - (and cte (intern (downcase (mail-header-remove-whitespace - (mail-header-remove-comments - cte))))) - no-strict-mime - (and cd (ignore-errors (mail-header-parse-content-disposition cd))) - description id)))) + (mm-possibly-verify-or-decrypt + (mm-dissect-singlepart + ctl + (and cte (intern (downcase (mail-header-remove-whitespace + (mail-header-remove-comments + cte))))) + no-strict-mime + (and cd (ignore-errors + (mail-header-parse-content-disposition cd))) + description id) + ctl)))) (when id (when (string-match " *<\\(.*\\)> *" id) (setq id (match-string 1 id))) @@ -286,16 +554,8 @@ to: (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) - res))) - -(defun mm-remove-all-parts () - "Remove all MIME handles." - (interactive) - (mapcar 'mm-remove-part mm-dissection-list) - (setq mm-dissection-list nil)) + (mm-make-handle + (mm-copy-to-buffer) ctl cte nil cdl description nil id))) (defun mm-dissect-multipart (ctl) (goto-char (point-min)) @@ -308,33 +568,39 @@ to: (match-beginning 0) (point-max))))) (setq boundary (concat (regexp-quote boundary) "[ \t]*$")) - (while (re-search-forward boundary end t) + (while (and (< (point) end) (re-search-forward boundary end t)) (goto-char (match-beginning 0)) (when start (save-excursion (save-restriction (narrow-to-region start (point)) (setq parts (nconc (list (mm-dissect-buffer t)) parts))))) - (forward-line 2) + (end-of-line 2) + (or (looking-at boundary) + (forward-line 1)) (setq start (point))) - (when start + (when (and start (< start end)) (save-excursion (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." (save-excursion - (let ((obuf (current-buffer)) - beg) + (let ((flag enable-multibyte-characters) + (new-buffer (generate-new-buffer " *mm*"))) (goto-char (point-min)) (search-forward-regexp "^\n" nil t) - (setq beg (point)) - (set-buffer (generate-new-buffer " *mm*")) - (insert-buffer-substring obuf beg) - (current-buffer)))) + (save-restriction + (narrow-to-region (point) (point-max)) + (when flag + (set-buffer-multibyte nil)) + (copy-to-buffer new-buffer (point-min) (point-max)) + (when flag + (set-buffer-multibyte t))) + new-buffer))) (defun mm-display-parts (handle &optional no-default) (if (stringp (car handle)) @@ -356,7 +622,8 @@ external if displayed external." (mm-remove-part handle) (let* ((type (mm-handle-media-type handle)) (method (mailcap-mime-info type))) - (if (mm-inlined-p handle) + (if (and (mm-inlinable-p handle) + (mm-inlined-p handle)) (progn (forward-line 1) (mm-display-inline handle) @@ -380,13 +647,13 @@ external if displayed external." (let ((cur (current-buffer))) (if (eq method 'mailcap-save-binary-file) (progn - (set-buffer (generate-new-buffer "*mm*")) + (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*"))) + (switch-to-buffer (generate-new-buffer " *mm*"))) (buffer-disable-undo) (mm-set-buffer-file-coding-system mm-binary-coding-system) (insert-buffer-substring cur) @@ -405,9 +672,13 @@ external if displayed external." (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)) + (let* ((dir (mm-make-temp-file + (expand-file-name "emm." mm-tmp-directory) 'dir)) + (filename (or + (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (mail-content-type-get + (mm-handle-type handle) 'name))) (mime-info (mailcap-mime-info (mm-handle-media-type handle) t)) (needsterm (or (assoc "needsterm" mime-info) @@ -415,69 +686,91 @@ external if displayed external." (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)))) + (setq file (expand-file-name + (gnus-map-function mm-file-name-rewrite-functions + (file-name-nondirectory filename)) + dir)) + (setq file (mm-make-temp-file (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) - (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*")) - nil - shell-command-switch - (mm-mailcap-command - 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))))))) - + (cond + (needsterm + (let ((command (mm-mailcap-command + method file (mm-handle-type handle)))) + (unwind-protect + (if window-system + (start-process "*display*" nil + mm-external-terminal-program + "-e" shell-file-name + shell-command-switch command) + (require 'term) + (require 'gnus-win) + (set-buffer + (setq buffer + (make-term "display" + shell-file-name + nil + shell-command-switch command))) + (term-mode) + (term-char-mode) + (set-process-sentinel + (get-buffer-process buffer) + `(lambda (process state) + (if (eq 'exit (process-status process)) + (gnus-configure-windows + ',gnus-current-window-configuration)))) + (gnus-configure-windows 'display-term)) + (mm-handle-set-external-undisplayer handle (cons file buffer))) + (message "Displaying %s..." command)) + '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*")) + nil + shell-command-switch + (mm-mailcap-command + 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 + (let ((command (mm-mailcap-command + method file (mm-handle-type handle)))) + (unwind-protect + (start-process "*display*" + (setq buffer + (generate-new-buffer " *mm*")) + shell-file-name + shell-command-switch command) + (mm-handle-set-external-undisplayer + handle (cons file buffer))) + (message "Displaying %s..." command)) + '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'\\|\"%s\"\\|%s\\|%t\\|%%" + method beg) (push (substring method beg (match-beginning 0)) out) (setq beg (match-end 0) total (match-string 0 method) @@ -485,20 +778,25 @@ external if displayed external." (cond ((string= total "%%") (push "%" out)) - ((string= total "%s") + ((or (string= total "%s") + ;; We do our own quoting. + (string= total "'%s'") + (string= total "\"%s\"")) (setq uses-stdin nil) - (push (mm-quote-arg file) out)) + (push (mm-quote-arg + (gnus-map-function mm-path-name-rewrite-functions 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))) + (when uses-stdin + (push "<" out) + (push (mm-quote-arg + (gnus-map-function mm-path-name-rewrite-functions file)) + out)) (mapconcat 'identity (nreverse out) ""))) - + (defun mm-remove-parts (handles) "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) @@ -508,8 +806,8 @@ external if displayed external." (while (setq handle (pop handles)) (cond ((stringp handle) - ;; Do nothing. - ) + (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))) @@ -525,11 +823,11 @@ external if displayed external." (while (setq handle (pop handles)) (cond ((stringp handle) - ;; Do nothing. - ) + (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))))))) @@ -550,7 +848,7 @@ external if displayed external." ((consp object) (ignore-errors (delete-file (car object))) (ignore-errors (delete-directory (file-name-directory (car object)))) - (ignore-errors (kill-buffer (cdr object)))) + (ignore-errors (and (cdr object) (kill-buffer (cdr object))))) ((bufferp object) (when (buffer-live-p object) (kill-buffer object))))) @@ -567,6 +865,18 @@ external if displayed external." (when (string-match (car elem) type) (return elem)))) +(defun mm-automatic-display-p (handle) + "Say whether the user wants HANDLE to be displayed automatically." + (let ((methods mm-automatic-display) + (type (mm-handle-media-type handle)) + method result) + (while (setq method (pop methods)) + (when (and (not (mm-inline-override-p handle)) + (string-match method type)) + (setq result t + methods nil))) + result)) + (defun mm-inlinable-p (handle) "Say whether HANDLE can be displayed inline." (let ((alist mm-inline-media-tests) @@ -580,28 +890,14 @@ external if displayed external." (pop alist)) test)) -(defun mm-automatic-display-p (handle) - "Say whether the user wants HANDLE to be displayed automatically." - (let ((methods mm-automatic-display) - (type (mm-handle-media-type handle)) - method result) - (while (setq method (pop methods)) - (when (and (not (mm-inline-override-p handle)) - (string-match method type) - (mm-inlinable-p handle)) - (setq result t - methods nil))) - result)) - (defun mm-inlined-p (handle) - "Say whether the user wants HANDLE to be displayed automatically." + "Say whether the user wants HANDLE to be displayed inline." (let ((methods mm-inlined-types) (type (mm-handle-media-type handle)) method result) (while (setq method (pop methods)) (when (and (not (mm-inline-override-p handle)) - (string-match method type) - (mm-inlinable-p handle)) + (string-match method type)) (setq result t methods nil))) result)) @@ -655,7 +951,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 + (buffer-string)))) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) (buffer-string))) (defun mm-insert-part (handle) @@ -664,23 +965,52 @@ 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)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - (let ((temp (current-buffer))) - (set-buffer cur) - (insert-buffer-substring temp))) + (insert-buffer-substring (mm-handle-buffer handle)) + (prog1 + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + (let ((temp (current-buffer))) + (set-buffer cur) + (insert-buffer-substring temp)))) (mm-with-unibyte-buffer (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - (let ((temp (current-buffer))) - (set-buffer cur) - (insert-buffer-substring temp))))))) + (prog1 + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + (let ((temp (current-buffer))) + (set-buffer cur) + (insert-buffer-substring temp)))))))) + +(defun mm-file-name-delete-whitespace (file-name) + "Remove all whitespace characters from FILE-NAME." + (while (string-match "\\s-+" file-name) + (setq file-name (replace-match "" t t file-name))) + file-name) + +(defun mm-file-name-trim-whitespace (file-name) + "Remove leading and trailing whitespace characters from FILE-NAME." + (when (string-match "\\`\\s-+" file-name) + (setq file-name (substring file-name (match-end 0)))) + (when (string-match "\\s-+\\'" file-name) + (setq file-name (substring file-name 0 (match-beginning 0)))) + file-name) -(defvar mm-default-directory nil) +(defun mm-file-name-collapse-whitespace (file-name) + "Collapse multiple whitespace characters in FILE-NAME." + (while (string-match "\\s-\\s-+" file-name) + (setq file-name (replace-match " " t t file-name))) + file-name) + +(defun mm-file-name-replace-whitespace (file-name) + "Replace whitespace characters in FILE-NAME with underscores. +Set `mm-file-name-replace-whitespace' to any other string if you do not +like underscores." + (let ((s (or mm-file-name-replace-whitespace "_"))) + (while (string-match "\\s-" file-name) + (setq file-name (replace-match s t t file-name)))) + file-name) (defun mm-save-part (handle) "Write HANDLE to a file." @@ -689,17 +1019,19 @@ external if displayed external." (mm-handle-disposition handle) 'filename)) file) (when filename - (setq filename (file-name-nondirectory filename))) + (setq filename (gnus-map-function mm-file-name-rewrite-functions + (file-name-nondirectory filename)))) (setq file (read-file-name "Save MIME part to: " - (expand-file-name - (or filename name "") - (or mm-default-directory default-directory)))) + (or mm-default-directory default-directory) + nil nil (or filename name ""))) (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 @@ -720,7 +1052,8 @@ external if displayed external." (read-string "Shell command on MIME part: " mm-last-shell-command))) (mm-with-unibyte-buffer (mm-insert-part handle) - (shell-command-on-region (point-min) (point-max) command nil)))) + (let ((coding-system-for-write 'binary)) + (shell-command-on-region (point-min) (point-max) command nil))))) (defun mm-interactively-view-part (handle) "Display HANDLE using METHOD." @@ -733,9 +1066,9 @@ external if displayed external." (completing-read "Viewer: " methods)))) (when (string= method "") (error "No method given")) - (if (string-match "^[^% \t]+$" method) + (if (string-match "^[^% \t]+$" method) (setq method (concat method " %s"))) - (mm-display-external (copy-sequence handle) method))) + (mm-display-external handle method))) (defun mm-preferred-alternative (handles &optional preferred) "Say which of HANDLES are preferred." @@ -773,6 +1106,35 @@ external if displayed external." "Return the handle(s) referred to by ID." (cdr (assoc id mm-content-id-alist))) +(defconst mm-image-type-regexps + '(("/\\*.*XPM.\\*/" . xpm) + ("P[1-6]" . pbm) + ("GIF8" . gif) + ("\377\330" . jpeg) + ("\211PNG\r\n" . png) + ("#define" . xbm) + ("\\(MM\0\\*\\)\\|\\(II\\*\0\\)" . tiff) + ("%!PS" . postscript)) + "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types. +When the first bytes of an image file match REGEXP, it is assumed to +be of image type IMAGE-TYPE.") + +;; Steal from image.el. image-type-from-data suffers multi-line matching bug. +(defun mm-image-type-from-buffer () + "Determine the image type from data in the current buffer. +Value is a symbol specifying the image type or nil if type cannot +be determined." + (let ((types mm-image-type-regexps) + type) + (goto-char (point-min)) + (while (and types (null type)) + (let ((regexp (car (car types))) + (image-type (cdr (car types)))) + (when (looking-at regexp) + (setq type image-type)) + (setq types (cdr types)))) + type)) + (defun mm-get-image (handle) "Return an image instance based on HANDLE." (let ((type (mm-handle-media-subtype handle)) @@ -784,6 +1146,8 @@ external if displayed external." "xpm") ((equal type "x-xbitmap") "xbm") + ((equal type "x-portable-bitmap") + "pbm") (t type))) (or (mm-handle-cache handle) (mm-with-unibyte-buffer @@ -791,31 +1155,40 @@ external if displayed external." (prog1 (setq spec (ignore-errors - ;; Avoid testing `make-glyph' since W3 may define - ;; a bogus version of it. + ;; 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)))))))) + (create-image (buffer-string) + (or (mm-image-type-from-buffer) + (intern type)) + 'data-p) + (mm-create-image-xemacs type)))) (mm-handle-set-cache handle spec)))))) +(defun mm-create-image-xemacs (type) + (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 (mm-make-temp-file + (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 + (or (mm-image-type-from-buffer) + (intern type)) + :data (buffer-string)))))) + (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) @@ -851,6 +1224,182 @@ external if displayed external." (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-string)))))) + (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-string)))))) + result)) + +(defvar mm-security-handle nil) + +(defsubst mm-set-handle-multipart-parameter (handle parameter value) + ;; HANDLE could be a CTL. + (when handle + (put-text-property 0 (length (car handle)) parameter value + (car handle)))) + +(defun mm-possibly-verify-or-decrypt (parts ctl) + (let ((type (car ctl)) + (subtype (cadr (split-string (car ctl) "/"))) + (mm-security-handle ctl) ;; (car CTL) is the type. + protocol func functest) + (cond + ((or (equal type "application/x-pkcs7-mime") + (equal type "application/pkcs7-mime")) + (with-temp-buffer + (when (and (cond + ((eq mm-decrypt-option 'never) nil) + ((eq mm-decrypt-option 'always) t) + ((eq mm-decrypt-option 'known) t) + (t (y-or-n-p + (format "Decrypt (S/MIME) part? ")))) + (mm-view-pkcs7 parts)) + (setq parts (mm-dissect-buffer t))))) + ((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))) + (when (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))) + (when (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)) + +(defun mm-multiple-handles (handles) + (and (listp (car handles)) + (> (length handles) 1))) + +(defun mm-merge-handles (handles1 handles2) + (append + (if (listp (car handles1)) + handles1 + (list handles1)) + (if (listp (car handles2)) + handles2 + (list handles2)))) + +(defun mm-readable-p (handle) + "Say whether the content of HANDLE is readable." + (and (< (with-current-buffer (mm-handle-buffer handle) + (buffer-size)) 10000) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (and (eq (mm-body-7-or-8) '7bit) + (not (mm-long-lines-p 76)))))) + (provide 'mm-decode) ;;; mm-decode.el ends here diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 3baec82..770d106 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -1,5 +1,6 @@ -;;; mm-encode.el --- Functions for encoding MIME things -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;;; mm-encode.el --- Functions for encoding MIME things +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -30,16 +31,25 @@ (eval-and-compile (autoload 'mm-body-7-or-8 "mm-bodies")) -(defvar mm-content-transfer-encoding-defaults +(defcustom mm-content-transfer-encoding-defaults '(("text/x-patch" 8bit) ("text/.*" qp-or-base64) ("message/rfc822" 8bit) ("application/emacs-lisp" 8bit) + ("application/x-emacs-lisp" 8bit) ("application/x-patch" 8bit) - (".*" qp-or-base64)) + (".*" base64)) "Alist of regexps that match MIME types and their encodings. If the encoding is `qp-or-base64', then either quoted-printable -or base64 will be used, depending on what is more efficient.") +or base64 will be used, depending on what is more efficient." + :type '(repeat (list (regexp :tag "MIME type") + (choice :tag "encoding" + (const 7bit) + (const 8bit) + (const qp-or-base64) + (const quoted-printable) + (const base64)))) + :group 'mime) (defvar mm-use-ultra-safe-encoding nil "If non-nil, use encodings aimed at Procrustean bed survival. @@ -78,14 +88,15 @@ This variable should never be set directly, but bound before a call to "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 + ;; The remaining 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) - (quoted-printable-encode-region (point-min) (point-max) t)) + (mm-with-unibyte-current-buffer-mule4 + (quoted-printable-encode-region (point-min) (point-max) t))) ((eq encoding 'base64) (when (equal type "text/plain") (goto-char (point-min)) @@ -105,7 +116,7 @@ This variable should never be set directly, but bound before a call to ((functionp encoding) (ignore-errors (funcall encoding (point-min) (point-max)))) (t - (message "Unknown encoding %s; defaulting to 8bit" encoding)))) + (message "Unknown encoding %s; treating it as 8bit" encoding)))) (defun mm-encode-buffer (type) "Encode the buffer which contains data of TYPE. @@ -118,7 +129,8 @@ The encoding used is returned." (bits (mm-body-7-or-8))) ;; We force buffers that are 7bit to be unencoded, no matter ;; what the preferred encoding is. - (when (eq bits '7bit) + ;; Only if the buffers don't contain lone lines. + (when (and (eq bits '7bit) (not (mm-long-lines-p 76))) (setq encoding bits)) (mm-encode-content-transfer-encoding encoding mime-type) encoding)) @@ -143,7 +155,7 @@ The encoding used is returned." (while rules (when (string-match (caar rules) type) (throw 'found - (let ((encoding + (let ((encoding (if (eq (cadr (car rules)) 'qp-or-base64) (mm-qp-or-base64) (cadr (car rules))))) @@ -153,18 +165,24 @@ The encoding used is returned." (pop rules))))) (defun mm-qp-or-base64 () - (save-excursion - (let ((limit (min (point-max) (+ 2000 (point-min)))) - (n8bit 0)) - (goto-char (point-min)) - (skip-chars-forward "\x20-\x7f\r\n\t" limit) - (while (< (point) limit) - (incf n8bit) - (forward-char 1) - (skip-chars-forward "\x20-\x7f\r\n\t" limit)) - (if (< (* 6 n8bit) (- limit (point-min))) - 'quoted-printable - 'base64)))) + (if (equal mm-use-ultra-safe-encoding '(sign . "pgp")) + ;; perhaps not always accurate? + 'quoted-printable + (save-excursion + (let ((limit (min (point-max) (+ 2000 (point-min)))) + (n8bit 0)) + (goto-char (point-min)) + (skip-chars-forward "\x20-\x7f\r\n\t" limit) + (while (< (point) limit) + (incf n8bit) + (forward-char 1) + (skip-chars-forward "\x20-\x7f\r\n\t" limit)) + (if (or (< (* 6 n8bit) (- limit (point-min))) + ;; Don't base64, say, a short line with a single + ;; non-ASCII char when splitting parts by charset. + (= n8bit 1)) + 'quoted-printable + 'base64))))) (provide 'mm-encode) diff --git a/lisp/mm-partial.el b/lisp/mm-partial.el index 38986c4..7a4cd0b 100644 --- a/lisp/mm-partial.el +++ b/lisp/mm-partial.el @@ -1,5 +1,5 @@ ;;; mm-partial.el --- showing message/partial -;; Copyright (C) 2000 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: message partial @@ -25,8 +25,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl)) (require 'gnus-sum) (require 'mm-util) @@ -40,13 +39,14 @@ (while (setq header (pop headers)) (unless (eq (aref header 0) art) (mm-with-unibyte-buffer - (gnus-request-article-this-buffer (aref header 0) + (gnus-request-article-this-buffer (aref header 0) gnus-newsgroup-name) (when (search-forward id nil t) - (let ((nhandles (mm-dissect-buffer)) nid) + (let ((nhandles (mm-dissect-buffer + nil gnus-article-loose-mime)) nid) (if (consp (car nhandles)) (mm-destroy-parts nhandles) - (setq nid (cdr (assq 'id + (setq nid (cdr (assq 'id (cdr (mm-handle-type nhandles))))) (if (not (equal id nid)) (mm-destroy-parts nhandles) @@ -56,50 +56,47 @@ ;;;###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 +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))))) + (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.")) + (error "Can not find message/partial id")) (setq phandles - (sort (cons handle + (sort (cons handle (mm-partial-find-parts - id + id (save-excursion (set-buffer gnus-summary-buffer) (gnus-summary-article-number)))) #'(lambda (a b) - (let ((anumber (string-to-number - (cdr (assq 'number + (let ((anumber (string-to-number + (cdr (assq 'number (cdr (mm-handle-type a)))))) - (bnumber (string-to-number - (cdr (assq 'number + (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)) + (mm-merge-handles 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 + (setq nn (string-to-number + (cdr (assq 'number (cdr (mm-handle-type phandle)))))) - (setq ntotal (string-to-number - (cdr (assq 'total + (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.")) + (unless (eq total ntotal) + (error "The numbers of total are different")) (setq total ntotal))) (unless (< nn n) (unless (eq nn n) @@ -118,7 +115,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (error "Missing part %d" n)) (kill-buffer (mm-handle-buffer handle)) (goto-char (point-min)) - (let ((point (if (search-forward "\n\n" nil t) + (let ((point (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) (goto-char (point-min)) @@ -138,11 +135,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (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-merge-handles gnus-article-mime-handles handles))) (mm-handle-set-undisplayer handle `(lambda () @@ -150,10 +143,12 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (condition-case nil ;; This is only valid on XEmacs. (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) + (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 +(provide 'mm-partial) + +;;; mm-partial.el ends here diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 8a0264b..08d9284 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,6 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -30,51 +31,6 @@ (require 'mail-prsvr) -(defvar mm-mime-mule-charset-alist - '((us-ascii ascii) - (iso-8859-1 latin-iso8859-1) - (iso-8859-2 latin-iso8859-2) - (iso-8859-3 latin-iso8859-3) - (iso-8859-4 latin-iso8859-4) - (iso-8859-5 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) - (iso-8859-9 latin-iso8859-9) - (viscii vietnamese-viscii-lower) - (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) - (euc-kr korean-ksc5601) - (cn-gb-2312 chinese-gb2312) - (cn-big5 chinese-big5-1 chinese-big5-2) - (tibetan tibetan) - (thai-tis620 thai-tis620) - (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) - (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - katakana-jisx0201) - (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2) - (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2 - cyrillic-iso8859-5 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2 - chinese-cns11643-3 chinese-cns11643-4 - chinese-cns11643-5 chinese-cns11643-6 - 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) @@ -88,19 +44,12 @@ (coding-system-list . ignore) (decode-coding-region . ignore) (char-int . identity) - (device-type . ignore) (coding-system-equal . equal) (annotationp . ignore) (set-buffer-file-coding-system . ignore) (make-char . (lambda (charset int) (int-to-char int))) - (read-coding-system - . (lambda (prompt) - "Prompt the user for a coding system." - (completing-read - prompt (mapcar (lambda (s) (list (symbol-name (car s)))) - mm-mime-mule-charset-alist)))) (read-charset . (lambda (prompt) "Return a charset." @@ -113,7 +62,7 @@ (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. + (let ((string (substring string 0)) ;Copy string. (len (length string)) (idx 0)) ;; Replace all occurrences of FROM with TO. @@ -122,15 +71,35 @@ (aset string idx to)) (setq idx (1+ idx))) string))) - ))) + (string-as-unibyte . identity) + (string-make-unibyte . identity) + (string-as-multibyte . identity) + (multibyte-string-p . ignore) + (insert-byte . insert-char) + (multibyte-char-to-unibyte . identity)))) (eval-and-compile (defalias 'mm-char-or-char-int-p - (cond + (cond ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) - ((fboundp 'char-valid-p) 'char-valid-p) + ((fboundp 'char-valid-p) 'char-valid-p) (t 'identity)))) +(eval-and-compile + (defalias 'mm-read-coding-system + (cond + ((fboundp 'read-coding-system) + (if (and (featurep 'xemacs) + (<= (string-to-number emacs-version) 21.1)) + (lambda (prompt &optional default-coding-system) + (read-coding-system prompt)) + 'read-coding-system)) + (t (lambda (prompt &optional default-coding-system) + "Prompt the user for a coding system." + (completing-read + prompt (mapcar (lambda (s) (list (symbol-name (car s)))) + mm-mime-mule-charset-alist))))))) + (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () "Get the coding system list." @@ -143,18 +112,36 @@ (memq sym (mm-get-coding-system-list)))) (defvar mm-charset-synonym-alist - `((big5 . cn-big5) - (gb2312 . cn-gb-2312) - (cn-gb . cn-gb-2312) + `( + ;; Perfectly fine? A valid MIME name, anyhow. + ,@(unless (mm-coding-system-p 'big5) + '((big5 . cn-big5))) + ;; Not in XEmacs, but it's not a proper MIME charset anyhow. + ,@(unless (mm-coding-system-p 'x-ctext) + '((x-ctext . ctext))) + ;; Apparently not defined in Emacs 20, but is a valid MIME name. + ,@(unless (mm-coding-system-p 'gb2312) + '((gb2312 . cn-gb-2312))) + ;; ISO-8859-15 is very similar to ISO-8859-1. + ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it. + '((iso-8859-15 . iso-8859-1))) ;; 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)) + ,@(unless (mm-coding-system-p 'windows-1252) + (if (mm-coding-system-p 'cp1252) + '((windows-1252 . cp1252)) + '((windows-1252 . iso-8859-1)))) + ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft + ;; Outlook users in Czech republic. Use this to allow reading of their + ;; e-mails. cp1250 should be defined by M-x codepage-setup. + ,@(if (and (not (mm-coding-system-p 'windows-1250)) + (mm-coding-system-p 'cp1250)) + '((windows-1250 . cp1250))) + ) "A mapping from invalid charset names to the real charset names.") (defvar mm-binary-coding-system - (cond + (cond ((mm-coding-system-p 'binary) 'binary) ((mm-coding-system-p 'no-conversion) 'no-conversion) (t nil)) @@ -171,30 +158,178 @@ "Text coding system for write.") (defvar mm-auto-save-coding-system - (cond + (cond + ((mm-coding-system-p 'utf-8-emacs) ; Mule 7 + (if (memq system-type '(windows-nt ms-dos ms-windows)) + (if (mm-coding-system-p 'utf-8-emacs-dos) + 'utf-8-emacs-dos mm-binary-coding-system) + 'utf-8-emacs)) ((mm-coding-system-p 'emacs-mule) (if (memq system-type '(windows-nt ms-dos ms-windows)) - (if (mm-coding-system-p 'emacs-mule-dos) + (if (mm-coding-system-p 'emacs-mule-dos) 'emacs-mule-dos mm-binary-coding-system) 'emacs-mule)) ((mm-coding-system-p 'escape-quoted) 'escape-quoted) (t mm-binary-coding-system)) "Coding system of auto save file.") +(defvar mm-universal-coding-system mm-auto-save-coding-system + "The universal coding system.") + +;; Fixme: some of the cars here aren't valid MIME charsets. That +;; should only matter with XEmacs, though. +(defvar mm-mime-mule-charset-alist + `((us-ascii ascii) + (iso-8859-1 latin-iso8859-1) + (iso-8859-2 latin-iso8859-2) + (iso-8859-3 latin-iso8859-3) + (iso-8859-4 latin-iso8859-4) + (iso-8859-5 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) + (iso-8859-9 latin-iso8859-9) + (iso-8859-14 latin-iso8859-14) + (iso-8859-15 latin-iso8859-15) + (viscii vietnamese-viscii-lower) + (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) + (euc-kr korean-ksc5601) + (gb2312 chinese-gb2312) + (big5 chinese-big5-1 chinese-big5-2) + (tibetan tibetan) + (thai-tis620 thai-tis620) + (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) + (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212 + katakana-jisx0201) + (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212 + chinese-cns11643-1 chinese-cns11643-2) + (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2 + cyrillic-iso8859-5 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212 + chinese-cns11643-1 chinese-cns11643-2 + chinese-cns11643-3 chinese-cns11643-4 + chinese-cns11643-5 chinese-cns11643-6 + chinese-cns11643-7) + ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case + (charsetp 'unicode-a) + (not (mm-coding-system-p 'mule-utf-8))) + '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e) + ;; If we have utf-8 we're in Mule 5+. + (append '(utf-8) + (delete 'ascii + (coding-system-get 'mule-utf-8 'safe-charsets))))) + "Alist of MIME-charset/MULE-charsets.") + +;; Correct by construction, but should be unnecessary: +;; XEmacs hates it. +(when (and (not (featurep 'xemacs)) + (fboundp 'coding-system-list) + (fboundp 'sort-coding-systems)) + (setq mm-mime-mule-charset-alist + (apply + 'nconc + (mapcar + (lambda (cs) + (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22 + (coding-system-get cs 'mime-charset)) + (not (eq t (coding-system-get cs 'safe-charsets)))) + (list (cons (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset)) + (delq 'ascii + (coding-system-get cs 'safe-charsets)))))) + (sort-coding-systems (coding-system-list 'base-only)))))) + +(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) + "A list of special charsets. +Valid elements include: +`iso-8859-15' convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists. +`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists." +) + +(defvar mm-iso-8859-15-compatible + '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE") + (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE")) + "ISO-8859-15 exchangeable coding systems and inconvertible characters.") + +(defvar mm-iso-8859-x-to-15-table + (and (fboundp 'coding-system-p) + (mm-coding-system-p 'iso-8859-15) + (mapcar + (lambda (cs) + (if (mm-coding-system-p (car cs)) + (let ((c (string-to-char + (decode-coding-string "\341" (car cs))))) + (cons (char-charset c) + (cons + (- (string-to-char + (decode-coding-string "\341" 'iso-8859-15)) c) + (string-to-list (decode-coding-string (car (cdr cs)) + (car cs)))))) + '(gnus-charset 0))) + mm-iso-8859-15-compatible)) + "A table of the difference character between ISO-8859-X and ISO-8859-15.") + +(defcustom mm-coding-system-priorities + (if (boundp 'current-language-environment) + (let ((lang (symbol-value 'current-language-environment))) + (cond ((string= lang "Japanese") + ;; Japanese users may prefer iso-2022-jp to shift-jis. + '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis + iso-latin-1 utf-8))))) + "Preferred coding systems for encoding outgoing mails. + +More than one suitable coding system may be found for some text. By +default, the coding system with the highest priority is used to encode +outgoing mails (see `sort-coding-systems'). If this variable is set, +it overrides the default priority." + :type '(repeat (symbol :tag "Coding system")) + :group 'mime) + +;; ?? +(defvar mm-use-find-coding-systems-region + (fboundp 'find-coding-systems-region) + "Use `find-coding-systems-region' to find proper coding systems. + +Setting it to nil is useful on Emacsen supporting Unicode if sending +mail with multiple parts is preferred to sending a Unicode one.") + ;;; Internal variables: ;;; Functions: (defun mm-mule-charset-to-mime-charset (charset) "Return the MIME charset corresponding to the given Mule CHARSET." - (let ((alist mm-mime-mule-charset-alist) - out) - (while alist - (when (memq charset (cdar alist)) - (setq out (caar alist) - alist nil)) - (pop alist)) - out)) + (if (and (fboundp 'find-coding-systems-for-charsets) + (fboundp 'sort-coding-systems)) + (let (mime) + (dolist (cs (sort-coding-systems + (copy-sequence + (find-coding-systems-for-charsets (list charset))))) + (unless mime + (when cs + (setq mime (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset)))))) + mime) + (let ((alist mm-mime-mule-charset-alist) + out) + (while alist + (when (memq charset (cdar alist)) + (setq out (caar alist) + alist nil)) + (pop alist)) + out))) (defun mm-charset-to-coding-system (charset &optional lbt) "Return coding-system corresponding to CHARSET. @@ -203,71 +338,111 @@ If optional argument LBT (`unix', `dos' or `mac') is specified, it is used as the line break code type of the coding system." (when (stringp charset) (setq charset (intern (downcase charset)))) - (setq charset - (or (cdr (assq charset mm-charset-synonym-alist)) - charset)) (when lbt (setq charset (intern (format "%s-%s" charset lbt)))) (cond + ((null charset) + charset) ;; Running in a non-MULE environment. - ((null (mm-get-coding-system-list)) + ((or (null (mm-get-coding-system-list)) + (not (fboundp 'coding-system-get))) charset) ;; ascii ((eq charset 'us-ascii) 'ascii) ;; 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)) + ;; property defined, as there should be.) + ((and (mm-coding-system-p charset) +;;; Doing this would potentially weed out incorrect charsets. +;;; charset +;;; (eq charset (coding-system-get charset 'mime-charset)) + ) charset) - ;; Nope. - (t - nil))) + ;; Translate invalid charsets. + ((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) + (and cs (mm-coding-system-p cs) cs))) + ;; Last resort: search the coding system list for entries which + ;; have the right mime-charset in case the canonical name isn't + ;; defined (though it should be). + ((let (cs) + ;; mm-get-coding-system-list returns a list of cs without lbt. + ;; Do we need -lbt? + (dolist (c (mm-get-coding-system-list)) + (if (and (null cs) + (eq charset (or (coding-system-get c :mime-charset) + (coding-system-get c 'mime-charset)))) + (setq cs c))) + cs)))) (defsubst mm-replace-chars-in-string (string from to) (mm-subst-char-in-string from to string)) -(defsubst mm-enable-multibyte () - "Set the multibyte flag of the current buffer. +(eval-and-compile + (defvar mm-emacs-mule (and (not (featurep 'xemacs)) + (boundp 'default-enable-multibyte-characters) + default-enable-multibyte-characters + (fboundp 'set-buffer-multibyte)) + "Emacs mule.") + + (defvar mm-mule4-p (and mm-emacs-mule + (fboundp 'charsetp) + (not (charsetp 'eight-bit-control))) + "Mule version 4.") + + (if mm-emacs-mule + (defun mm-enable-multibyte () + "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 (not (featurep 'xemacs)) - (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters - (fboundp 'set-buffer-multibyte)) - (set-buffer-multibyte t))) - -(defsubst mm-disable-multibyte () - "Unset the multibyte flag of in the current buffer. + (set-buffer-multibyte t)) + (defalias 'mm-enable-multibyte 'ignore)) + + (if mm-emacs-mule + (defun mm-disable-multibyte () + "Unset the multibyte flag of in the current buffer. This is a no-op in XEmacs." - (when (and (not (featurep 'xemacs)) - (fboundp 'set-buffer-multibyte)) - (set-buffer-multibyte nil))) + (set-buffer-multibyte nil)) + (defalias 'mm-disable-multibyte 'ignore)) -(defsubst mm-enable-multibyte-mule4 () - "Enable multibyte in the current buffer. + (if mm-mule4-p + (defun mm-enable-multibyte-mule4 () + "Enable multibyte in the current buffer. Only used in Emacs Mule 4." - (when (and (not (featurep 'xemacs)) - (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters - (fboundp 'set-buffer-multibyte) - (fboundp 'charsetp) - (not (charsetp 'eight-bit-control))) - (set-buffer-multibyte t))) - -(defsubst mm-disable-multibyte-mule4 () - "Disable multibyte in the current buffer. + (set-buffer-multibyte t)) + (defalias 'mm-enable-multibyte-mule4 'ignore)) + + (if mm-mule4-p + (defun mm-disable-multibyte-mule4 () + "Disable multibyte in the current buffer. Only used in Emacs Mule 4." - (when (and (not (featurep 'xemacs)) - (fboundp 'set-buffer-multibyte) - (fboundp 'charsetp) - (not (charsetp 'eight-bit-control))) - (set-buffer-multibyte nil))) + (set-buffer-multibyte nil)) + (defalias 'mm-disable-multibyte-mule4 'ignore))) (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))) + (or (get-charset-property charset 'preferred-coding-system) + (get-charset-property charset 'prefered-coding-system))) + +(defsubst mm-guess-charset () + "Guess Mule charset from the language environment." + (or + mail-parse-mule-charset ;; cached mule-charset + (progn + (setq mail-parse-mule-charset + (and (boundp 'current-language-environment) + (car (last + (assq 'charset + (assoc current-language-environment + language-info-alist)))))) + (if (or (not mail-parse-mule-charset) + (eq mail-parse-mule-charset 'ascii)) + (setq mail-parse-mule-charset + (or (car (last (assq mail-parse-charset + mm-mime-mule-charset-alist))) + ;; default + 'latin-iso8859-1))) + mail-parse-mule-charset))) (defun mm-charset-after (&optional pos) "Return charset of a character in current buffer at position POS. @@ -285,33 +460,20 @@ If the charset is `composition', return the actual one." (if (and charset (not (memq charset '(ascii eight-bit-control eight-bit-graphic)))) charset - (or - mail-parse-mule-charset ;; cached mule-charset - (progn - (setq mail-parse-mule-charset - (and (boundp 'current-language-environment) - (car (last - (assq 'charset - (assoc current-language-environment - language-info-alist)))))) - (if (or (not mail-parse-mule-charset) - (eq mail-parse-mule-charset 'ascii)) - (setq mail-parse-mule-charset - (or (car (last (assq mail-parse-charset - mm-mime-mule-charset-alist))) - 'latin-iso8859-1))) - mail-parse-mule-charset))))))) + (mm-guess-charset)))))) (defun mm-mime-charset (charset) - "Return the MIME charset corresponding to the MULE CHARSET." + "Return the MIME charset corresponding to the given Mule CHARSET." (if (eq charset 'unknown) - (error "8-bit characters are found in the message, please specify charset.")) + (error "The message contains non-printable characters, please use attachment")) (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property)) ;; This exists in Emacs 20. (or (and (mm-preferred-coding-system charset) - (coding-system-get - (mm-preferred-coding-system charset) 'mime-charset)) + (or (coding-system-get + (mm-preferred-coding-system charset) :mime-charset) + (coding-system-get + (mm-preferred-coding-system charset) 'mime-charset))) (and (eq charset 'ascii) 'us-ascii) (mm-preferred-coding-system charset) @@ -320,7 +482,7 @@ If the charset is `composition', return the actual one." (mm-mule-charset-to-mime-charset charset))) (defun mm-delete-duplicates (list) - "Simple substitute for CL `delete-duplicates', testing with `equal'." + "Simple substitute for CL `delete-duplicates', testing with `equal'." (let (result head) (while list (setq head (car list)) @@ -328,26 +490,95 @@ If the charset is `composition', return the actual one." (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))))) - (when (memq 'iso-2022-jp-2 charsets) - (setq charsets (delq 'iso-2022-jp charsets))) - (setq charsets (mm-delete-duplicates charsets)) +(if (and (not (featurep 'xemacs)) + (boundp 'enable-multibyte-characters)) + (defalias 'mm-multibyte-p + (lambda () + "Say whether multibyte is enabled in the current buffer." + enable-multibyte-characters)) + (defalias 'mm-multibyte-p (lambda () (featurep 'mule)))) + +(defun mm-iso-8859-x-to-15-region (&optional b e) + (if (fboundp 'char-charset) + (let (charset item c inconvertible) + (save-restriction + (if e (narrow-to-region b e)) + (goto-char (point-min)) + (skip-chars-forward "\0-\177") + (while (not (eobp)) + (cond + ((not (setq item (assq (char-charset (setq c (char-after))) + mm-iso-8859-x-to-15-table))) + (forward-char)) + ((memq c (cdr (cdr item))) + (setq inconvertible t) + (forward-char)) + (t + (insert-before-markers (prog1 (+ c (car (cdr item))) + (delete-char 1))))) + (skip-chars-forward "\0-\177"))) + (not inconvertible)))) + +(defun mm-sort-coding-systems-predicate (a b) + (let ((priorities + (mapcar (lambda (cs) + ;; Note: invalid entries are dropped silently + (and (coding-system-p cs) + (coding-system-base cs))) + mm-coding-system-priorities))) + (> (length (memq a priorities)) + (length (memq b priorities))))) + +(defun mm-find-mime-charset-region (b e &optional hack-charsets) + "Return the MIME charsets needed to encode the region between B and E. +nil means ASCII, a single-element list represents an appropriate MIME +charset, and a longer list means no appropriate charset." + (let (charsets) + ;; The return possibilities of this function are a mess... + (or (and (mm-multibyte-p) + mm-use-find-coding-systems-region + ;; Find the mime-charset of the most preferred coding + ;; system that has one. + (let ((systems (find-coding-systems-region b e))) + (when mm-coding-system-priorities + (setq systems + (sort systems 'mm-sort-coding-systems-predicate))) + (setq systems (delq 'compound-text systems)) + (unless (equal systems '(undecided)) + (while systems + (let* ((head (pop systems)) + (cs (or (coding-system-get head :mime-charset) + (coding-system-get head 'mime-charset)))) + ;; The mime-charset (`x-ctext') of + ;; `compound-text' is not in the IANA list. We + ;; shouldn't normally use anything here with a + ;; mime-charset having an `x-' prefix. + ;; Fixme: allow this to be overridden, since + ;; there is existing use of x-ctext. + ;; Also people apparently need the coding system + ;; `iso-2022-jp-3', which Mule-UCS defines. + (if (and cs + (not (string-match "^[Xx]-" (symbol-name cs)))) + (setq systems nil + charsets (list cs)))))) + charsets)) + ;; Otherwise we're not multibyte, we're XEmacs or a single + ;; coding system won't cover it. + (setq charsets + (mm-delete-duplicates + (mapcar 'mm-mime-charset + (delq 'ascii + (mm-find-charset-region b e)))))) (if (and (> (length charsets) 1) - (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." - (if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - enable-multibyte-characters - (featurep 'mule))) + (memq 'iso-8859-15 charsets) + (memq 'iso-8859-15 hack-charsets) + (save-excursion (mm-iso-8859-x-to-15-region b e))) + (mapcar (lambda (x) (setq charsets (delq (car x) charsets))) + mm-iso-8859-15-compatible)) + (if (and (memq 'iso-2022-jp-2 charsets) + (memq 'iso-2022-jp-2 hack-charsets)) + (setq charsets (delq 'iso-2022-jp charsets))) + charsets)) (defmacro mm-with-unibyte-buffer (&rest forms) "Create a temporary buffer, and evaluate FORMS there like `progn'. @@ -358,21 +589,20 @@ Use unibyte mode for this." (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. + "Evaluate FORMS with current buffer temporarily made unibyte. Also bind `default-enable-multibyte-characters' to nil. Equivalent to `progn' in XEmacs" - (let ((buffer (make-symbol "buffer"))) - `(if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters) - enable-multibyte-characters - (fboundp 'set-buffer-multibyte)) - (let ((,buffer (current-buffer))) + (let ((multibyte (make-symbol "multibyte")) + (buffer (make-symbol "buffer"))) + `(if mm-emacs-mule + (let ((,multibyte enable-multibyte-characters) + (,buffer (current-buffer))) (unwind-protect (let (default-enable-multibyte-characters) (set-buffer-multibyte nil) ,@forms) (set-buffer ,buffer) - (set-buffer-multibyte t))) + (set-buffer-multibyte ,multibyte))) (let (default-enable-multibyte-characters) ,@forms)))) (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) @@ -381,20 +611,17 @@ Equivalent to `progn' in XEmacs" (defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms) "Evaluate FORMS there like `progn' in current buffer. Mule4 only." - (let ((buffer (make-symbol "buffer"))) - `(if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters) - enable-multibyte-characters - (fboundp 'set-buffer-multibyte) - (fboundp 'charsetp) - (not (charsetp 'eight-bit-control))) ;; For Emacs Mule 4 only. - (let ((,buffer (current-buffer))) - (unwind-protect - (let (default-enable-multibyte-characters) - (set-buffer-multibyte nil) - ,@forms) - (set-buffer ,buffer) - (set-buffer-multibyte t))) + (let ((multibyte (make-symbol "multibyte")) + (buffer (make-symbol "buffer"))) + `(if mm-mule4-p + (let ((,multibyte enable-multibyte-characters) + (,buffer (current-buffer))) + (unwind-protect + (let (default-enable-multibyte-characters) + (set-buffer-multibyte nil) + ,@forms) + (set-buffer ,buffer) + (set-buffer-multibyte ,multibyte))) (let (default-enable-multibyte-characters) ,@forms)))) (put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0) @@ -411,12 +638,13 @@ Mule4 only." "Return a list of Emacs charsets in the region B to E." (cond ((and (mm-multibyte-p) - (fboundp 'find-charset-region)) + (fboundp 'find-charset-region)) ;; 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)) + '(composition eight-bit-control eight-bit-graphic + control-1)) css)) (t ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. @@ -430,8 +658,8 @@ Mule4 only." (let (charset) (setq charset (and (boundp 'current-language-environment) - (car (last (assq 'charset - (assoc current-language-environment + (car (last (assq 'charset + (assoc current-language-environment language-info-alist)))))) (if (eq charset 'ascii) (setq charset nil)) (or charset @@ -466,7 +694,7 @@ Mule4 only." (nreverse out))) (defvar mm-inhibit-file-name-handlers - '(jka-compr-handler) + '(jka-compr-handler image-file-handler) "A list of handlers doing (un)compression (etc) thingies.") (defun mm-insert-file-contents (filename &optional visit beg end replace @@ -475,21 +703,21 @@ Mule4 only." A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, find-file-hooks, etc. -If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers. +If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. This function ensures that none of these modifications will take place." (let ((format-alist nil) (auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) (default-major-mode 'fundamental-mode) (enable-local-variables nil) - (after-insert-file-functions nil) + (after-insert-file-functions nil) (enable-local-eval nil) (find-file-hooks nil) - (inhibit-file-name-operation (if inhibit + (inhibit-file-name-operation (if inhibit 'insert-file-contents inhibit-file-name-operation)) (inhibit-file-name-handlers (if inhibit - (append mm-inhibit-file-name-handlers + (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers))) (insert-file-contents filename visit beg end replace))) @@ -501,34 +729,34 @@ START, END and FILENAME. START and END are buffer positions saying what text to write. Optional fourth argument specifies the coding system to use when encoding the file. -If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." - (let ((coding-system-for-write - (or codesys mm-text-coding-system-for-write +If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." + (let ((coding-system-for-write + (or codesys mm-text-coding-system-for-write mm-text-coding-system)) - (inhibit-file-name-operation (if inhibit + (inhibit-file-name-operation (if inhibit 'append-to-file inhibit-file-name-operation)) (inhibit-file-name-handlers (if inhibit - (append mm-inhibit-file-name-handlers + (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers))) (append-to-file start end filename))) -(defun mm-write-region (start end filename &optional append visit lockname +(defun mm-write-region (start end filename &optional append visit lockname coding-system inhibit) "Like `write-region'. -If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." - (let ((coding-system-for-write - (or coding-system mm-text-coding-system-for-write +If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." + (let ((coding-system-for-write + (or coding-system mm-text-coding-system-for-write mm-text-coding-system)) - (inhibit-file-name-operation (if inhibit + (inhibit-file-name-operation (if inhibit 'write-region inhibit-file-name-operation)) (inhibit-file-name-handlers (if inhibit - (append mm-inhibit-file-name-handlers + (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) @@ -543,6 +771,70 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." (push dir result)) (push path result)))) +(if (fboundp 'detect-coding-region) + (defun mm-detect-coding-region (start end) + "Like `detect-coding-region' except returning the best one." + (let ((coding-systems + (detect-coding-region (point) (point-max)))) + (or (car-safe coding-systems) + coding-systems))) + (defun mm-detect-coding-region (start end) + (let ((point (point))) + (goto-char start) + (skip-chars-forward "\0-\177" end) + (prog1 + (if (eq (point) end) 'ascii (mm-guess-charset)) + (goto-char point))))) + +(if (fboundp 'coding-system-get) + (defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + (coding-system-get cs 'mime-charset))) + (defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + cs))) + +(defun mm-guess-mime-charset () + "Guess the default MIME charset from the language environment." + (let ((language-info + (and (boundp 'current-language-environment) + (assoc current-language-environment + language-info-alist))) + item) + (cond + ((null language-info) + 'iso-8859-1) + ((setq item + (cadr + (or (assq 'coding-priority language-info) + (assq 'coding-system language-info)))) + (if (fboundp 'coding-system-get) + (or (coding-system-get item 'mime-charset) + item) + item)) + ((setq item (car (last (assq 'charset language-info)))) + (if (eq item 'ascii) + 'iso-8859-1 + (mm-mime-charset item))) + (t + 'iso-8859-1)))) + +;; It is not a MIME function, but some MIME functions use it. +(defalias 'mm-make-temp-file + (if (fboundp 'make-temp-file) + 'make-temp-file + (lambda (prefix &optional dir-flag) + (let ((file (expand-file-name + (make-temp-name prefix) + (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory)))) + (if dir-flag + (make-directory file)) + file)))) + (provide 'mm-util) ;;; mm-util.el ends here diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 0029a4a..a3cad89 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -1,8 +1,8 @@ -;;; mm-uu.el -- Return uu stuff as mm handles -;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. +;;; mm-uu.el --- Return uu stuff as mm handles +;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; Keywords: postscript uudecode binhex shar forward news +;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp ;; This file is part of GNU Emacs. @@ -23,7 +23,6 @@ ;;; Commentary: - ;;; Code: (eval-when-compile (require 'cl)) @@ -31,193 +30,462 @@ (require 'nnheader) (require 'mm-decode) (require 'gnus-mailcap) +(require 'mml2015) -(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")) +(autoload 'uudecode-decode-region "uudecode") +(autoload 'uudecode-decode-region-external "uudecode") +(autoload 'uudecode-decode-region-internal "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)))) +(autoload 'binhex-decode-region "binhex") +(autoload 'binhex-decode-region-external "binhex") +(autoload 'binhex-decode-region-internal "binhex") -;;; 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]*$") +(autoload 'yenc-decode-region "yenc") +(autoload 'yenc-extract-filename "yenc") (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 "Auto detect" uudecode-decode-region) + (function-item :tag "Internal" uudecode-decode-region-internal) + (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. Internal function is done in elisp by default, therefore decoding may appear to be horribly slow . You can make Gnus use the external Unix decoder, such as hexbin." - :type '(choice (item :tag "internal" binhex-decode-region) - (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") + :type '(choice (function-item :tag "Auto detect" binhex-decode-region) + (function-item :tag "Internal" binhex-decode-region-internal) + (function-item :tag "External" binhex-decode-region-external)) + :group 'gnus-article-mime) -;;; 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") +(defvar mm-uu-yenc-decode-function 'yenc-decode-region) -(defvar mm-uu-begin-line nil) +(defvar mm-uu-pgp-beginning-signature + "^-----BEGIN PGP SIGNATURE-----") -(defconst mm-uu-identifier-alist - '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar) - (?- . forward))) +(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-emacs-sources-regexp "gnu\\.emacs\\.sources" + "The regexp of emacs sources groups.") + +(defcustom mm-uu-diff-groups-regexp "gnus\\.commits" + "*Regexp matching diff groups." + :type 'regexp + :group 'gnus-article-mime) + +(defvar mm-uu-type-alist + '((postscript + "^%!PS-" + "^%%EOF$" + mm-uu-postscript-extract + nil) + (uu + "^begin[ \t]+0?[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) + (yenc + "^=ybegin.*size=[0-9]+.*name=.*$" + "^=yend.*size=[0-9]+" + mm-uu-yenc-extract + mm-uu-yenc-filename) + (shar + "^#! */bin/sh" + "^exit 0$" + mm-uu-shar-extract) + (forward +;;; Thanks to Edward J. Sabol and +;;; Peter von der Ah\'e + "^-+ \\(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) + (emacs-sources + "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--" + "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here" + mm-uu-emacs-sources-extract + nil + mm-uu-emacs-sources-test) + (diff + "^Index: " + nil + mm-uu-diff-extract + nil + mm-uu-diff-test))) + +(defcustom mm-uu-configure-list '((shar . disabled)) + "A list of mm-uu configuration. +To disable dissecting shar codes, for instance, add +`(shar . disabled)' to this list." + :type 'alist + :options (mapcar (lambda (entry) + (list (car entry) '(const disabled))) + mm-uu-type-alist) + :group 'gnus-article-mime) + +;; functions + +(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)) + (coding-system + ;; Might not exist in non-MULE XEmacs + (when (boundp 'buffer-file-coding-system) + buffer-file-coding-system))) + (set-buffer (generate-new-buffer " *mm-uu*")) + (setq buffer-file-coding-system coding-system) + (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) - 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 nil) + (mapcar (lambda (entry) + (if (mm-uu-configure-p (mm-uu-type entry) 'disabled) + nil + (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-yenc-filename () + (goto-char start-point) + (setq file-name + (ignore-errors + (yenc-extract-filename)))) + +(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-emacs-sources-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + '("application/emacs-lisp") + nil nil + (list mm-dissect-disposition + (cons 'filename file-name)))) + +(eval-when-compile + (defvar gnus-newsgroup-name)) + +(defun mm-uu-emacs-sources-test () + (setq file-name (match-string 1)) + (and gnus-newsgroup-name + mm-uu-emacs-sources-regexp + (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name))) + +(defun mm-uu-diff-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + '("text/x-patch"))) + +(defun mm-uu-diff-test () + (and gnus-newsgroup-name + mm-uu-diff-groups-regexp + (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name))) + +(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-yenc-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-yenc 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?"))))) + +(eval-when-compile + (defvar gnus-newsgroup-charset)) + +(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))) + (goto-char (point-min)) + (while (re-search-forward "^- " nil t) + (replace-match "" t t) + (forward-line 1))) + (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)))))) + (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 - (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 (cond - ((eq type 'binhex) - (setq file-name - (ignore-errors - (binhex-decode-region start-char end-char t)))) - ((eq type 'forward) - (save-excursion - (goto-char start-char-1) - (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:"))) - (t 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)))) + (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) @@ -225,26 +493,6 @@ To disable dissecting shar codes, for instance, add (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 d2a67a0..4fba52b 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -1,5 +1,5 @@ -;;; mm-view.el --- Functions for viewing MIME objects -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;;; mm-view.el --- functions for viewing MIME objects +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -25,7 +25,7 @@ (eval-when-compile (require 'cl)) (require 'mail-parse) -(require 'mailcap) +(require 'gnus-mailcap) (require 'mm-bodies) (require 'mm-decode) @@ -34,32 +34,67 @@ (autoload 'vcard-parse-string "vcard") (autoload 'vcard-format-string "vcard") (autoload 'fill-flowed "flow-fill") - (autoload 'diff-mode "diff-mode")) + (autoload 'html2text "html2text") + (unless (fboundp 'diff-mode) + (autoload 'diff-mode "diff-mode" "" t nil))) + +(defvar mm-text-html-renderer-alist + '((w3 . mm-inline-text-html-render-with-w3) + (w3m . mm-inline-text-html-render-with-w3m) + (w3m-standalone mm-inline-render-with-stdin nil + "w3m" "-dump" "-T" "text/html") + (links mm-inline-render-with-file + mm-links-remove-leading-blank + "links" "-dump" file) + (lynx mm-inline-render-with-stdin nil + "lynx" "-dump" "-force_html" "-stdin" "-nolist") + (html2text mm-inline-render-with-function html2text)) + "The attributes of renderer types for text/html.") + +(defvar mm-text-html-washer-alist + '((w3 . gnus-article-wash-html-with-w3) + (w3m . gnus-article-wash-html-with-w3m) + (w3m-standalone mm-inline-render-with-stdin nil + "w3m" "-dump" "-T" "text/html") + (links mm-inline-wash-with-file + mm-links-remove-leading-blank + "links" "-dump" file) + (lynx mm-inline-wash-with-stdin nil + "lynx" "-dump" "-force_html" "-stdin" "-nolist") + (html2text html2text)) + "The attributes of washer types for text/html.") + +;;; Internal variables. ;;; ;;; 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) + (insert "\n\n") (mm-handle-set-undisplayer handle - `(lambda () (remove-images ,b (1+ ,b)))))) + `(lambda () + (let ((b ,b) + buffer-read-only) + (remove-images b b) + (delete-region b (+ b 2))))))) (defun mm-inline-image-xemacs (handle) - (let ((b (point)) - (annot (make-annotation (mm-get-image handle) nil 'text)) + (insert "\n\n") + (forward-char -2) + (let ((annot (make-annotation (mm-get-image handle) nil 'text)) buffer-read-only) - (insert "\n") (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) + (let ((b ,(point-marker)) + buffer-read-only) (delete-annotation ,annot) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point)))))) + (delete-region (- b 2) b)))) (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) @@ -78,110 +113,273 @@ (require 'url-vars) (setq mm-w3-setup t))) -(defun mm-inline-text (handle) - (let ((type (mm-handle-media-subtype handle)) - text buffer-read-only) - (cond - ((equal type "html") - (mm-setup-w3) - (setq text (mm-get-part handle)) - (let ((b (point)) - (url-standalone-mode t) - (url-current-object - (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) - (width (window-width)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (save-excursion - (insert text) +(defun mm-inline-text-html-render-with-w3 (handle) + (mm-setup-w3) + (let ((text (mm-get-part handle)) + (b (point)) + (url-standalone-mode t) + (url-gateway-unplugged t) + (w3-honor-stylesheets nil) + (url-current-object + (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) + (width (window-width)) + (charset (mail-content-type-get + (mm-handle-type handle) 'charset))) + (save-excursion + (insert text) + (save-restriction + (narrow-to-region b (point)) + (goto-char (point-min)) + (if (or (and (boundp 'w3-meta-content-type-charset-regexp) + (re-search-forward + w3-meta-content-type-charset-regexp nil t)) + (and (boundp 'w3-meta-charset-content-type-regexp) + (re-search-forward + w3-meta-charset-content-type-regexp nil t))) + (setq charset + (or (let ((bsubstr (buffer-substring-no-properties + (match-beginning 2) + (match-end 2)))) + (if (fboundp 'w3-coding-system-for-mime-charset) + (w3-coding-system-for-mime-charset bsubstr) + (mm-charset-to-coding-system bsubstr))) + charset))) + (delete-region (point-min) (point-max)) + (insert (mm-decode-string text charset)) + (save-window-excursion (save-restriction - (narrow-to-region b (point)) - (goto-char (point-min)) - (if (or (and (boundp 'w3-meta-content-type-charset-regexp) - (re-search-forward - w3-meta-content-type-charset-regexp nil t)) - (and (boundp 'w3-meta-charset-content-type-regexp) - (re-search-forward - w3-meta-charset-content-type-regexp nil t))) - (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)) - (error - (message - "Error while rendering html; showing as text/plain")))))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (if (functionp 'remove-specifier) - (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") - (equal type "richtext")) - (save-excursion - (mm-with-unibyte-buffer + (let ((w3-strict-width width) + ;; Don't let w3 set the global version of + ;; this variable. + (fill-column fill-column)) + (if (or debug-on-error debug-on-quit) + (w3-region (point-min) (point-max)) + (condition-case () + (w3-region (point-min) (point-max)) + (error + (delete-region (point-min) (point-max)) + (let ((b (point)) + (charset (mail-content-type-get + (mm-handle-type handle) 'charset))) + (if (or (eq charset 'gnus-decoded) + (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)))) + (message + "Error while rendering html; showing as text/plain"))))))) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (if (functionp 'remove-specifier) + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) + (current-buffer))) + '(background background-pixmap foreground))) + (delete-region ,(point-min-marker) + ,(point-max-marker))))))))) + +(defvar mm-w3m-setup nil + "Whether gnus-article-mode has been setup to use emacs-w3m.") + +(defun mm-setup-w3m () + "Setup gnus-article-mode to use emacs-w3m." + (unless mm-w3m-setup + (require 'w3m) + (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist) + (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve) + w3m-cid-retrieve-function-alist)) + (setq mm-w3m-setup t)) + (setq w3m-display-inline-images mm-inline-text-html-with-images)) + +(defun mm-w3m-cid-retrieve (url &rest args) + "Insert a content pointed by URL if it has the cid: scheme." + (when (string-match "\\`cid:" url) + (setq url (concat "<" (substring url (match-end 0)) ">")) + (catch 'found-handle + (dolist (handle (with-current-buffer w3m-current-buffer + gnus-article-mime-handles)) + (when (and (listp handle) + (equal url (mm-handle-id handle))) (mm-insert-part handle) - (save-window-excursion - (enriched-decode (point-min) (point-max)) - (setq text (buffer-string))))) - (mm-insert-inline handle text)) - ((equal type "x-vcard") - (mm-insert-inline + (throw 'found-handle (mm-handle-media-type handle))))))) + +(eval-and-compile + (unless (or (featurep 'xemacs) + (>= emacs-major-version 21)) + (defvar mm-w3m-mode-map nil + "Keymap for text/html part rendered by `mm-w3m-preview-text/html'. +This map is overwritten by `mm-w3m-local-map-property' based on the +value of `w3m-minor-mode-map'. Therefore, in order to add some +commands to this map, add them to `w3m-minor-mode-map' instead of this +map."))) + +(defun mm-w3m-local-map-property () + (when (and (boundp 'w3m-minor-mode-map) w3m-minor-mode-map) + (if (or (featurep 'xemacs) + (>= emacs-major-version 21)) + (list 'keymap w3m-minor-mode-map) + (list 'local-map + (or mm-w3m-mode-map + (progn + (setq mm-w3m-mode-map (copy-keymap w3m-minor-mode-map)) + (set-keymap-parent mm-w3m-mode-map gnus-article-mode-map) + mm-w3m-mode-map)))))) + +(defun mm-inline-text-html-render-with-w3m (handle) + "Render a text/html part using emacs-w3m." + (mm-setup-w3m) + (let ((text (mm-get-part handle)) + (b (point)) + (charset (mail-content-type-get (mm-handle-type handle) 'charset))) + (save-excursion + (insert text) + (save-restriction + (narrow-to-region b (point)) + (goto-char (point-min)) + (when (re-search-forward w3m-meta-content-type-charset-regexp nil t) + (setq charset (or (w3m-charset-to-coding-system (match-string 2)) + charset))) + (when charset + (delete-region (point-min) (point-max)) + (insert (mm-decode-string text charset))) + (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) + w3m-force-redisplay) + (w3m-region (point-min) (point-max))) + (when mm-inline-text-html-with-w3m-keymap + (add-text-properties + (point-min) (point-max) + (nconc (mm-w3m-local-map-property) + '(mm-inline-text-html-with-w3m t))))) + (mm-handle-set-undisplayer handle - (concat "\n-- \n" + `(lambda () + (let (buffer-read-only) + (if (functionp 'remove-specifier) + (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-links-remove-leading-blank () + ;; Delete the annoying three spaces preceding each line of links + ;; output. + (goto-char (point-min)) + (while (re-search-forward "^ " nil t) + (delete-region (match-beginning 0) (match-end 0)))) + +(defun mm-inline-wash-with-file (post-func cmd &rest args) + (let ((file (mm-make-temp-file + (expand-file-name "mm" mm-tmp-directory)))) + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) file nil 'silent)) + (delete-region (point-min) (point-max)) + (unwind-protect + (apply 'call-process cmd nil t nil (mapcar 'eval args)) + (delete-file file)) + (and post-func (funcall post-func)))) + +(defun mm-inline-wash-with-stdin (post-func cmd &rest args) + (let ((coding-system-for-write 'binary)) + (apply 'call-process-region (point-min) (point-max) + cmd t t nil args)) + (and post-func (funcall post-func))) + +(defun mm-inline-render-with-file (handle post-func cmd &rest args) + (let ((source (mm-get-part handle))) + (mm-insert-inline + handle + (mm-with-unibyte-buffer + (insert source) + (apply 'mm-inline-wash-with-file post-func cmd args) + (buffer-string))))) + +(defun mm-inline-render-with-stdin (handle post-func cmd &rest args) + (let ((source (mm-get-part handle))) + (mm-insert-inline + handle + (mm-with-unibyte-buffer + (insert source) + (apply 'mm-inline-wash-with-stdin post-func cmd args) + (buffer-string))))) + +(defun mm-inline-render-with-function (handle func &rest args) + (let ((source (mm-get-part handle))) + (mm-insert-inline + handle + (mm-with-unibyte-buffer + (insert source) + (apply func args) + (buffer-string))))) + +(defun mm-inline-text-html (handle) + (let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer)) + (entry (assq func mm-text-html-renderer-alist)) + buffer-read-only) + (if entry + (setq func (cdr entry))) + (cond + ((functionp func) + (funcall func handle)) + (t + (apply (car func) handle (cdr func)))))) + +(defun mm-inline-text-vcard (handle) + (let (buffer-read-only) + (mm-insert-inline + handle + (concat "\n-- \n" + (ignore-errors (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 - (let ((b (point)) - (charset (mail-content-type-get - (mm-handle-type handle) '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)))) + 'vcard-standard-filter)))))))) + +(defun mm-inline-text (handle) + (let ((b (point)) + (type (mm-handle-media-subtype handle)) + (charset (mail-content-type-get + (mm-handle-type handle) 'charset)) + buffer-read-only) + (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 b (point)) - (set-text-properties (point-min) (point-max) nil) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (delete-region ,(point-min-marker) - ,(point-max-marker))))))))))) + (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) + (when (or (equal type "enriched") + (equal type "richtext")) + (ignore-errors + (enriched-decode (point-min) (point-max)))) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (delete-region ,(point-min-marker) + ,(point-max-marker)))))))) (defun mm-insert-inline (handle text) "Insert TEXT inline from HANDLE." @@ -202,7 +400,9 @@ (defun mm-w3-prepare-buffer () (require 'w3) - (let ((url-standalone-mode t)) + (let ((url-standalone-mode t) + (url-gateway-unplugged t) + (w3-honor-stylesheets nil)) (w3-prepare-buffer))) (defun mm-view-message () @@ -215,14 +415,13 @@ (setq handles gnus-article-mime-handles)) (when handles (setq gnus-article-mime-handles - (nconc gnus-article-mime-handles - (if (listp (car handles)) - handles (list handles)))))) + (mm-merge-handles gnus-article-mime-handles handles)))) (fundamental-mode) (goto-char (point-min))) (defun mm-inline-message (handle) (let ((b (point)) + (bolp (bolp)) (charset (mail-content-type-get (mm-handle-type handle) 'charset)) gnus-displaying-mime handles) @@ -236,22 +435,23 @@ (narrow-to-region b b) (mm-insert-part handle) (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook + ;; 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)) + (goto-char (point-min)) + (unless bolp + (insert "\n")) (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert "----------\n\n") (when handles (setq gnus-article-mime-handles - (nconc gnus-article-mime-handles - (if (listp (car handles)) - handles (list handles))))) + (mm-merge-handles gnus-article-mime-handles handles))) (mm-handle-set-undisplayer handle `(lambda () @@ -266,24 +466,120 @@ (defun mm-display-inline-fontify (handle mode) (let (text) - (with-temp-buffer - (mm-insert-part handle) - (funcall mode) - (font-lock-fontify-buffer) - (when (fboundp 'extent-list) - (map-extents (lambda (ext ignored) - (set-extent-property ext 'duplicable t) - nil) - nil nil nil nil nil 'text-prop)) - (setq text (buffer-string))) + ;; XEmacs @#$@ version of font-lock refuses to fully turn itself + ;; on for buffers whose name begins with " ". That's why we use + ;; save-current-buffer/get-buffer-create rather than + ;; with-temp-buffer. + (save-current-buffer + (set-buffer (generate-new-buffer "*fontification*")) + (unwind-protect + (progn + (buffer-disable-undo) + (mm-insert-part handle) + (funcall mode) + (require 'font-lock) + (let ((font-lock-verbose nil)) + ;; I find font-lock a bit too verbose. + (font-lock-fontify-buffer)) + ;; By default, XEmacs font-lock uses non-duplicable text + ;; properties. This code forces all the text properties + ;; to be copied along with the text. + (when (fboundp 'extent-list) + (map-extents (lambda (ext ignored) + (set-extent-property ext 'duplicable t) + nil) + nil nil nil nil nil 'text-prop)) + (setq text (buffer-string))) + (kill-buffer (current-buffer)))) (mm-insert-inline handle text))) +;; Shouldn't these functions check whether the user even wants to use +;; font-lock? At least under XEmacs, this fontification is pretty +;; much unconditional. Also, it would be nice to change for the size +;; of the fontified region. + (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)) +;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) +;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } +(defvar mm-pkcs7-signed-magic + (mm-string-as-unibyte + (apply 'concat + (mapcar 'char-to-string + (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c + ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e + ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 + ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02))))) + +;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) +;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } +(defvar mm-pkcs7-enveloped-magic + (mm-string-as-unibyte + (apply 'concat + (mapcar 'char-to-string + (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c + ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e + ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 + ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03))))) + +(defun mm-view-pkcs7-get-type (handle) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (cond ((looking-at mm-pkcs7-enveloped-magic) + 'enveloped) + ((looking-at mm-pkcs7-signed-magic) + 'signed) + (t + (error "Could not identify PKCS#7 type"))))) + +(defun mm-view-pkcs7 (handle) + (case (mm-view-pkcs7-get-type handle) + (enveloped (mm-view-pkcs7-decrypt handle)) + (signed (mm-view-pkcs7-verify handle)) + (otherwise (error "Unknown or unimplemented PKCS#7 type")))) + +(defun mm-view-pkcs7-verify (handle) + ;; A bogus implementation of PKCS#7. FIXME:: + (mm-insert-part handle) + (goto-char (point-min)) + (if (search-forward "Content-Type: " nil t) + (delete-region (point-min) (match-beginning 0))) + (goto-char (point-max)) + (if (re-search-backward "--\r?\n?" nil t) + (delete-region (match-end 0) (point-max))) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n")) + (message "Verify signed PKCS#7 message is unimplemented.") + (sit-for 1) + t) + +(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro) + +(defun mm-view-pkcs7-decrypt (handle) + (insert-buffer-substring (mm-handle-buffer handle)) + (goto-char (point-min)) + (insert "MIME-Version: 1.0\n") + (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m") + (smime-decrypt-region + (point-min) (point-max) + (if (= (length smime-keys) 1) + (cadar smime-keys) + (smime-get-key-by-email + (gnus-completing-read-maybe-default + (concat "Decipher using which key? " + (if smime-keys (concat "(default " (caar smime-keys) ") ") + "")) + smime-keys nil nil nil nil (car-safe (car-safe smime-keys)))))) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n")) + (goto-char (point-min))) + (provide 'mm-view) -;; mm-view.el ends here +;;; mm-view.el ends here diff --git a/lisp/mmgnus.el b/lisp/mmgnus.el index 3493ee1..d5ad15f 100644 --- a/lisp/mmgnus.el +++ b/lisp/mmgnus.el @@ -37,55 +37,7 @@ (apply (car (luna-class-find-functions (luna-find-class 'standard-object) 'initialize-instance)) - entity init-args) - ) - -;; (luna-define-method mime-entity-fetch-field ((entity mime-gnus-entity) -;; field-name) -;; (or (funcall (car (luna-class-find-functions -;; (luna-find-class 'mime-entity) -;; 'mime-entity-fetch-field)) -;; entity field-name) -;; (with-current-buffer gnus-original-article-buffer -;; (let ((ret (std11-field-body field-name))) -;; (when ret -;; (or (symbolp field-name) -;; (setq field-name -;; (intern (capitalize (capitalize field-name))))) -;; (mime-entity-set-original-header-internal -;; entity -;; (put-alist field-name ret -;; (mime-entity-original-header-internal entity))) -;; ret))))) - -;; (luna-define-method mime-entity-buffer ((entity mime-gnus-entity)) -;; ;; (if (with-current-buffer gnus-summary-buffer -;; ;; (eq gnus-current-article (mail-header-number entity))) -;; ;; ...) -;; (unless (mime-buffer-entity-header-end-internal entity) -;; (set-buffer gnus-original-article-buffer) -;; (mime-buffer-entity-set-header-start-internal entity (point-min)) -;; (mime-buffer-entity-set-body-end-internal entity (point-max)) -;; (goto-char (point-min)) -;; (if (re-search-forward "^$" nil t) -;; (progn -;; (mime-buffer-entity-set-header-end-internal entity (match-end 0)) -;; (mime-buffer-entity-set-body-start-internal -;; entity -;; (if (= (mime-buffer-entity-header-end-internal entity) -;; (mime-buffer-entity-body-end-internal entity)) -;; (mime-buffer-entity-body-end-internal entity) -;; (1+ (mime-buffer-entity-header-end-internal entity)) -;; )) -;; ) -;; (mime-buffer-entity-set-header-end-internal entity (point-min)) -;; (mime-buffer-entity-set-body-start-internal entity (point-min)) -;; )) -;; gnus-original-article-buffer) - - -;;; @ end -;;; + entity init-args)) (provide 'mmgnus) diff --git a/lisp/mml.el b/lisp/mml.el index 07c2bc7..415102d 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -1,5 +1,6 @@ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -27,19 +28,59 @@ (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) +(require 'mml-sec) (eval-when-compile (require 'cl)) (eval-and-compile (autoload 'message-make-message-id "message") (autoload 'gnus-setup-posting-charset "gnus-msg") (autoload 'gnus-add-minor-mode "gnus-ems") + (autoload 'gnus-make-local-hook "gnus-util") (autoload 'message-fetch-field "message") + (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message")) +(defcustom mml-content-type-parameters + '(name access-type expiration size permission format) + "*A list of acceptable parameters in MML tag. +These parameters are generated in Content-Type header if exists." + :type '(repeat (symbol :tag "Parameter")) + :group 'message) + +(defcustom mml-content-disposition-parameters + '(filename creation-date modification-date read-date) + "*A list of acceptable parameters in MML tag. +These parameters are generated in Content-Disposition header if exists." + :type '(repeat (symbol :tag "Parameter")) + :group 'message) + +(defvar mml-tweak-type-alist nil + "A list of (TYPE . FUNCTION) for tweaking MML parts. +TYPE is a string containing a regexp to match the MIME type. FUNCTION +is a Lisp function which is called with the MML handle to tweak the +part. This variable is used only when no TWEAK parameter exists in +the MML handle.") + +(defvar mml-tweak-function-alist nil + "A list of (NAME . FUNCTION) for tweaking MML parts. +NAME is a string containing the name of the TWEAK parameter in the MML +handle. FUNCTION is a Lisp function which is called with the MML +handle to tweak the part.") + +(defvar mml-tweak-sexp-alist + '((mml-externalize-attachments . mml-tweak-externalize-attachments)) + "A list of (SEXP . FUNCTION) for tweaking MML parts. +SEXP is a s-expression. If the evaluation of SEXP is non-nil, FUNCTION +is called. FUNCTION is a Lisp function which is called with the MML +handle to tweak the part.") + +(defvar mml-externalize-attachments nil + "*If non-nil, local-file attachments are generated as external parts.") + (defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. Each entry has the form (NAME . FUNCTION), where -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. @@ -73,20 +114,11 @@ 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-mime-preprocess-function nil - "A function called before generating a mime part. -The function is called with one parameter, which is the part to be -generated.") - -(defvar mml-generate-mime-postprocess-function nil - "A function called after generating a mime part. -The function is called with one parameter, which is the generated part.") - (defvar mml-generate-default-type "text/plain") (defvar mml-buffer-list nil) -(defun mml-generate-new-buffer (name) +(defun mml-generate-new-buffer (name) (let ((buf (generate-new-buffer name))) (push buf mml-buffer-list) buf)) @@ -98,13 +130,14 @@ The function is called with one parameter, which is the generated part.") (defun mml-parse () "Parse the current buffer as an MML document." - (goto-char (point-min)) - (let ((table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table mml-syntax-table) - (mml-parse-1)) - (set-syntax-table table)))) + (save-excursion + (goto-char (point-min)) + (let ((table (syntax-table))) + (unwind-protect + (progn + (set-syntax-table mml-syntax-table) + (mml-parse-1)) + (set-syntax-table table))))) (defun mml-parse-1 () "Parse the current buffer as an MML document." @@ -112,6 +145,43 @@ The function is called with one parameter, which is the generated part.") (while (and (not (eobp)) (not (looking-at "<#/multipart"))) (cond + ((looking-at "<#secure") + ;; The secure part is essentially a meta-meta tag, which + ;; expands to either a part tag if there are no other parts in + ;; the document or a multipart tag if there are other parts + ;; included in the message + (let* (secure-mode + (taginfo (mml-read-tag)) + (recipients (cdr (assq 'recipients taginfo))) + (sender (cdr (assq 'sender taginfo))) + (location (cdr (assq 'tag-location taginfo))) + (mode (cdr (assq 'mode taginfo))) + (method (cdr (assq 'method taginfo))) + tags) + (save-excursion + (if + (re-search-forward + "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) + (setq secure-mode "multipart") + (setq secure-mode "part"))) + (save-excursion + (goto-char location) + (re-search-forward "<#secure[^\n]*>\n")) + (delete-region (match-beginning 0) (match-end 0)) + (cond ((string= mode "sign") + (setq tags (list "sign" method))) + ((string= mode "encrypt") + (setq tags (list "encrypt" method))) + ((string= mode "signencrypt") + (setq tags (list "sign" method "encrypt" method)))) + (eval `(mml-insert-tag ,secure-mode + ,@tags + ,(if recipients "recipients") + ,recipients + ,(if sender "sender") + ,sender)) + ;; restart the parse + (goto-char location))) ((looking-at "<#multipart") (push (nconc (mml-read-tag) (mml-parse-1)) struct)) ((looking-at "<#external") @@ -128,15 +198,25 @@ The function is called with one parameter, which is the generated part.") (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)))) + charsets (cond + (raw nil) + ((assq 'charset tag) + (list + (intern (downcase (cdr (assq 'charset tag)))))) + (t + (mm-find-mime-charset-region point (point) + mm-hack-charsets)))) (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 + (message-options-get 'unknown-encoding) + (and (y-or-n-p "\ +Message contains characters with unknown encoding. Really send?") + (message-options-set 'unknown-encoding t))) + (if (setq use-ascii (or (memq 'use-ascii mml-confirmation-set) - (y-or-n-p "Use ASCII as charset?"))) + (message-options-get 'use-ascii) + (and (y-or-n-p "Use ASCII as charset?") + (message-options-set 'use-ascii t)))) (setq charsets (delq nil charsets)) (setq warn nil)) (error "Edit your message to remove those characters"))) @@ -152,18 +232,18 @@ The function is called with one parameter, which is the generated part.") tag point (point) use-ascii))) (when (and warn (not (memq 'multipart mml-confirmation-set)) - (not - (y-or-n-p - (format - "Warning: Your message contains more than %d parts. Really send? " - (length nstruct))))) + (not (message-options-get 'multipart)) + (not (and (y-or-n-p (format "\ +A message part needs to be split into %d charset parts. Really send? " + (length nstruct))) + (message-options-set 'multipart t)))) (error "Edit your message to use only one charset")) (setq struct (nconc nstruct struct))))))) (unless (eobp) (forward-line 1)) (nreverse struct))) -(defun mml-parse-singlepart-with-multiple-charsets +(defun mml-parse-singlepart-with-multiple-charsets (orig-tag beg end &optional use-ascii) (save-excursion (save-restriction @@ -223,7 +303,8 @@ The function is called with one parameter, which is the generated part.") (defun mml-read-tag () "Read a tag and return the contents." - (let (contents name elem val) + (let ((orig-point (point)) + contents name elem val) (forward-char 2) (setq name (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point)))) @@ -241,8 +322,19 @@ The function is called with one parameter, which is the generated part.") (goto-char (match-end 0)) ;; Don't skip the leading space. ;;(skip-chars-forward " \t\n") + ;; Put the tag location into the returned contents + (setq contents (append (list (cons 'tag-location orig-point)) contents)) (cons (intern name) (nreverse contents)))) +(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) + (let ((str (buffer-substring-no-properties start end)) + (bufstart start) tmp) + (while (setq tmp (text-property-any start end 'hard 't)) + (set-text-properties (- tmp bufstart) (- tmp bufstart -1) + '(hard t) str) + (setq start (1+ tmp))) + str)) + (defun mml-read-part (&optional mml) "Return the buffer up till the next part, multipart or closing part or multipart. If MML is non-nil, return the buffer up till the correspondent mml tag." @@ -256,19 +348,22 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (re-search-forward "<#\\(/\\)?mml." nil t) (setq count (+ count (if (match-beginning 1) -1 1))) (goto-char (point-max)))) - (buffer-substring-no-properties beg (if (> count 0) - (point) - (match-beginning 0)))) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (if (> count 0) + (point) + (match-beginning 0)))) (if (re-search-forward "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) (prog1 - (buffer-substring-no-properties beg (match-beginning 0)) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (match-beginning 0)) (if (or (not (match-beginning 1)) (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) - (buffer-substring-no-properties beg (goto-char (point-max))))))) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (goto-char (point-max))))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") @@ -289,124 +384,181 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (buffer-string))))) (defun mml-generate-mime-1 (cont) - (save-restriction - (narrow-to-region (point) (point)) - (if mml-generate-mime-preprocess-function - (funcall mml-generate-mime-preprocess-function cont)) - (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 + (let ((mm-use-ultra-safe-encoding + (or mm-use-ultra-safe-encoding (assq 'sign cont)))) + (save-restriction + (narrow-to-region (point) (point)) + (mml-tweak-part cont) + (cond + ((or (eq (car cont) 'part) (eq (car cont) 'mml)) + (let ((raw (cdr (assq 'raw cont))) + coded encoding charset filename type flowed) + (setq type (or (cdr (assq 'type cont)) "text/plain")) + (if (and (not raw) + (member (car (split-string type "/")) '("text" "message"))) + (progn + (with-temp-buffer + (setq charset (mm-charset-to-coding-system + (cdr (assq 'charset cont)))) + (when (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 + ;; Only perform format=flowed filling on text/plain + ;; parts where there either isn't a format parameter + ;; in the mml tag or it says "flowed" and there + ;; actually are hard newlines in the text. + (let (use-hard-newlines) + (when (and (string= type "text/plain") + (or (null (assq 'format cont)) + (string= (cdr (assq 'format cont)) + "flowed")) + (setq use-hard-newlines + (text-property-any + (point-min) (point-max) 'hard 't))) + (fill-flowed-encode) + ;; Indicate that `mml-insert-mime-headers' should + ;; insert a "; format=flowed" string unless the + ;; user has already specified it. + (setq flowed (null (assq 'format cont))))) + (setq charset (mm-encode-body charset)) + (setq encoding (mm-body-encoding + charset (cdr (assq 'encoding cont)))))) + (setq coded (buffer-string))) + (mml-insert-mime-headers cont type charset encoding flowed) + (insert "\n") + (insert coded)) + (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"))) - (mm-insert-file-contents filename)) - ((eq 'mml (car cont)) - (insert (cdr (assq 'contents cont)))) + (let ((coding-system-for-read mm-binary-coding-system)) + (mm-insert-file-contents filename nil nil nil nil t))) (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)) - (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)))) - (when name - (setq name (mml-parse-file-name name)) - (if (stringp name) + (insert (cdr (assq 'contents cont))))) + (setq encoding (mm-encode-buffer type) + coded (mm-string-as-multibyte (buffer-string)))) + (mml-insert-mime-headers cont type charset encoding nil) + (insert "\n") + (mm-with-unibyte-current-buffer + (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" 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)))) + (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 - (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")) - (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)) - ;; Skip `multipart' and `type' elements. - (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))) - (if mml-generate-mime-postprocess-function - (funcall mml-generate-mime-postprocess-function 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))) + ;; handle sign & encrypt tags in a semi-smart way. + (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) + (encrypt-item (assoc (cdr (assq 'encrypt cont)) + mml-encrypt-alist)) + sender recipients) + (when (or sign-item encrypt-item) + (when (setq sender (cdr (assq 'sender cont))) + (message-options-set 'mml-sender sender) + (message-options-set 'message-sender sender)) + (if (setq recipients (cdr (assq 'recipients cont))) + (message-options-set 'message-recipients recipients)) + (let ((style (mml-signencrypt-style (first (or sign-item encrypt-item))))) + ;; check if: we're both signing & encrypting, both methods + ;; are the same (why would they be different?!), and that + ;; the signencrypt style allows for combined operation. + (if (and sign-item encrypt-item (equal (first sign-item) + (first encrypt-item)) + (equal style 'combined)) + (funcall (nth 1 encrypt-item) cont t) + ;; otherwise, revert to the old behavior. + (when sign-item + (funcall (nth 1 sign-item) cont)) + (when encrypt-item + (funcall (nth 1 encrypt-item) cont))))))))) (defun mml-compute-boundary (cont) "Return a unique boundary that does not exist in CONT." @@ -448,13 +600,14 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." "") mml-base-boundary)) -(defun mml-insert-mime-headers (cont type charset encoding) +(defun mml-insert-mime-headers (cont type charset encoding flowed) (let (parameters disposition description) (setq parameters (mml-parameter-string - cont '(name access-type expiration size permission))) + cont mml-content-type-parameters)) (when (or charset parameters + flowed (not (equal type mml-generate-default-type))) (when (consp charset) (error @@ -463,19 +616,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (when charset (insert "; " (mail-header-encode-parameter "charset" (symbol-name charset)))) + (when flowed + (insert "; format=flowed")) (when parameters (mml-insert-parameter-string - cont '(name access-type expiration size permission))) + cont mml-content-type-parameters)) (insert "\n")) (setq parameters (mml-parameter-string - cont '(filename creation-date modification-date read-date))) + cont mml-content-disposition-parameters)) (when (or (setq disposition (cdr (assq 'disposition cont))) parameters) (insert "Content-Disposition: " (or disposition "inline")) (when parameters (mml-insert-parameter-string - cont '(filename creation-date modification-date read-date))) + cont mml-content-disposition-parameters)) (insert "\n")) (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) @@ -508,8 +663,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (mail-header-encode-parameter (symbol-name type) value)))))) -(defvar ange-ftp-name-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) @@ -531,25 +687,28 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." ;;; 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-Disposition") (message-remove-header "Content-Transfer-Encoding"))) (defun mml-to-mime () @@ -557,6 +716,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (message-encode-message-body) (save-restriction (message-narrow-to-headers-or-head) + ;; Skip past any From_ headers. + (while (looking-at "From ") + (forward-line 1)) (let ((mail-parse-charset message-default-charset)) (mail-encode-encoded-word-buffer)))) @@ -568,7 +730,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (save-excursion (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) (mm-insert-part handle) - (if (setq mmlp (equal (mm-handle-media-type handle) + (if (setq mmlp (equal (mm-handle-media-type handle) "message/rfc822")) (mime-to-mml))))) (if mmlp @@ -577,18 +739,19 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (equal (mm-handle-media-type handle) "text/plain")) (mml-insert-mml-markup handle buffer textp))) (cond - (mmlp - (insert-buffer buffer) + (mmlp + (insert-buffer-substring 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"))))) @@ -603,7 +766,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (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 @@ -630,8 +794,25 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." ;;; (defvar mml-mode-map - (let ((map (make-sparse-keymap)) + (let ((sign (make-sparse-keymap)) + (encrypt (make-sparse-keymap)) + (signpart (make-sparse-keymap)) + (encryptpart (make-sparse-keymap)) + (map (make-sparse-keymap)) (main (make-sparse-keymap))) + (define-key sign "p" 'mml-secure-message-sign-pgpmime) + (define-key sign "o" 'mml-secure-message-sign-pgp) + (define-key sign "s" 'mml-secure-message-sign-smime) + (define-key signpart "p" 'mml-secure-sign-pgpmime) + (define-key signpart "o" 'mml-secure-sign-pgp) + (define-key signpart "s" 'mml-secure-sign-smime) + (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime) + (define-key encrypt "o" 'mml-secure-message-encrypt-pgp) + (define-key encrypt "s" 'mml-secure-message-encrypt-smime) + (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime) + (define-key encryptpart "o" 'mml-secure-encrypt-pgp) + (define-key encryptpart "s" 'mml-secure-encrypt-smime) + (define-key map "\C-n" 'mml-unsecure-message) (define-key map "f" 'mml-attach-file) (define-key map "b" 'mml-attach-buffer) (define-key map "e" 'mml-attach-external) @@ -640,23 +821,43 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (define-key map "p" 'mml-insert-part) (define-key map "v" 'mml-validate) (define-key map "P" 'mml-preview) + (define-key map "s" sign) + (define-key map "S" signpart) + (define-key map "c" encrypt) + (define-key map "C" encryptpart) ;;(define-key map "n" 'mml-narrow-to-part) - (define-key main "\M-m" map) + ;; `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 mml-menu mml-mode-map "" - '("MML" - ("Attach" - ["File" mml-attach-file t] - ["Buffer" mml-attach-buffer t] - ["External" mml-attach-external t]) - ("Insert" - ["Multipart" mml-insert-multipart t] - ["Part" mml-insert-part t]) + `("Attachments" + ["Attach File..." mml-attach-file + ,@(if (featurep 'xemacs) '(t) + '(:help "Attach a file at point"))] + ["Attach Buffer..." mml-attach-buffer t] + ["Attach External..." mml-attach-external t] + ["Insert Part..." mml-insert-part t] + ["Insert Multipart..." mml-insert-multipart t] + ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t] + ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t] + ["PGP Sign" mml-secure-message-sign-pgp t] + ["PGP Encrypt" mml-secure-message-encrypt-pgp t] + ["S/MIME Sign" mml-secure-message-sign-smime t] + ["S/MIME Encrypt" mml-secure-message-encrypt-smime t] + ("Secure MIME part" + ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t] + ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t] + ["PGP Sign Part" mml-secure-sign-pgp t] + ["PGP Encrypt Part" mml-secure-encrypt-pgp t] + ["S/MIME Sign Part" mml-secure-sign-smime t] + ["S/MIME Encrypt Part" mml-secure-encrypt-smime t]) + ["Encrypt/Sign off" mml-unsecure-message t] ;;["Narrow" mml-narrow-to-part t] - ["Quote" mml-quote-region t] - ["Validate" mml-validate t] + ["Quote MML" mml-quote-region t] + ["Validate MML" mml-validate t] ["Preview" mml-preview t])) (defvar mml-mode nil @@ -664,6 +865,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (defun mml-mode (&optional arg) "Minor mode for editing MML. +MML is the MIME Meta Language, a minor mode for composing MIME articles. +See Info node `(emacs-mime)Composing'. \\{mml-mode-map}" (interactive "P") @@ -680,7 +883,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." ;;; (defun mml-minibuffer-read-file (prompt) - (let ((file (read-file-name prompt nil nil t))) + (let* ((completion-ignored-extensions nil) + (file (read-file-name prompt nil nil t))) ;; Prevent some common errors. This is inspired by similar code in ;; VM. (when (file-directory-p file) @@ -739,7 +943,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (when value ;; Quote VALUE if it contains suspicious characters. (when (string-match "[\"'\\~/*;() \t\n]" value) - (setq value (prin1-to-string value))) + (setq value (with-output-to-string + (let (print-escape-nonascii) + (prin1 value))))) (insert (format " %s=%s" key value))))) (insert ">\n")) @@ -807,45 +1013,124 @@ TYPE is the MIME type to use." (mml-insert-tag 'part 'type type 'disposition "inline") (forward-line -1)) +(defun mml-preview-insert-mail-followup-to () + "Insert a Mail-Followup-To header before previewing an article. +Should be adopted if code in `message-send-mail' is changed." + (when (and (message-mail-p) + (message-subscribed-p) + (not (mail-fetch-field "mail-followup-to")) + (message-make-mail-followup-to)) + (message-position-on-field "Mail-Followup-To" "X-Draft-From") + (insert (message-make-mail-followup-to)))) + (defun mml-preview (&optional raw) "Display current buffer with Gnus, in a new buffer. If RAW, don't highlight the article." (interactive "P") - (let ((buf (current-buffer)) - (message-posting-charset (or (gnus-setup-posting-charset - (save-restriction - (message-narrow-to-headers-or-head) - (message-fetch-field "Newsgroups"))) - message-posting-charset))) - (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) - (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)))) + (save-excursion + (let* ((buf (current-buffer)) + (message-options message-options) + (message-this-is-mail (message-mail-p)) + (message-this-is-news (message-news-p)) + (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-substring buf) + (mml-preview-insert-mail-followup-to) + (let ((message-deletable-headers (if (message-news-p) + nil + message-deletable-headers))) + (message-generate-headers + (copy-sequence (if (message-news-p) + message-required-news-headers + message-required-mail-headers)))) + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) + (replace-match "\n")) + (let ((mail-header-separator ""));; mail-header-separator is removed. + (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)) + gnus-article-prepare-hook gnus-original-article-buffer) + (run-hooks 'gnus-article-decode-hook) + (let ((gnus-newsgroup-name "dummy") + (gnus-newsrc-hashtb (or gnus-newsrc-hashtb + (gnus-make-hashtable 5)))) + (gnus-article-prepare-display)))) + ;; Disable article-mode-map. + (use-local-map nil) + (gnus-make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook + (lambda () + (mm-destroy-parts gnus-article-mime-handles)) nil t) + (setq buffer-read-only t) + (local-set-key "q" (lambda () (interactive) (kill-buffer nil))) + (local-set-key "=" (lambda () (interactive) (delete-other-windows))) + (local-set-key "\r" + (lambda () + (interactive) + (widget-button-press (point)))) + (local-set-key gnus-mouse-2 + (lambda (event) + (interactive "@e") + (widget-button-press (widget-event-point event) event))) + (goto-char (point-min))))) (defun mml-validate () "Validate the current MML document." (interactive) (mml-parse)) +(defun mml-tweak-part (cont) + "Tweak a MML part." + (let ((tweak (cdr (assq 'tweak cont))) + func) + (cond + (tweak + (setq func + (or (cdr (assoc tweak mml-tweak-function-alist)) + (intern tweak)))) + (mml-tweak-type-alist + (let ((alist mml-tweak-type-alist) + (type (or (cdr (assq 'type cont)) "text/plain"))) + (while alist + (if (string-match (caar alist) type) + (setq func (cdar alist) + alist nil) + (setq alist (cdr alist))))))) + (if func + (funcall func cont) + cont) + (let ((alist mml-tweak-sexp-alist)) + (while alist + (if (eval (caar alist)) + (funcall (cdar alist) cont)) + (setq alist (cdr alist))))) + cont) + +(defun mml-tweak-externalize-attachments (cont) + "Tweak attached files as external parts." + (let (filename-cons) + (when (and (eq (car cont) 'part) + (not (cdr (assq 'buffer cont))) + (and (setq filename-cons (assq 'filename cont)) + (not (equal (cdr (assq 'nofile cont)) "yes")))) + (setcar cont 'external) + (setcar filename-cons 'name)))) + (provide 'mml) ;;; mml.el ends here diff --git a/lisp/nnagent.el b/lisp/nnagent.el index b445395..21b9f97 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -1,5 +1,7 @@ ;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. + +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -67,7 +69,7 @@ (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 + (nnoo-change-server 'nnagent (nnagent-server server) defs) (let ((dir (gnus-agent-directory)) @@ -121,68 +123,108 @@ (deffoo nnagent-request-set-mark (group action server) (with-temp-buffer (insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n" - (nth 0 gnus-command-method) group action - (or server (nth 1 gnus-command-method)))) + (nth 0 gnus-command-method) group action + (or server (nth 1 gnus-command-method)))) (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) nil) +(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) + (let ((file (gnus-agent-article-name ".overview" group)) + arts n first) + (save-excursion + (gnus-agent-load-alist group) + (setq arts (gnus-sorted-difference + articles (mapcar 'car gnus-agent-article-alist))) + ;; Assume that articles with smaller numbers than the first one + ;; Agent knows are gone. + (setq first (caar gnus-agent-article-alist)) + (when first + (while (and arts (< (car arts) first)) + (pop arts))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-nov-file file (car articles)) + (goto-char (point-min)) + (gnus-parse-without-error + (while (and arts (not (eobp))) + (setq n (read (current-buffer))) + (when (> n (car arts)) + (beginning-of-line)) + (while (and arts (> n (car arts))) + (insert (format + "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" + (car arts) (car arts))) + (pop arts)) + (when (and arts (= n (car arts))) + (pop arts)) + (forward-line 1))) + (while arts + (insert (format + "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" + (car arts) (car arts))) + (pop arts)) + (if (and fetch-old + (not (numberp fetch-old))) + t ; Don't remove anything. + (nnheader-nov-delete-outside-range + (if fetch-old (max 1 (- (car articles) fetch-old)) + (car articles)) + (car (last articles))) + t) + 'nov))) + +(deffoo nnagent-request-expire-articles (articles group &optional server force) + articles) + (deffoo nnagent-request-group (group &optional server dont-check) (nnoo-parent-function 'nnagent 'nnml-request-group - (list group (nnagent-server server) dont-check))) + (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)))) + (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))) + (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))) + (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))) + (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))) + (list group force (nnagent-server server)))) (deffoo nnagent-request-list (&optional server) - (nnoo-parent-function 'nnagent 'nnml-request-list - (list (nnagent-server 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)))) + (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups + (list (nnagent-server server)))) -(deffoo nnagent-request-move-article +(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))) + (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)))) + (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))) + (nnoo-parent-function 'nnagent 'nnml-request-scan + (list group (nnagent-server server)))) (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)))) + (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 @@ -192,6 +234,10 @@ (nnoo-parent-function 'nnagent 'nnml-status-message (list (nnagent-server server)))) +(deffoo nnagent-request-regenerate (server) + (nnoo-parent-function 'nnagent 'nnml-request-regenerate + (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 787123b..8cecb1e 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -1,10 +1,10 @@ ;;; nnbabyl.el --- rmail mbox access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -52,6 +52,7 @@ (defvoo nnbabyl-get-new-mail t "If non-nil, nnbabyl will check the incoming mail file and split the mail.") + (defvoo nnbabyl-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") @@ -281,6 +282,15 @@ (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))) + (nnbabyl-possibly-change-newsgroup newsgroup server)) (nnheader-message 5 "Deleting article %d in %s..." (car articles) newsgroup) (nnbabyl-delete-mail)) @@ -340,7 +350,7 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (setq result (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -356,7 +366,7 @@ (insert-buffer-substring buf) (when last (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) diff --git a/lisp/nndb.el b/lisp/nndb.el index 30eb2e2..fa5e641 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -1,6 +1,6 @@ ;;; nndb.el --- nndb access for Gnus -;; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 2000, 2003 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Kai Grossjohann @@ -8,7 +8,7 @@ ;; David Blacka ;; Keywords: news -;; This file is NOT part of GNU Emacs. +;; 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 @@ -169,7 +169,7 @@ article was posted to nndb") (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) (setq msg (nndb-status-message)) (if (string-match "^423" msg) - () + () (or (string-match "'\\(.+\\)'" msg) (error "Not a valid response for X-DATE command: %s" msg)) @@ -286,7 +286,7 @@ Optional LAST is ignored." (nntp-send-buffer "^[23].*\n")) (set-buffer nntp-server-buffer) - (setq msg (buffer-substring (point-min) (point-max))) + (setq msg (buffer-string)) (or (string-match "^\\([0-9]+\\)" msg) (error "nndb: %s" msg)) (setq art (substring msg (match-beginning 1) (match-end 1))) @@ -312,7 +312,7 @@ Optional LAST is ignored." (deffoo nndb-status-message (&optional server) "Return server status as a string." (set-buffer nntp-server-buffer) - (buffer-substring (point-min) (point-max))) + (buffer-string)) ;; Import stuff from nntp @@ -320,3 +320,5 @@ Optional LAST is ignored." (nntp)) (provide 'nndb) + +;;; nndb.el ends here diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 3833395..73a7582 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -1,9 +1,9 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. @@ -25,6 +25,8 @@ ;;; Commentary: +;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/ + ;;; Code: (eval-when-compile (require 'cl)) @@ -41,7 +43,8 @@ "*Type of the file. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', `rfc934', `rfc822-forward', `mime-parts', `standard-digest', -`slack-digest', `clari-briefs', `nsmail' or `guess'.") +`slack-digest', `clari-briefs', `nsmail', `outlook', `oe-dbx', +`mailman', `exim-bounce', or `guess'.") (defvoo nndoc-post-type 'mail "*Whether the nndoc group is `mail' or `post'.") @@ -55,6 +58,9 @@ from the document.") `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) + (mime-parts + (generate-head-function . nndoc-generate-mime-parts-head) + (article-transform-function . nndoc-transform-mime-parts)) (nsmail (article-begin . "^From - ")) (news @@ -70,14 +76,17 @@ from the document.") (body-end . "\^_") (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.*$") - (prepare-body-function . nndoc-unquote-dashes)) + (exim-bounce + (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n") + (body-end-function . nndoc-exim-bounce-body-end-function)) (rfc934 (article-begin . "^--.*\n+") (body-end . "^--.*$") (prepare-body-function . nndoc-unquote-dashes)) + (mailman + (article-begin . "^--__--__--\n\nMessage:") + (body-end . "^--__--__--$") + (prepare-body-function . nndoc-unquote-dashes)) (clari-briefs (article-begin . "^ \\*") (body-end . "^\t------*[ \t]^*\n^ \\*") @@ -92,9 +101,6 @@ from the document.") (body-end . "") (file-end . "") (subtype digest guess)) - (mime-parts - (generate-head-function . nndoc-generate-mime-parts-head) - (article-transform-function . nndoc-transform-mime-parts)) (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+")) (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+")) @@ -117,8 +123,8 @@ from the document.") (head-begin . "^Paper.*:") (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") (body-begin . "") - (body-end . "-------------------------------------------------") - (file-end . "^Title: Recent Seminal") + (body-end . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)") + (file-end . "\\(^Title: Recent Seminal\\|%%%---%%%---%%%---%%%---\\)") (generate-head-function . nndoc-generate-lanl-gov-head) (article-transform-function . nndoc-transform-lanl-gov-announce) (subtype preprints guess)) @@ -128,6 +134,16 @@ from the document.") (outlook (article-begin-function . nndoc-outlook-article-begin) (body-end . "\0")) + (oe-dbx ;; Outlook Express DBX format + (dissection-function . nndoc-oe-dbx-dissection) + (generate-head-function . nndoc-oe-dbx-generate-head) + (generate-article-function . nndoc-oe-dbx-generate-article)) + (forward + (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+") + (body-end . "^-+ End \\(of \\)?forwarded message.*$") + (prepare-body-function . nndoc-unquote-dashes)) + (mail-in-mail ;; Wild guess on mailer daemon's messages or others + (article-begin-function . nndoc-mail-in-mail-article-begin)) (guess (guess . t) (subtype nil)) @@ -138,6 +154,9 @@ from the document.") (guess . t) (subtype nil)))) +(defvar nndoc-binary-file-names ".[Dd][Bb][Xx]$" + "Regexp for binary nndoc file names.") + (defvoo nndoc-file-begin nil) (defvoo nndoc-first-article nil) @@ -163,6 +182,8 @@ from the document.") (defvoo nndoc-generate-head-function nil) (defvoo nndoc-article-transform-function nil) (defvoo nndoc-article-begin-function nil) +(defvoo nndoc-generate-article-function nil) +(defvoo nndoc-dissection-function nil) (defvoo nndoc-status-string "") (defvoo nndoc-group-alist nil) @@ -213,8 +234,11 @@ from the document.") (set-buffer buffer) (erase-buffer) (when entry - (if (stringp article) - nil + (cond + ((stringp article) nil) + (nndoc-generate-article-function + (funcall nndoc-generate-article-function article)) + (t (insert-buffer-substring nndoc-current-buffer (car entry) (nth 1 entry)) (insert "\n") @@ -226,7 +250,7 @@ from the document.") (funcall nndoc-prepare-body-function)) (when nndoc-article-transform-function (funcall nndoc-article-transform-function article)) - t))))) + t)))))) (deffoo nndoc-request-group (group &optional server dont-check) "Select news GROUP." @@ -246,8 +270,8 @@ from the document.") (deffoo nndoc-request-type (group &optional article) (cond ((not article) 'unknown) - (nndoc-post-type nndoc-post-type) - (t 'unknown))) + (nndoc-post-type nndoc-post-type) + (t 'unknown))) (deffoo nndoc-close-group (group &optional server) (nndoc-possibly-change-buffer group server) @@ -299,10 +323,14 @@ from the document.") (save-excursion (set-buffer nndoc-current-buffer) (erase-buffer) - (if (stringp nndoc-address) - (nnheader-insert-file-contents nndoc-address) - (insert-buffer-substring nndoc-address)) - (run-hooks 'nndoc-open-document-hook)))) + (if (and (stringp nndoc-address) + (string-match nndoc-binary-file-names nndoc-address)) + (let ((nnheader-file-coding-system 'binary)) + (nnheader-insert-file-contents nndoc-address)) + (if (stringp nndoc-address) + (nnheader-insert-file-contents nndoc-address) + (insert-buffer-substring nndoc-address)) + (run-hooks 'nndoc-open-document-hook))))) ;; Initialize the nndoc structures according to this new document. (when (and nndoc-current-buffer (not nndoc-dissection-alist)) @@ -331,7 +359,9 @@ from the document.") nndoc-body-begin nndoc-body-end-function nndoc-body-end nndoc-prepare-body-function nndoc-article-transform-function nndoc-generate-head-function nndoc-body-begin-function - nndoc-head-begin-function))) + nndoc-head-begin-function + nndoc-generate-article-function + nndoc-dissection-function))) (while vars (set (pop vars) nil))) (let (defs) @@ -436,11 +466,9 @@ from the document.") t)) (defun nndoc-forward-type-p () - (when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+" + (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))) + (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")) t)) (defun nndoc-rfc934-type-p () @@ -450,6 +478,10 @@ from the document.") (not (re-search-forward "^From:" nil t 2))) t)) +(defun nndoc-mailman-type-p () + (when (re-search-forward "^--__--__--\n+" nil t) + t)) + (defun nndoc-rfc822-forward-type-p () (save-restriction (message-narrow-to-head) @@ -464,11 +496,11 @@ from the document.") (limit (search-forward "\n\n" nil t))) (goto-char (point-min)) (when (and limit - (re-search-forward - (concat "\ + (re-search-forward + (concat "\ ^Content-Type:[ \t]*multipart/[a-z]+ *; *\\(\\(\n[ \t]\\)?.*;\\)*" - "\\(\n[ \t]\\)?[ \t]*boundary=\"?[^\"\n]*[^\" \t\n]") - limit t)) + "\\(\n[ \t]\\)?[ \t]*boundary=\"?[^\"\n]*[^\" \t\n]") + limit t)) t))) (defun nndoc-transform-mime-parts (article) @@ -520,6 +552,13 @@ from the document.") (insert "From: " "clari@clari.net (" (or from "unknown") ")" "\nSubject: " (or subject "(no subject)") "\n"))) +(defun nndoc-exim-bounce-type-p () + (and (re-search-forward "^------ This is a copy of the message, including all the headers. ------" nil t) + t)) + +(defun nndoc-exim-bounce-body-end-function () + (goto-char (point-max))) + (defun nndoc-mime-digest-type-p () (let ((case-fold-search t) @@ -540,7 +579,7 @@ from the document.") (cons 'body-begin "^ ?\n") (cons 'article-begin b-delimiter) (cons 'body-end-function 'nndoc-digest-body-end) - (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) + (cons 'file-end (concat "^--" boundary-id "--[ \t]*$")))) t))) (defun nndoc-standard-digest-type-p () @@ -558,35 +597,54 @@ from the document.") (defun nndoc-lanl-gov-announce-type-p () (when (let ((case-fold-search nil)) - (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t)) + (re-search-forward "^\\\\\\\\\nPaper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+" nil t)) t)) (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 "\n\nGet it at \\1 (\\2)" t nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\\\\\\\$" nil t) + (replace-match "" t nil)) + (goto-char (point-min)) + (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t) + (replace-match "Date: \\1 (revised) " t nil)) + (goto-char (point-min)) + (unless (re-search-forward "^From" nil t) + (goto-char (point-min)) + (when (re-search-forward "^Authors?: \\(.*\\)" nil t) + (goto-char (point-min)) + (insert "From: " (match-string 1) "\n")))) (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) - (e-mail "no address given") - subject from) + (from "") + subject date) (save-excursion (set-buffer nndoc-current-buffer) (save-restriction - (narrow-to-region (car entry) (nth 1 entry)) - (goto-char (point-min)) - (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)") - (setq subject (concat " (" (match-string 1) ")")) - (when (re-search-forward "^From: \\([^ ]+\\)" nil t) - (setq e-mail (match-string 1))) - (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" - nil t) - (setq subject (concat (match-string 1) subject)) - (setq from (concat (match-string 2) " <" e-mail ">")))))) + (narrow-to-region (car entry) (nth 1 entry)) + (goto-char (point-min)) + (when (looking-at "^Paper.*: \\([a-zA-Z-\\.]+/[0-9]+\\)") + (setq subject (concat " (" (match-string 1) ")")) + (when (re-search-forward "^From: \\(.*\\)" nil t) + (setq from (concat "<" + (cadr (funcall gnus-extract-address-components + (match-string 1))) ">"))) + (if (re-search-forward "^Date: +\\([^(]*\\)" nil t) + (setq date (match-string 1)) + (when (re-search-forward "^replaced with revised version +\\([^(]*\\)" nil t) + (setq date (match-string 1)))) + (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" + nil t) + (setq subject (concat (match-string 1) subject)) + (setq from (concat (match-string 2) " " from)))))) (while (and from (string-match "(\[^)\]*)" from)) (setq from (replace-match "" t t from))) (insert "From: " (or from "unknown") - "\nSubject: " (or subject "(no subject)") "\n"))) + "\nSubject: " (or subject "(no subject)") "\n") + (if date (insert "Date: " date)))) (defun nndoc-nsmail-type-p () (when (looking-at "From - ") @@ -600,10 +658,106 @@ from the document.") ;; FIXME: Is JMF the magic of outlook mailbox? -- ShengHuo. (looking-at "JMF")) +(defun nndoc-oe-dbx-type-p () + (looking-at (string-as-multibyte "\317\255\022\376"))) + +(defun nndoc-read-little-endian () + (+ (prog1 (char-after) (forward-char 1)) + (lsh (prog1 (char-after) (forward-char 1)) 8) + (lsh (prog1 (char-after) (forward-char 1)) 16) + (lsh (prog1 (char-after) (forward-char 1)) 24))) + +(defun nndoc-oe-dbx-decode-block () + (list + (nndoc-read-little-endian) ;; this address + (nndoc-read-little-endian) ;; next address offset + (nndoc-read-little-endian) ;; blocksize + (nndoc-read-little-endian))) ;; next address + +(defun nndoc-oe-dbx-dissection () + (let ((i 0) blk p tp) + (goto-char 60117) ;; 0x0000EAD4+1 + (setq p (point)) + (unless (eobp) + (setq blk (nndoc-oe-dbx-decode-block))) + (while (and blk (> (car blk) 0) (or (zerop (nth 3 blk)) + (> (nth 3 blk) p))) + (push (list (incf i) p nil nil nil 0) nndoc-dissection-alist) + (while (and (> (car blk) 0) (> (nth 3 blk) p)) + (goto-char (1+ (nth 3 blk))) + (setq blk (nndoc-oe-dbx-decode-block))) + (if (or (<= (car blk) p) + (<= (nth 1 blk) 0) + (not (zerop (nth 3 blk)))) + (setq blk nil) + (setq tp (+ (car blk) (nth 1 blk) 17)) + (if (or (<= tp p) (>= tp (point-max))) + (setq blk nil) + (goto-char tp) + (setq p tp + blk (nndoc-oe-dbx-decode-block))))))) + +(defun nndoc-oe-dbx-generate-article (article &optional head) + (let ((entry (cdr (assq article nndoc-dissection-alist))) + (cur (current-buffer)) + (begin (point)) + blk p) + (with-current-buffer nndoc-current-buffer + (setq p (car entry)) + (while (> p (point-min)) + (goto-char p) + (setq blk (nndoc-oe-dbx-decode-block)) + (setq p (point)) + (with-current-buffer cur + (insert-buffer-substring nndoc-current-buffer p (+ p (nth 2 blk)))) + (setq p (1+ (nth 3 blk))))) + (goto-char begin) + (while (re-search-forward "\r$" nil t) + (delete-backward-char 1)) + (when head + (goto-char begin) + (when (search-forward "\n\n" nil t) + (setcar (cddddr entry) (count-lines (point) (point-max))) + (delete-region (1- (point)) (point-max)))) + t)) + +(defun nndoc-oe-dbx-generate-head (article) + (nndoc-oe-dbx-generate-article article 'head)) + +(defun nndoc-mail-in-mail-type-p () + (let (found) + (save-excursion + (catch 'done + (while (re-search-forward "\n\n[-A-Za-z0-9]+:" nil t) + (setq found 0) + (forward-line) + (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:") + (if (looking-at "[-A-Za-z0-9]+:") + (setq found (1+ found))) + (forward-line)) + (if (and (> found 0) (looking-at "\n")) + (throw 'done 9999))) + nil)))) + +(defun nndoc-mail-in-mail-article-begin () + (let (point found) + (if (catch 'done + (while (re-search-forward "\n\n\\([-A-Za-z0-9]+:\\)" nil t) + (setq found 0) + (setq point (match-beginning 1)) + (forward-line) + (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:") + (if (looking-at "[-A-Za-z0-9]+:") + (setq found (1+ found))) + (forward-line)) + (if (and (> found 0) (looking-at "\n")) + (throw 'done t))) + nil) + (goto-char point)))) + (deffoo nndoc-request-accept-article (group &optional server last) nil) - ;;; ;;; Functions for dissecting the documents ;;; @@ -625,43 +779,45 @@ from the document.") ;; Remove blank lines. (while (eq (following-char) ?\n) (delete-char 1)) - ;; Find the beginning of the file. - (when nndoc-file-begin - (nndoc-search nndoc-file-begin)) - ;; Go through the file. - (while (if (and first nndoc-first-article) - (nndoc-search nndoc-first-article) - (nndoc-article-begin)) - (setq first nil) - (cond (nndoc-head-begin-function - (funcall nndoc-head-begin-function)) - (nndoc-head-begin - (nndoc-search nndoc-head-begin))) - (if (or (eobp) - (and nndoc-file-end - (looking-at nndoc-file-end))) - (goto-char (point-max)) - (setq head-begin (point)) - (nndoc-search (or nndoc-head-end "^$")) - (setq head-end (point)) - (if nndoc-body-begin-function - (funcall nndoc-body-begin-function) - (nndoc-search (or nndoc-body-begin "^\n"))) - (setq body-begin (point)) - (or (and nndoc-body-end-function - (funcall nndoc-body-end-function)) - (and nndoc-body-end - (nndoc-search nndoc-body-end)) - (nndoc-article-begin) - (progn - (goto-char (point-max)) - (when nndoc-file-end - (and (re-search-backward nndoc-file-end nil t) - (beginning-of-line))))) - (setq body-end (point)) - (push (list (incf i) head-begin head-end body-begin body-end - (count-lines body-begin body-end)) - nndoc-dissection-alist)))))) + (if nndoc-dissection-function + (funcall nndoc-dissection-function) + ;; Find the beginning of the file. + (when nndoc-file-begin + (nndoc-search nndoc-file-begin)) + ;; Go through the file. + (while (if (and first nndoc-first-article) + (nndoc-search nndoc-first-article) + (nndoc-article-begin)) + (setq first nil) + (cond (nndoc-head-begin-function + (funcall nndoc-head-begin-function)) + (nndoc-head-begin + (nndoc-search nndoc-head-begin))) + (if (or (eobp) + (and nndoc-file-end + (looking-at nndoc-file-end))) + (goto-char (point-max)) + (setq head-begin (point)) + (nndoc-search (or nndoc-head-end "^$")) + (setq head-end (point)) + (if nndoc-body-begin-function + (funcall nndoc-body-begin-function) + (nndoc-search (or nndoc-body-begin "^\n"))) + (setq body-begin (point)) + (or (and nndoc-body-end-function + (funcall nndoc-body-end-function)) + (and nndoc-body-end + (nndoc-search nndoc-body-end)) + (nndoc-article-begin) + (progn + (goto-char (point-max)) + (when nndoc-file-end + (and (re-search-backward nndoc-file-end nil t) + (beginning-of-line))))) + (setq body-end (point)) + (push (list (incf i) head-begin head-end body-begin body-end + (count-lines body-begin body-end)) + nndoc-dissection-alist))))))) (defun nndoc-article-begin () (if nndoc-article-begin-function @@ -734,8 +890,12 @@ PARENT is the message-ID of the parent summary line, or nil for none." subtype "plain")) ;; Prepare the article and summary inserts. (unless article-insert - (setq article-insert (buffer-substring (point-min) (point-max)) + (setq article-insert (buffer-string) head-end head-begin)) + ;; Fix MIME-Version + (unless (string-match "MIME-Version:" article-insert) + (setq article-insert + (concat article-insert "MIME-Version: 1.0\n"))) (setq summary-insert article-insert) ;; - summary Subject. (setq summary-insert diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 71531ee..bd27cfe 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -1,5 +1,6 @@ ;;; nndraft.el --- draft article access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -33,9 +34,6 @@ (require 'gnus-start) (require 'nnmh) (require 'nnoo) -(eval-when-compile - ;; This is just to shut up the byte-compiler. - (defalias 'nndraft-request-group 'ignore)) (nnoo-declare nndraft nnmh) @@ -111,7 +109,12 @@ (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) - (let ((nnmail-file-coding-system nnheader-text-coding-system)) + (let ((nnmail-file-coding-system + (if (file-newer-than-file-p file auto) + (if (member group '("drafts" "delayed")) + message-draft-coding-system + nnheader-text-coding-system) + nnheader-auto-save-coding-system))) (nnmail-find-file newest))) (save-excursion (set-buffer nntp-server-buffer) @@ -119,7 +122,7 @@ ;; If there's a mail header separator in this file, ;; we remove it. (when (re-search-forward - (concat "^" mail-header-separator "$") nil t) + (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t))) t)))) @@ -129,7 +132,9 @@ (when (nndraft-request-article article group server (current-buffer)) (message-remove-header "xref") (message-remove-header "lines") - (message-remove-header "date") + ;; Articles in nndraft:queue are considered as sent messages. The + ;; Date field should be the time when they are sent. + ;;(message-remove-header "date") t)) (deffoo nndraft-request-update-info (group info &optional server) @@ -147,6 +152,12 @@ nil)))) t) +(defun nndraft-generate-headers () + (save-excursion + (message-generate-headers + (message-headers-to-generate + message-required-headers message-draft-headers nil)))) + (deffoo nndraft-request-associate-buffer (group) "Associate the current buffer with some article in the draft group." (nndraft-open-server "") @@ -163,8 +174,35 @@ (setq buffer-file-name (expand-file-name file) buffer-auto-save-file-name (make-auto-save-file-name)) (clear-visited-file-modtime) + (make-local-variable 'write-contents-hooks) + (push 'nndraft-generate-headers write-contents-hooks) article)) +(deffoo nndraft-request-group (group &optional server dont-check) + (nndraft-possibly-change-group group) + (unless dont-check + (let* ((pathname (nnmail-group-pathname group nndraft-directory)) + (file-name-coding-system nnmail-pathname-coding-system) + dir file) + (nnheader-re-read-dir pathname) + (setq dir (mapcar (lambda (name) (string-to-int (substring name 1))) + (ignore-errors (directory-files + pathname nil "^#[0-9]+#$" t)))) + (dolist (n dir) + (unless (file-exists-p + (setq file (expand-file-name (int-to-string n) pathname))) + (rename-file (nndraft-auto-save-file-name file) file))))) + (nnoo-parent-function 'nndraft + 'nnmh-request-group + (list group server dont-check))) + +(deffoo nndraft-request-move-article (article group server + accept-form &optional last) + (nndraft-possibly-change-group group) + (let ((nnmh-allow-delete-final t)) + (nnoo-parent-function 'nndraft 'nndraft-request-move-article + (list article group server accept-form last)))) + (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) @@ -196,7 +234,10 @@ (deffoo nndraft-request-replace-article (article group buffer) (nndraft-possibly-change-group group) - (let ((nnmail-file-coding-system nnheader-text-coding-system)) + (let ((nnmail-file-coding-system + (if (member group '("drafts" "delayed")) + message-draft-coding-system + nnheader-text-coding-system))) (nnoo-parent-function 'nndraft 'nnmh-request-replace-article (list article group buffer)))) @@ -252,8 +293,7 @@ nnmh-request-group nnmh-close-group nnmh-request-list - nnmh-request-newsgroups - nnmh-request-move-article)) + nnmh-request-newsgroups)) (provide 'nndraft) diff --git a/lisp/nneething.el b/lisp/nneething.el index a9c3bb6..420d7f9 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -1,10 +1,10 @@ ;;; nneething.el --- arbitrary file access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -64,7 +64,6 @@ included.") (defvoo nneething-status-string "") -(defvoo nneething-message-id-number 0) (defvoo nneething-work-buffer " *nneething work*") (defvoo nneething-group nil) @@ -73,6 +72,103 @@ included.") (defvoo nneething-active nil) (defvoo nneething-address nil) +(defvar nneething-mime-extensions + '(("" . "text/plain") + (".abs" . "audio/x-mpeg") + (".aif" . "audio/aiff") + (".aifc" . "audio/aiff") + (".aiff" . "audio/aiff") + (".ano" . "application/x-annotator") + (".au" . "audio/ulaw") + (".avi" . "video/x-msvideo") + (".bcpio" . "application/x-bcpio") + (".bin" . "application/octet-stream") + (".cdf" . "application/x-netcdr") + (".cpio" . "application/x-cpio") + (".csh" . "application/x-csh") + (".css" . "text/css") + (".dvi" . "application/x-dvi") + (".diff" . "text/x-patch") + (".el" . "application/emacs-lisp") + (".eps" . "application/postscript") + (".etx" . "text/x-setext") + (".exe" . "application/octet-stream") + (".fax" . "image/x-fax") + (".gif" . "image/gif") + (".hdf" . "application/x-hdf") + (".hqx" . "application/mac-binhex40") + (".htm" . "text/html") + (".html" . "text/html") + (".icon" . "image/x-icon") + (".ief" . "image/ief") + (".jpg" . "image/jpeg") + (".macp" . "image/x-macpaint") + (".man" . "application/x-troff-man") + (".me" . "application/x-troff-me") + (".mif" . "application/mif") + (".mov" . "video/quicktime") + (".movie" . "video/x-sgi-movie") + (".mp2" . "audio/x-mpeg") + (".mp3" . "audio/x-mpeg") + (".mp2a" . "audio/x-mpeg2") + (".mpa" . "audio/x-mpeg") + (".mpa2" . "audio/x-mpeg2") + (".mpe" . "video/mpeg") + (".mpeg" . "video/mpeg") + (".mpega" . "audio/x-mpeg") + (".mpegv" . "video/mpeg") + (".mpg" . "video/mpeg") + (".mpv" . "video/mpeg") + (".ms" . "application/x-troff-ms") + (".nc" . "application/x-netcdf") + (".nc" . "application/x-netcdf") + (".oda" . "application/oda") + (".patch" . "text/x-patch") + (".pbm" . "image/x-portable-bitmap") + (".pdf" . "application/pdf") + (".pgm" . "image/portable-graymap") + (".pict" . "image/pict") + (".png" . "image/png") + (".pnm" . "image/x-portable-anymap") + (".ppm" . "image/portable-pixmap") + (".ps" . "application/postscript") + (".qt" . "video/quicktime") + (".ras" . "image/x-raster") + (".rgb" . "image/x-rgb") + (".rtf" . "application/rtf") + (".rtx" . "text/richtext") + (".sh" . "application/x-sh") + (".sit" . "application/x-stuffit") + (".siv" . "application/sieve") + (".snd" . "audio/basic") + (".src" . "application/x-wais-source") + (".tar" . "archive/tar") + (".tcl" . "application/x-tcl") + (".tex" . "application/x-tex") + (".texi" . "application/texinfo") + (".tga" . "image/x-targa") + (".tif" . "image/tiff") + (".tiff" . "image/tiff") + (".tr" . "application/x-troff") + (".troff" . "application/x-troff") + (".tsv" . "text/tab-separated-values") + (".txt" . "text/plain") + (".vbs" . "video/mpeg") + (".vox" . "audio/basic") + (".vrml" . "x-world/x-vrml") + (".wav" . "audio/x-wav") + (".xls" . "application/vnd.ms-excel") + (".wrl" . "x-world/x-vrml") + (".xbm" . "image/xbm") + (".xpm" . "image/xpm") + (".xwd" . "image/windowdump") + (".zip" . "application/zip") + (".ai" . "application/postscript") + (".jpe" . "image/jpeg") + (".jpeg" . "image/jpeg")) + "An alist of file extensions and corresponding MIME content-types. +This variable is used as the alternative of `mailcap-mime-extensions'.") + ;;; Interface functions. @@ -126,11 +222,25 @@ included.") (file-exists-p file) ; The file exists. (not (file-directory-p file)) ; It's not a dir. (save-excursion - (nnmail-find-file file) ; Insert the file in the nntp buf. + (let ((nnmail-file-coding-system 'binary)) + (nnmail-find-file file)) ; Insert the file in the nntp buf. (unless (nnheader-article-p) ; Either it's a real article... - (goto-char (point-min)) - (nneething-make-head - file (current-buffer)) ; ... or we fake some headers. + (let ((type + (unless (file-directory-p file) + (or (cdr (assoc (concat "." (file-name-extension file)) + (if (boundp 'mailcap-mime-extensions) + (symbol-value 'mailcap-mime-extensions) + nneething-mime-extensions))) + "text/plain"))) + (charset + (mm-detect-mime-charset-region (point-min) (point-max))) + (encoding)) + (unless (string-match "\\`text/" type) + (base64-encode-region (point-min) (point-max)) + (setq encoding "base64")) + (goto-char (point-min)) + (nneething-make-head file (current-buffer) + nil type charset encoding)) (insert "\n")) t)))) @@ -272,13 +382,42 @@ included.") (insert-buffer-substring nneething-work-buffer) (goto-char (point-max)))) -(defun nneething-make-head (file &optional buffer) +(defun nneething-encode-file-name (file &optional coding-system) + "Encode the name of the FILE in CODING-SYSTEM." + (let ((pos 0) buf) + (setq file (mm-encode-coding-string + file (or coding-system nnmail-pathname-coding-system))) + (while (string-match "[^-0-9a-zA-Z_:/.]" file pos) + (setq buf (cons (format "%%%02x" (aref file (match-beginning 0))) + (cons (substring file pos (match-beginning 0)) buf)) + pos (match-end 0))) + (apply (function concat) + (nreverse (cons (substring file pos) buf))))) + +(defun nneething-decode-file-name (file &optional coding-system) + "Decode the name of the FILE is encoded in CODING-SYSTEM." + (let ((pos 0) buf) + (while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos) + (setq buf (cons (string (string-to-number (match-string 1 file) 16)) + (cons (substring file pos (match-beginning 0)) buf)) + pos (match-end 0))) + (decode-coding-string + (apply (function concat) + (nreverse (cons (substring file pos) buf))) + (or coding-system nnmail-pathname-coding-system)))) + +(defun nneething-get-file-name (id) + "Extract the file name from the message ID string." + (when (string-match "\\`\\'" id) + (nneething-decode-file-name (match-string 1 id)))) + +(defun nneething-make-head (file &optional buffer extra-msg + mime-type mime-charset mime-encoding) "Create a head by looking at the file attributes of FILE." (let ((atts (file-attributes file))) (insert - "Subject: " (file-name-nondirectory file) "\n" - "Message-ID: \n" (if (equal '(0 0) (nth 5 atts)) "" (concat "Date: " (current-time-string (nth 5 atts)) "\n")) @@ -297,6 +436,19 @@ included.") (concat "Lines: " (int-to-string (count-lines (point-min) (point-max))) "\n")) + "") + (if mime-type + (concat "Content-Type: " mime-type + (if mime-charset + (concat "; charset=" + (if (stringp mime-charset) + mime-charset + (symbol-name mime-charset))) + "") + (if mime-encoding + (concat "\nContent-Transfer-Encoding: " mime-encoding) + "") + "\nMIME-Version: 1.0\n") "")))) (defun nneething-from-line (uid &optional file) @@ -344,28 +496,32 @@ included.") (nneething-make-head file) t) (t ;; We examine the file. - (nnheader-insert-head file) - (if (nnheader-article-p) - (delete-region - (progn - (goto-char (point-min)) - (or (and (search-forward "\n\n" nil t) - (1- (point))) - (point-max))) - (point-max)) - (goto-char (point-min)) - (nneething-make-head file (current-buffer)) - (delete-region (point) (point-max))) + (condition-case () + (progn + (nnheader-insert-head file) + (if (nnheader-article-p) + (delete-region + (progn + (goto-char (point-min)) + (or (and (search-forward "\n\n" nil t) + (1- (point))) + (point-max))) + (point-max)) + (goto-char (point-min)) + (nneething-make-head file (current-buffer)) + (delete-region (point) (point-max)))) + (file-error + (nneething-make-head file (current-buffer) " (unreadable)"))) t)))) (defun nneething-file-name (article) "Return the file name of ARTICLE." (let ((dir (file-name-as-directory nneething-address)) - fname) + fname) (if (numberp article) (if (setq fname (cadr (assq article nneething-map))) (expand-file-name fname dir) - (make-temp-name (expand-file-name "nneething" dir))) + (mm-make-temp-file (expand-file-name "nneething" dir))) (expand-file-name article dir)))) (provide 'nneething) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 5917d11..448ada4 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1,10 +1,12 @@ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. -;; Author: Scott Byer +;; Author: Simon Josefsson (adding MARKS) +;; ShengHuo Zhu (adding NOV) +;; Scott Byer ;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -28,18 +30,34 @@ ;;; Code: +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) + (require 'nnheader) (require 'message) (require 'nnmail) (require 'nnoo) -(eval-when-compile (require 'cl)) +(require 'gnus) (require 'gnus-util) +(require 'gnus-range) + +(eval-and-compile + (autoload 'gnus-article-unpropagatable-p "gnus-sum") + (autoload 'gnus-intersection "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-marks-directory nil + "The name of the nnfolder MARKS directory. +If nil, `nnfolder-directory' is used.") + (defvoo nnfolder-active-file (nnheader-concat nnfolder-directory "active") "The name of the active file.") @@ -75,12 +93,13 @@ message, a huge time saver for large mailboxes.") (defvoo nnfolder-save-buffer-hook nil "Hook run before saving the nnfolder mbox buffer.") + (defvoo nnfolder-inhibit-expiry nil "If non-nil, inhibit expiry.") -(defconst nnfolder-version "nnfolder 1.0" +(defconst nnfolder-version "nnfolder 2.0" "nnfolder version.") (defconst nnfolder-article-marker "X-Gnus-Article-Number: " @@ -94,12 +113,42 @@ message, a huge time saver for large mailboxes.") (defvoo nnfolder-scantime-alist nil) (defvoo nnfolder-active-timestamp nil) (defvoo nnfolder-active-file-coding-system nnheader-text-coding-system) -(defvoo nnfolder-active-file-coding-system-for-write +(defvoo nnfolder-active-file-coding-system-for-write nnmail-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.") +if nil, `nnfolder-file-coding-system' is used.") ; FIXME: fill-in the doc-string of this variable + +(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) + +(defvoo nnfolder-marks-is-evil nil + "If non-nil, Gnus will never generate and use marks file for mail groups. +Using marks files makes it possible to backup and restore mail groups +separately from `.newsrc.eld'. If you have, for some reason, set +this to t, and want to set it to nil again, you should always remove +the corresponding marks file (usually base nnfolder file name +concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for +the group. Then the marks file will be regenerated properly by Gnus.") + +(defvoo nnfolder-marks nil) + +(defvoo nnfolder-marks-file-suffix ".mrk") + +(defvar nnfolder-marks-modtime (gnus-make-hashtable)) @@ -111,34 +160,82 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (let (article start stop) + (let (article start stop num) (nnfolder-possibly-change-group group server) (when nnfolder-current-buffer (set-buffer nnfolder-current-buffer) (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 + (setq articles (gnus-sorted-intersection + ;; Is ARTICLES sorted? + (sort articles '<) + (nnfolder-existing-articles))) + (while (setq article (pop articles)) + (set-buffer nnfolder-current-buffer) + (cond ((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")) + + ;; If we couldn't find this article, skip over ranges + ;; of missing articles so we don't search the whole file + ;; for each of them. + ((numberp article) + (setq start (point)) + (and + ;; Check that we are either at BOF or after an + ;; article with a lower number. We do this so we + ;; won't be confused by out-of-order article numbers, + ;; as caused by active file bogosity. + (cond + ((bobp)) + ((search-backward (concat "\n" nnfolder-article-marker) + nil t) + (goto-char (match-end 0)) + (setq num (string-to-int + (buffer-substring + (point) (gnus-point-at-eol)))) + (goto-char start) + (< num article))) + ;; Check that we are before an article with a + ;; higher number. + (search-forward (concat "\n" nnfolder-article-marker) + nil t) + (progn + (setq num (string-to-int + (buffer-substring + (point) (gnus-point-at-eol)))) + (> num article)) + ;; Discard any article numbers before the one we're + ;; now looking at. + (while (and articles + (< (car articles) num)) + (setq articles (cdr articles)))) + (goto-char start)))) + (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))) + (unless nnfolder-marks-is-evil + (and nnfolder-marks-directory + (gnus-make-directory nnfolder-marks-directory))) (cond ((not (file-exists-p nnfolder-directory)) (nnfolder-close-server) @@ -188,11 +285,10 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (cons nnfolder-current-group article) (goto-char (point-min)) (cons nnfolder-current-group - (if (search-forward (concat "\n" nnfolder-article-marker) + (if (search-forward (concat "\n" nnfolder-article-marker) nil t) - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point)))) + (string-to-int (buffer-substring + (point) (gnus-point-at-eol))) -1)))))))) (deffoo nnfolder-request-group (group &optional server dont-check) @@ -312,13 +408,13 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (let ((marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") numbers) - (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) (push newnum numbers)))) - numbers)))) + ;; The article numbers are increasing, so this result is sorted. + (nreverse numbers))))) (deffoo nnfolder-request-expire-articles (articles newsgroup &optional server force) @@ -329,7 +425,7 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") ;; The articles that really exist and will ;; be expired if they are old enough. (maybe-expirable - (gnus-intersection articles (nnfolder-existing-articles)))) + (gnus-sorted-intersection articles (nnfolder-existing-articles)))) (nnmail-activate 'nnfolder) (save-excursion @@ -349,9 +445,19 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (buffer-substring (point) (progn (end-of-line) (point))) force nnfolder-inhibit-expiry)) - (nnheader-message 5 "Deleting article %d..." + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnfolder-request-article (car maybe-expirable) + newsgroup server (current-buffer)) + (let ((nnfolder-current-directory nil)) + (nnmail-expiry-target-group + nnmail-expiry-target newsgroup))) + (nnfolder-possibly-change-group newsgroup server)) + (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))) @@ -360,7 +466,7 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (nnfolder-save-buffer) (nnfolder-adjust-min-active newsgroup) (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (gnus-sorted-complement articles (nreverse deleted-articles))))) + (gnus-sorted-difference articles (nreverse deleted-articles))))) (deffoo nnfolder-request-move-article (article group server accept-form &optional last) @@ -376,10 +482,9 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (goto-char (point-min)) (while (re-search-forward (concat "^" nnfolder-article-marker) - (save-excursion (and (search-forward "\n\n" nil t) (point))) + (save-excursion (and (search-forward "\n\n" nil t) (point))) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (gnus-delete-line)) (setq result (eval accept-form)) (kill-buffer buf) result) @@ -389,6 +494,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) @@ -403,34 +510,38 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") result art-group) (goto-char (point-min)) (when (looking-at "X-From-Line: ") - (replace-match "From ")) - (and - (nnfolder-request-list) - (save-excursion - (set-buffer buf) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) - (delete-region (point) (progn (forward-line 1) (point)))) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (setq result (if (stringp group) - (list (cons group (nnfolder-active-number group))) - (setq art-group - (nnmail-article-group 'nnfolder-active-number)))) - (if (and (null result) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result - (car (nnfolder-save-mail result))))) - (when last - (save-excursion - (nnfolder-possibly-change-folder (or (caar art-group) group)) - (nnfolder-save-buffer) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-close))))) + (replace-match "From ") + (while (progn (forward-line) (looking-at "[ \t]")) + (delete-char -1))) + (with-temp-buffer + (let ((nnmail-file-coding-system nnfolder-active-file-coding-system) + (nntp-server-buffer (current-buffer))) + (nnmail-find-file nnfolder-active-file) + (setq nnfolder-group-alist (nnmail-parse-active)))) + (save-excursion + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (forward-line -1) + (goto-char (point-max))) + (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) + (delete-region (point) (progn (forward-line 1) (point)))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (setq result (if (stringp group) + (list (cons group (nnfolder-active-number group))) + (setq art-group + (nnmail-article-group 'nnfolder-active-number)))) + (if (and (null result) + (yes-or-no-p "Moved to `junk' group; delete article? ")) + (setq result 'junk) + (setq result + (car (nnfolder-save-mail result))))) + (when last + (save-excursion + (nnfolder-possibly-change-folder (or (caar art-group) group)) + (nnfolder-save-buffer) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)))) (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) @@ -441,15 +552,13 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (save-excursion (set-buffer buffer) (goto-char (point-min)) - (let (xfrom) - (while (re-search-forward "^X-From-Line: \\(.*\\)$" nil t) - (setq xfrom (match-string 1)) - (gnus-delete-line)) - (goto-char (point-min)) - (if xfrom - (insert "From " xfrom "\n") - (unless (looking-at "From ") - (insert "From nobody " (current-time-string) "\n")))) + (if (not (looking-at "X-From-Line: ")) + (insert "From nobody " (current-time-string) "\n") + (replace-match "From ") + (forward-line 1) + (while (looking-at "[ \t]") + (delete-char -1) + (forward-line 1))) (nnfolder-normalize-buffer) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) @@ -457,6 +566,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))) @@ -466,8 +584,12 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (if (not force) () ; Don't delete the articles. ;; Delete the file that holds the group. - (ignore-errors - (delete-file (nnfolder-group-pathname group)))) + (let ((data (nnfolder-group-pathname group)) + (nov (nnfolder-group-nov-pathname group)) + (mrk (nnfolder-group-marks-pathname group))) + (ignore-errors (delete-file data)) + (ignore-errors (delete-file nov)) + (ignore-errors (delete-file mrk)))) ;; Remove the group from all structures. (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) @@ -483,11 +605,17 @@ 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) + (when (file-exists-p (nnfolder-group-nov-pathname group)) + (setq new-file (nnfolder-group-nov-pathname new-name)) + (gnus-make-directory (file-name-directory new-file)) + (rename-file (nnfolder-group-nov-pathname group) new-file)) + (when (file-exists-p (nnfolder-group-marks-pathname group)) + (setq new-file (nnfolder-group-marks-pathname new-name)) + (gnus-make-directory (file-name-directory new-file)) + (rename-file (nnfolder-group-marks-pathname group) new-file))) t) ;; That went ok, so we change the internal structures. (let ((entry (assoc group nnfolder-group-alist))) @@ -500,7 +628,7 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (kill-buffer (current-buffer)) t)))) -(defun nnfolder-request-regenerate (server) +(deffoo nnfolder-request-regenerate (server) (nnfolder-possibly-change-group nil server) (nnfolder-generate-active-file) t) @@ -582,18 +710,14 @@ deleted. Point is left where the deleted region was." (setq nnfolder-current-buffer nil nnfolder-current-group nil)) ;; Change group. - (when (and group - (not (equal group nnfolder-current-group))) - (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)) - + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (when (and group + (not (equal group nnfolder-current-group)) + (progn + (nnmail-activate 'nnfolder) + (and (assoc group nnfolder-group-alist) + (file-exists-p (nnfolder-group-pathname group))))) (if dont-check (setq nnfolder-current-group group nnfolder-current-buffer nil) @@ -622,10 +746,11 @@ deleted. Point is left where the deleted region was." ;; 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 + (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))) + (nnmail-write-region (point-min) (point-min) + file t 'nomesg))) (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) (set-buffer nnfolder-current-buffer) (push (list group nnfolder-current-buffer) @@ -674,7 +799,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)) @@ -684,7 +813,8 @@ deleted. Point is left where the deleted region was." (goto-char (point-max)) (skip-chars-backward "\n") (delete-region (point) (point-max)) - (insert "\n\n")) + (unless (bobp) + (insert "\n\n"))) (defun nnfolder-insert-newsgroup-line (group-art) (save-excursion @@ -720,25 +850,27 @@ deleted. Point is left where the deleted region was." (push (list group (nnfolder-read-folder group)) nnfolder-buffer-alist)))) -;; This method has a problem if you've accidentally let the active list get -;; out of sync with the files. This could happen, say, if you've -;; accidentally gotten new mail with something other than Gnus (but why -;; would _that_ ever happen? :-). In that case, we will be in the middle of -;; processing the file, ready to add new X-Gnus article number markers, and -;; we'll run across a message with no ID yet - the active list _may_not_ be -;; ready for us yet. - -;; To handle this, I'm modifying this routine to maintain the maximum ID seen -;; so far, and when we hit a message with no ID, we will _manually_ scan the -;; rest of the message looking for any more, possibly higher IDs. We'll -;; assume the maximum that we find is the highest active. Note that this -;; shouldn't cost us much extra time at all, but will be a lot less -;; vulnerable to glitches between the mbox and the active file. +;; This method has a problem if you've accidentally let the active +;; list get out of sync with the files. This could happen, say, if +;; you've accidentally gotten new mail with something other than Gnus +;; (but why would _that_ ever happen? :-). In that case, we will be +;; in the middle of processing the file, ready to add new X-Gnus +;; article number markers, and we'll run across a message with no ID +;; yet - the active list _may_not_ be ready for us yet. + +;; To handle this, I'm modifying this routine to maintain the maximum +;; ID seen so far, and when we hit a message with no ID, we will +;; _manually_ scan the rest of the message looking for any more, +;; possibly higher IDs. We'll assume the maximum that we find is the +;; highest active. Note that this shouldn't cost us much extra time +;; at all, but will be a lot less vulnerable to glitches between the +;; mbox and the active file. (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 + (let ((nnheader-file-coding-system nnfolder-file-coding-system)) (nnheader-find-file-noselect file))))) (if (equal (cadr (assoc group nnfolder-scantime-alist)) @@ -765,9 +897,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 @@ -777,13 +923,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))) @@ -797,8 +957,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 @@ -821,18 +982,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 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) + (push (list group newscantime) nnfolder-scantime-alist)) + ;; Save nov. + (when novbuf + (nnfolder-save-nov)) (current-buffer)))))) ;;;###autoload @@ -841,27 +1014,37 @@ 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) + file) (while (setq file (pop files)) (when (and (not (backup-file-name-p file)) - (message-mail-file-mbox-p + (message-mail-file-mbox-p (nnheader-concat nnfolder-directory file))) - (let ((oldgroup (assoc file nnfolder-group-alist))) - (if oldgroup - (nnheader-message 5 "Refreshing group %s..." file) - (nnheader-message 5 "Adding group %s..." file)) + (let ((oldgroup (assoc file nnfolder-group-alist))) + (if oldgroup + (nnheader-message 5 "Refreshing group %s..." file) + (nnheader-message 5 "Adding group %s..." file)) (if oldgroup (setq nnfolder-group-alist (delq oldgroup (copy-sequence nnfolder-group-alist)))) - (push (list file (cons 1 0)) nnfolder-group-alist) - (nnfolder-possibly-change-folder file) - (nnfolder-possibly-change-group file) - (nnfolder-close-group file)))) + (push (list file (cons 1 0)) nnfolder-group-alist) + (nnfolder-possibly-change-folder file) + (nnfolder-possibly-change-group file) + (nnfolder-close-group file)))) (nnheader-message 5 ""))) (defun nnfolder-group-pathname (group) - "Make pathname for GROUP." + "Make file name for GROUP." (setq group (encode-coding-string group nnmail-pathname-coding-system)) (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) @@ -872,6 +1055,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) @@ -881,7 +1070,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 @@ -889,6 +1080,194 @@ 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) + (let ((headers (nnheader-parse-naked-head))) + (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))) + +(deffoo nnfolder-request-set-mark (group actions &optional server) + (when (and server + (not (nnfolder-server-opened server))) + (nnfolder-open-server server)) + (unless nnfolder-marks-is-evil + (nnfolder-open-marks group server) + (dolist (action actions) + (let ((range (nth 0 action)) + (what (nth 1 action)) + (marks (nth 2 action))) + (assert (or (eq what 'add) (eq what 'del)) t + "Unknown request-set-mark action: %s" what) + (dolist (mark marks) + (setq nnfolder-marks (gnus-update-alist-soft + mark + (funcall (if (eq what 'add) 'gnus-range-add + 'gnus-remove-from-range) + (cdr (assoc mark nnfolder-marks)) range) + nnfolder-marks))))) + (nnfolder-save-marks group server)) + nil) + +(deffoo nnfolder-request-update-info (group info &optional server) + ;; Change servers. + (when (and server + (not (nnfolder-server-opened server))) + (nnfolder-open-server server)) + (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group)) + (nnheader-message 8 "Updating marks for %s..." group) + (nnfolder-open-marks group server) + ;; Update info using `nnfolder-marks'. + (mapcar (lambda (pred) + (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) + (gnus-info-set-marks + info + (gnus-update-alist-soft + (cdr pred) + (cdr (assq (cdr pred) nnfolder-marks)) + (gnus-info-marks info)) + t))) + gnus-article-mark-lists) + (let ((seen (cdr (assq 'read nnfolder-marks)))) + (gnus-info-set-read info + (if (and (integerp (car seen)) + (null (cdr seen))) + (list (cons (car seen) (car seen))) + seen))) + (nnheader-message 8 "Updating marks for %s...done" group)) + info) + +(defun nnfolder-group-marks-pathname (group) + "Make pathname for GROUP NOV." + (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory))) + (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix))) + +(defun nnfolder-marks-changed-p (group) + (let ((file (nnfolder-group-marks-pathname group))) + (if (null (gnus-gethash file nnfolder-marks-modtime)) + t ;; never looked at marks file, assume it has changed + (not (equal (gnus-gethash file nnfolder-marks-modtime) + (nth 5 (file-attributes file))))))) + +(defun nnfolder-save-marks (group server) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (file (nnfolder-group-marks-pathname group))) + (condition-case err + (progn + (with-temp-file file + (erase-buffer) + (gnus-prin1 nnfolder-marks) + (insert "\n")) + (gnus-sethash file + (nth 5 (file-attributes file)) + nnfolder-marks-modtime)) + (error (or (gnus-yes-or-no-p + (format "Could not write to %s (%s). Continue? " file err)) + (error "Cannot write to %s (%s)" err)))))) + +(defun nnfolder-open-marks (group server) + (let ((file (nnfolder-group-marks-pathname group))) + (if (file-exists-p file) + (condition-case err + (with-temp-buffer + (gnus-sethash file (nth 5 (file-attributes file)) + nnfolder-marks-modtime) + (nnheader-insert-file-contents file) + (setq nnfolder-marks (read (current-buffer))) + (dolist (el gnus-article-unpropagated-mark-lists) + (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))) + (error (or (gnus-yes-or-no-p + (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) + (error "Cannot read nnfolder marks file %s (%s)" file err)))) + ;; User didn't have a .marks file. Probably first time + ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. + (let ((info (gnus-get-info + (gnus-group-prefixed-name + group + (gnus-server-to-method (format "nnfolder:%s" server)))))) + (nnheader-message 7 "Bootstrapping marks for %s..." group) + (setq nnfolder-marks (gnus-info-marks info)) + (push (cons 'read (gnus-info-read info)) nnfolder-marks) + (dolist (el gnus-article-unpropagated-mark-lists) + (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))) + (nnfolder-save-marks group server) + (nnheader-message 7 "Bootstrapping marks for %s...done" group))))) + (provide 'nnfolder) ;;; nnfolder.el ends here diff --git a/lisp/nngateway.el b/lisp/nngateway.el index 65bd2cc..6059dcf 100644 --- a/lisp/nngateway.el +++ b/lisp/nngateway.el @@ -1,6 +1,6 @@ ;;; nngateway.el --- posting news via mail gateways -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -65,7 +65,8 @@ parameter -- the gateway address.") (insert mail-header-separator "\n") (widen) (let (message-required-mail-headers) - (funcall message-send-mail-function)) + (funcall (or message-send-mail-real-function + message-send-mail-function))) t)))) ;;; Internal functions diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 603b1ed..b994e58 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,11 +1,11 @@ ;;; nnheader.el --- header access macros for Semi-gnus and its backends ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000 +;; 1997, 1998, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen +;; Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko ;; Katsumi Yamaoka ;; Keywords: mail, news, MIME @@ -34,6 +34,10 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) +;; Requiring `gnus-util' at compile time creates a circular +;; dependency between nnheader.el and gnus-util.el. +;;(eval-when-compile (require 'gnus-util)) + (require 'mail-utils) ;; Reduce the required value of `recursive-load-depth-limit' for Emacs 21. @@ -42,14 +46,59 @@ (require 'std11) (require 'mime) +(eval-and-compile + (autoload 'gnus-sorted-intersection "gnus-range") + (autoload 'gnus-intersection "gnus-range") + (autoload 'gnus-sorted-complement "gnus-range") + (autoload 'gnus-sorted-difference "gnus-range")) + +(defcustom gnus-verbose-backends 7 + "Integer that says how verbose the Gnus backends should be. +The higher the number, the more messages the Gnus backends will flash +to say what it's doing. At zero, the Gnus backends will be totally +mute; at five, they will display most important messages; and at ten, +they will keep on jabbering all the time." + :group 'gnus-start + :type 'integer) + +(defcustom gnus-nov-is-evil nil + "If non-nil, Gnus backends will never output headers in the NOV format." + :group 'gnus-server + :type 'boolean) (defvar nnheader-max-head-length 4096 - "*Max length of the head of articles.") + "*Max length of the head of articles. + +Value is an integer, nil, or t. nil means read in chunks of a file +indefinitely until a complete head is found\; t means always read the +entire file immediately, disregarding `nnheader-head-chop-length'. + +Integer values will in effect be rounded up to the nearest multiple of +`nnheader-head-chop-length'.") (defvar nnheader-head-chop-length 2048 "*Length of each read operation when trying to fetch HEAD headers.") -(defvar nnheader-file-name-translation-alist nil +(defvar nnheader-read-timeout + (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + 1.0 + 0.1) + "How long nntp should wait between checking for the end of output. +Shorter values mean quicker response, but is more CPU intensive.") + +(defvar nnheader-file-name-translation-alist + (let ((case-fold-search t)) + (cond + ((string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + (append (mapcar (lambda (c) (cons c ?_)) + '(?: ?* ?\" ?< ?> ??)) + (if (string-match "windows-nt\\|cygwin" + (symbol-name system-type)) + nil + '((?+ . ?-))))) + (t nil))) "*Alist that says how to translate characters in file names. For instance, if \":\" is invalid as a file character in file names on your system, you could say something like: @@ -67,14 +116,390 @@ This variable is a substitute for `mm-text-coding-system'.") "Text coding system for write. This variable is a substitute for `mm-text-coding-system-for-write'.") +(defvar nnheader-auto-save-coding-system + (cond + ((boundp 'MULE) '*junet*) + ((not (fboundp 'find-coding-system)) nil) + ((find-coding-system 'emacs-mule) + (if (memq system-type '(windows-nt ms-dos ms-windows)) + 'emacs-mule-dos 'emacs-mule)) + ((find-coding-system 'escape-quoted) 'escape-quoted) + ((find-coding-system 'no-conversion) 'no-conversion) + (t nil)) + "Coding system of auto save file.") + +(defvar nnheader-directory-separator-character + (string-to-char (substring (file-name-as-directory ".") -1)) + "*A character used to a directory separator.") + (eval-and-compile (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")) +;; mm-util stuff. +(unless (featurep 'mm-util) + ;; Should keep track of `mm-image-load-path' in mm-util.el. + (defun nnheader-image-load-path (&optional package) + (let (dir result) + (dolist (path load-path (nreverse result)) + (if (file-directory-p + (setq dir (concat (file-name-directory + (directory-file-name path)) + "etc/" (or package "gnus/")))) + (push dir result)) + (push path result)))) + (defalias 'mm-image-load-path 'nnheader-image-load-path) + + ;; Should keep track of `mm-read-coding-system' in mm-util.el. + (defalias 'mm-read-coding-system + (if (or (and (featurep 'xemacs) + (<= (string-to-number emacs-version) 21.1)) + (boundp 'MULE)) + (lambda (prompt &optional default-coding-system) + (read-coding-system prompt)) + 'read-coding-system)) + + ;; Should keep track of `mm-%s' in mm-util.el. + (defalias 'mm-multibyte-string-p + (if (fboundp 'multibyte-string-p) + 'multibyte-string-p + 'ignore)) + (defalias 'mm-encode-coding-string 'encode-coding-string) + (defalias 'mm-decode-coding-string 'decode-coding-string) + + ;; Should keep track of `mm-detect-coding-region' in mm-util.el. + (defun nnheader-detect-coding-region (start end) + "Like 'detect-coding-region' except returning the best one." + (let ((coding-systems + (static-if (boundp 'MULE) + (code-detect-region (point) (point-max)) + (detect-coding-region (point) (point-max))))) + (or (car-safe coding-systems) + coding-systems))) + (defalias 'mm-detect-coding-region 'nnheader-detect-coding-region) + + ;; Should keep track of `mm-detect-mime-charset-region' in mm-util.el. + (defun nnheader-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (coding-system-to-mime-charset + (nnheader-detect-coding-region start end))) + (defalias 'mm-detect-mime-charset-region + 'nnheader-detect-mime-charset-region) + + ;; Should keep track of `mm-with-unibyte-buffer' in mm-util.el. + (defmacro nnheader-with-unibyte-buffer (&rest forms) + "Create a temporary buffer, and evaluate FORMS there like `progn'. +Use unibyte mode for this." + `(let (default-enable-multibyte-characters default-mc-flag) + (with-temp-buffer ,@forms))) + (put 'nnheader-with-unibyte-buffer 'lisp-indent-function 0) + (put 'nnheader-with-unibyte-buffer 'edebug-form-spec '(body)) + (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) + (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) + (defalias 'mm-with-unibyte-buffer 'nnheader-with-unibyte-buffer) + + ;; Should keep track of `mm-with-unibyte-current-buffer' in mm-util.el. + (defmacro nnheader-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")) + (buffer (make-symbol "buffer"))) + (cond ((featurep 'xemacs) + `(let (default-enable-multibyte-characters) + ,@forms)) + ((boundp 'MULE) + `(let ((,multibyte mc-flag) + (,buffer (current-buffer))) + (unwind-protect + (let (default-enable-multibyte-characters default-mc-flag) + (setq mc-flag nil) + ,@forms) + (set-buffer ,buffer) + (setq mc-flag ,multibyte)))) + (t + `(let ((,multibyte enable-multibyte-characters) + (,buffer (current-buffer))) + (unwind-protect + (let (default-enable-multibyte-characters) + (set-buffer-multibyte nil) + ,@forms) + (set-buffer ,buffer) + (set-buffer-multibyte ,multibyte))))))) + (put 'nnheader-with-unibyte-current-buffer 'lisp-indent-function 0) + (put 'nnheader-with-unibyte-current-buffer 'edebug-form-spec '(body)) + (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) + (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) + (defalias 'mm-with-unibyte-current-buffer + 'nnheader-with-unibyte-current-buffer) + + ;; Should keep track of `mm-with-unibyte' in mm-util.el. + (defmacro nnheader-with-unibyte (&rest forms) + "Eval the FORMS with the default value of `enable-multibyte-characters' +nil, ." + `(let (default-enable-multibyte-characters) + ,@forms)) + (put 'nnheader-with-unibyte 'lisp-indent-function 0) + (put 'nnheader-with-unibyte 'edebug-form-spec '(body)) + (put 'mm-with-unibyte 'lisp-indent-function 0) + (put 'mm-with-unibyte 'edebug-form-spec '(body)) + (defalias 'mm-with-unibyte 'nnheader-with-unibyte) + + ;; Should keep track of `mm-guess-mime-charset' in mm-util.el. + (defun nnheader-guess-mime-charset () + "Guess the default MIME charset from the language environment." + (let ((language-info + (and (boundp 'current-language-environment) + (assoc current-language-environment + language-info-alist))) + item) + (cond + ((null language-info) + 'iso-8859-1) + ((setq item + (cadr + (or (assq 'coding-priority language-info) + (assq 'coding-system language-info)))) + (if (fboundp 'coding-system-get) + (or (coding-system-get item 'mime-charset) + item) + item)) + ((setq item (car (last (assq 'charset language-info)))) + (if (eq item 'ascii) + 'iso-8859-1 + (charsets-to-mime-charset (list item)))) + (t + 'iso-8859-1)))) + (defalias 'mm-guess-mime-charset 'nnheader-guess-mime-charset) + + (defalias 'mm-char-int 'char-int) + + ;; Should keep track of the same alias in mm-util.el. + (defalias 'mm-multibyte-p + (static-cond ((and (featurep 'xemacs) (featurep 'mule)) + (lambda nil t)) + ((featurep 'xemacs) + (lambda nil nil)) + ((boundp 'MULE) + (lambda nil mc-flag)) + (t + (lambda nil enable-multibyte-characters)))) + + ;; Should keep track of the same alias in mm-util.el. + (defalias 'mm-make-temp-file + (if (fboundp 'make-temp-file) + 'make-temp-file + (lambda (prefix &optional dir-flag) + (let ((file (expand-file-name + (make-temp-name prefix) + (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory)))) + (if dir-flag + (make-directory file)) + file)))) + + ;; Should keep track of `mm-coding-system-p' in mm-util.el. + (defun nnheader-coding-system-p (sym) + "Return non-nil if SYM is a coding system." + (or (and (fboundp 'find-coding-system) (find-coding-system sym)) + (and (fboundp 'coding-system-p) (coding-system-p sym)))) + (defalias 'mm-coding-system-p 'nnheader-coding-system-p)) + +;; mail-parse stuff. +(unless (featurep 'mail-parse) + ;; Should keep track of `rfc2047-narrow-to-field' in rfc2047.el. + (defun-maybe std11-narrow-to-field () + "Narrow the buffer to the header on the current line." + (forward-line 0) + (narrow-to-region (point) + (progn + (std11-field-end) + (when (eolp) (forward-line 1)) + (point))) + (goto-char (point-min))) + (defalias 'mail-header-narrow-to-field 'std11-narrow-to-field) + + ;; Should keep track of `ietf-drums-narrow-to-header' in ietf-drums.el. + (defun mail-narrow-to-head () + "Narrow to the header section in the current buffer." + (narrow-to-region + (goto-char (point-min)) + (if (re-search-forward "^\r?$" nil 1) + (match-beginning 0) + (point-max))) + (goto-char (point-min))) + + ;; Should keep track of `rfc2047-fold-region' in rfc2047.el. + (defun-maybe std11-fold-region (b e) + "Fold long lines in region B to E." + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((break nil) + (qword-break nil) + (first t) + (bol (save-restriction + (widen) + (gnus-point-at-bol)))) + (while (not (eobp)) + (when (and (or break qword-break) + (> (- (point) bol) 76)) + (goto-char (or break qword-break)) + (setq break nil + qword-break nil) + (if (looking-at "[ \t]") + (insert "\n") + (insert "\n ")) + (setq bol (1- (point))) + ;; Don't break before the first non-LWSP characters. + (skip-chars-forward " \t") + (unless (eobp) + (forward-char 1))) + (cond + ((eq (char-after) ?\n) + (forward-char 1) + (setq bol (point) + break nil + qword-break nil) + (skip-chars-forward " \t") + (unless (or (eobp) (eq (char-after) ?\n)) + (forward-char 1))) + ((eq (char-after) ?\r) + (forward-char 1)) + ((memq (char-after) '(? ?\t)) + (skip-chars-forward " \t") + (if first + ;; Don't break just after the header name. + (setq first nil) + (setq break (1- (point))))) + ((not break) + (if (not (looking-at "=\\?[^=]")) + (if (eq (char-after) ?=) + (forward-char 1) + (skip-chars-forward "^ \t\n\r=")) + (setq qword-break (point)) + (skip-chars-forward "^ \t\n\r"))) + (t + (skip-chars-forward "^ \t\n\r")))) + (when (and (or break qword-break) + (> (- (point) bol) 76)) + (goto-char (or break qword-break)) + (setq break nil + qword-break nil) + (if (looking-at "[ \t]") + (insert "\n") + (insert "\n ")) + (setq bol (1- (point))) + ;; Don't break before the first non-LWSP characters. + (skip-chars-forward " \t") + (unless (eobp) + (forward-char 1)))))) + + ;; Should keep track of `rfc2047-fold-field' in rfc2047.el. + (defun-maybe std11-fold-field () + "Fold the current line." + (save-excursion + (save-restriction + (std11-narrow-to-field) + (std11-fold-region (point-min) (point-max))))) + + (defalias 'mail-header-fold-field 'std11-fold-field) + + ;; Should keep track of `rfc2047-unfold-region' in rfc2047.el. + (defun-maybe std11-unfold-region (b e) + "Unfold lines in region B to E." + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((bol (save-restriction + (widen) + (gnus-point-at-bol))) + (eol (gnus-point-at-eol))) + (forward-line 1) + (while (not (eobp)) + (if (and (looking-at "[ \t]") + (< (- (gnus-point-at-eol) bol) 76)) + (delete-region eol (progn + (goto-char eol) + (skip-chars-forward "\r\n") + (point))) + (setq bol (gnus-point-at-bol))) + (setq eol (gnus-point-at-eol)) + (forward-line 1))))) + + ;; Should keep track of `rfc2047-unfold-field' in rfc2047.el. + (defun-maybe std11-unfold-field () + "Fold the current line." + (save-excursion + (save-restriction + (std11-narrow-to-field) + (std11-unfold-region (point-min) (point-max))))) + + (defalias 'mail-header-unfold-field 'std11-unfold-field) + + ;; This is the original function in T-gnus. + (defun-maybe std11-extract-addresses-components (string) + "Extract a list of full name and canonical address from STRING. Each +element looks like a list of the form (FULL-NAME CANONICAL-ADDRESS). +If no name can be extracted, FULL-NAME will be nil." + (when string + (let (addresses) + (dolist (structure (std11-parse-addresses-string + (std11-unfold-string string)) + addresses) + (push (list (std11-full-name-string structure) + (std11-address-string structure)) + addresses)) + (nreverse addresses)))) + + ;; Should keep track of `ietf-drums-parse-addresses' in ietf-drums.el. + (defun mail-header-parse-addresses (string) + "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." + (mapcar (function + (lambda (components) + (cons (nth 1 components) (car components)))) + (std11-extract-addresses-components string))) + + ;; Should keep track of `rfc2047-field-value' in rfc2047.el. + (defun std11-field-value (&optional dont-include-last-newline) + "Return the value of the field at point. If the optional argument is +given, the return value will not contain the last newline." + (let ((begin (point)) + (inhibit-point-motion-hooks t) + start value) + (beginning-of-line) + (unless (eobp) + (while (and (memq (char-after) '(?\t ?\ )) + (zerop (forward-line -1)))) + (when (looking-at "[^\t\n ]+:[\t\n ]+") + (goto-char (setq start (match-end 0))) + (forward-line 1) + (while (and (memq (char-after) '(?\t ?\ )) + (zerop (forward-line 1)))) + (when dont-include-last-newline + (skip-chars-backward "\t\n " start)) + (setq value (buffer-substring start (point))))) + (goto-char begin) + value)) + + (defalias 'mail-header-field-value 'std11-field-value)) + +;; ietf-drums stuff. +(unless (featurep 'ietf-drums) + ;; Should keep track of `ietf-drums-unfold-fws' in ietf-drums.el. + (defun nnheader-unfold-fws () + "Unfold folding white space in the current buffer." + (goto-char (point-min)) + (while (re-search-forward "[ \t]*\n[ \t]+" nil t) + (replace-match " " t t)) + (goto-char (point-min))) + + (defalias 'ietf-drums-unfold-fws 'nnheader-unfold-fws)) + ;;; Header access macros. ;; These macros may look very much like the ones in GNUS 4.1. They @@ -194,123 +619,138 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") ;; Parsing headers and NOV lines. +(defsubst nnheader-remove-cr-followed-by-lf () + (goto-char (point-max)) + (while (search-backward "\r\n" nil t) + (delete-char 1))) + (defsubst nnheader-header-value () (let ((pt (point))) - (prog1 - (buffer-substring (match-end 0) (std11-field-end)) + (prog2 + (skip-chars-forward " \t") + (buffer-substring (point) (std11-field-end)) (goto-char pt)))) -(defun nnheader-parse-head (&optional naked) +(defun nnheader-parse-naked-head (&optional number) + ;; This function unfolds continuation lines in this buffer + ;; destructively. When this side effect is unwanted, use + ;; `nnheader-parse-head' instead of this function. (let ((case-fold-search t) - (cur (current-buffer)) (buffer-read-only nil) - in-reply-to lines p ref) - (goto-char (point-min)) - (when naked - (insert "\n")) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. + (cur (current-buffer)) + (p (point-min)) + in-reply-to lines ref) + (nnheader-remove-cr-followed-by-lf) + (ietf-drums-unfold-fws) + (subst-char-in-region (point-min) (point-max) ?\t ? ) + (goto-char p) + (insert "\n") (prog1 - (when (or naked (re-search-forward "^[23][0-9]+ " nil t)) - ;; This implementation of this function, with nine - ;; search-forwards instead of the one re-search-forward and - ;; a case (which basically was the old function) is actually - ;; about twice as fast, even though it looks messier. You - ;; can't have everything, I guess. Speed and elegance - ;; don't always go hand in hand. - (make-full-mail-header - ;; Number. - (if naked - (progn - (setq p (point-min)) - 0) - (prog1 - (read cur) - (end-of-line) - (setq p (point)) - (narrow-to-region (point) - (or (and (search-forward "\n.\n" nil t) - (- (point) 2)) - (point))))) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject: " nil t) - (nnheader-header-value) "(none)")) - ;; From. - (progn - (goto-char p) - (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) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (if (search-forward "\nmessage-id:" nil t) - (buffer-substring - (1- (or (search-forward "<" (gnus-point-at-eol) t) - (point))) - (or (search-forward ">" (gnus-point-at-eol) t) (point))) - ;; If there was no message-id, we just fake one to make - ;; subsequent routines simpler. - (nnheader-generate-fake-message-id))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences: " nil t) - (nnheader-header-value) - ;; Get the references from the in-reply-to header if there - ;; were no references and the in-reply-to header looks - ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (nnheader-header-value)) - (string-match "<[^\n>]+>" in-reply-to)) - (let (ref2) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (while (string-match "<[^\n>]+>" - in-reply-to (match-end 0)) - (setq ref2 (substring in-reply-to (match-beginning 0) - (match-end 0))) - (when (> (length ref2) (length ref)) - (setq ref ref2))) - ref) - nil))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref: " nil t) - (nnheader-header-value))) - - ;; Extra. - (when nnmail-extra-headers - (let ((extra nnmail-extra-headers) - out) - (while extra - (goto-char p) - (when (search-forward - (concat "\n" (symbol-name (car extra)) ": ") nil t) - (push (cons (car extra) (nnheader-header-value)) - out)) - (pop extra)) - out)))) - (when naked - (goto-char (point-min)) - (delete-char 1))))) + ;; This implementation of this function, with nine + ;; search-forwards instead of the one re-search-forward and a + ;; case (which basically was the old function) is actually + ;; about twice as fast, even though it looks messier. You + ;; can't have everything, I guess. Speed and elegance don't + ;; always go hand in hand. + (make-full-mail-header + ;; Number. + (or number 0) + ;; Subject. + (progn + (goto-char p) + (if (search-forward "\nsubject:" nil t) + (nnheader-header-value) "(none)")) + ;; From. + (progn + (goto-char p) + (if (search-forward "\nfrom:" nil t) + (nnheader-header-value) "(nobody)")) + ;; Date. + (progn + (goto-char p) + (if (search-forward "\ndate:" nil t) + (nnheader-header-value) "")) + ;; Message-ID. + (progn + (goto-char p) + (if (search-forward "\nmessage-id:" nil t) + (buffer-substring + (1- (or (search-forward "<" (gnus-point-at-eol) t) + (point))) + (or (search-forward ">" (gnus-point-at-eol) t) (point))) + ;; If there was no message-id, we just fake one to make + ;; subsequent routines simpler. + (nnheader-generate-fake-message-id))) + ;; References. + (progn + (goto-char p) + (if (search-forward "\nreferences:" nil t) + (nnheader-header-value) + ;; Get the references from the in-reply-to header if + ;; there were no references and the in-reply-to header + ;; looks promising. + (if (and (search-forward "\nin-reply-to:" nil t) + (setq in-reply-to (nnheader-header-value)) + (string-match "<[^\n>]+>" in-reply-to)) + (let (ref2) + (setq ref (substring in-reply-to (match-beginning 0) + (match-end 0))) + (while (string-match "<[^\n>]+>" + in-reply-to (match-end 0)) + (setq ref2 (substring in-reply-to (match-beginning 0) + (match-end 0))) + (when (> (length ref2) (length ref)) + (setq ref ref2))) + ref) + nil))) + ;; Chars. + 0 + ;; Lines. + (progn + (goto-char p) + (if (search-forward "\nlines: " nil t) + (if (numberp (setq lines (read cur))) + lines 0) + 0)) + ;; Xref. + (progn + (goto-char p) + (and (search-forward "\nxref:" nil t) + (nnheader-header-value))) + ;; Extra. + (when nnmail-extra-headers + (let ((extra nnmail-extra-headers) + out) + (while extra + (goto-char p) + (when (search-forward + (concat "\n" (symbol-name (car extra)) ":") nil t) + (push (cons (car extra) (nnheader-header-value)) + out)) + (pop extra)) + out))) + (goto-char p) + (delete-char 1)))) + +(defun nnheader-parse-head (&optional naked) + (let ((cur (current-buffer)) num beg end) + (when (if naked + (setq num 0 + beg (point-min) + end (point-max)) + (goto-char (point-min)) + ;; Search to the beginning of the next header. Error + ;; messages do not begin with 2 or 3. + (when (re-search-forward "^[23][0-9]+ " nil t) + (end-of-line) + (setq num (read cur) + beg (point) + end (if (search-forward "\n.\n" nil t) + (- (point) 2) + (point))))) + (with-temp-buffer + (insert-buffer-substring cur beg end) + (nnheader-parse-naked-head num))))) (defmacro nnheader-nov-skip-field () '(search-forward "\t" eol 'move)) @@ -396,6 +836,22 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (delete-char 1)) (forward-line 1))) +(defun nnheader-parse-overview-file (file) + "Parse FILE and return a list of headers." + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (let (headers) + (while (not (eobp)) + (push (nnheader-parse-nov) headers) + (forward-line 1)) + (nreverse headers)))) + +(defun nnheader-write-overview-file (file headers) + "Write HEADERS to FILE." + (with-temp-file file + (mapcar 'nnheader-insert-nov headers))) + (defun nnheader-insert-header (header) (insert "Subject: " (or (mail-header-subject header) "(none)") "\n" @@ -439,7 +895,7 @@ the line could be found." (prev (point-min)) num found) (while (not found) - (goto-char (/ (+ max min) 2)) + (goto-char (+ min (/ (- max min) 2))) (beginning-of-line) (if (or (= (point) prev) (eobp)) @@ -665,10 +1121,6 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (defvar nntp-server-buffer nil) (defvar nntp-process-response nil) -(defvar gnus-verbose-backends 7 - "*A number that says how talkative the Gnus backends should be.") -(defvar gnus-nov-is-evil nil - "If non-nil, Gnus backends will never output headers in the NOV format.") (defvar news-reply-yank-from nil) (defvar news-reply-yank-message-id nil) @@ -738,7 +1190,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; This is invalid, but not all articles have Message-IDs. () (mail-position-on-field "References") - (let ((begin (save-excursion (beginning-of-line) (point))) + (let ((begin (gnus-point-at-bol)) (fill-column 78) (fill-prefix "\t")) (when references @@ -772,6 +1224,12 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (point-max))) (goto-char (point-min))) +(defun nnheader-remove-body () + "Remove the body from an article in this current buffer." + (goto-char (point-min)) + (when (re-search-forward "\n\r?\n" nil t) + (delete-region (point) (point-max)))) + (defun nnheader-set-temp-buffer (name &optional noerase) "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." (set-buffer (get-buffer-create name)) @@ -794,7 +1252,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." "Regexp that matches numerical file names.") (defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) - "Regexp that matches numerical full file paths.") + "Regexp that matches numerical full file names.") (defsubst nnheader-file-to-number (file) "Take a FILE name and return the article number." @@ -803,7 +1261,10 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (string-match nnheader-numerical-short-files file) (string-to-int (match-string 0 file)))) -(defvar nnheader-directory-files-is-safe nil +(defvar nnheader-directory-files-is-safe + (or (eq system-type 'windows-nt) + (and (not (featurep 'xemacs)) + (> emacs-major-version 20))) "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, @@ -820,7 +1281,7 @@ an alarming frequency on NFS mounted file systems. If it is nil, (defun nnheader-directory-articles (dir) "Return a list of all article files in directory DIR." (mapcar 'nnheader-file-to-number - (if nnheader-directory-files-is-safe + (if nnheader-directory-files-is-safe (directory-files dir nil nnheader-numerical-short-files t) (nnheader-directory-files-safe @@ -829,7 +1290,7 @@ an alarming frequency on NFS mounted file systems. If it is nil, (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)) - (if nnheader-directory-files-is-safe + (if nnheader-directory-files-is-safe (directory-files dir nil nnheader-numerical-short-files t) (nnheader-directory-files-safe @@ -856,12 +1317,13 @@ If FULL, translate everything." ;; We translate -- but only the file name. We leave the directory ;; alone. (if (and (featurep 'xemacs) - (memq system-type '(win32 w32 mswindows windows-nt))) + (memq system-type '(cygwin32 win32 w32 mswindows windows-nt + cygwin))) ;; 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" @@ -954,7 +1416,7 @@ without formatting." (expand-file-name (file-name-as-directory top)))) (error ""))) - ?/ ?.)) + nnheader-directory-separator-character ?.)) (defun nnheader-message (level &rest args) "Message if the Gnus backends are talkative." @@ -969,10 +1431,10 @@ without formatting." (<= level gnus-verbose-backends))) (defvar nnheader-pathname-coding-system 'binary - "*Coding system for pathname.") + "*Coding system for file name.") (defun nnheader-group-pathname (group dir &optional file) - "Make pathname for GROUP." + "Make file name for GROUP." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) ;; If this directory exists, we use it directly. @@ -1000,16 +1462,16 @@ without formatting." (defun nnheader-ms-strip-cr () "Strip ^M from the end of all lines." (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (delete-backward-char 1)))) + (nnheader-remove-cr-followed-by-lf))) (defun nnheader-file-size (file) "Return the file size of FILE or 0." (or (nth 7 (file-attributes file)) 0)) (defun nnheader-find-etc-directory (package &optional file) - "Go through the path and find the \".../etc/PACKAGE\" directory. + "Go through `load-path' and find the \"../etc/PACKAGE\" directory. +This function will look in the parent directory of each `load-path' +entry, and look for the \"etc\" directory there. If FILE, find the \".../etc/PACKAGE\" file instead." (let ((path load-path) dir result) @@ -1054,12 +1516,32 @@ find-file-hooks, etc. (auto-mode-alist (nnheader-auto-mode-alist)) (default-major-mode 'fundamental-mode) (enable-local-variables nil) - (after-insert-file-functions nil) + (after-insert-file-functions nil) (enable-local-eval nil) (find-file-hooks nil)) (insert-file-contents-as-coding-system nnheader-file-coding-system filename visit beg end replace))) +(defun nnheader-insert-nov-file (file first) + (let ((size (nth 7 (file-attributes file))) + (cutoff (* 32 1024))) + (when size + (if (< size cutoff) + ;; If the file is small, we just load it. + (nnheader-insert-file-contents file) + ;; We start on the assumption that FIRST is pretty recent. If + ;; not, we just insert the rest of the file as well. + (let (current) + (nnheader-insert-file-contents file nil (- size cutoff) size) + (goto-char (point-min)) + (delete-region (point) (or (search-forward "\n" nil 'move) (point))) + (setq current (ignore-errors (read (current-buffer)))) + (if (and (numberp current) + (< current first)) + t + (delete-region (point-min) (point-max)) + (nnheader-insert-file-contents file))))))) + (defun nnheader-find-file-noselect (&rest args) (let ((format-alist nil) (auto-mode-alist (nnheader-auto-mode-alist)) @@ -1136,6 +1618,7 @@ find-file-hooks, etc. (defalias 'nnheader-run-at-time 'run-at-time) (defalias 'nnheader-cancel-timer 'cancel-timer) (defalias 'nnheader-cancel-function-timers 'cancel-function-timers) +(defalias 'nnheader-string-as-multibyte 'string-as-multibyte) (defun nnheader-Y-or-n-p (prompt) "Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"." @@ -1154,6 +1637,21 @@ find-file-hooks, etc. (message "%s(Y/n) Yes" prompt) t))) +(defun-maybe shell-command-to-string (command) + "Execute shell command COMMAND and return its output as a string." + (with-output-to-string + (with-current-buffer + standard-output + (call-process shell-file-name nil t nil shell-command-switch command)))) + +(defun nnheader-accept-process-output (process) + (accept-process-output + process + (truncate nnheader-read-timeout) + (truncate (* (- nnheader-read-timeout + (truncate nnheader-read-timeout)) + 1000)))) + (when (featurep 'xemacs) (require 'nnheaderxm)) diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index 7d38bbd..ea5df2f 100644 --- a/lisp/nnheaderxm.el +++ b/lisp/nnheaderxm.el @@ -1,6 +1,6 @@ ;;; nnheaderxm.el --- making Gnus backends work under XEmacs -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -58,8 +58,9 @@ (defalias 'nnheader-run-at-time 'nnheader-xmas-run-at-time) (defalias 'nnheader-cancel-timer 'delete-itimer) (defalias 'nnheader-cancel-function-timers 'ignore) +(defalias 'nnheader-string-as-multibyte 'identity) (defalias 'nnheader-Y-or-n-p 'nnheader-xmas-Y-or-n-p) (provide 'nnheaderxm) -;;; nnheaderxm.el ends here. +;;; nnheaderxm.el ends here diff --git a/lisp/nnimap.el b/lisp/nnimap.el index b402c3a..306f54e 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -1,5 +1,6 @@ ;;; nnimap.el --- imap backend for Gnus -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Jim Radford @@ -42,7 +43,7 @@ ;; o Split up big fetches (1,* header especially) in smaller chunks ;; o What do I do with gnus-newsgroup-*? ;; o Tell Gnus about new groups (how can we tell?) -;; o Respooling (fix Gnus?) (unnecessery?) +;; o Respooling (fix Gnus?) (unnecessary?) ;; o Add support for the following: (if applicable) ;; request-list-newsgroups, request-regenerate ;; list-active-group, @@ -55,12 +56,13 @@ ;; o What about Gnus's article editing, can we support it? NO! ;; o Use \Draft to support the draft group?? ;; o Duplicate suppression +;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers ;;; Code: (eval-when-compile (require 'cl)) (eval-when-compile (require 'gnus-clfns)) -(eval-and-compile (require 'imap)) +(require 'imap) (require 'nnoo) (require 'nnmail) @@ -72,31 +74,51 @@ (nnoo-declare nnimap) -(defconst nnimap-version "nnimap 0.131") +(defconst nnimap-version "nnimap 1.0") + +(defgroup nnimap nil + "Reading IMAP mail with Gnus." + :group 'gnus) (defvoo nnimap-address nil "Address of physical IMAP server. If nil, use the virtual server's name.") (defvoo nnimap-server-port nil "Port number on physical IMAP server. -If nil, defaults to 993 for SSL connections and 143 otherwise.") +If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.") ;; Splitting variables -(defvar nnimap-split-crosspost t +(defcustom nnimap-split-crosspost t "If non-nil, do crossposting if several split methods match the mail. -If nil, the first match found will be used.") +If nil, the first match found will be used." + :group 'nnimap + :type 'boolean) -(defvar nnimap-split-inbox nil - "*Name of mailbox to split mail from. +(defcustom nnimap-split-inbox nil + "Name of mailbox to split mail from. Mail is read from this mailbox and split according to rules in `nnimap-split-rule'. -This can be a string or a list of strings.") +This can be a string or a list of strings." + :group 'nnimap + :type '(choice (string) + (repeat string))) + +(define-widget 'nnimap-strict-function 'function + "This widget only matches values that are functionp. + +Warning: This means that a value that is the symbol of a not yet +loaded function will not match. Use with care." + :match 'nnimap-strict-function-match) -(defvar nnimap-split-rule nil - "*Mail will be split according to theese rules. +(defun nnimap-strict-function-match (widget value) + "Ignoring WIDGET, match if VALUE is a function." + (functionp value)) + +(defcustom nnimap-split-rule nil + "Mail will be split according to these rules. Mail is read from mailbox(es) specified in `nnimap-split-inbox'. @@ -105,13 +127,13 @@ If you'd like, for instance, one mail group for mail from the everything else in the incoming mailbox, you could do something like this: -(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\") +\(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\") (\"INBOX.junk\" \"Subject:.*buy\"))) -As you can see, `nnimap-split-rule' is a list of lists, where the first -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. +As you can see, `nnimap-split-rule' is a list of lists, where the +first element in each \"rule\" is the name of the IMAP mailbox (or the +symbol `junk' if you want to remove the mail), and the second is a +regexp that nnimap will try to match on the header to find a fit. 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 @@ -126,29 +148,106 @@ 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 +\(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))))) + (\"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" +group/function elements." + :group 'nnimap + :type '(choice :tag "Rule type" + (repeat :menu-tag "Single-server" + :tag "Single-server list" + (list (string :tag "Mailbox") + (choice :tag "Predicate" + (regexp :tag "A regexp") + (nnimap-strict-function :tag "A function")))) + (choice :menu-tag "A function" + :tag "A function" + (function-item nnimap-split-fancy) + (function-item nnmail-split-fancy) + (nnimap-strict-function :tag "User-defined function")) + (repeat :menu-tag "Multi-server (extended)" + :tag "Multi-server list" + (list (regexp :tag "Server regexp") + (list (regexp :tag "Incoming Mailbox regexp") + (repeat :tag "Rules for matching server(s) and mailbox(es)" + (list (string :tag "Destination mailbox") + (choice :tag "Predicate" + (regexp :tag "A Regexp") + (nnimap-strict-function :tag "A Function"))))))))) + +(defcustom 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.") +RFC2060 section 6.4.4." + :group 'nnimap + :type 'string) + +(defcustom nnimap-split-fancy nil + "Like the variable `nnmail-split-fancy'." + :group 'nnimap + :type 'sexp) + +(defvar nnimap-split-download-body-default nil + "Internal variable with default value for `nnimap-split-download-body'.") + +(defcustom nnimap-split-download-body 'default + "Whether to download entire articles during splitting. +This is generally not required, and will slow things down considerably. +You may need it if you want to use an advanced splitting function that +analyses the body before splitting the article. +If this variable is nil, bodies will not be downloaded; if this +variable is the symbol `default' the default behaviour is +used (which currently is nil, unless you use a statistical +spam.el test); if this variable is another non-nil value bodies +will be downloaded." + :group 'nnimap + :type '(choice (const :tag "Let system decide" deault) + boolean)) + +;; Performance / bug workaround variables + +(defcustom nnimap-close-asynchronous t + "Close mailboxes asynchronously in `nnimap-close-group'. +This means that errors cought by nnimap when closing the mailbox will +not prevent Gnus from updating the group status, which may be harmful. +However, it increases speed." + :type 'boolean + :group 'nnimap) + +(defcustom nnimap-dont-close t + "Never close mailboxes. +This increases the speed of closing mailboxes (quiting group) but may +decrease the speed of selecting another mailbox later. Re-selecting +the same mailbox will be faster though." + :type 'boolean + :group 'nnimap) + +(defcustom nnimap-retrieve-groups-asynchronous t + "Send asynchronous STATUS commands for each mailbox before checking mail. +If you have mailboxes that rarely receives mail, this speeds up new +mail checking. It works by first sending STATUS commands for each +mailbox, and then only checking groups which has a modified UIDNEXT +more carefully for new mail. + +In summary, the default is O((1-p)*k+p*n) and changing it to nil makes +it O(n). If p is small, then the default is probably faster." + :type 'boolean + :group 'nnimap) + +(defvoo nnimap-need-unselect-to-notice-new-mail nil + "Unselect mailboxes before looking for new mail in them. +Some servers seem to need this under some circumstances.") ;; Authorization / Privacy variables @@ -163,14 +262,16 @@ handle. Change this if -1) you want to connect with SSL. The SSL integration with IMAP is - brain-dead so you'll have to tell it specifically. +1) you want to connect with TLS/SSL. The TLS/SSL integration + with IMAP is suboptimal so you'll have to tell it + specifically. 2) your server is more capable than your environment -- i.e. your server accept Kerberos login's but you haven't installed the `imtest' program or your machine isn't configured for Kerberos. -Possible choices: kerberos4, ssl, network") +Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell. +See also `imap-streams' and `imap-stream-alist'.") (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. @@ -184,7 +285,8 @@ connect to a server that accept Kerberos login's but you haven't installed the `imtest' program or your machine isn't configured for Kerberos. -Possible choices: kerberos4, cram-md5, login, anonymous.") +Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous. +See also `imap-authenticators' and `imap-authenticator-alist'") (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/") "Directory to keep NOV cache files for nnimap groups. @@ -201,9 +303,12 @@ typical complete file name would be (defvoo nnimap-nov-file-name-suffix ".novcache" "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. +(defvoo nnimap-nov-is-evil gnus-agent + "If non-nil, never generate or use a local nov database for this backend. +Using nov databases should speed up header fetching considerably. +However, it will invoke a UID SEARCH UID command on the server, and +some servers implement this command inefficiently by opening each and +every message in the group, thus making it quite slow. Unlike other backends, you do not need to take special care if you flip this variable.") @@ -236,7 +341,8 @@ 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. @@ -251,6 +357,22 @@ 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-expunge-search-string "UID %s NOT SINCE %s" + "IMAP search command to use for articles that are to be expired. +The first %s is replaced by a UID set of articles to search on, +and the second %s is replaced by a date criterium. + +One useful (and perhaps the only useful) value to change this to would +be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header +instead of the internal date of messages. See section 6.4.4 of RFC +2060 for more information on valid strings.") + +(defvoo nnimap-importantize-dormant t + "If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients. +Note that within Gnus, dormant articles will still (only) be +marked as ticked. This is to make \"dormant\" articles stand out, +just like \"ticked\" articles, in other IMAP clients.") + (defvoo nnimap-server-address nil "Obsolete. Use `nnimap-address'.") @@ -280,11 +402,15 @@ use this to make replies go directly to the group.") If this is 'imap-mailbox-lsub, then use a server-side subscription list to restrict visible folders.") +(defcustom nnimap-debug nil + "If non-nil, random debug spews are placed in *nnimap-debug* buffer." + :group 'nnimap + :type 'boolean) + ;; Internal variables: -(defvar nnimap-debug nil - "Name of buffer to record debugging info. -For example: (setq nnimap-debug \"*nnimap-debug*\")") +(defvar nnimap-debug-buffer "*nnimap-debug*") +(defvar nnimap-mailbox-info (gnus-make-hashtable 997)) (defvar nnimap-current-move-server nil) (defvar nnimap-current-move-group nil) (defvar nnimap-current-move-article nil) @@ -292,10 +418,6 @@ For example: (setq nnimap-debug \"*nnimap-debug*\")") (defvar nnimap-progress-chars '(?| ?/ ?- ?\\)) (defvar nnimap-progress-how-often 20) (defvar nnimap-counter) -(defvar nnimap-callback-callback-function nil - "Gnus callback the nnimap asynchronous callback should call.") -(defvar nnimap-callback-buffer nil - "Which buffer the asynchronous article prefetch callback should work in.") (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 @@ -324,13 +446,13 @@ If SERVER is nil, uses the current server." (new-uidvalidity (imap-mailbox-get '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 + (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 @@ -350,16 +472,18 @@ If SERVER is nil, uses the current server." (defun nnimap-before-find-minmax-bugworkaround () "Function called before iterating through mailboxes with `nnimap-find-minmax-uid'." - ;; XXX this is for UoW imapd problem, it doesn't notice new mail in - ;; currently selected mailbox without a re-select/examine. - (or (null (imap-current-mailbox nnimap-server-buffer)) - (imap-mailbox-unselect nnimap-server-buffer))) + (when nnimap-need-unselect-to-notice-new-mail + ;; XXX this is for UoW imapd problem, it doesn't notice new mail in + ;; currently selected mailbox without a re-select/examine. + (or (null (imap-current-mailbox nnimap-server-buffer)) + (imap-mailbox-unselect nnimap-server-buffer)))) (defun nnimap-find-minmax-uid (group &optional examine) - "Find lowest and highest active article nummber in GROUP. + "Find lowest and highest active article number in GROUP. If EXAMINE is non-nil the group is selected read-only." (with-current-buffer nnimap-server-buffer - (when (imap-mailbox-select group examine) + (when (or (string= group (imap-current-mailbox)) + (imap-mailbox-select group examine)) (let (minuid maxuid) (when (> (imap-mailbox-get 'exists) 0) (imap-fetch "1,*" "UID" nil 'nouidfetch) @@ -368,7 +492,7 @@ If EXAMINE is non-nil the group is selected read-only." maxuid (if maxuid (max maxuid uid) uid))) 'UID)) (list (imap-mailbox-get 'exists) minuid maxuid))))) - + (defun nnimap-possibly-change-group (group &optional server) "Make GROUP the current group, and SERVER the current server." (when (nnimap-possibly-change-server server) @@ -379,12 +503,14 @@ If EXAMINE is non-nil the group is selected read-only." (if (or (nnimap-verify-uidvalidity group (or server nnimap-current-server)) (zerop (imap-mailbox-get 'exists group)) + t ;; for OGnus to see if ignoring uidvalidity + ;; changes has any bad effects. (yes-or-no-p (format "nnimap: Group %s is not uidvalid. Continue? " group))) imap-current-mailbox (imap-mailbox-unselect) - (error "nnimap: Group %s is not uid-valid." group)) + (error "nnimap: Group %s is not uid-valid" group)) (nnheader-report 'nnimap (imap-error-text))))))) (defun nnimap-replace-whitespace (string) @@ -424,12 +550,7 @@ If EXAMINE is non-nil the group is selected read-only." (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))) + (let ((head (nnheader-parse-naked-head))) (mail-header-set-number head uid) (mail-header-set-chars head chars) (mail-header-set-lines head lines) @@ -458,7 +579,7 @@ If EXAMINE is non-nil the group is selected read-only." articles)))) (defun nnimap-group-overview-filename (group server) - "Make pathname for GROUP on SERVER." + "Make file name for GROUP on SERVER." (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) (uidvalidity (gnus-group-get-parameter (gnus-group-prefixed-name @@ -538,7 +659,7 @@ If EXAMINE is non-nil the group is selected read-only." (> nnimap-length nnmail-large-newsgroup) (nnheader-message 6 "nnimap: Retrieving headers...done"))))) -(defun nnimap-use-nov-p (group server) +(defun nnimap-dont-use-nov-p (group server) (or gnus-nov-is-evil nnimap-nov-is-evil (unless (and (gnus-make-directory (file-name-directory @@ -552,7 +673,7 @@ If EXAMINE is non-nil the group is selected read-only." (when (nnimap-possibly-change-group group server) (with-current-buffer nntp-server-buffer (erase-buffer) - (if (nnimap-use-nov-p group server) + (if (nnimap-dont-use-nov-p group server) (nnimap-retrieve-headers-from-server (gnus-compress-sequence articles) group server) (let (uids cached low high) @@ -575,15 +696,15 @@ 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)) (when (buffer-modified-p) (nnmail-write-region - 1 (point-max) (nnimap-group-overview-filename group server) - nil 'nomesg)) + (point-min) (point-max) + (nnimap-group-overview-filename group server) nil 'nomesg)) (nnheader-nov-delete-outside-range low high)))) 'nov))) @@ -599,9 +720,9 @@ If EXAMINE is non-nil the group is selected read-only." (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")) + (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) @@ -627,10 +748,17 @@ 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) + (or nnimap-server-buffer + (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer 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)) + (imap-opened nnimap-server-buffer) + (if (with-current-buffer nnimap-server-buffer + (memq imap-state '(auth select examine))) + t + (imap-close nnimap-server-buffer) + (nnimap-open-connection server))) (nnimap-open-connection server)))) (deffoo nnimap-server-opened (&optional server) @@ -678,18 +806,26 @@ function is generally only called when Gnus is shutting down." 'identity) (or string ""))) -(defun nnimap-callback () - (remove-hook 'imap-fetch-data-hook 'nnimap-callback) - (with-current-buffer nnimap-callback-buffer - (insert - (with-current-buffer nnimap-server-buffer - (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-make-callback (article gnus-callback buffer) + "Return a callback function." + `(lambda () + (nnimap-callback ,article ,gnus-callback ,buffer))) + +(defun nnimap-callback (article gnus-callback buffer) + (when (eq article (imap-current-message)) + (remove-hook 'imap-fetch-data-hook + (nnimap-make-callback article gnus-callback buffer)) + (with-current-buffer buffer + (insert + (with-current-buffer nnimap-server-buffer + (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 article 'BODYDETAIL))) + (imap-message-get article 'RFC822))))) + (nnheader-ms-strip-cr) + (funcall gnus-callback t)))) (defun nnimap-request-article-part (article part prop &optional group server to-buffer detail) @@ -700,25 +836,30 @@ function is generally only called when Gnus is shutting down." nnimap-server-buffer)) article))) (when article - (gnus-message 10 "nnimap: Fetching (part of) article %d..." article) + (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..." + article (or group imap-current-mailbox + gnus-newsgroup-name)) (if (not nnheader-callback-function) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) (let ((data (imap-fetch article part prop nil nnimap-server-buffer))) (when data - (insert (if detail (nth 2 (car data)) data)) + (insert (nnimap-demule (if detail (nth 2 (car data)) data))) (nnheader-ms-strip-cr) - (gnus-message 10 - "nnimap: Fetching (part of) article %d...done" - article) + (gnus-message + 10 "nnimap: Fetching (part of) article %d from %s...done" + article (or group imap-current-mailbox gnus-newsgroup-name)) (if (bobp) - (nnheader-report 'nnimap "No such article: %s" + (nnheader-report 'nnimap "No such article %d in %s: %s" + article (or group imap-current-mailbox + gnus-newsgroup-name) (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) + (add-hook 'imap-fetch-data-hook + (nnimap-make-callback article + nnheader-callback-function + nntp-server-buffer)) (imap-fetch-asynch article part nil nnimap-server-buffer) (cons group article)))))) @@ -766,20 +907,35 @@ function is generally only called when Gnus is shutting down." (nnheader-report 'nnimap "Group %s selected" group) t))))) +(defun nnimap-update-unseen (group &optional server) + "Update the unseen count in `nnimap-mailbox-info'." + (gnus-sethash + (gnus-group-prefixed-name group server) + (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) + nnimap-mailbox-info))) + (list (nth 0 old) (nth 1 old) + (imap-mailbox-status group 'unseen nnimap-server-buffer) + (nth 3 old))) + nnimap-mailbox-info)) + (defun nnimap-close-group (group &optional server) (with-current-buffer nnimap-server-buffer (when (and (imap-opened) (nnimap-possibly-change-group group server)) + (nnimap-update-unseen group server) (case nnimap-expunge-on-close - ('always (imap-mailbox-expunge) - (imap-mailbox-close)) - ('ask (if (and (imap-search "DELETED") - (gnus-y-or-n-p (format - "Expunge articles in group `%s'? " - imap-current-mailbox))) - (progn (imap-mailbox-expunge) - (imap-mailbox-close)) - (imap-mailbox-unselect))) + (always (progn + (imap-mailbox-expunge nnimap-close-asynchronous) + (unless nnimap-dont-close + (imap-mailbox-close nnimap-close-asynchronous)))) + (ask (if (and (imap-search "DELETED") + (gnus-y-or-n-p (format "Expunge articles in group `%s'? " + imap-current-mailbox))) + (progn + (imap-mailbox-expunge nnimap-close-asynchronous) + (unless nnimap-dont-close + (imap-mailbox-close nnimap-close-asynchronous))) + (imap-mailbox-unselect))) (t (imap-mailbox-unselect))) (not imap-current-mailbox)))) @@ -806,9 +962,9 @@ function is generally only called when Gnus is shutting down." (let ((info (nnimap-find-minmax-uid mbx 'examine))) (when info (with-current-buffer nntp-server-buffer - (insert (format "\"%s\" %d %d y\n" - 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)) @@ -834,20 +990,96 @@ function is generally only called when Gnus is shutting down." ;; Optional backend functions +(defun nnimap-string-lessp-numerical (s1 s2) + "Return t if first arg string is less than second in numerical order." + (cond ((string= s1 s2) + nil) + ((> (length s1) (length s2)) + nil) + ((< (length s1) (length s2)) + t) + ((< (string-to-number (substring s1 0 1)) + (string-to-number (substring s2 0 1))) + t) + ((> (string-to-number (substring s1 0 1)) + (string-to-number (substring s2 0 1))) + nil) + (t + (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1))))) + (deffoo nnimap-retrieve-groups (groups &optional server) (when (nnimap-possibly-change-server server) (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))) - (insert (format "\"%s\" %d %d y\n" group - (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1)))))))) + (let (asyncgroups slowgroups) + (if (null nnimap-retrieve-groups-asynchronous) + (setq slowgroups groups) + (dolist (group groups) + (gnus-message 9 "nnimap: Quickly checking mailbox %s" group) + (add-to-list (if (gnus-gethash-safe + (gnus-group-prefixed-name group server) + nnimap-mailbox-info) + 'asyncgroups + 'slowgroups) + (list group (imap-mailbox-status-asynch + group '(uidvalidity uidnext unseen) + nnimap-server-buffer)))) + (dolist (asyncgroup asyncgroups) + (let ((group (nth 0 asyncgroup)) + (tag (nth 1 asyncgroup)) + new old) + (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) + (if (or (not (string= + (nth 0 (gnus-gethash (gnus-group-prefixed-name + group server) + nnimap-mailbox-info)) + (imap-mailbox-get 'uidvalidity group + nnimap-server-buffer))) + (not (string= + (nth 1 (gnus-gethash (gnus-group-prefixed-name + group server) + nnimap-mailbox-info)) + (imap-mailbox-get 'uidnext group + nnimap-server-buffer)))) + (push (list group) slowgroups) + (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name + group server) + nnimap-mailbox-info)))))))) + (dolist (group slowgroups) + (if nnimap-retrieve-groups-asynchronous + (setq group (car group))) + (gnus-message 7 "nnimap: Mailbox %s modified" group) + (imap-mailbox-put 'uidnext nil group nnimap-server-buffer) + (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group + nnimap-server-buffer)) + (let* ((info (nnimap-find-minmax-uid group 'examine)) + (str (format "\"%s\" %d %d y\n" group + (or (nth 2 info) 0) + (max 1 (or (nth 1 info) 1))))) + (when (> (or (imap-mailbox-get 'recent group + nnimap-server-buffer) 0) + 0) + (push (list (cons group 0)) nnmail-split-history)) + (insert str) + (when nnimap-retrieve-groups-asynchronous + (gnus-sethash + (gnus-group-prefixed-name group server) + (list (or (imap-mailbox-get + 'uidvalidity group nnimap-server-buffer) + (imap-mailbox-status + group 'uidvalidity nnimap-server-buffer)) + (or (imap-mailbox-get + 'uidnext group nnimap-server-buffer) + (imap-mailbox-status + group 'uidnext nnimap-server-buffer)) + (or (imap-mailbox-get + 'unseen group nnimap-server-buffer) + (imap-mailbox-status + group 'unseen nnimap-server-buffer)) + str) + nnimap-mailbox-info))))))) (gnus-message 5 "nnimap: Checking mailboxes...done") 'active)) @@ -857,7 +1089,7 @@ function is generally only called when Gnus is shutting down." (with-current-buffer nnimap-server-buffer (gnus-message 5 "nnimap: Updating info for %s..." (gnus-info-group info)) - + (when (nnimap-mark-permanent-p 'read) (let (seen unseen) ;; read info could contain articles marked unread by other @@ -881,12 +1113,13 @@ function is generally only called when Gnus is shutting down." (gnus-info-set-read info seen))) (mapcar (lambda (pred) - (when (and (nnimap-mark-permanent-p (cdr pred)) - (member (nnimap-mark-to-flag (cdr pred)) - (imap-mailbox-get 'flags))) + (when (or (eq (cdr pred) 'recent) + (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 + (gnus-update-alist-soft (cdr pred) (gnus-compress-sequence (imap-search (nnimap-mark-to-predicate (cdr pred)))) @@ -894,18 +1127,19 @@ function is generally only called when Gnus is shutting down." 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) - + (when nnimap-importantize-dormant + ;; 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 + (gnus-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)) @@ -926,11 +1160,22 @@ function is generally only called when Gnus is shutting down." (what (nth 1 action)) (cmdmarks (nth 2 action)) marks) + ;; bookmark can't be stored (not list/range + (setq cmdmarks (delq 'bookmark cmdmarks)) + ;; killed can't be stored (not list/range + (setq cmdmarks (delq 'killed cmdmarks)) + ;; unsent are for nndraft groups only + (setq cmdmarks (delq 'unsent cmdmarks)) ;; cache flags are pointless on the server (setq cmdmarks (delq 'cache cmdmarks)) - ;; flag dormant articles as ticked - (if (memq 'dormant cmdmarks) - (setq cmdmarks (cons 'tick cmdmarks))) + ;; seen flags are local to each gnus + (setq cmdmarks (delq 'seen cmdmarks)) + ;; recent marks can't be set + (setq cmdmarks (delq 'recent cmdmarks)) + (when nnimap-importantize-dormant + ;; flag dormant articles as ticked + (if (memq 'dormant cmdmarks) + (setq cmdmarks (cons 'tick cmdmarks)))) ;; remove stuff we are forbidden to store (mapcar (lambda (mark) (if (imap-message-flag-permanent-p @@ -954,7 +1199,7 @@ function is generally only called when Gnus is shutting down." nil) (defun nnimap-split-fancy () - "Like nnmail-split-fancy, but uses nnimap-split-fancy." + "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'." (let ((nnmail-split-fancy nnimap-split-fancy)) (nnmail-split-fancy))) @@ -976,7 +1221,10 @@ function is generally only called when Gnus is shutting down." (goto-char (point-min)) (when (and (if (stringp regexp) (progn - (setq regrepp (string-match "\\\\[0-9&]" group)) + (if (not (stringp group)) + (setq group (eval group)) + (setq regrepp + (string-match "\\\\[0-9&]" group))) (re-search-forward regexp nil t)) (funcall regexp group)) ;; Don't enter the article into the same group twice. @@ -987,7 +1235,7 @@ function is generally only called when Gnus is shutting down." to-groups) (or nnimap-split-crosspost (throw 'split-done to-groups)))))))))) - + (defun nnimap-assoc-match (key alist) (let (element) (while (and alist (not element)) @@ -998,9 +1246,9 @@ function is generally only called when Gnus is shutting down." (defun nnimap-split-find-rule (server inbox) (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule)) - (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) + (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) ;; extended format - (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match + (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match server nnimap-split-rule)))) nnimap-split-rule)) @@ -1020,20 +1268,39 @@ function is generally only called when Gnus is shutting down." (when (setq rule (nnimap-split-find-rule server inbox)) ;; iterate over articles (dolist (article (imap-search nnimap-split-predicate)) - (when (nnimap-request-head article) + (when (if (if (eq nnimap-split-download-body 'default) + nnimap-split-download-body-default + nnimap-split-download-body) + (and (nnimap-request-article article) + (mail-narrow-to-head)) + (nnimap-request-head article)) ;; copy article to right group(s) (setq removeorig nil) (dolist (to-group (nnimap-split-to-groups rule)) - (if (imap-message-copy (number-to-string article) - to-group nil 'nocopyuid) - (progn - (message "IMAP split moved %s:%s:%d to %s" server inbox - article to-group) - (setq removeorig t) - ;; Add the group-art list to the history list. - (push (list (cons to-group 0)) nnmail-split-history)) - (message "IMAP split failed to move %s:%s:%d to %s" server - inbox article to-group))) + (cond ((eq to-group 'junk) + (message "IMAP split removed %s:%s:%d" server inbox + article) + (setq removeorig t)) + ((imap-message-copy (number-to-string article) + to-group nil 'nocopyuid) + (message "IMAP split moved %s:%s:%d to %s" server + inbox article to-group) + (setq removeorig t) + (when nnmail-cache-accepted-message-ids + (with-current-buffer nntp-server-buffer + (let (msgid) + (and (setq msgid + (nnmail-fetch-field "message-id")) + (nnmail-cache-insert msgid to-group))))) + ;; Add the group-art list to the history list. + (push (list (cons to-group 0)) nnmail-split-history)) + (t + (message "IMAP split failed to move %s:%s:%d to %s" + server inbox article to-group)))) + (if (if (eq nnimap-split-download-body 'default) + nnimap-split-download-body-default + nnimap-split-download-body) + (widen)) ;; remove article if it was successfully copied somewhere (and removeorig (imap-message-flags-add (format "%d" article) @@ -1042,6 +1309,8 @@ function is generally only called when Gnus is shutting down." ;; todo: UID EXPUNGE (if available) to remove splitted articles (imap-mailbox-expunge) (imap-mailbox-close))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) t)))) (deffoo nnimap-request-scan (&optional group server) @@ -1056,7 +1325,7 @@ function is generally only called when Gnus is shutting down." (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 (catch 'found (dolist (mailbox (imap-mailbox-get 'list-flags mbx @@ -1072,11 +1341,13 @@ function is generally only called when Gnus is shutting down." (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" (if (> (length server) 0) " on " "") server)) t)) - + (deffoo nnimap-request-create-group (group &optional server args) (when (nnimap-possibly-change-server server) (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) - (imap-mailbox-create group nnimap-server-buffer)))) + (imap-mailbox-create group nnimap-server-buffer) + (nnheader-report 'nnimap "%S" + (imap-error-text nnimap-server-buffer))))) (defun nnimap-time-substract (time1 time2) "Return TIME for TIME1 - TIME2." @@ -1088,10 +1359,12 @@ function is generally only called when Gnus is shutting down." (defun nnimap-date-days-ago (daysago) "Return date, in format \"3-Aug-1998\", for DAYSAGO days ago." - (let ((date (format-time-string "%d-%b-%Y" - (nnimap-time-substract - (current-time) - (days-to-time daysago))))) + (let* ((time (nnimap-time-substract (current-time) (days-to-time daysago))) + (date (format-time-string + (format "%%d-%s-%%Y" + (capitalize (car (rassoc (nth 4 (decode-time time)) + parse-time-months)))) + time))) (if (eq ?0 (string-to-char date)) (substring date 1) date))) @@ -1100,36 +1373,53 @@ function is generally only called when Gnus is shutting down." (gnus-message 5 "nnimap: Marking article %d for deletion..." imap-current-message)) +(defun nnimap-expiry-target (arts group server) + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (dolist (art arts) + (nnimap-request-article art group server (current-buffer)) + ;; hints for optimization in `nnimap-request-accept-article' + (let ((nnimap-current-move-article art) + (nnimap-current-move-group group) + (nnimap-current-move-server server)) + (nnmail-expiry-target-group nnmail-expiry-target group)))) + ;; It is not clear if `nnmail-expiry-target' somehow cause the + ;; current group to be changed or not, so we make sure here. + (nnimap-possibly-change-group group server))) + ;; Notice that we don't actually delete anything, we just mark them deleted. (deffoo nnimap-request-expire-articles (articles group &optional server force) (let ((artseq (gnus-compress-sequence articles))) (when (and artseq (nnimap-possibly-change-group group server)) (with-current-buffer nnimap-server-buffer - (if force - (and (imap-message-flags-add - (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 - (imap-range-to-message-set artseq) "\\Deleted") - (setq articles nil))) - ((numberp days) - (let ((oldarts (imap-search - (format "UID %s NOT SINCE %s" - (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 - (imap-range-to-message-set - (gnus-compress-sequence oldarts)) - "\\Deleted") - (setq articles (gnus-set-difference - articles oldarts))))))))))) + (let ((days (or (and nnmail-expiry-wait-function + (funcall nnmail-expiry-wait-function group)) + nnmail-expiry-wait))) + (cond ((or force (eq days 'immediate)) + (let ((oldarts (imap-search + (concat "UID " + (imap-range-to-message-set artseq))))) + (when oldarts + (nnimap-expiry-target oldarts group server) + (when (imap-message-flags-add + (imap-range-to-message-set + (gnus-compress-sequence oldarts)) "\\Deleted") + (setq articles (gnus-set-difference + articles oldarts)))))) + ((numberp days) + (let ((oldarts (imap-search + (format nnimap-expunge-search-string + (imap-range-to-message-set artseq) + (nnimap-date-days-ago days)))) + (imap-fetch-data-hook + '(nnimap-request-expire-articles-progress))) + (when oldarts + (nnimap-expiry-target oldarts group server) + (when (imap-message-flags-add + (imap-range-to-message-set + (gnus-compress-sequence oldarts)) "\\Deleted") + (setq articles (gnus-set-difference + articles oldarts))))))))))) ;; return articles not deleted articles) @@ -1150,9 +1440,11 @@ function is generally only called when Gnus is shutting down." (setq result (eval accept-form)) (kill-buffer buf) result) - (nnimap-request-expire-articles (list article) group server t)) + (imap-message-flags-add + (imap-range-to-message-set (list article)) + "\\Deleted" 'silent nnimap-server-buffer)) result)))) - + (deffoo nnimap-request-accept-article (group &optional server last) (when (nnimap-possibly-change-server server) (let (uid) @@ -1170,13 +1462,18 @@ function is generally only called when Gnus is shutting down." ;; remove any 'From blabla' lines, some IMAP servers ;; reject the entire message otherwise. (when (looking-at "^From[^:]") - (kill-region (point) (progn (forward-line) (point)))) + (delete-region (point) (progn (forward-line) (point)))) ;; turn into rfc822 format (\r\n eol's) (while (search-forward "\n" nil t) - (replace-match "\r\n"))) - ;; this 'or' is for Cyrus server bug - (or (null (imap-current-mailbox nnimap-server-buffer)) - (imap-mailbox-unselect nnimap-server-buffer)) + (replace-match "\r\n")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group))) + (when (and last nnmail-cache-accepted-message-ids) + (nnmail-cache-close)) + ;; 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)) @@ -1197,7 +1494,7 @@ function is generally only called when Gnus is shutting down." (defun nnimap-expunge (mailbox server) (when (nnimap-possibly-change-group mailbox server) - (imap-mailbox-expunge nnimap-server-buffer))) + (imap-mailbox-expunge nil nnimap-server-buffer))) (defun nnimap-acl-get (mailbox server) (when (nnimap-possibly-change-server server) @@ -1245,12 +1542,13 @@ function is generally only called when Gnus is shutting down." (mapcar (lambda (pair) ; cdr is the mark (or (assoc (cdr pair) - '((read . "SEEN") - (tick . "FLAGGED") - (draft . "DRAFT") - (reply . "ANSWERED"))) - (cons (cdr pair) - (format "KEYWORD gnus-%s" (symbol-name (cdr pair)))))) + '((read . "SEEN") + (tick . "FLAGGED") + (draft . "DRAFT") + (recent . "RECENT") + (reply . "ANSWERED"))) + (cons (cdr pair) + (format "KEYWORD gnus-%s" (symbol-name (cdr pair)))))) (cons '(read . read) gnus-article-mark-lists))) (defun nnimap-mark-to-predicate (pred) @@ -1263,12 +1561,13 @@ to be used within a IMAP SEARCH query." (mapcar (lambda (pair) (or (assoc (cdr pair) - '((read . "\\Seen") - (tick . "\\Flagged") - (draft . "\\Draft") - (reply . "\\Answered"))) - (cons (cdr pair) - (format "gnus-%s" (symbol-name (cdr pair)))))) + '((read . "\\Seen") + (tick . "\\Flagged") + (draft . "\\Draft") + (recent . "\\Recent") + (reply . "\\Answered"))) + (cons (cdr pair) + (format "gnus-%s" (symbol-name (cdr pair)))))) (cons '(read . read) gnus-article-mark-lists))) (defun nnimap-mark-to-flag-1 (preds) @@ -1298,86 +1597,67 @@ be used in a STORE FLAGS command." "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 -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'." - (when alist - (if (equal key (caar alist)) - (cdr alist) - (setcdr alist (nnimap-remassoc key (cdr alist))) - alist))) - -(defun nnimap-update-alist-soft (key value alist) - (if value - (cons (cons key value) (nnimap-remassoc key alist)) - (nnimap-remassoc key alist))) - (when nnimap-debug (require 'trace) - (buffer-disable-undo (get-buffer-create nnimap-debug)) - (mapcar (lambda (f) (trace-function-background f nnimap-debug)) - '( - 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 - ))) + (buffer-disable-undo (get-buffer-create nnimap-debug-buffer)) + (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer)) + '( + 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 + ))) (provide 'nnimap) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 8fb0b6c..07aa565 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -1,6 +1,6 @@ ;;; nnkiboze.el --- select virtual news access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -110,10 +110,12 @@ (setq num (string-to-int (match-string 2 xref)) group (match-string 1 xref)) (or (with-current-buffer buffer - (gnus-cache-request-article num group)) + (or (and gnus-use-cache (gnus-cache-request-article num group)) + (gnus-agent-request-article num group))) (gnus-request-article num group buffer))))) (deffoo nnkiboze-request-scan (&optional group server) + (nnkiboze-possibly-change-group group) (nnkiboze-generate-group (concat "nnkiboze:" group))) (deffoo nnkiboze-request-group (group &optional server dont-check) @@ -151,7 +153,7 @@ (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)) + (let ((cur (current-buffer)) (nnheader-file-coding-system nnkiboze-file-coding-system)) (nnheader-insert-file-contents (nnkiboze-nov-file-name)) (goto-char (point-min)) @@ -229,11 +231,11 @@ Finds out what articles are to be part of the nnkiboze groups." (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 - (concat group ".newsrc")))) + (nnheader-translate-file-chars + (concat group ".newsrc")))) (nov-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".nov")))) + (nnheader-translate-file-chars + (concat group ".nov")))) method nnkiboze-newsrc gname newsrc active ginfo lowest glevel orig-info nov-buffer ;; Bind various things to nil to make group entry faster. @@ -244,113 +246,117 @@ Finds out what articles are to be part of the nnkiboze groups." (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-select-group-hook gnus-summary-prepare-hook gnus-thread-sort-functions gnus-show-threads gnus-visual gnus-suppress-duplicates num-unread) (unless info (error "No such group: %s" group)) ;; Load the kiboze newsrc file for this group. - (when (file-exists-p newsrc-file) - (load newsrc-file)) - (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"))) - (unless inhibit-list-groups - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups))) - t) + (mm-with-unibyte + (when (file-exists-p newsrc-file) + (load newsrc-file)) + (let ((coding-system-for-write nnkiboze-file-coding-system) + (output-coding-system nnkiboze-file-coding-system)) + (gnus-make-directory (file-name-directory nov-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) (cdr active)) + (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) + (setq newsrc (cdr newsrc))))) + ;; We save the kiboze newsrc for this group. + (gnus-make-directory (file-name-directory newsrc-file)) + (with-temp-file newsrc-file + (insert "(setq nnkiboze-newsrc '") + (gnus-prin1 nnkiboze-newsrc) + (insert ")\n"))) + (unless inhibit-list-groups + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-group-list-groups))) + t)) (defun nnkiboze-enter-nov (buffer header group) (save-excursion diff --git a/lisp/nnlistserv.el b/lisp/nnlistserv.el index 666cd70..1008141 100644 --- a/lisp/nnlistserv.el +++ b/lisp/nnlistserv.el @@ -24,18 +24,13 @@ ;;; Commentary: -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - ;;; Code: (eval-when-compile (require 'cl)) (require 'nnoo) -(eval-when-compile - (ignore-errors - (require 'nnweb)) ; requires W3 - (autoload 'url-insert-file-contents "nnweb")) +(require 'mm-url) +(require 'nnweb) (nnoo-declare nnlistserv nnweb) @@ -85,7 +80,7 @@ ;;; (defun nnlistserv-kk-create-mapping () - "Perform the search and create an number-to-url alist." + "Perform the search and create a number-to-url alist." (save-excursion (set-buffer nnweb-buffer) (let ((case-fold-search t) @@ -98,7 +93,7 @@ (when (funcall (nnweb-definition 'search) page) ;; Go through all the article hits on this page. (goto-char (point-min)) - (nnweb-decode-entities) + (mm-url-decode-entities) (goto-char (point-min)) (while (re-search-forward "^

  • *\\([^\\>]+\\) *<[^>]+>\\([^>]+\\)<" nil t) (setq url (match-string 1) @@ -124,7 +119,7 @@ (let ((case-fold-search t) (headers '(sent name email subject id)) sent name email subject id) - (nnweb-decode-entities) + (mm-url-decode-entities) (while headers (goto-char (point-min)) (re-search-forward (format "\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://list-archives.xemacs.org/") - (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)) - ("bbdb-ml" - (url . "http://www.rc.tutrp.tut.ac.jp/bbdb-ml/") - (groups "bbdb-ml") - (coding-system . ,(static-if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp)) - (generate-nov . nnshimbun-generate-nov-for-each-group) - (get-headers . nnshimbun-fml-get-headers) - (index-url . nnshimbun-url) - (make-contents . nnshimbun-make-fml-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.") @@ -192,58 +181,52 @@ (defvoo nnshimbun-nov-file-name ".overview") -(defvoo nnshimbun-pre-fetch-article nil - "*Non nil means that nnshimbun fetch unread articles when scanning groups.") +(defvoo nnshimbun-pre-fetch-article 'off + "*If it is neither `off' nor nil, nnshimbun fetch unread articles when +scanning groups. Note that this variable has just a default value for +all the nnshimbun groups. You can specify the nnshimbun group +parameter `prefecth-articles' for each nnshimbun group.") + +(defvoo nnshimbun-encapsulate-images shimbun-encapsulate-images + "*If it is neither `off' nor nil, inline images will be encapsulated in +the articles. Note that this variable has just a default value for +all the nnshimbun groups. You can specify the nnshimbun group +parameter `encapsulate-images' for each nnshimbun group.") + +(defvoo nnshimbun-index-range nil + "*Range of indices to detect new pages. Note that this variable has +just a default value for all the nnshimbun groups. You can specify +the nnshimbun group parameter `index-range' for each nnshimbun group.") -;; 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-shimbun 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-current-server () + '(nnoo-current-server 'nnshimbun)) +(defmacro nnshimbun-server-directory (&optional server) + `(nnmail-group-pathname ,(or server '(nnshimbun-current-server)) + nnshimbun-directory)) +(defmacro nnshimbun-current-group () + '(shimbun-current-group-internal nnshimbun-shimbun)) + +(defmacro nnshimbun-current-directory (&optional group) + `(nnmail-group-pathname ,(or group '(nnshimbun-current-group)) + (nnshimbun-server-directory))) -;;; 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-buffer + (format " *nnshimbun backlog %s*" (nnshimbun-current-server))) (gnus-backlog-articles nnshimbun-backlog-articles) (gnus-backlog-hashtb nnshimbun-backlog-hashtb)) (unwind-protect @@ -251,367 +234,349 @@ for a charset indication") (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)) - +(put 'nnshimbun-backlog 'edebug-form-spec t) + + +;;; Group parameter +(defmacro nnshimbun-find-parameter (group symbol &optional full-name-p) + "Return the value of a nnshimbun group parameter for GROUP which is +associated with SYMBOL. If FULL-NAME-P is non-nil, it treats that +GROUP has a full name." + (let ((name (if full-name-p + group + `(concat "nnshimbun+" (nnshimbun-current-server) ":" ,group)))) + (cond ((eq 'index-range (eval symbol)) + `(or (plist-get (nnshimbun-find-group-parameters ,name) + 'index-range) + nnshimbun-index-range)) + ((eq 'prefetch-articles (eval symbol)) + `(let ((val (or (plist-get (nnshimbun-find-group-parameters ,name) + 'prefetch-articles) + nnshimbun-pre-fetch-article))) + (if (eq 'off val) + nil + val))) + ((eq 'encapsulate-images (eval symbol)) + `(let ((val (or (plist-get (nnshimbun-find-group-parameters ,name) + 'encapsulate-images) + nnshimbun-encapsulate-images))) + (if (eq 'off val) + nil + val))) + ((eq 'expiry-wait (eval symbol)) + (if full-name-p + `(or (plist-get (nnshimbun-find-group-parameters ,group) + 'expiry-wait) + (gnus-group-find-parameter ,group 'expiry-wait)) + `(let ((name ,name)) + (or (plist-get (nnshimbun-find-group-parameters name) + 'expiry-wait) + (gnus-group-find-parameter name 'expiry-wait))))) + (t + `(plist-get (nnshimbun-find-group-parameters ,name) ,symbol))))) ;;; Interface Functions (nnoo-define-basics nnshimbun) +(defun nnshimbun-possibly-change-group (group &optional server) + (when (if server + (nnshimbun-open-server server) + nnshimbun-shimbun) + (or (not group) + (when (condition-case err + (shimbun-open-group nnshimbun-shimbun group) + (error + (nnheader-report 'nnshimbun "%s" (error-message-string err)))) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) + (dir (nnshimbun-current-directory group))) + (or (file-directory-p dir) + (ignore-errors + (make-directory dir) + (file-directory-p dir)) + (nnheader-report 'nnshimbun + (if (file-exists-p dir) + "Not a directory: %s" + "Couldn't create directory: %s") + dir))))))) + (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))))) + (or (nnshimbun-server-opened server) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) + (shimbun)) + (when (condition-case err + (setq shimbun + (shimbun-open server + (luna-make-entity 'shimbun-gnus-mua))) + (error + (nnheader-report 'nnshimbun "%s" (error-message-string err)))) + (nnoo-change-server 'nnshimbun server + (cons (list 'nnshimbun-shimbun shimbun) defs)) + (when (or (file-directory-p nnshimbun-directory) + (ignore-errors + (make-directory nnshimbun-directory) + (file-directory-p nnshimbun-directory)) + (progn + (nnshimbun-close-server) + (nnheader-report 'nnshimbun + (if (file-exists-p nnshimbun-directory) + "Not a directory: %s" + "Couldn't create directory: %s") + nnshimbun-directory))) + (let ((dir (nnshimbun-server-directory server))) + (when (or (file-directory-p dir) + (ignore-errors + (make-directory dir) + (file-directory-p dir)) + (progn + (nnshimbun-close-server) + (nnheader-report 'nnshimbun + (if (file-exists-p dir) + "Not a directory: %s" + "Couldn't create directory: %s") + dir))) + (nnheader-report 'nnshimbun + "Opened server %s using directory %s" + server dir) + t))))))) (deffoo nnshimbun-close-server (&optional server) - (and (nnshimbun-server-opened server) - (gnus-buffer-live-p nnshimbun-buffer) - (kill-buffer nnshimbun-buffer)) + (when (nnshimbun-server-opened server) + (when nnshimbun-shimbun + (dolist (group (shimbun-groups nnshimbun-shimbun)) + (nnshimbun-write-nov group t)) + (shimbun-close nnshimbun-shimbun))) (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))) - (eval-when-compile - (defvar w3m-work-buffer-name) - (autoload 'w3m-retrieve "w3m")) -(eval-and-compile - (if (and (ignore-errors (require 'w3m)) - (fboundp 'w3m-retrieve)) -;; When w3m.el is available. -(defun nnshimbun-retrieve-url (url &optional no-cache) - "Rertrieve URL contents and insert to current buffer." - (when (w3m-retrieve url nil no-cache) - (insert-buffer w3m-work-buffer-name))) -;; Otherwise. -(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 (and (boundp 'url-current-mime-charset) - (symbol-value '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)) + (require 'gnus-sum)) ;; For the macro `gnus-summary-article-header'. (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)) + (let* ((header (with-current-buffer (nnshimbun-open-nov group) + (and (nnheader-find-nov-line article) + (nnshimbun-parse-nov)))) + (original-id (shimbun-header-id header))) + (when header + (with-current-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))))))) + (let ((shimbun-encapsulate-images + (nnshimbun-find-parameter group 'encapsulate-images))) + (shimbun-article nnshimbun-shimbun header)) + (when (> (buffer-size) 0) + ;; Kludge! replace a date string in `gnus-newsgroup-data' + ;; based on the newly retrieved article. + (let ((x (gnus-summary-article-header article))) + (when x + ;; Trick to suppress byte compile of mail-header-set-date(), + ;; in order to keep compatibility between T-gnus and Oort Gnus. + (eval + `(mail-header-set-date ,x ,(shimbun-header-date header))))) + (nnshimbun-replace-nov-entry group article header original-id) + (nnshimbun-backlog + (gnus-backlog-enter-article group article (current-buffer))) + (nnheader-report 'nnshimbun "Article %s retrieved" + (shimbun-header-id header)) + (cons group article))))))) + +(deffoo nnshimbun-request-article (article &optional group server to-buffer) + (when (nnshimbun-possibly-change-group group server) + (if (or (integerp article) + (when (stringp article) + (setq article + (or (when (or group (setq group (nnshimbun-current-group))) + (nnshimbun-search-id group article)) + (catch 'found + (dolist (x (shimbun-groups nnshimbun-shimbun)) + (and (nnshimbun-possibly-change-group x) + (setq x (nnshimbun-search-id x article)) + (throw 'found x)))))))) + (nnshimbun-request-article-1 article group server to-buffer) + (nnheader-report 'nnshimbun "Couldn't retrieve article: %s" + (prin1-to-string article))))) (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)))))) + (if (not (nnshimbun-possibly-change-group group server)) + (nnheader-report 'nnshimbun "Invalid group (no such directory)") + (let (beg end lines) + (with-current-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 'nnshimbun "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)) + (when (nnshimbun-possibly-change-group nil server) + (if group + (nnshimbun-generate-nov-database group) + (dolist (group (shimbun-groups nnshimbun-shimbun)) + (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")))) + (when (nnshimbun-possibly-change-group nil server) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (group (shimbun-groups nnshimbun-shimbun)) + (when (nnshimbun-possibly-change-group group) + (let (beg end) + (with-current-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 (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) + (if (nnshimbun-retrieve-headers-with-nov articles group fetch-old) 'nov - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-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)))))) + (when (and (if (stringp art) + (setq art (nnshimbun-search-id group art)) + (integerp art)) + (setq header + (with-current-buffer (nnshimbun-open-nov group) + (and (nnheader-find-nov-line art) + (nnshimbun-parse-nov))))) + (insert (format "220 %d Article retrieved.\n" art)) + (shimbun-header-insert nnshimbun-shimbun 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)))))) - +(defun nnshimbun-retrieve-headers-with-nov (articles &optional group fetch-old) + (unless (or gnus-nov-is-evil nnshimbun-nov-is-evil) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (insert-buffer (nnshimbun-open-nov group)) + (unless (and fetch-old (not (numberp fetch-old))) + (nnheader-nov-delete-outside-range + (if fetch-old + (max 1 (- (car articles) fetch-old)) + (car articles)) + (nth (1- (length articles)) articles))) + t))) ;;; Nov Database Operations +(defvar nnshimbun-tmp-string nil + "Internal variable used to just a rest for a temporary string. The +macro `nnshimbun-string-or' uses it exclusively.") + +(defmacro nnshimbun-string-or (&rest strings) + "Return the first element of STRINGS that is a non-blank string. It +should run fast, especially if two strings are given. Each string can +also be nil." + (cond ((null strings) + nil) + ((= 1 (length strings)) + ;; Return irregularly nil if one blank string is given. + `(unless (zerop (length (setq nnshimbun-tmp-string ,(car strings)))) + nnshimbun-tmp-string)) + ((= 2 (length strings)) + ;; Return the second string when the first string is blank. + `(if (zerop (length (setq nnshimbun-tmp-string ,(car strings)))) + ,(cadr strings) + nnshimbun-tmp-string)) + (t + `(let ((strings (list ,@strings))) + (while strings + (setq strings (if (zerop (length (setq nnshimbun-tmp-string + (car strings)))) + (cdr strings)))) + nnshimbun-tmp-string)))) + +(autoload 'message-make-date "message") + +(defsubst nnshimbun-insert-nov (number header &optional id) + (insert "\n") + (backward-char 1) + (let ((header-id (nnshimbun-string-or (shimbun-header-id header))) + ;; Force `princ' to work in the current buffer. + (standard-output (current-buffer)) + (xref (nnshimbun-string-or (shimbun-header-xref header))) + (start (point))) + (and (stringp id) + header-id + (string-equal id header-id) + (setq id nil)) + (princ number) + (insert + "\t" + (nnshimbun-string-or (shimbun-header-subject header) "(none)") "\t" + (nnshimbun-string-or (shimbun-header-from header) "(nobody)") "\t" + (nnshimbun-string-or (shimbun-header-date header) (message-make-date)) + "\t" + (or header-id (nnmail-message-id)) "\t" + (or (shimbun-header-references header) "") "\t") + (princ (or (shimbun-header-chars header) 0)) + (insert "\t") + (princ (or (shimbun-header-lines header) 0)) + (insert "\t") + (if xref + (progn + (insert "Xref: " xref "\t") + (when id + (insert "X-Nnshimbun-Id: " id "\t"))) + (when id + (insert "\tX-Nnshimbun-Id: " id "\t"))) + ;; Replace newlines with spaces in the current NOV line. + (while (progn + (forward-line 0) + (> (point) start)) + (backward-delete-char 1) + (insert " ")) + (forward-line 1))) (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) + (when (nnshimbun-possibly-change-group group) + (with-current-buffer (nnshimbun-open-nov group) (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)) + (let* ((i (or (ignore-errors (read (current-buffer))) 0)) + (name (concat "nnshimbun+" (nnshimbun-current-server) ":" group)) + (pre-fetch (nnshimbun-find-parameter name 'prefetch-articles t))) + (dolist (header + (shimbun-headers nnshimbun-shimbun + (nnshimbun-find-parameter name + 'index-range t))) + (unless (nnshimbun-search-id group (shimbun-header-id header)) + (goto-char (point-max)) + (nnshimbun-insert-nov (setq i (1+ i)) header) + (when pre-fetch + (with-temp-buffer + (nnshimbun-request-article-1 i group nil (current-buffer))))))) + (nnshimbun-write-nov group)))) + +(defun nnshimbun-replace-nov-entry (group article header &optional id) + (with-current-buffer (nnshimbun-open-nov group) + (when (nnheader-find-nov-line article) + (delete-region (point) (progn (forward-line 1) (point))) + (nnshimbun-insert-nov article header id)))) + +(defun nnshimbun-search-id (group id) + (with-current-buffer (nnshimbun-open-nov group) (goto-char (point-min)) (let (found) (while (and (not found) @@ -624,871 +589,174 @@ for a charset indication") (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)))) + (setq id (concat "X-Nnshimbun-Id: " id)) + (while (and (not found) + (search-forward id nil t)) + (if (not (search-backward "\t" (gnus-point-at-bol) t 8)) + (forward-line 1) + (forward-line 0) + (setq found t)))) + (when found + (ignore-errors (read (current-buffer))))))) + +;; This function is defined as an alternative of `nnheader-parse-nov', +;; in order to keep compatibility between T-gnus and Oort Gnus. +(defun nnshimbun-parse-nov () + (let ((eol (gnus-point-at-eol))) + (let ((number (nnheader-nov-read-integer)) + (subject (nnheader-nov-field)) + (from (nnheader-nov-field)) + (date (nnheader-nov-field)) + (id (nnheader-nov-read-message-id)) + (refs (nnheader-nov-field)) + (chars (nnheader-nov-read-integer)) + (lines (nnheader-nov-read-integer)) + (xref (unless (eq (char-after) ?\n) + (when (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field))) + (extra (nnheader-nov-parse-extra))) + (shimbun-make-header number subject from date + (or (cdr (assq 'X-Nnshimbun-Id extra)) id) + refs chars lines xref)))) + +(defsubst nnshimbun-nov-buffer-name (&optional group) + (format " *nnshimbun overview %s %s*" + (nnshimbun-current-server) + (or group (nnshimbun-current-group)))) + +(defsubst nnshimbun-nov-file-name (&optional group) + (nnmail-group-pathname (or group (nnshimbun-current-group)) + (nnshimbun-server-directory) + nnshimbun-nov-file-name)) (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))) + (let ((buffer (nnshimbun-nov-buffer-name group))) + (unless (gnus-buffer-live-p buffer) + (with-current-buffer (gnus-get-buffer-create buffer) (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 - (append "!)-_~}]:;',.?$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7(B\ -$B!8!9!:!;!!?!@!A!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n$!$#$%$'$)(B\ -$B$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v(B" nil)) - -(defconst nnshimbun-kinsoku-eol-list - (append "({[`$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!x(B" nil)) - -(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"))) - -(defun nnshimbun-make-fml-contents (header &rest args) - (require 'mml) - (catch 'stop - (if (search-forward "" nil t) - (delete-region (point-min) (point)) - (throw 'stop nil)) - (if (search-forward "") - (progn - (beginning-of-line) - (delete-region (point) (point-max))) - (throw 'stop nil)) - (if (search-backward "") - (progn - (beginning-of-line) - (kill-line)) - (throw 'stop nil)) - (save-restriction - (narrow-to-region (point-min) (point)) - (subst-char-in-region (point-min) (point-max) ?\t ? t) - (nnweb-decode-entities) - (goto-char (point-min)) - (let (buf field value start value-beg end) - (while (and (setq start (point)) - (re-search-forward "\\(.*\\):" - nil t) - (setq field (match-string 2)) - (re-search-forward - (concat "") nil t) - (setq value-beg (point)) - (search-forward "" nil t) - (setq end (point))) - (setq value (buffer-substring value-beg - (progn (search-backward "") - (point)))) - (delete-region start end) - (cond ((string= field "Date") - (push (cons 'date value) buf)) - ((string= field "From") - (push (cons 'from value) buf)) - ((string= field "Subject") - (push (cons 'subject value) buf)) - ((string= field "Message-Id") - (push (cons 'id value) buf)) - ((string= field "References") - (push (cons 'references value) buf)) - (t - (insert (concat field ": " value "\n"))))) - (nnshimbun-nov-fix-header nnshimbun-current-group header buf) - (goto-char (point-min)) - (nnshimbun-insert-header header)) - (goto-char (point-max))) - ;; Processing body. - (save-restriction - (narrow-to-region (point) (point-max)) - (nnweb-remove-markup) - (nnweb-decode-entities))) - (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 - "^[ \t\r\f\n]*" - 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 - (format "%s%s/update/%s" nnshimbun-url nnshimbun-current-group 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))) - -;;; MLs using fml -(defun nnshimbun-fml-get-headers () - (let (headers auxs aux) - (catch 'stop - (while (re-search-forward "" nil t) - (setq auxs (append auxs (list (match-string 1))))) - (while auxs - (erase-buffer) - (nnshimbun-retrieve-url - (concat nnshimbun-url (setq aux (car auxs)) "/")) - (subst-char-in-region (point-min) (point-max) ?\t ? t) - (let (id url date subject from) - (goto-char (point-min)) - (while (re-search-forward - "

  • Article .*
    Article \\([0-9]+\\) at \\([^<]*\\) Subject: \\([^<]*\\)
    From: \\([^<]*\\)
    " - nil t) - (setq url (concat nnshimbun-url aux "/" (match-string 1)) - id (format "<%s%05d%%%s>" - aux - (string-to-number (match-string 2)) - nnshimbun-current-group) - date (match-string 3) - subject (match-string 4) - from (match-string 5)) - (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) - from date id "" 0 0 url) - headers)) - ;;(message "%s" id) - )) - (setq auxs (cdr auxs)))) - headers)) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) + (nov (nnshimbun-nov-file-name group))) + (when (file-exists-p nov) + (nnheader-insert-file-contents nov))) + (set-buffer-modified-p nil))) + buffer)) + +(defun nnshimbun-write-nov (group &optional close) + (let ((buffer (nnshimbun-nov-buffer-name group))) + (when (gnus-buffer-live-p buffer) + (with-current-buffer buffer + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) + (nov (nnshimbun-nov-file-name group))) + (when (and (buffer-modified-p) + (or (> (buffer-size) 0) + (file-exists-p nov))) + (nnmail-write-region 1 (point-max) nov nil 'nomesg) + (set-buffer-modified-p nil)))) + (when close + (kill-buffer buffer))))) + +(deffoo nnshimbun-request-expire-articles (articles group + &optional server force) + "Do expiration for the specified ARTICLES in the nnshimbun GROUP. +Notice that nnshimbun does not actually delete any articles, it just +delete the corresponding entries in the NOV database locally. The +optional fourth argument FORCE is ignored." + (when (nnshimbun-possibly-change-group group server) + (let* ((expirable (copy-sequence articles)) + (name (concat "nnshimbun+" (nnshimbun-current-server) ":" group)) + ;; If the group's parameter `expiry-wait' is non-nil, the + ;; value of the option `nnmail-expiry-wait' will be bound + ;; to that value, and the value of the option + ;; `nnmail-expiry-wait-function' will be bound to nil. See + ;; the source code of `gnus-summary-expire-articles' how + ;; does it work. If the group's parameter is not specified + ;; by user, the shimbun's default value will be used. + (expiry-wait + (or (nnshimbun-find-parameter name 'expiry-wait t) + (shimbun-article-expiration-days nnshimbun-shimbun))) + (nnmail-expiry-wait (or expiry-wait nnmail-expiry-wait)) + (nnmail-expiry-wait-function (if expiry-wait + nil + nnmail-expiry-wait-function)) + article end time) + (with-current-buffer (nnshimbun-open-nov group) + (while expirable + (setq article (pop expirable)) + (when (and (nnheader-find-nov-line article) + (setq end (gnus-point-at-eol)) + (not (= (point-max) (1+ end)))) + (setq time (and (search-forward "\t" end t) + (search-forward "\t" end t) + (search-forward "\t" end t) + (parse-time-string + (buffer-substring + (point) + (if (search-forward "\t" end t) + (1- (point)) + end))))) + (when (if (setq time (condition-case nil + (apply 'encode-time time) + (error nil))) + (nnmail-expired-article-p name time nil) + ;; Inhibit expiration if there's no parsable date + ;; and the following option is non-nil. + (not nnshimbun-keep-unparsable-dated-articles)) + (forward-line 0) + (delete-region (point) (1+ end)) + (setq articles (delq article articles))))) + (nnshimbun-write-nov group)) + articles))) + + +;;; shimbun-gnus-mua +(luna-define-class shimbun-gnus-mua (shimbun-mua) ()) + +(luna-define-method shimbun-mua-search-id ((mua shimbun-gnus-mua) id) + (nnshimbun-search-id + (shimbun-current-group-internal (shimbun-mua-shimbun-internal mua)) + id)) + + +;;; Command to create nnshimbun group +(defvar nnshimbun-server-history nil) + +;;;###autoload +(defun gnus-group-make-shimbun-group () + "Create a nnshimbun group." + (interactive) + (let* ((minibuffer-setup-hook + (append minibuffer-setup-hook '(beginning-of-line))) + (alist + (apply 'nconc + (mapcar + (lambda (d) + (and (stringp d) + (file-directory-p d) + (delq nil + (mapcar + (lambda (f) + (and (string-match "^sb-\\(.*\\)\\.el$" f) + (list (match-string 1 f)))) + (directory-files d))))) + load-path))) + (server (completing-read + "Shimbun address: " + alist nil t + (or (car nnshimbun-server-history) + (caar alist)) + 'nnshimbun-server-history)) + (groups) + (nnshimbun-pre-fetch-article)) + (if (setq groups (shimbun-groups (shimbun-open server))) + (gnus-group-make-group + (completing-read "Group name: " (mapcar 'list groups) nil t nil) + (list 'nnshimbun server)) + (error "%s" "Can't find group")))) + (provide 'nnshimbun) -;;; nnshimbun.el ends here. + +;;; nnshimbun.el ends here diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 1a9ac54..57de225 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -1,5 +1,5 @@ ;;; nnslashdot.el --- interfacing with Slashdot -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -23,9 +23,6 @@ ;;; Commentary: -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - ;;; Code: (eval-when-compile (require 'cl)) @@ -37,11 +34,7 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) -(eval-when-compile - (ignore-errors - (require 'nnweb))) -;; Report failure to find w3 at load time if appropriate. -(eval '(require 'nnweb)) +(require 'mm-url) (nnoo-declare nnslashdot) @@ -58,6 +51,12 @@ "http://slashdot.org/article.pl?sid=%s&mode=nocomment" "Where nnslashdot will fetch the article from.") +(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml" + "Where nnslashdot will fetch the stories from.") + +(defvoo nnslashdot-use-front-page nil + "Use the front page in addition to the backslash page.") + (defvoo nnslashdot-threshold -1 "The article threshold.") @@ -87,31 +86,30 @@ (nnslashdot-possibly-change-server group server) (condition-case why (unless gnus-nov-is-evil - (if nnslashdot-threaded - (nnslashdot-threaded-retrieve-headers articles group) - (nnslashdot-sane-retrieve-headers articles group))) + (nnslashdot-retrieve-headers-1 articles group)) (search-failed (nnslashdot-lose why)))) -(deffoo nnslashdot-threaded-retrieve-headers (articles group) - (let ((last (car (last articles))) - (did nil) - (start 1) - (sid (caddr (assoc group nnslashdot-groups))) - (first-comments t) - (startats '(1)) - headers article subject score from date lines parent point s) +(deffoo nnslashdot-retrieve-headers-1 (articles group) + (let* ((last (car (last articles))) + (start (if nnslashdot-threaded 1 (pop articles))) + (entry (assoc group nnslashdot-groups)) + (sid (nth 2 entry)) + (first-comments t) + headers article subject score from date lines parent point cid + s startats changed) (save-excursion (set-buffer nnslashdot-buffer) (let ((case-fold-search t)) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url - (nnslashdot-sid-strip sid)) t) + (mm-url-insert (format nnslashdot-article-url sid) t) (goto-char (point-min)) - (search-forward "Posted by ") - (when (looking-at "]+>\\([^<]+\\)") - (setq from (nnweb-decode-entities-string (match-string 1)))) - (search-forward " on ") + (if (eobp) + (error "Couldn't open connection to slashdot")) + (re-search-forward "Posted by[ \t\r\n]+") + (when (looking-at "\\(]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") + (setq from (mm-url-decode-entities-string (match-string 2)))) + (search-forward "on ") (setq date (nnslashdot-date-to-date (buffer-substring (point) (1- (search-forward "<"))))) (setq lines (/ (- (point) @@ -122,18 +120,17 @@ 1 (make-full-mail-header 1 group from date - (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>") + (concat "<" sid "%1@slashdot>") "" 0 lines nil nil)) - headers)) - (while (and (setq start (pop startats)) - (< start last)) + headers) + (setq start (if nnslashdot-threaded 2 (pop articles)))) + (while (and start (<= start last)) (setq point (goto-char (point-max))) - (nnweb-insert - (format nnslashdot-comments-url - (nnslashdot-sid-strip sid) - nnslashdot-threshold 0 start) + (mm-url-insert + (format nnslashdot-comments-url sid + nnslashdot-threshold 0 (- start 2)) t) - (when first-comments + (when (and nnslashdot-threaded first-comments) (setq first-comments nil) (goto-char (point-max)) (while (re-search-backward "startat=\\([0-9]+\\)" nil t) @@ -141,161 +138,74 @@ (unless (memq s startats) (push s startats))) (setq startats (sort startats '<))) + (setq article (if (and article (< start article)) article start)) (goto-char point) (while (re-search-forward "<\\(b\\|H4\\)>\\([^<]+\\).*score:\\([^)]+\\))" nil t) - (setq article (string-to-number (match-string 1)) + (setq cid (match-string 1) subject (match-string 3) score (match-string 5)) + (unless (assq article (nth 4 entry)) + (setcar (nthcdr 4 entry) (cons (cons article cid) (nth 4 entry))) + (setq changed t)) (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]*.*(\\([^)]+\\))") - (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 subject (mm-url-decode-entities-string subject)) + (search-forward "
    ") + (cond + ((looking-at + "by[ \t\n]+]+>\\([^<]+\\)[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))") + (goto-char (- (match-end 0) 5)) + (setq from (concat + (mm-url-decode-entities-string (match-string 1)) + " <" (match-string 3) ">"))) + ((looking-at "by[ \t\n]+]+>\\([^<(]+\\) (\\([0-9]+\\))") + (goto-char (- (match-end 0) 5)) + (setq from (concat + (mm-url-decode-entities-string (match-string 1)) + " <" (match-string 2) ">"))) + ((looking-at "by \\([^<>]*\\)[\t\n\r ]+on ") + (goto-char (- (match-end 0) 5)) + (setq from (mm-url-decode-entities-string (match-string 1)))) + (t + (setq from ""))) + (search-forward "on ") (setq date (nnslashdot-date-to-date - (buffer-substring (point) (progn (end-of-line) (point))))) - (setq lines (/ (abs (- (search-forward "\n\r") (point))))) + (setq lines (/ (abs (- (search-forward ""))) 70)) - (forward-line 4) - (setq parent - (if (looking-at ".*cid=\\([0-9]+\\)") - (match-string 1) - nil)) - (setq did t) + (if (not + (re-search-forward ".*cid=\\([0-9]+\\)\">Parent" nil t)) + (setq parent nil) + (setq parent (match-string 1)) + (when (string= parent "0") + (setq parent nil))) (push (cons - (1+ article) + article (make-full-mail-header - (1+ article) + article (concat subject " (" score ")") from date - (concat "<" (nnslashdot-sid-strip sid) "%" - (number-to-string (1+ article)) - "@slashdot>") + (concat "<" sid "%" cid "@slashdot>") (if parent - (concat "<" (nnslashdot-sid-strip sid) "%" - (number-to-string (1+ (string-to-number parent))) - "@slashdot>") + (concat "<" sid "%" parent "@slashdot>") "") 0 lines nil nil)) - headers))))) - (setq nnslashdot-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (mm-with-unibyte-current-buffer - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header))))) - 'nov)) - -(deffoo nnslashdot-sane-retrieve-headers (articles group) - (let ((last (car (last articles))) - (did nil) - (start (max (1- (car articles)) 1)) - (sid (caddr (assoc group nnslashdot-groups))) - headers article subject score from date lines parent point) - (save-excursion - (set-buffer nnslashdot-buffer) - (erase-buffer) - (when (= start 1) - (nnweb-insert (format nnslashdot-article-url - (nnslashdot-sid-strip sid)) t) - (goto-char (point-min)) - (search-forward "Posted by ") - (when (looking-at "]+>\\([^<]+\\)") - (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) - (re-search-forward - "A href=\"\\(http://slashdot.org\\)?/article"))) - (push - (cons - 1 - (make-full-mail-header - 1 group from date (concat "<" (nnslashdot-sid-strip sid) - "%1@slashdot>") - "" 0 lines nil nil)) - headers)) - (while (or (not article) - (and did - (< article last))) - (when article - (setq start (1+ article))) - (setq point (goto-char (point-max))) - (nnweb-insert - (format nnslashdot-comments-url (nnslashdot-sid-strip sid) - nnslashdot-threshold 4 start) - t) - (goto-char point) - (while (re-search-forward - "<\\(b\\|H4\\)>\\([^<]+\\).*score:\\([^)]+\\))" - nil t) - (setq article (string-to-number (match-string 1)) - 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]*.*(\\([^)]+\\))") + headers) + (while (and articles (<= (car articles) article)) + (pop articles)) + (setq article (1+ article))) + (if nnslashdot-threaded (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 - (buffer-substring (point) (progn (end-of-line) (point))))) - (setq lines (/ (abs (- (search-forward ""))) - 70)) - (forward-line 2) - (setq parent - (if (looking-at ".*cid=\\([0-9]+\\)") - (match-string 1) - nil)) - (setq did t) - (push - (cons - (1+ article) - (make-full-mail-header - (1+ article) (concat subject " (" score ")") - from date - (concat "<" (nnslashdot-sid-strip sid) "%" - (number-to-string (1+ article)) - "@slashdot>") - (if parent - (concat "<" (nnslashdot-sid-strip sid) "%" - (number-to-string (1+ (string-to-number parent))) - "@slashdot>") - "") - 0 lines nil nil)) - headers)))) - (setq nnslashdot-headers - (sort headers (lambda (s1 s2) (< (car s1) (car s2))))) + (setq start (pop startats)) + (if start (setq start (+ start 2)))) + (setq start (pop articles)))))) + (if changed (nnslashdot-write-groups)) + (setq nnslashdot-headers (sort headers 'car-less-than-car)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) @@ -326,7 +236,7 @@ (deffoo nnslashdot-request-article (article &optional group server buffer) (nnslashdot-possibly-change-server group server) - (let (contents) + (let (contents cid) (condition-case why (save-excursion (set-buffer nnslashdot-buffer) @@ -334,23 +244,32 @@ (goto-char (point-min)) (when (and (stringp article) (string-match "%\\([0-9]+\\)@" article)) - (setq article (string-to-number (match-string 1 article)))) + (setq cid (match-string 1 article)) + (let ((map (nth 4 (assoc group nnslashdot-groups)))) + (while map + (if (equal (cdar map) cid) + (setq article (caar map) + map nil) + (setq map (cdr map)))))) (when (numberp article) (if (= article 1) (progn - (re-search-forward "Posted by *<[^>]+>[^>]*<[^>]+> *on ") + (re-search-forward + "Posted by") (search-forward "
    ") (setq contents (buffer-substring (point) (progn (re-search-forward - "

    .*A href=\"\\(http://slashdot.org\\)?/article") + "\\|\\|< [ \t\r\n]*" (1- article))) + (setq cid (cdr (assq article + (nth 4 (assoc group nnslashdot-groups))))) + (search-forward (format "" cid)) (setq contents (buffer-substring - (re-search-forward "]+>") + (re-search-forward "]*>") (search-forward ""))))))) (search-failed (nnslashdot-lose why))) @@ -383,56 +302,63 @@ (deffoo nnslashdot-request-list (&optional server) (nnslashdot-possibly-change-server nil server) (let ((number 0) + (first nnslashdot-use-front-page) sid elem description articles gname) (condition-case why - ;; First we do the Ultramode to get info on all the latest groups. - (progn + ;; 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) + (mm-url-insert nnslashdot-backslash-url t) (goto-char (point-min)) + (if (eobp) + (error "Couldn't open connection to slashdot")) (while (search-forward "" nil t) (narrow-to-region (point) (search-forward "")) (goto-char (point-min)) (re-search-forward "\\([^<]+\\)") (setq description - (nnweb-decode-entities-string (match-string 1))) + (mm-url-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))) + (string-match "sid=\\([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)) + (push (list gname articles sid (current-time) nil) + nnslashdot-groups)) (goto-char (point-max)) (widen))) ;; Then do the older groups. - (while (> (- nnslashdot-group-number number) 0) + (while (or first + (> (- nnslashdot-group-number number) 0)) + (setq first nil) (mm-with-unibyte-buffer (let ((case-fold-search t)) - (nnweb-insert (format nnslashdot-active-url number) t) + (mm-url-insert (format nnslashdot-active-url number) t) (goto-char (point-min)) (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" + "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)" nil t) (setq sid (match-string 1) description - (nnweb-decode-entities-string (match-string 2))) + (mm-url-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)))) + (when (re-search-forward "with \\([0-9]+\\) comment" nil t) + (setq articles (1+ (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))))) + (push (list gname articles sid (current-time) nil) + 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) @@ -440,7 +366,7 @@ (deffoo nnslashdot-request-post (&optional server) (nnslashdot-possibly-change-server nil server) - (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) + (let ((sid (message-fetch-field "newsgroups")) (subject (message-fetch-field "subject")) (references (car (last (split-string (message-fetch-field "references"))))) @@ -475,7 +401,7 @@ (message-goto-body) (setq body (buffer-substring (point) (point-max))) (erase-buffer) - (nnweb-fetch-form + (mm-url-fetch-form "http://slashdot.org/comments.pl" `(("sid" . ,sid) ("pid" . ,pid) @@ -497,6 +423,24 @@ (setq nnslashdot-headers nil nnslashdot-groups nil)) +(deffoo nnslashdot-request-expire-articles + (articles group &optional server force) + (nnslashdot-possibly-change-server group server) + (let ((item (assoc group nnslashdot-groups))) + (when item + (if (fourth item) + (when (and (>= (length articles) (cadr item)) ;; All are expirable. + (nnmail-expired-article-p + group + (fourth item) + force)) + (setq nnslashdot-groups (delq item nnslashdot-groups)) + (nnslashdot-write-groups) + (setq articles nil)) ;; all expired. + (setcdr (cddr item) (list (current-time))) + (nnslashdot-write-groups)))) + articles) + (nnoo-define-skeleton nnslashdot) ;;; Internal functions @@ -509,18 +453,32 @@ (unless nnslashdot-groups (nnslashdot-read-groups))) +(defun nnslashdot-make-tuple (tuple n) + (prog1 + tuple + (while (> n 1) + (unless (cdr tuple) + (setcdr tuple (list nil))) + (setq tuple (cdr tuple) + n (1- n))))) + (defun nnslashdot-read-groups () (let ((file (expand-file-name "groups" nnslashdot-directory))) (when (file-exists-p file) (mm-with-unibyte-buffer (insert-file-contents file) (goto-char (point-min)) - (setq nnslashdot-groups (read (current-buffer))))))) + (setq nnslashdot-groups (read (current-buffer)))) + (if (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) + (let ((groups nnslashdot-groups)) + (while groups + (nnslashdot-make-tuple (car groups) 5) + (setq groups (cdr groups)))))))) (defun nnslashdot-write-groups () (with-temp-file (expand-file-name "groups" nnslashdot-directory) - (prin1 nnslashdot-groups (current-buffer)))) - + (gnus-prin1 nnslashdot-groups))) + (defun nnslashdot-init (server) "Initialize buffers and such." (unless (file-exists-p nnslashdot-directory) @@ -529,7 +487,8 @@ (setq nnslashdot-buffer (save-excursion (nnheader-set-temp-buffer - (format " *nnslashdot %s*" server)))))) + (format " *nnslashdot %s*" server)))) + (push nnslashdot-buffer gnus-buffers))) (defun nnslashdot-date-to-date (sdate) (condition-case err @@ -547,19 +506,13 @@ (set-buffer nntp-server-buffer) (erase-buffer) (dolist (elem nnslashdot-groups) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n")))) + (when (numberp (cadr elem)) + (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 140fe5e..d39c999 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -1,10 +1,10 @@ ;;; nnsoup.el --- SOUP access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -115,7 +115,7 @@ backend for the messages.") ;; articles in SEQUENCE come from. (while (and areas sequence) ;; Peel off areas that are below sequence. - (while (and areas (< (cdaar areas) (car sequence))) + (while (and areas (< (cdar (car areas)) (car sequence))) (setq areas (cdr areas))) (when areas ;; This is a useful area. @@ -131,7 +131,7 @@ backend for the messages.") (setq use-nov nil)) ;; We assign the portion of `sequence' that is relevant to ;; this MSG packet to this packet. - (while (and sequence (<= (car sequence) (cdaar areas))) + (while (and sequence (<= (car sequence) (cdar (car areas)))) (push (car sequence) this-area-seq) (setq sequence (cdr sequence))) (setcar useful-areas (cons (nreverse this-area-seq) @@ -159,7 +159,7 @@ backend for the messages.") (when index-buffer (insert-buffer-substring index-buffer) (goto-char b) - ;; We have to remove the index number entires and + ;; We have to remove the index number entries and ;; insert article numbers instead. (while (looking-at "[0-9]+") (replace-match (int-to-string number) t t) @@ -250,7 +250,7 @@ backend for the messages.") ;; Try to guess the type based on the first article in the group. (when (not article) (setq article - (cdaar (cddr (assoc group nnsoup-group-alist))))) + (cdar (car (cddr (assoc group nnsoup-group-alist)))))) (if (not article) 'unknown (let ((kind (gnus-soup-encoding-kind @@ -258,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) @@ -338,7 +338,7 @@ backend for the messages.") (delete-file (nnsoup-file prefix t))) t) (setcdr (cdr total-infolist) (delq info (cddr total-infolist))) - (setq articles (gnus-sorted-complement articles range-list)))) + (setq articles (gnus-sorted-difference articles range-list)))) (when (not mod-time) (setcdr (cdr total-infolist) (delq info (cddr total-infolist))))) (if (cddr total-infolist) @@ -372,7 +372,7 @@ backend for the messages.") (setq min (caaar e)) (while (cdr e) (setq e (cdr e))) - (setq max (cdaar e)) + (setq max (cdar (car e))) (setcdr entry (cons (cons min max) (cdr entry))))) (setq nnsoup-group-alist-touched t)) nnsoup-group-alist)) @@ -400,7 +400,7 @@ backend for the messages.") prefix)) (defun nnsoup-file-name (dir file) - "Return the full path of FILE (in any case) in DIR." + "Return the full name of FILE (in any case) in DIR." (let* ((case-fold-search t) (files (directory-files dir t)) (regexp (concat (regexp-quote file) "$"))) @@ -652,25 +652,25 @@ backend for the messages.") (defun nnsoup-article-to-area (article group) "Return the area that ARTICLE in GROUP is located in." (let ((areas (cddr (assoc group nnsoup-group-alist)))) - (while (and areas (< (cdaar areas) article)) + (while (and areas (< (cdar (car areas)) article)) (setq areas (cdr areas))) (and areas (car areas)))) (defvar nnsoup-old-functions - (list message-send-mail-function message-send-news-function)) + (list message-send-mail-real-function message-send-news-function)) ;;;###autoload (defun nnsoup-set-variables () "Use the SOUP methods for posting news and mailing mail." (interactive) (setq message-send-news-function 'nnsoup-request-post) - (setq message-send-mail-function 'nnsoup-request-mail)) + (setq message-send-mail-real-function 'nnsoup-request-mail)) ;;;###autoload (defun nnsoup-revert-variables () "Revert posting and mailing methods to the standard Emacs methods." (interactive) - (setq message-send-mail-function (car nnsoup-old-functions)) + (setq message-send-mail-real-function (car nnsoup-old-functions)) (setq message-send-news-function (cadr nnsoup-old-functions))) (defun nnsoup-store-reply (kind) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 9463d63..a799687 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -1,10 +1,11 @@ ;;; nnspool.el --- spool access for GNU Emacs ;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000 Free Software Foundation, Inc. +;; 2000, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen +;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -51,7 +52,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") @@ -141,9 +145,8 @@ there.") (inline (nnheader-insert-head file)) (goto-char beg) (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (insert ".\n")) + (progn (forward-char -1) + (insert ".\n")) (goto-char (point-max)) (if (bolp) (insert ".\n") @@ -329,7 +332,8 @@ there.") () (nnheader-report 'nnspool "") (set-process-sentinel proc 'nnspool-inews-sentinel) - (process-send-region proc (point-min) (point-max)) + (mm-with-unibyte-current-buffer + (process-send-region proc (point-min) (point-max))) ;; We slap a condition-case around this, because the process may ;; have exited already... (ignore-errors @@ -361,7 +365,7 @@ there.") (let ((nov (nnheader-group-pathname nnspool-current-group nnspool-nov-directory ".overview")) (arts articles) - (nnheader-file-coding-system nnspool-file-coding-system) + (nnheader-file-coding-system nnspool-file-coding-system) last) (if (not (file-exists-p nov)) () @@ -457,7 +461,7 @@ there.") (nnheader-report 'nnspool "No such newsgroup: %s" group))))) (defun nnspool-article-pathname (group &optional article) - "Find the path for GROUP." + "Find the file name for GROUP." (nnheader-group-pathname group nnspool-spool-directory article)) (provide 'nnspool) diff --git a/lisp/nntp.el b/lisp/nntp.el index 05147ed..62a6b16 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,7 +1,7 @@ ;;; nntp.el --- nntp access for Gnus + ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000 -;; Free Software Foundation, Inc. +;; 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Katsumi Yamaoka @@ -10,18 +10,18 @@ ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 2, or (at your +;; option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: @@ -101,57 +101,78 @@ You probably don't want to do that, though.") (defvoo nntp-open-connection-function 'nntp-open-network-stream "*Function used for connecting to a remote system. -It will be called with the buffer to output in. +It will be called with the buffer to output in as argument. -Two pre-made functions are `nntp-open-network-stream', which is the -default, and simply connects to some port or other on the remote -system (see nntp-port-number). The other are `nntp-open-rlogin', -which does an rlogin on the remote system, and then does a telnet to -the NNTP server available there (see nntp-rlogin-parameters) and -`nntp-open-telnet' which telnets to a remote system, logs in and does -the same.") +Currently, five such functions are provided (please refer to their +respective doc string for more information), three of them establishing +direct connections to the nntp server, and two of them using an indirect +host. -(defvoo nntp-rlogin-program "rsh" - "*Program used to log in on remote machines. -The default is \"rsh\", but \"ssh\" is a popular alternative.") +Direct connections: +- `nntp-open-network-stream' (the default), +- `nntp-open-ssl-stream', +- `nntp-open-tls-stream', +- `nntp-open-telnet-stream'. -(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-rlogin'. -That function may be used as `nntp-open-connection-function'. In that -case, this list will be used as the parameter list given to rsh.") +Indirect connections: +- `nntp-open-via-rlogin-and-telnet', +- `nntp-open-via-telnet-and-telnet'.") -(defvoo nntp-rlogin-user-name nil - "*User name on remote system when using the rlogin connect method.") +(defvoo nntp-pre-command nil + "*Pre-command to use with the various nntp-open-via-* methods. +This is where you would put \"runsocks\" or stuff like that.") -(defvoo nntp-telnet-parameters - '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-telnet'. -That function may be used as `nntp-open-connection-function'. In that -case, this list will be executed as a command after logging in -via telnet.") +(defvoo nntp-telnet-command "telnet" + "*Telnet command used to connect to the nntp server. +This command is used by the various nntp-open-via-* methods.") -(defvoo nntp-telnet-user-name nil - "User name to log in via telnet with.") +(defvoo nntp-telnet-switches '("-8") + "*Switches given to the telnet command `nntp-telnet-command'.") -(defvoo nntp-telnet-passwd nil - "Password to use to log in via telnet with.") +(defvoo nntp-end-of-line "\r\n" + "*String to use on the end of lines when talking to the NNTP server. +This is \"\\r\\n\" by default, but should be \"\\n\" when +using and indirect connection method (nntp-open-via-*).") -(defvoo nntp-open-telnet-envuser nil - "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.") +(defvoo nntp-via-rlogin-command "rsh" + "*Rlogin command used to connect to an intermediate host. +This command is used by the `nntp-open-via-rlogin-and-telnet' method. +The default is \"rsh\", but \"ssh\" is a popular alternative.") -(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?" - "*Regular expression to match the shell prompt on the remote machine.") +(defvoo nntp-via-rlogin-command-switches nil + "*Switches given to the rlogin command `nntp-via-rlogin-command'. +If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to +\(\"-C\") in order to compress all data connections, otherwise set this +to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet +command requires a pseudo-tty allocation on an intermediate host.") -(defvoo nntp-telnet-command "telnet" - "Command used to start telnet.") +(defvoo nntp-via-telnet-command "telnet" + "*Telnet command used to connect to an intermediate host. +This command is used by the `nntp-open-via-telnet-and-telnet' method.") -(defvoo nntp-telnet-switches '("-8") - "Switches given to the telnet command.") +(defvoo nntp-via-telnet-switches '("-8") + "*Switches given to the telnet command `nntp-via-telnet-command'.") -(defvoo nntp-end-of-line "\r\n" - "String to use on the end of lines when talking to the NNTP server. -This is \"\\r\\n\" by default, but should be \"\\n\" when -using rlogin or telnet to communicate with the server.") +(defvoo nntp-via-user-name nil + "*User name to log in on an intermediate host with. +This variable is used by the `nntp-open-via-telnet-and-telnet' method.") + +(defvoo nntp-via-user-password nil + "*Password to use to log in on an intermediate host with. +This variable is used by the `nntp-open-via-telnet-and-telnet' method.") + +(defvoo nntp-via-address nil + "*Address of an intermediate host to connect to. +This variable is used by the `nntp-open-via-rlogin-and-telnet' and +`nntp-open-via-telnet-and-telnet' methods.") + +(defvoo nntp-via-envuser nil + "*Whether both telnet client and server support the ENVIRON option. +If non-nil, there will be no prompt for a login name.") + +(defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?" + "*Regular expression to match the shell prompt on an intermediate host. +This variable is used by the `nntp-open-via-telnet-and-telnet' method.") (defvoo nntp-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup. @@ -214,8 +235,8 @@ 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 -inserting Cancel-Lock headers, signing with Gpg, etc.") + "*Hook run just before posting an article. It is supposed to be used +to insert Cancel-Lock headers.") ;;; Internal variables. @@ -257,9 +278,12 @@ noticing asynchronous data.") (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) -(eval-and-compile - (autoload 'mail-source-read-passwd "mail-source") - (autoload 'open-ssl-stream "ssl")) +(defvar nntp-ssl-program + "openssl s_client -quiet -ssl3 -connect %s:%p" +"A string 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.") @@ -274,7 +298,9 @@ noticing asynchronous data.") nntp-last-command string) (when nntp-record-commands (nntp-record-command string)) - (process-send-string process (concat string nntp-end-of-line))) + (process-send-string process (concat string nntp-end-of-line)) + (or (memq (process-status process) '(open run)) + (nntp-report "Server closed connection"))) (defun nntp-record-command (string) "Record the command STRING." @@ -286,6 +312,27 @@ noticing asynchronous data.") "." (format "%03d" (/ (nth 2 time) 1000)) " " nntp-address " " string "\n")))) +(defun nntp-report (&rest args) + "Report an error from the nntp backend. The first string in ARGS +can be a format string. For some commands, the failed command may be +retried once before actually displaying the error report." + + (when nntp-record-commands + (nntp-record-command "*** CALLED nntp-report ***")) + + (nnheader-report 'nntp args) + + (apply 'error args)) + +(defun nntp-report-1 (&rest args) + "Throws out to nntp-with-open-group-error so that the connection may +be restored and the command retried." + + (when nntp-record-commands + (nntp-record-command "*** CONNECTION LOST ***")) + + (throw 'nntp-with-open-group-error t)) + (defsubst nntp-wait-for (process wait-for buffer &optional decode discard) "Wait for WAIT-FOR to arrive from PROCESS." (save-excursion @@ -296,6 +343,8 @@ noticing asynchronous data.") (memq (process-status process) '(open run))) (when (looking-at "480") (nntp-handle-authinfo process)) + (when (looking-at "^.*\n") + (delete-region (point) (progn (forward-line 1) (point)))) (nntp-accept-process-output process) (goto-char (point-min))) (prog1 @@ -305,7 +354,7 @@ noticing asynchronous data.") (nntp-snarf-error-message) nil)) ((not (memq (process-status process) '(open run))) - (nnheader-report 'nntp "Server closed connection")) + (nntp-report "Server closed connection")) (t (goto-char (point-max)) (let ((limit (point-min)) @@ -317,20 +366,19 @@ noticing asynchronous data.") (setq limit (max (- (point-max) 1000) (point-min))) (goto-char (point-max))) (setq response (match-string 0)) - (save-current-buffer - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (setq nntp-process-response response))) (nntp-decode-text (not decode)) (unless discard (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) + (set-buffer buffer) + (goto-char (point-max)) + (insert-buffer-substring (process-buffer process)) ;; Nix out "nntp reading...." message. (when nntp-have-messaged (setq nntp-have-messaged nil) - (nnheader-message 5 "")) - t)))) + (nnheader-message 5 "")))) + t)) (unless discard (erase-buffer))))) @@ -370,32 +418,33 @@ noticing asynchronous data.") "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." (let ((process (or (nntp-find-connection buffer) (nntp-open-connection buffer)))) - (if (not process) - (nnheader-report 'nntp "Couldn't open connection to %s" address) - (unless (or nntp-inhibit-erase nnheader-callback-function) - (save-excursion - (set-buffer (process-buffer process)) - (erase-buffer))) - (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))))) + (if process + (progn + (unless (or nntp-inhibit-erase nnheader-callback-function) + (save-excursion + (set-buffer (process-buffer process)) + (erase-buffer))) + (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))) + (nnheader-report 'nntp "Couldn't open connection to %s" address)))) (defsubst nntp-send-command (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." @@ -404,17 +453,57 @@ noticing asynchronous data.") (save-excursion (set-buffer nntp-server-buffer) (erase-buffer))) - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) + (let* ((command (mapconcat 'identity strings " ")) + (process (nntp-find-connection nntp-server-buffer)) + (buffer (and process (process-buffer process))) + (pos (and buffer (with-current-buffer buffer (point))))) + (if process + (prog1 + (nntp-retrieve-data command + nntp-address nntp-port-number + nntp-server-buffer + wait-for nnheader-callback-function) + ;; If nothing to wait for, still remove possibly echo'ed commands. + ;; We don't have echos if nntp-open-connection-function + ;; is `nntp-open-network-stream', so we skip this in that case. + (unless (or wait-for + (equal nntp-open-connection-function + 'nntp-open-network-stream)) + (nntp-accept-response) + (save-excursion + (set-buffer buffer) + (goto-char pos) + (if (looking-at (regexp-quote command)) + (delete-region pos (progn (forward-line 1) + (gnus-point-at-bol)))) + ))) + (nnheader-report 'nntp "Couldn't open connection to %s." + nntp-address)))) (defun nntp-send-command-nodelete (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) + (let* ((command (mapconcat 'identity strings " ")) + (process (nntp-find-connection nntp-server-buffer)) + (buffer (and process (process-buffer process))) + (pos (and buffer (with-current-buffer buffer (point))))) + (if process + (prog1 + (nntp-retrieve-data command + nntp-address nntp-port-number + nntp-server-buffer + wait-for nnheader-callback-function) + ;; If nothing to wait for, still remove possibly echo'ed commands + (unless wait-for + (nntp-accept-response) + (save-excursion + (set-buffer buffer) + (goto-char pos) + (if (looking-at (regexp-quote command)) + (delete-region pos (progn (forward-line 1) + (gnus-point-at-bol)))) + ))) + (nnheader-report 'nntp "Couldn't open connection to %s." + nntp-address)))) (defun nntp-send-command-and-decode (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." @@ -423,10 +512,27 @@ noticing asynchronous data.") (save-excursion (set-buffer nntp-server-buffer) (erase-buffer))) - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function t)) + (let* ((command (mapconcat 'identity strings " ")) + (process (nntp-find-connection nntp-server-buffer)) + (buffer (and process (process-buffer process))) + (pos (and buffer (with-current-buffer buffer (point))))) + (if process + (prog1 + (nntp-retrieve-data command + nntp-address nntp-port-number + nntp-server-buffer + wait-for nnheader-callback-function t) + ;; If nothing to wait for, still remove possibly echo'ed commands + (unless wait-for + (nntp-accept-response) + (save-excursion + (set-buffer buffer) + (goto-char pos) + (if (looking-at (regexp-quote command)) + (delete-region pos (progn (forward-line 1) (gnus-point-at-bol)))) + ))) + (nnheader-report 'nntp "Couldn't open connection to %s." + nntp-address)))) (defun nntp-send-buffer (wait-for) "Send the current buffer to server and wait until WAIT-FOR returns." @@ -436,8 +542,16 @@ noticing asynchronous data.") (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) (erase-buffer))) (nntp-encode-text) - (process-send-region (nntp-find-connection nntp-server-buffer) - (point-min) (point-max)) + (let ((multibyte (and (boundp 'enable-multibyte-characters) + (symbol-value 'enable-multibyte-characters)))) + (unwind-protect + ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro. + (let (default-enable-multibyte-characters mc-flag) + ;; `set-buffer-multibyte' will be provided by APEL for all Emacsen. + (set-buffer-multibyte nil) + (process-send-region (nntp-find-connection nntp-server-buffer) + (point-min) (point-max)))) + (set-buffer-multibyte multibyte)) (nntp-retrieve-data nil nntp-address nntp-port-number nntp-server-buffer wait-for nnheader-callback-function)) @@ -466,217 +580,288 @@ noticing asynchronous data.") (t nil))) +(eval-when-compile + (defvar nntp-with-open-group-internal nil) + (defvar nntp-report-n nil)) + +(defmacro nntp-with-open-group (group server &optional connectionless &rest forms) + "Protect against servers that don't like clients that keep idle connections opens. +The problem being that these servers may either close a connection or +simply ignore any further requests on a connection. Closed +connections are not detected until accept-process-output has updated +the process-status. Dropped connections are not detected until the +connection timeouts (which may be several minutes) or +nntp-connection-timeout has expired. When these occur +nntp-with-open-group, opens a new connection then re-issues the NNTP +command whose response triggered the error." + (when (and (listp connectionless) + (not (eq connectionless nil))) + (setq forms (cons connectionless forms) + connectionless nil)) + `(letf ((nntp-report-n (symbol-function 'nntp-report)) + ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1)) + (nntp-with-open-group-internal nil)) + (while (catch 'nntp-with-open-group-error + ;; Open the connection to the server + ;; NOTE: Existing connections are NOT tested. + (nntp-possibly-change-group ,group ,server ,connectionless) + + (let ((timer + (and nntp-connection-timeout + (nnheader-run-at-time + nntp-connection-timeout nil + '(lambda () + (let ((process (nntp-find-connection + nntp-server-buffer)) + (buffer (and process + (process-buffer process)))) + ;; When I an able to identify the + ;; connection to the server AND I've + ;; received NO reponse for + ;; nntp-connection-timeout seconds. + (when (and buffer (eq 0 (buffer-size buffer))) + ;; Close the connection. Take no + ;; other action as the accept input + ;; code will handle the closed + ;; connection. + (nntp-kill-buffer buffer)))))))) + (unwind-protect + (setq nntp-with-open-group-internal + (condition-case nil + (progn ,@forms) + (quit + (nntp-close-server) + (signal 'quit nil)))) + (when timer + (nnheader-cancel-timer timer))) + nil)) + (setf (symbol-function 'nntp-report) nntp-report-n)) + nntp-with-open-group-internal)) + (deffoo nntp-retrieve-headers (articles &optional group server fetch-old) "Retrieve the headers of ARTICLES." - (nntp-possibly-change-group group server) - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - (erase-buffer) - (if (and (not gnus-nov-is-evil) - (not nntp-nov-is-evil) - (nntp-retrieve-headers-with-xover articles fetch-old)) - ;; We successfully retrieved the headers via XOVER. - 'nov - ;; XOVER didn't work, so we do it the hard, slow and inefficient - ;; way. - (let ((number (length articles)) - (count 0) - (received 0) - (last-point (point-min)) - (buf (nntp-find-connection-buffer nntp-server-buffer)) - (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)))) - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (nnheader-message 6 "NNTP: Receiving headers...done")) - - ;; Now all of replies are received. Fold continuation lines. - (nnheader-fold-continuation-lines) - ;; Remove all "\r"'s. - (nnheader-strip-cr) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'headers)))) + (nntp-with-open-group + group server + (save-excursion + (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) + (erase-buffer) + (if (and (not gnus-nov-is-evil) + (not nntp-nov-is-evil) + (nntp-retrieve-headers-with-xover articles fetch-old)) + ;; We successfully retrieved the headers via XOVER. + 'nov + ;; XOVER didn't work, so we do it the hard, slow and inefficient + ;; way. + (let ((number (length articles)) + (articles articles) + (count 0) + (received 0) + (last-point (point-min)) + (buf (nntp-find-connection-buffer nntp-server-buffer)) + (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)))) + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (nnheader-message 6 "NNTP: Receiving headers...done")) + + ;; Now all of replies are received. Fold continuation lines. + (nnheader-fold-continuation-lines) + ;; Remove all "\r"'s. + (nnheader-strip-cr) + (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + 'headers))))) (deffoo nntp-retrieve-groups (groups &optional server) "Retrieve group info on GROUPS." - (nntp-possibly-change-group nil server) - (when (nntp-find-connection-buffer nntp-server-buffer) - (save-excursion - ;; Erase nntp-server-buffer before nntp-inhibit-erase. - (set-buffer nntp-server-buffer) - (erase-buffer) - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - ;; The first time this is run, this variable is `try'. So we - ;; try. - (when (eq nntp-server-list-active-group 'try) - (nntp-try-list-active (car groups))) - (erase-buffer) - (let ((count 0) - (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. - (nntp-send-command nil command (pop groups)) - (incf count) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null groups) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (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 (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)) - - (if (not nntp-server-list-active-group) - (progn - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'group) - ;; We have read active entries, so we just delete the - ;; superfluous gunk. - (goto-char (point-min)) - (while (re-search-forward "^[.2-5]" nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'active))))) + (nntp-with-open-group + nil server + (when (nntp-find-connection-buffer nntp-server-buffer) + (catch 'done + (save-excursion + ;; Erase nntp-server-buffer before nntp-inhibit-erase. + (set-buffer nntp-server-buffer) + (erase-buffer) + (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) + ;; The first time this is run, this variable is `try'. So we + ;; try. + (when (eq nntp-server-list-active-group 'try) + (nntp-try-list-active (car groups))) + (erase-buffer) + (let ((count 0) + (groups groups) + (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 + ;; Timeout may have killed the buffer. + (unless (gnus-buffer-live-p buf) + (nnheader-report 'nntp "Connection to %s is closed." server) + (throw 'done nil)) + ;; Send the command to the server. + (nntp-send-command nil command (pop groups)) + (incf count) + ;; Every 400 requests we have to read the stream in + ;; order to avoid deadlocks. + (when (or (null groups) ;All requests have been sent. + (zerop (% count nntp-maximum-request))) + (nntp-accept-response) + (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) + (nnheader-report 'nntp "Connection to %s is closed." server) + (throw 'done nil)) + (set-buffer buf) + (goto-char (point-max)) + (re-search-backward "^[0-9]" nil t) + (when (looking-at "^[23]") + (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) + (nnheader-report 'nntp "Connection to %s is closed." server) + (throw 'done nil)) + (set-buffer buf) + (goto-char (point-min)) + (while (search-forward "\r" nil t) + (replace-match "" t t)) + + (if (not nntp-server-list-active-group) + (progn + (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + 'group) + ;; We have read active entries, so we just delete the + ;; superfluous gunk. + (goto-char (point-min)) + (while (re-search-forward "^[.2-5]" nil t) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point)))) + (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + 'active))))))) (deffoo nntp-retrieve-articles (articles &optional group server) - (nntp-possibly-change-group group server) - (save-excursion - (let ((number (length articles)) - (count 0) - (received 0) - (last-point (point-min)) - (buf (nntp-find-connection-buffer nntp-server-buffer)) - (nntp-inhibit-erase t) - (map (apply 'vector articles)) - (point 1) - article) - (set-buffer buf) - (erase-buffer) - ;; Send ARTICLE command. - (while (setq article (pop articles)) - (nntp-send-command - nil - "ARTICLE" (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) - (aset map received (cons (aref map received) (point))) - (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 articles... %d%%" - (/ (* received 100) number))) - (nntp-accept-response)))) - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (nnheader-message 6 "NNTP: Receiving articles...done")) - - ;; Now we have all the responses. We go through the results, - ;; wash it and copy it over to the server buffer. - (set-buffer nntp-server-buffer) - (erase-buffer) - (setq last-point (point-min)) - (mapcar - (lambda (entry) - (narrow-to-region - (setq point (goto-char (point-max))) - (progn - (insert-buffer-substring buf last-point (cdr entry)) - (point-max))) - (setq last-point (cdr entry)) - (nntp-decode-text) - (widen) - (cons (car entry) point)) - map)))) + (nntp-with-open-group + group server + (save-excursion + (let ((number (length articles)) + (articles articles) + (count 0) + (received 0) + (last-point (point-min)) + (buf (nntp-find-connection-buffer nntp-server-buffer)) + (nntp-inhibit-erase t) + (map (apply 'vector articles)) + (point 1) + article) + (set-buffer buf) + (erase-buffer) + ;; Send ARTICLE command. + (while (setq article (pop articles)) + (nntp-send-command + nil + "ARTICLE" (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) + (aset map received (cons (aref map received) (point))) + (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 articles... %d%%" + (/ (* received 100) number))) + (nntp-accept-response)))) + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (nnheader-message 6 "NNTP: Receiving articles...done")) + + ;; Now we have all the responses. We go through the results, + ;; wash it and copy it over to the server buffer. + (set-buffer nntp-server-buffer) + (erase-buffer) + (setq last-point (point-min)) + (mapcar + (lambda (entry) + (narrow-to-region + (setq point (goto-char (point-max))) + (progn + (insert-buffer-substring buf last-point (cdr entry)) + (point-max))) + (setq last-point (cdr entry)) + (nntp-decode-text) + (widen) + (cons (car entry) point)) + map))))) (defun nntp-try-list-active (group) (nntp-list-active-group group) @@ -691,47 +876,53 @@ noticing asynchronous data.") (deffoo nntp-list-active-group (group &optional server) "Return the active info on GROUP (which can be a regexp)." - (nntp-possibly-change-group nil server) - (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)) + (nntp-with-open-group + nil server + (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))) (deffoo nntp-request-group-articles (group &optional server) "Return the list of existing articles in GROUP." - (nntp-possibly-change-group nil server) - (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)) + (nntp-with-open-group + nil server + (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))) (deffoo nntp-request-article (article &optional group server buffer command) - (nntp-possibly-change-group group server) - (when (nntp-send-command-and-decode - "\r?\n\\.\r?\n" "ARTICLE" - (if (numberp article) (int-to-string article) article)) - (if (and buffer - (not (equal buffer nntp-server-buffer))) - (save-excursion - (set-buffer nntp-server-buffer) - (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number)) - (nntp-find-group-and-number)))) + (nntp-with-open-group + group server + (when (nntp-send-command-and-decode + "\r?\n\\.\r?\n" "ARTICLE" + (if (numberp article) (int-to-string article) article)) + (if (and buffer + (not (equal buffer nntp-server-buffer))) + (save-excursion + (set-buffer nntp-server-buffer) + (copy-to-buffer buffer (point-min) (point-max)) + (nntp-find-group-and-number group)) + (nntp-find-group-and-number group))))) (deffoo nntp-request-head (article &optional group server) - (nntp-possibly-change-group group server) - (when (nntp-send-command - "\r?\n\\.\r?\n" "HEAD" - (if (numberp article) (int-to-string article) article)) - (prog1 - (nntp-find-group-and-number) - (nntp-decode-text)))) + (nntp-with-open-group + group server + (when (nntp-send-command + "\r?\n\\.\r?\n" "HEAD" + (if (numberp article) (int-to-string article) article)) + (prog1 + (nntp-find-group-and-number group) + (nntp-decode-text))))) (deffoo nntp-request-body (article &optional group server) - (nntp-possibly-change-group group server) - (nntp-send-command-and-decode - "\r?\n\\.\r?\n" "BODY" - (if (numberp article) (int-to-string article) article))) + (nntp-with-open-group + group server + (nntp-send-command-and-decode + "\r?\n\\.\r?\n" "BODY" + (if (numberp article) (int-to-string article) article)))) (deffoo nntp-request-group (group &optional server dont-check) - (nntp-possibly-change-group nil server) - (when (nntp-send-command "^[245].*\n" "GROUP" group) - (let ((entry (nntp-find-connection-entry nntp-server-buffer))) - (setcar (cddr entry) group)))) + (nntp-with-open-group + nil server + (when (nntp-send-command "^[245].*\n" "GROUP" group) + (let ((entry (nntp-find-connection-entry nntp-server-buffer))) + (setcar (cddr entry) group))))) (deffoo nntp-close-group (group &optional server) t) @@ -794,71 +985,85 @@ 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) - (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))))) + (nntp-with-open-group + nil server + (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) - (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS")) + (nntp-with-open-group + nil server + (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))) (deffoo nntp-request-newgroups (date &optional server) - (nntp-possibly-change-group nil server) - (save-excursion - (set-buffer nntp-server-buffer) - (prog1 - (nntp-send-command - "^\\.\r?\n" "NEWGROUPS" - (format-time-string "%y%m%d %H%M%S" (date-to-time date))) - (nntp-decode-text)))) + (nntp-with-open-group + nil server + (save-excursion + (set-buffer nntp-server-buffer) + (let* ((time (date-to-time date)) + (ls (- (cadr time) (nth 8 (decode-time time))))) + (cond ((< ls 0) + (setcar time (1- (car time))) + (setcar (cdr time) (+ ls 65536))) + ((>= ls 65536) + (setcar time (1+ (car time))) + (setcar (cdr time) (- ls 65536))) + (t + (setcar (cdr time) ls))) + (prog1 + (nntp-send-command + "^\\.\r?\n" "NEWGROUPS" + (format-time-string "%y%m%d %H%M%S" time) + "GMT") + (nntp-decode-text)))))) (deffoo nntp-request-post (&optional server) - (nntp-possibly-change-group nil server) - (when (nntp-send-command "^[23].*\r?\n" "POST") - (let ((response (save-current-buffer - (set-buffer nntp-server-buffer) - nntp-process-response)) - server-id) - (when (and response - (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)" - response)) - (setq server-id (match-string 1 response)) - (narrow-to-region (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (unless (mail-fetch-field "Message-ID") - (goto-char (point-min)) - (insert "Message-ID: " server-id "\n")) - (widen)) - (run-hooks 'nntp-prepare-post-hook) - (nntp-send-buffer "^[23].*\n")))) + (nntp-with-open-group + nil server + (when (nntp-send-command "^[23].*\r?\n" "POST") + (let ((response (with-current-buffer nntp-server-buffer + nntp-process-response)) + server-id) + (when (and response + (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)" + response)) + (setq server-id (match-string 1 response)) + (narrow-to-region (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (unless (mail-fetch-field "Message-ID") + (goto-char (point-min)) + (insert "Message-ID: " server-id "\n")) + (widen)) + (run-hooks 'nntp-prepare-post-hook) + (nntp-send-buffer "^[23].*\n"))))) (deffoo nntp-request-type (group article) 'news) @@ -901,9 +1106,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the (or passwd nntp-authinfo-password (setq nntp-authinfo-password - (mail-source-read-passwd - (format "NNTP (%s@%s) password: " - user nntp-address)))))))))) + (read-passwd (format "NNTP (%s@%s) password: " + user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () "Send the AUTHINFO to the nntp server." @@ -912,8 +1116,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) (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)))))) + (read-passwd (format "NNTP (%s@%s) password: " + user nntp-address))))))) (defun nntp-send-authinfo-from-file () "Send the AUTHINFO to the nntp server. @@ -927,7 +1131,7 @@ password contained in '~/.nntp-authinfo'." (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (progn (end-of-line) (point))))))) + (buffer-substring (point) (gnus-point-at-eol)))))) ;;; Internal functions. @@ -984,8 +1188,8 @@ password contained in '~/.nntp-authinfo'." (when (and (buffer-name pbuffer) process) (process-kill-without-query process) - (nntp-wait-for process "^.*\n" buffer nil t) - (if (memq (process-status process) '(open run)) + (if (and (nntp-wait-for process "^2.*\n" buffer nil t) + (memq (process-status process) '(open run))) (prog1 (caar (push (list process buffer nil) nntp-connection-alist)) (push process nntp-connection-list) @@ -1005,11 +1209,31 @@ password contained in '~/.nntp-authinfo'." "nntpd" buffer nntp-address nntp-port-number)) (defun nntp-open-ssl-stream (buffer) - (let* ((ssl-program-arguments '("-connect" (concat host ":" service))) - (proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number))) + (let* ((process-connection-type nil) + (proc (as-binary-process + (start-process "nntpd" buffer + shell-file-name + shell-command-switch + (format-spec nntp-ssl-program + (format-spec-make + ?s nntp-address + ?p nntp-port-number)))))) + (process-kill-without-query proc) (save-excursion (set-buffer buffer) - (nntp-wait-for-string "^\r*20[01]") + (let ((nntp-connection-alist (list proc buffer nil))) + (nntp-wait-for-string "^\r*20[01]")) + (beginning-of-line) + (delete-region (point-min) (point)) + proc))) + +(defun nntp-open-tls-stream (buffer) + (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number))) + (process-kill-without-query proc) + (save-excursion + (set-buffer buffer) + (let ((nntp-connection-alist (list proc buffer nil))) + (nntp-wait-for-string "^\r*20[01]")) (beginning-of-line) (delete-region (point-min) (point)) proc))) @@ -1098,8 +1322,7 @@ password contained in '~/.nntp-authinfo'." (when (re-search-backward nntp-process-wait-for nntp-process-start-point t) (let ((response (match-string 0))) - (save-current-buffer - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (setq nntp-process-response response))) (nntp-async-stop process) ;; convert it. @@ -1134,17 +1357,24 @@ password contained in '~/.nntp-authinfo'." (nnheader-report 'nntp message) message)) -(defun nntp-accept-process-output (process &optional timeout) +(defun nntp-accept-process-output (process) "Wait for output from PROCESS and message some dots." (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) nntp-server-buffer)) - (let ((len (/ (point-max) 1024)) + (let ((len (/ (buffer-size) 1024)) message-log-max) (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) - (accept-process-output process (or timeout 1)))) + (nnheader-accept-process-output process) + ;; accept-process-output may update status of process to indicate + ;; that the server has closed the connection. This MUST be + ;; handled here as the buffer restored by the save-excursion may + ;; be the process's former output buffer (i.e. now killed) + (or (and process + (memq (process-status process) '(open run))) + (nntp-report "Server closed connection")))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." @@ -1162,13 +1392,18 @@ password contained in '~/.nntp-authinfo'." (when group (let ((entry (nntp-find-connection-entry nntp-server-buffer))) - (when (not (equal group (caddr entry))) - (save-excursion - (set-buffer (process-buffer (car entry))) - (erase-buffer) - (nntp-send-command "^[245].*\n" "GROUP" group) - (setcar (cddr entry) group) - (erase-buffer)))))) + (cond ((not entry) + (nntp-report "Server closed connection")) + ((not (equal group (caddr entry))) + (save-excursion + (set-buffer (process-buffer (car entry))) + (erase-buffer) + (nntp-send-command "^[245].*\n" "GROUP" group) + (setcar (cddr entry) group) + (erase-buffer) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer)))))))) (defun nntp-decode-text (&optional cr-only) "Decode the text in the current buffer." @@ -1252,7 +1487,8 @@ password contained in '~/.nntp-authinfo'." in-process-buffer-p (buf nntp-server-buffer) (process-buffer (nntp-find-connection-buffer nntp-server-buffer)) - first) + first + last) ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we ;; won't know that until we try. @@ -1265,17 +1501,17 @@ password contained in '~/.nntp-authinfo'." (setq articles (cdr articles))) (setq in-process-buffer-p (stringp nntp-server-xover)) - (nntp-send-xover-command first (car articles)) - (setq articles (cdr articles)) - + (nntp-send-xover-command first (setq last (car articles))) + (setq articles (cdr articles)) + (when (and nntp-server-xover in-process-buffer-p) ;; Don't count tried request. (setq count (1+ 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))) + (= 1 (% count nntp-maximum-request))) (nntp-accept-response) ;; On some Emacs versions the preceding function has a @@ -1289,27 +1525,39 @@ password contained in '~/.nntp-authinfo'." (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t) (incf received)) (setq last-point (point)) - (< received count)) + (or (< received count) + ;; I haven't started reading the final response + (progn + (goto-char (point-max)) + (forward-line -1) + (not (looking-at "^\\.\r?\n"))))) + ;; I haven't read the end of the final response (nntp-accept-response) - (set-buffer process-buffer)) - (set-buffer buf)))) + (set-buffer process-buffer)))) + + ;; Some nntp servers seem to have an extension to the XOVER + ;; extension. On these servers, requesting an article range + ;; preceeding the active range does not return an error as + ;; specified in the RFC. What we instead get is the NOV entry + ;; for the first available article. Obviously, a client can + ;; use that entry to avoid making unnecessary requests. The + ;; only problem is for a client that assumes that the response + ;; will always be within the requested ranage. For such a + ;; client, we can get N copies of the same entry (one for each + ;; XOVER command sent to the server). + + (when (<= count 1) + (goto-char (point-min)) + (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t) + (let ((low-limit (string-to-int + (buffer-substring (match-beginning 1) + (match-end 1))))) + (while (and articles (<= (car articles) low-limit)) + (setq articles (cdr articles)))))) + (set-buffer buf)) (when nntp-server-xover (when in-process-buffer-p - (set-buffer process-buffer) - ;; Wait for the reply from the final command. - (goto-char (point-max)) - (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)) - (forward-line -1) - (not (looking-at "^\\.\r?\n"))) - (nntp-accept-response) - (set-buffer process-buffer))) (set-buffer buf) (goto-char (point-max)) (insert-buffer-substring process-buffer) @@ -1362,19 +1610,114 @@ password contained in '~/.nntp-authinfo'." (set-buffer nntp-server-buffer) (erase-buffer) (setq nntp-server-xover nil))) - nntp-server-xover)))) + nntp-server-xover)))) -;;; Alternative connection methods. +(defun nntp-find-group-and-number (&optional group) + (save-excursion + (save-restriction + (set-buffer nntp-server-buffer) + (narrow-to-region (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-max))) + (goto-char (point-min)) + ;; We first find the number by looking at the status line. + (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ") + (string-to-int + (buffer-substring (match-beginning 1) + (match-end 1))))) + newsgroups xref) + (and number (zerop number) (setq number nil)) + (if number + ;; Then we find the group name. + (setq group + (cond + ;; If there is only one group in the Newsgroups + ;; header, then it seems quite likely that this + ;; article comes from that group, I'd say. + ((and (setq newsgroups + (mail-fetch-field "newsgroups")) + (not (string-match "," newsgroups))) + newsgroups) + ;; If there is more than one group in the + ;; Newsgroups header, then the Xref header should + ;; be filled out. We hazard a guess that the group + ;; that has this article number in the Xref header + ;; is the one we are looking for. This might very + ;; well be wrong if this article happens to have + ;; the same number in several groups, but that's + ;; life. + ((and (setq xref (mail-fetch-field "xref")) + number + (string-match + (format "\\([^ :]+\\):%d" number) xref)) + (match-string 1 xref)) + (t ""))) + (cond + ((and (setq xref (mail-fetch-field "xref")) + (string-match + (if group + (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)") + "\\([^ :]+\\):\\([0-9]+\\)") + xref)) + (setq group (match-string 1 xref) + number (string-to-int (match-string 2 xref)))) + ((and (setq newsgroups + (mail-fetch-field "newsgroups")) + (not (string-match "," newsgroups))) + (setq group newsgroups)) + (group) + (t (setq group "")))) + (when (string-match "\r" group) + (setq group (substring group 0 (match-beginning 0)))) + (cons group number))))) (defun nntp-wait-for-string (regexp) "Wait until string arrives in the buffer." - (let ((buf (current-buffer))) + (let ((buf (current-buffer)) + proc) (goto-char (point-min)) - (while (not (re-search-forward regexp nil t)) - (accept-process-output (nntp-find-connection nntp-server-buffer)) + (while (and (setq proc (get-buffer-process buf)) + (memq (process-status proc) '(open run)) + (not (re-search-forward regexp nil t))) + (accept-process-output proc) (set-buffer buf) (goto-char (point-min))))) + +;; ========================================================================== +;; Obsolete nntp-open-* connection methods -- drv +;; ========================================================================== + +(defvoo nntp-open-telnet-envuser nil + "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.") + +(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?" + "*Regular expression to match the shell prompt on the remote machine.") + +(defvoo nntp-rlogin-program "rsh" + "*Program used to log in on remote machines. +The default is \"rsh\", but \"ssh\" is a popular alternative.") + +(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") + "*Parameters to `nntp-open-rlogin'. +That function may be used as `nntp-open-connection-function'. In that +case, this list will be used as the parameter list given to rsh.") + +(defvoo nntp-rlogin-user-name nil + "*User name on remote system when using the rlogin connect method.") + +(defvoo nntp-telnet-parameters + '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") + "*Parameters to `nntp-open-telnet'. +That function may be used as `nntp-open-connection-function'. In that +case, this list will be executed as a command after logging in +via telnet.") + +(defvoo nntp-telnet-user-name nil + "User name to log in via telnet with.") + +(defvoo nntp-telnet-passwd nil + "Password to use to log in via telnet with.") + (defun nntp-open-telnet (buffer) (save-excursion (set-buffer buffer) @@ -1406,7 +1749,7 @@ password contained in '~/.nntp-authinfo'." proc (concat (or nntp-telnet-passwd (setq nntp-telnet-passwd - (mail-source-read-passwd "Password: "))) + (read-passwd "Password: "))) "\n")) (nntp-wait-for-string nntp-telnet-shell-prompt) (process-send-string @@ -1443,44 +1786,158 @@ password contained in '~/.nntp-authinfo'." (delete-region (point-min) (point)) proc))) -(defun nntp-find-group-and-number () - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (narrow-to-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) + +;; ========================================================================== +;; Replacements for the nntp-open-* functions -- drv +;; ========================================================================== + +(defun nntp-open-telnet-stream (buffer) + "Open a nntp connection by telnet'ing the news server. + +Please refer to the following variables to customize the connection: +- `nntp-pre-command', +- `nntp-telnet-command', +- `nntp-telnet-switches', +- `nntp-address', +- `nntp-port-number', +- `nntp-end-of-line'." + (let ((command `(,nntp-telnet-command + ,@nntp-telnet-switches + ,nntp-address ,nntp-port-number)) + proc) + (and nntp-pre-command + (push nntp-pre-command command)) + (setq proc (as-binary-process + (apply 'start-process "nntpd" buffer command))) + (save-excursion + (set-buffer buffer) + (nntp-wait-for-string "^\r*20[01]") + (beginning-of-line) + (delete-region (point-min) (point)) + proc))) + +(defun nntp-open-via-rlogin-and-telnet (buffer) + "Open a connection to an nntp server through an intermediate host. +First rlogin to the remote host, and then telnet the real news server +from there. + +Please refer to the following variables to customize the connection: +- `nntp-pre-command', +- `nntp-via-rlogin-command', +- `nntp-via-rlogin-command-switches', +- `nntp-via-user-name', +- `nntp-via-address', +- `nntp-telnet-command', +- `nntp-telnet-switches', +- `nntp-address', +- `nntp-port-number', +- `nntp-end-of-line'." + (let ((command `(,nntp-via-address + ,nntp-telnet-command + ,@nntp-telnet-switches)) + proc) + (when nntp-via-user-name + (setq command `("-l" ,nntp-via-user-name ,@command))) + (when nntp-via-rlogin-command-switches + (setq command (append nntp-via-rlogin-command-switches command))) + (push nntp-via-rlogin-command command) + (and nntp-pre-command + (push nntp-pre-command command)) + (setq proc (as-binary-process + (apply 'start-process "nntpd" buffer command))) + (save-excursion + (set-buffer buffer) + (nntp-wait-for-string "^r?telnet") + (process-send-string proc (concat "open " nntp-address + " " nntp-port-number "\n")) + (nntp-wait-for-string "^\r*20[01]") + (beginning-of-line) + (delete-region (point-min) (point)) + (process-send-string proc "\^]") + (nntp-wait-for-string "^r?telnet") + (process-send-string proc "mode character\n") + (accept-process-output proc 1) + (sit-for 1) (goto-char (point-min)) - ;; We first find the number by looking at the status line. - (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ") - (string-to-int - (buffer-substring (match-beginning 1) - (match-end 1))))) - group newsgroups xref) - (and number (zerop number) (setq number nil)) - ;; Then we find the group name. - (setq group - (cond - ;; If there is only one group in the Newsgroups header, - ;; then it seems quite likely that this article comes - ;; from that group, I'd say. - ((and (setq newsgroups (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) - newsgroups) - ;; If there is more than one group in the Newsgroups - ;; header, then the Xref header should be filled out. - ;; We hazard a guess that the group that has this - ;; article number in the Xref header is the one we are - ;; looking for. This might very well be wrong if this - ;; article happens to have the same number in several - ;; groups, but that's life. - ((and (setq xref (mail-fetch-field "xref")) - number - (string-match (format "\\([^ :]+\\):%d" number) xref)) - (substring xref (match-beginning 1) (match-end 1))) - (t ""))) - (when (string-match "\r" group) - (setq group (substring group 0 (match-beginning 0)))) - (cons group number))))) + (forward-line 1) + (delete-region (point) (point-max))) + proc)) + +(defun nntp-open-via-telnet-and-telnet (buffer) + "Open a connection to an nntp server through an intermediate host. +First telnet the remote host, and then telnet the real news server +from there. + +Please refer to the following variables to customize the connection: +- `nntp-pre-command', +- `nntp-via-telnet-command', +- `nntp-via-telnet-switches', +- `nntp-via-address', +- `nntp-via-envuser', +- `nntp-via-user-name', +- `nntp-via-user-password', +- `nntp-via-shell-prompt', +- `nntp-telnet-command', +- `nntp-telnet-switches', +- `nntp-address', +- `nntp-port-number', +- `nntp-end-of-line'." + (save-excursion + (set-buffer buffer) + (erase-buffer) + (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches)) + (case-fold-search t) + proc) + (and nntp-pre-command (push nntp-pre-command command)) + (setq proc (as-binary-process + (apply 'start-process "nntpd" buffer command))) + (when (memq (process-status proc) '(open run)) + (nntp-wait-for-string "^r?telnet") + (process-send-string proc "set escape \^X\n") + (cond + ((and nntp-via-envuser nntp-via-user-name) + (process-send-string proc (concat "open " "-l" nntp-via-user-name + nntp-via-address "\n"))) + (t + (process-send-string proc (concat "open " nntp-via-address + "\n")))) + (when (not nntp-via-envuser) + (nntp-wait-for-string "^\r*.?login:") + (process-send-string proc + (concat + (or nntp-via-user-name + (setq nntp-via-user-name + (read-string "login: "))) + "\n"))) + (nntp-wait-for-string "^\r*.?password:") + (process-send-string proc + (concat + (or nntp-via-user-password + (setq nntp-via-user-password + (read-passwd "Password: "))) + "\n")) + (nntp-wait-for-string nntp-via-shell-prompt) + (let ((real-telnet-command `("exec" + ,nntp-telnet-command + ,@nntp-telnet-switches + ,nntp-address + ,nntp-port-number))) + (process-send-string proc + (concat (mapconcat 'identity + real-telnet-command " ") + "\n"))) + (nntp-wait-for-string "^\r*20[01]") + (beginning-of-line) + (delete-region (point-min) (point)) + (process-send-string proc "\^]") + (nntp-wait-for-string "^r?telnet") + (process-send-string proc "mode character\n") + (accept-process-output proc 1) + (sit-for 1) + (goto-char (point-min)) + (forward-line 1) + (delete-region (point) (point-max))) + proc))) (provide 'nntp) diff --git a/lisp/nnultimate.el b/lisp/nnultimate.el index f4dd670..9730922 100644 --- a/lisp/nnultimate.el +++ b/lisp/nnultimate.el @@ -1,5 +1,6 @@ -;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system -*- coding: iso-latin-1 -*- -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system + +;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -37,11 +38,9 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) -(eval-when-compile - (ignore-errors - (require 'nnweb))) -;; Report failure to find w3 at load time if appropriate. -(eval '(require 'nnweb)) +(require 'mm-url) +(require 'nnweb) +(autoload 'w3-parse-buffer "w3-parse") (nnoo-declare nnultimate) @@ -57,7 +56,7 @@ (defvoo nnultimate-groups nil) (defvoo nnultimate-headers nil) (defvoo nnultimate-articles nil) -(defvar nnultimate-table-regexp +(defvar nnultimate-table-regexp "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") ;;; Interface functions @@ -81,11 +80,13 @@ "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 + inc datel table current-page total-contents pages farticles forum-contents parse furl-fetched mmap farticle) (setq map mapping) (while (and (setq article (car articles)) map) + ;; Skip past the articles in the map until we reach the + ;; article we're looking for. (while (and map (or (> article (caar map)) (< (cadar map) (caar map)))) @@ -124,31 +125,36 @@ (setq subject (nth 2 (assq (car elem) topics))) (setq href (nth 3 (assq (car elem) topics))) (if (= current-page 1) - (nnweb-insert href) + (mm-url-insert href) (string-match "\\.html$" href) - (nnweb-insert (concat (substring href 0 (match-beginning 0)) + (mm-url-insert (concat (substring href 0 (match-beginning 0)) "-" (number-to-string current-page) (match-string 0 href)))) (goto-char (point-min)) (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) - (setq pages (string-to-number (match-string 1 string))) - (setcdr table nil) - (setq table (nnultimate-find-forum-table contents))) + (goto-char (point-min)) + (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t) + (setq pages (string-to-number (match-string 1)))) (setq contents (cdr (nth 2 (car (nth 2 table))))) (setq total-contents (nconc total-contents contents)) (incf current-page)) - ;;(setq total-contents (nreverse total-contents)) - (dolist (art (cdr elem)) - (if (not (nth (1- (cdr art)) total-contents)) - () ;(debug) - (push (list (car art) - (nth (1- (cdr art)) total-contents) - subject) - nnultimate-articles))))) + (when t + (let ((i 0)) + (dolist (co total-contents) + (push (list (or (nnultimate-topic-article-to-article + group (car elem) (incf i)) + 1) + co subject) + nnultimate-articles)))) + (when nil + (dolist (art (cdr elem)) + (when (nth (1- (cdr art)) total-contents) + (push (list (car art) + (nth (1- (cdr art)) total-contents) + subject) + nnultimate-articles)))))) (setq nnultimate-articles (sort nnultimate-articles 'car-less-than-car)) ;; Now we have all the articles, conveniently in an alist @@ -166,17 +172,26 @@ (setq date (substring (car datel) (match-end 0)) datel nil)) (pop datel)) - (setq date (delete "" (split-string date "[- \n\t\r    ]"))) - (if (or (member "AM" date) - (member "PM" date)) - (setq date (format "%s %s %s %s" - (car (rassq (string-to-number (nth 0 date)) - parse-time-months)) - (nth 1 date) (nth 2 date) (nth 3 date))) - (setq date (format "%s %s %s %s" - (car (rassq (string-to-number (nth 1 date)) - parse-time-months)) - (nth 0 date) (nth 2 date) (nth 3 date)))) + (when date + (setq date (delete "" (split-string date "[-, \n\t\r    ]"))) + (setq date + (if (or (member "AM" date) + (member "PM" date)) + (format + "%s %s %s %s" + (nth 1 date) + (if (and (>= (length (nth 0 date)) 3) + (assoc (downcase + (substring (nth 0 date) 0 3)) + parse-time-months)) + (substring (nth 0 date) 0 3) + (car (rassq (string-to-number (nth 0 date)) + parse-time-months))) + (nth 2 date) (nth 3 date)) + (format "%s %s %s %s" + (car (rassq (string-to-number (nth 1 date)) + parse-time-months)) + (nth 0 date) (nth 2 date) (nth 3 date))))) (push (cons article @@ -185,7 +200,7 @@ from (or date "") (concat "<" (number-to-string sid) "%" (number-to-string article) - "@ultimate>") + "@ultimate." server ">") "" 0 (/ (length (mapconcat 'identity @@ -204,6 +219,16 @@ (nnheader-insert-nov (cdr header)))))) 'nov))) +(defun nnultimate-topic-article-to-article (group topic article) + (catch 'found + (dolist (elem (nth 5 (assoc group nnultimate-groups))) + (when (and (= topic (nth 2 elem)) + (>= article (nth 3 elem)) + (< article (+ (- (nth 1 elem) (nth 0 elem)) 1 + (nth 3 elem)))) + (throw 'found + (+ (nth 0 elem) (- article (nth 3 elem)))))))) + (deffoo nnultimate-request-group (group &optional server dont-check) (nnultimate-possibly-change-server nil server) (when (not nnultimate-groups) @@ -244,7 +269,7 @@ (deffoo nnultimate-request-list (&optional server) (nnultimate-possibly-change-server nil server) (mm-with-unibyte-buffer - (nnweb-insert + (mm-url-insert (if (string-match "/$" nnultimate-address) (concat nnultimate-address "Ultimate.cgi") nnultimate-address)) @@ -309,7 +334,7 @@ (mm-with-unibyte-buffer (while furls (erase-buffer) - (nnweb-insert (pop furls)) + (mm-url-insert (pop furls)) (goto-char (point-min)) (setq parse (w3-parse-buffer (current-buffer))) (setq contents @@ -408,7 +433,7 @@ nnultimate-groups-alist) (with-temp-file (expand-file-name "groups" nnultimate-directory) (prin1 nnultimate-groups-alist (current-buffer)))) - + (defun nnultimate-init (server) "Initialize buffers and such." (unless (file-exists-p nnultimate-directory) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index e1f43a0..76a4670 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,10 +1,10 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: David Moore ;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. @@ -46,13 +46,13 @@ (nnoo-declare nnvirtual) (defvoo nnvirtual-always-rescan t - "*If non-nil, always scan groups for unread articles when entering a group. + "If non-nil, always scan groups for unread articles when entering a group. If this variable is nil and you read articles in a component group after the virtual group has been activated, the read articles from the component group will show up when you enter the virtual group.") (defvoo nnvirtual-component-regexp nil - "*Regexp to match component groups.") + "Regexp to match component groups.") (defvoo nnvirtual-component-groups nil "Component group in this nnvirtual group.") @@ -363,7 +363,7 @@ component group will show up when you enter the virtual group.") (gnus-request-post (gnus-find-method-for-group group))))) -(deffoo nnvirtual-request-expire-articles (articles group +(deffoo nnvirtual-request-expire-articles (articles group &optional server force) (nnvirtual-possibly-change-server server) (setq nnvirtual-component-groups @@ -377,7 +377,7 @@ component group will show up when you enter the virtual group.") group article)) (gnus-uncompress-range (gnus-group-expire-articles-1 group)))))) - (sort unexpired '<))) + (sort (delq nil unexpired) '<))) ;;; Internal functions. @@ -427,7 +427,7 @@ component group will show up when you enter the virtual group.") (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") nil t) (replace-match "" t t)) - (unless (= (point) (point-max)) + (unless (eobp) (insert " ") (when (not (string= "" prefix)) (while (re-search-forward "[^ ]+:[0-9]+" nil t) @@ -522,14 +522,15 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;;; We map between virtual articles and real articles in a manner -;;; which keeps the size of the virtual active list the same as -;;; the sum of the component active lists. -;;; To achieve fair mixing of the groups, the last article in -;;; each of N component groups will be in the the last N articles -;;; in the virtual group. - -;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7 -;;; resprectively, then the virtual article numbers look like: +;;; which keeps the size of the virtual active list the same as the +;;; sum of the component active lists. + +;;; To achieve fair mixing of the groups, the last article in each of +;;; N component groups will be in the last N articles in the virtual +;;; group. + +;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and +;;; 6-7 respectively, then the virtual article numbers look like: ;;; ;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7 diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el index 5103b55..57f31e9 100644 --- a/lisp/nnwarchive.el +++ b/lisp/nnwarchive.el @@ -1,5 +1,5 @@ ;;; nnwarchive.el --- interfacing with web archives -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: news egroups mail-archive @@ -24,9 +24,9 @@ ;;; Commentary: ;; Note: You need to have `url' (w3 0.46) or greater version -;; installed for this backend to work. +;; installed for some functions of this backend to work. -;; Todo: +;; Todo: ;; 1. To support more web archives. ;; 2. Generalize webmail to other MHonArc archive. @@ -41,39 +41,27 @@ (require 'gnus-bcklg) (require 'nnmail) (require 'mm-util) -(require 'mail-source) -(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) - (require 'nnweb))) +(require 'mm-url) (nnoo-declare nnwarchive) (defvar nnwarchive-type-definition '((egroups (address . "www.egroups.com") - (open-url - "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" + (open-url + "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" nnwarchive-login nnwarchive-passwd) - (list-url + (list-url "http://www.egroups.com/mygroups") (list-dissect . nnwarchive-egroups-list) (list-groups . nnwarchive-egroups-list-groups) - (xover-url + (xover-url "http://www.egroups.com/messages/%s/%d" group aux) - (xover-last-url + (xover-last-url "http://www.egroups.com/messages/%s/" group) (xover-page-size . 13) (xover-dissect . nnwarchive-egroups-xover) - (article-url + (article-url "http://www.egroups.com/message/%s/%d?source=1" group article) (article-dissect . nnwarchive-egroups-article) (authentication . t) @@ -82,17 +70,17 @@ (mail-archive (address . "www.mail-archive.com") (open-url) - (list-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 + (xover-url "http://www.mail-archive.com/%s/mail%d.html" group aux) - (xover-last-url + (xover-last-url "http://www.mail-archive.com/%s/maillist.html" group) (xover-page-size) (xover-dissect . nnwarchive-mail-archive-xover) - (article-url + (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) @@ -105,7 +93,7 @@ "Where nnwarchive will save its files.") (defvoo nnwarchive-type nil - "The type of nnwarchive.") + "The type of nnwarchive.") (defvoo nnwarchive-address "" "The address of nnwarchive.") @@ -163,12 +151,12 @@ (let ((defs (cdr (assq type nnwarchive-type-definition))) def) (dolist (def defs) - (set (intern (concat "nnwarchive-" (symbol-name (car def)))) + (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 + (gnus-backlog-buffer (format " *nnwarchive backlog %s*" nnwarchive-address)) (gnus-backlog-articles nnwarchive-backlog-articles) (gnus-backlog-hashtb nnwarchive-backlog-hashtb)) @@ -183,10 +171,10 @@ (nnwarchive-backlog (gnus-backlog-enter-article group number buffer))) -(defun nnwarchive-get-article (article &optional group server buffer) +(defun nnwarchive-get-article (article &optional group server buffer) (if (numberp article) (if (nnwarchive-backlog - (gnus-backlog-request-article group article + (gnus-backlog-request-article group article (or buffer nntp-server-buffer))) (cons group article) (let (contents) @@ -234,9 +222,9 @@ (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) @@ -293,12 +281,12 @@ (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: " + (read-passwd + (format "Password for %s at %s: " nnwarchive-login server))))) (unless nnwarchive-groups (nnwarchive-read-groups)) @@ -322,7 +310,7 @@ (nnwarchive-open-server server))) (defun nnwarchive-read-groups () - (let ((file (expand-file-name (concat "groups-" nnwarchive-address) + (let ((file (expand-file-name (concat "groups-" nnwarchive-address) nnwarchive-directory))) (when (file-exists-p file) (with-temp-buffer @@ -331,14 +319,14 @@ (setq nnwarchive-groups (read (current-buffer))))))) (defun nnwarchive-write-groups () - (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address) + (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address) nnwarchive-directory) (prin1 nnwarchive-groups (current-buffer)))) (defun nnwarchive-init (server) "Initialize buffers and such." (let ((type (intern server)) (defs nnwarchive-type-definition) def) - (cond + (cond ((equal server "") (setq type nnwarchive-default-type)) ((assq type nnwarchive-type-definition) t) @@ -360,23 +348,6 @@ (format " *nnwarchive %s %s*" nnwarchive-type server))))) (nnwarchive-set-default nnwarchive-type)) -(defun nnwarchive-encode-www-form-urlencoded (pairs) - "Return PAIRS encoded for forms." - (mapconcat - (function - (lambda (data) - (concat (w3-form-encode-xwfu (car data)) "=" - (w3-form-encode-xwfu (cdr data))))) - pairs "&")) - -(defun nnwarchive-fetch-form (url pairs) - (let ((url-request-data (nnwarchive-encode-www-form-urlencoded pairs)) - (url-request-method "POST") - (url-request-extra-headers - '(("Content-type" . "application/x-www-form-urlencoded")))) - (nnweb-insert url)) - t) - (defun nnwarchive-eval (expr) (cond ((consp expr) @@ -388,15 +359,15 @@ (defun nnwarchive-url (xurl) (mm-with-unibyte-current-buffer - (let ((url-confirmation-func 'identity) + (let ((url-confirmation-func 'identity) ;; Some hacks. (url-cookie-multiple-line nil)) - (cond + (cond ((eq (car xurl) 'post) (pop xurl) - (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) + (mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) (t - (nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))) - + (mm-url-insert (apply 'format (nnwarchive-eval xurl)))))))) + (defun nnwarchive-generate-active () (save-excursion (set-buffer nntp-server-buffer) @@ -420,12 +391,12 @@ (save-excursion (let (articles) (set-buffer nnwarchive-buffer) - (dolist (group groups) + (dolist (group groups) (erase-buffer) (nnwarchive-url nnwarchive-xover-last-url) (goto-char (point-min)) (when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*" nil t) - (setq articles (string-to-number (match-string 1)))) + (setq articles (string-to-number (match-string 1)))) (let ((elem (assoc group nnwarchive-groups))) (if elem (setcar (cdr elem) articles) @@ -441,7 +412,7 @@ (let ((case-fold-search t) group description elem articles) (goto-char (point-min)) - (while + (while (re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t) (setq group (match-string 1) description (match-string 2)) @@ -469,12 +440,12 @@ (push (cons article (make-full-mail-header - article - (nnweb-decode-entities-string subject) - (nnweb-decode-entities-string from) + article + (mm-url-decode-entities-string subject) + (mm-url-decode-entities-string from) date (concat "<" group "%" - (number-to-string article) + (number-to-string article) "@egroup.com>") "" 0 0 "")) nnwarchive-headers)))) @@ -490,7 +461,7 @@ (goto-char (point-min)) (while (re-search-forward "]+>\\([^<]+\\)" nil t) (replace-match "\\1")) - (nnweb-decode-entities) + (mm-url-decode-entities) (buffer-string)) (defun nnwarchive-egroups-xover-files (group articles) @@ -523,7 +494,7 @@ (let ((elem (assoc group nnwarchive-headers-cache))) (if elem (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) + (push (cons group nnwarchive-headers) nnwarchive-headers-cache))))))) (defun nnwarchive-mail-archive-list () @@ -550,7 +521,7 @@ subject (match-string 2)) (forward-line 1) (unless (assq article nnwarchive-headers) - (if (looking-at "